*DECK GRAD
      SUBROUTINE GRAD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* compute gradients of system characteristics.
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): A. Hebert
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): creation or modification type(L_OPTIMIZE);
*         HENTRY(2): read-only type(L_FLUX);
*         HENTRY(3): read-only type(L_GPT).
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40)
      TYPE(C_PTR) IPFLX,IPGPT,IPGRAD
      CHARACTER HSIGN*12,TEXT4*4,TEXT12*12,TEXT16*16
      INTEGER ISTATE(NSTATE)
      DOUBLE PRECISION DFLOTT
      LOGICAL LBACK
      REAL NORX,OPTPRR(NSTATE)
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IREL
      REAL, ALLOCATABLE, DIMENSION(:) :: VARV,CSTV,RHS,CSTV0,VARV0,
     1 DERIV,DERIV0,WEIGH
*----
*  PARAMETER VALIDATION.
*----
      IF(NENTRY.NE.3) CALL XABORT('GRAD: THREE PARAMETERS EXPECTED.')
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('GRAD: LCM'
     1 //' OBJECT EXPECTED AT LHS.')
      IF(JENTRY(1).EQ.2) CALL XABORT('GRAD: OPTIMIZE ENTRY IN CREATE O'
     1 //'R MODIFICATION MODE EXPECTED.')
      DO I=2,NENTRY
         TEXT12=HENTRY(I)
         IF((JENTRY(I).NE.2).OR.((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)))
     1   CALL XABORT('GRAD: LCM OBJECT IN READ-ONLY MODE EXPECTED AT R'
     2   //'HS ('//TEXT12//').')
      ENDDO
      IPGRAD=KENTRY(1)
*----
*  RECOVER THE ACTUAL FLUX SOLUTION AND CORRESPONDING TRACKING.
*----
      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,1,HSIGN)
      IF(HSIGN.NE.'L_FLUX') THEN
         TEXT12=HENTRY(2)
         CALL XABORT('GRAD: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_FLUX EXPECTED.')
      ENDIF
      IPFLX=KENTRY(2)
      CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
      ITYPE=ISTATE(3)
      NGPT=ISTATE(5)
      IF(NGPT.EQ.0)  CALL XABORT('GRAD: MISSING FIXED-SOURCE EIGENVALU'
     1 //'E SOLUTION')
      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,1,HSIGN)
      IF(HSIGN.NE.'L_GPT') THEN
         TEXT12=HENTRY(3)
         CALL XABORT('GRAD: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_GPT EXPECTED.')
      ENDIF
      IPGPT=KENTRY(3)
      CALL LCMGET(IPGPT,'STATE-VECTOR',ISTATE)
      ND=ISTATE(3)
      NA=ISTATE(4)
*----
*  COMPUTE THE NUMBER OF CONSTRAINTS AND OF CONTROL VARIABLES
*----
      IF(ITYPE.EQ.100) THEN
        IF(IPRINT.GT.0) WRITE(6,'(/25H GRAD: EXPLICIT APPROACH.)')
        NVAR=NGPT
        NCST=NA-1
      ELSE IF(ITYPE.EQ.1000) THEN
        IF(IPRINT.GT.0) WRITE(6,'(/25H GRAD: IMPLICIT APPROACH.)')
        NVAR=ND
        NCST=NGPT-1
      ELSE
        CALL XABORT('GRAD: INVALID FLUX OBJECT')
      ENDIF
*----
*  READ INPUT PARAMETERS
*----
      IPRINT=1
      IOPT=1
      ICONV=0
      IEXT=1
      IEDSTP=2
      IMETH=2
      ISTEP=0
      SR=1.0
      EPS1=0.1
      EPS2=1.0E-4
      EPS3=1.0E-4
      EPS4=1.0E-4
      IF(JENTRY(1).EQ.0) THEN
        HSIGN='L_OPTIMIZE'
        CALL LCMPTC(IPGRAD,'SIGNATURE',12,1,HSIGN)
      ELSE IF (JENTRY(1).EQ.1) THEN
        CALL LCMGTC(IPGRAD,'SIGNATURE',12,1,HSIGN)
        IF(HSIGN.NE.'L_OPTIMIZE') THEN
           TEXT12=HENTRY(3)
           CALL XABORT('GRAD: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1     '. L_OPTIMIZE EXPECTED.')
        ENDIF
        CALL LCMGET(IPGRAD,'STATE-VECTOR',ISTATE)
        NVAR=ISTATE(1)
        NCST=ISTATE(2)
        IOPT=ISTATE(3)
        ICONV=ISTATE(4)
        IEXT=ISTATE(5)+1
        IEDSTP=ISTATE(6)
        IMETH=ISTATE(9)
        ISTEP=ISTATE(10)
        CALL LCMGET(IPGRAD,'OPT-PARAM-R',OPTPRR)
        SR=OPTPRR(1)
        EPS1=OPTPRR(2)
        EPS2=OPTPRR(3)
        EPS3=OPTPRR(4)
        EPS4=OPTPRR(5)
      ENDIF
   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
      IF(INDIC.EQ.10) GO TO 20
      IF(INDIC.NE.3) CALL XABORT('GRAD: CHARACTER DATA EXPECTED(1)')
      IF(TEXT12(:4).EQ.'EDIT') THEN
        CALL REDGET(INDIC,IPRINT,FLOTT,TEXT12,DFLOTT)
        IF(INDIC.NE.1) CALL XABORT('GRAD: INTEGER DATA EXPECTED FOR IP'
     1  //'RINT')
      ELSE IF(TEXT12.EQ.'METHOD') THEN
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('GRAD: CHARACTER DATA EXPECTED(2)')
         IF(TEXT12.EQ.'SIMPLEX') THEN
            IMETH=1
         ELSEIF(TEXT12.EQ.'LEMKE') THEN
            IMETH=2
         ELSEIF(TEXT12.EQ.'MAP') THEN
            IMETH=3
         ELSEIF(TEXT12.EQ.'AUG-LAGRANG') THEN
            IMETH=4
         ELSEIF(TEXT12.EQ.'PENAL-METH') THEN
            IMETH=5
         ELSE
            CALL XABORT('GRAD: WRONG METHOD KEYWORD')
         ENDIF
      ELSE IF(TEXT12.EQ.'OUT-STEP-LIM') THEN
         CALL REDGET(INDIC,NITMA,SR,TEXT12,DFLOTT)
         IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(1)')
      ELSE IF(TEXT12.EQ.'OUT-STEP-EPS') THEN
         CALL REDGET(INDIC,NITMA,EPS2,TEXT12,DFLOTT)
         IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(3)')
      ELSE IF(TEXT12.EQ.'INN-STEP-EPS') THEN
         CALL REDGET(INDIC,NITMA,EPS3,TEXT12,DFLOTT)
         IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(4)')
      ELSE IF(TEXT12.EQ.'CST-QUAD-EPS') THEN
         CALL REDGET(INDIC,NITMA,EPS4,TEXT12,DFLOTT)
         IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(5)')
      ELSE IF(TEXT12(:8).EQ.'MINIMIZE') THEN
        IOPT=1
      ELSE IF(TEXT12(:8).EQ.'MAXIMIZE') THEN
        IOPT=-1
      ELSE IF(TEXT12.EQ.'STEP-REDUCT') THEN
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF(ITYP.NE.3) CALL XABORT('GRAD: CHARACTER DATA EXPECTED')
         IF(TEXT12.EQ.'HALF') THEN
            IEDSTP=1
         ELSE IF(TEXT12.EQ.'PARABOLIC') THEN
            IEDSTP=2
         ELSE
            CALL XABORT('GRAD: WRONG STEP REDUCTION KEYWORD')
         ENDIF
      ELSE IF((TEXT12(:9).EQ.'VAR-VALUE').OR.
     1        (TEXT12(:10).EQ.'VAR-WEIGHT')) THEN
        ALLOCATE(VARV(NVAR))
        DO IVAR=1,NVAR
          CALL REDGET(INDIC,NITMA,VARV(IVAR),TEXT4,DFLOTT)
          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(6)')
        ENDDO
        CALL LCMPUT(IPGRAD,TEXT12,NVAR,2,VARV)
        DEALLOCATE(VARV)
      ELSE IF((TEXT12(:11).EQ.'VAR-VAL-MIN').OR.
     1        (TEXT12(:11).EQ.'VAR-VAL-MAX')) THEN
        ALLOCATE(VARV(NVAR))
        CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
        IF(INDIC.EQ.2) THEN
          VARV=FLOTT
          DO IVAR=2,NVAR
            CALL REDGET(INDIC,NITMA,VARV(IVAR),TEXT4,DFLOTT)
            IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(7)')
          ENDDO
        ELSE IF((INDIC.EQ.3).AND.(TEXT4.EQ.'ALL')) THEN
          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(8)')
          DO IVAR=1,NVAR
            VARV(IVAR)=FLOTT
          ENDDO
        ELSE
          CALL XABORT('GRAD: REAL DATA OR ALL KEYWORD EXPECTED')
        ENDIF
        CALL LCMPUT(IPGRAD,TEXT12,NVAR,2,VARV)
        DEALLOCATE(VARV)
      ELSE IF(TEXT12.EQ.'FOBJ-CST-VAL') THEN
        ALLOCATE(CSTV(NCST+1))
        DO ICST=1,NCST+1
          CALL REDGET(INDIC,NITMA,CSTV(ICST),TEXT4,DFLOTT)
          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(9)')
        ENDDO
        CALL LCMPUT(IPGRAD,TEXT12,NCST+1,2,CSTV)
        OBJNEW=CSTV(1)
        DEALLOCATE(CSTV)
      ELSE IF(TEXT12(:8).EQ.'CST-TYPE') THEN
        ALLOCATE(IREL(NCST))
        DO ICST=1,NCST
          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
          IF(INDIC.NE.1) THEN
            CALL XABORT('GRAD: INTEGER DATA EXPECTED')
          ELSE IF((NITMA.LT.-1).OR.(NITMA.GT.1)) THEN
            CALL XABORT('GRAD: -1, 0 or 1 EXPECTED')
          ENDIF
          IREL(ICST)=NITMA
        ENDDO
        CALL LCMPUT(IPGRAD,TEXT12,NCST,1,IREL)
        DEALLOCATE(IREL)
      ELSE IF((TEXT12(:7).EQ.'CST-OBJ').OR.
     1        (TEXT12(:10).EQ.'CST-WEIGHT')) THEN
        ALLOCATE(RHS(NCST))
        DO ICST=1,NCST
          CALL REDGET(INDIC,NITMA,RHS(ICST),TEXT4,DFLOTT)
          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(10)')
        ENDDO
        CALL LCMPUT(IPGRAD,TEXT12,NCST,2,RHS)
        DEALLOCATE(RHS)
      ELSE IF(TEXT12(:1).EQ.';') THEN
        GO TO 20
      ELSE 
        CALL XABORT('GRAD: '//TEXT12//' IS AN INVALID KEYWORD')
      ENDIF
      GO TO 10
*----
*  TEST FOR IMPROVEMENT FOR THE OBJECTIVE FINCTION
*----
   20 LBACK=.FALSE.
      CALL LCMLEN(IPGRAD,'OLD-VALUE',LENGT,ITYP)
      IF((JENTRY(1).EQ.1).AND.(LENGT.NE.0)) THEN
        CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
        ALLOCATE(CSTV0(NCST+1))
        CALL LCMLEN(IPGRAD,'FOBJ-CST-VAL',LENGT1,ITYP)
        CALL LCMLEN(IPGRAD,'VAR-VALUE',LENGT2,ITYP)
        IF(LENGT1.EQ.0) THEN
          CALL XABORT('GRAD: MISSING OLD OBJECTIVE FUNCTION VALUE')
        ELSE IF(LENGT1.NE.NCST+1) THEN
          CALL XABORT('GRAD: WRONG NUMBER OF CONSTRAINTS')
        ELSE IF(LENGT2.EQ.0) THEN
          CALL XABORT('GRAD: MISSING CONTROL VARIABLES RECORD')
        ELSE IF(LENGT2.NE.NVAR) THEN
          CALL XABORT('GRAD: WRONG NUMBER OF CONTROL VARIABLES')
        ENDIF
        CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',CSTV0)
        OBJOLD=CSTV0(1)
        IF(OBJNEW.GE.OBJOLD) THEN
          LBACK=.TRUE.
          IF(IPRINT.GT.1)  WRITE(6,130) OBJOLD,OBJNEW
        ENDIF
        DEALLOCATE(CSTV0)
        CALL LCMSIX(IPGRAD,' ',2)
      ENDIF
*----
*  RECOVER OBJECTIVE FUNCTION AND GRADIENTS FROM PRECEDING ITERATION
*----
      IF(LBACK) THEN
        ISTEP=0
        ALLOCATE(VARV(NVAR))
        CALL LCMGET(IPGRAD,'VAR-VALUE',VARV)
        IF(IPRINT.GT.1) THEN 
           WRITE(6,100) 'REJECTED CONTROL VARIABLES:',
     1     (VARV(IVAR),IVAR=1,NVAR)
        ENDIF
        CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
        ALLOCATE(CSTV0(NCST+1),VARV0(NVAR),DERIV0(NVAR*(NCST+1)),
     1  WEIGH(NVAR))
        CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',CSTV0)
        CALL LCMGET(IPGRAD,'VAR-VALUE',VARV0)
        CALL LCMGET(IPGRAD,'GRADIENT',DERIV0)
        CALL LCMSIX(IPGRAD,' ',2)
        CALL LCMPUT(IPGRAD,'FOBJ-CST-VAL',NCST+1,2,CSTV0)
        CALL LCMPUT(IPGRAD,'VAR-VALUE',NVAR,2,VARV0)
        CALL LCMPUT(IPGRAD,'GRADIENT',NVAR*(NCST+1),2,DERIV0)
        IF(IEDSTP.LE.1) THEN
          SR=SR*0.5
        ELSE IF(IEDSTP.EQ.2) THEN
          CALL LCMLEN(IPGRAD,'VAR-WEIGHT',LENGT,ITYLCM)
          IF(LENGT.EQ.NVAR) THEN
            CALL LCMGET(IPGRAD,'VAR-WEIGHT',WEIGH)
          ELSE
            CALL XDRSET(WEIGH,NVAR,1.0)
          ENDIF
          DERR=0.0
          NORX=0.0
          DO 205 I=1,NVAR
          DX=VARV(I)-VARV0(I)
          NORX=NORX+WEIGH(I)*DX**2
  205     DERR=DERR+SQRT(WEIGH(I))*DX*DERIV0(I)
          NORX=NORX**0.5
          DERR=DERR/NORX
          ERRX=ABS(0.5*DERR*NORX*NORX/(DERR*NORX-(OBJNEW-OBJOLD)))
          SR=MAX(MIN(SR,ERRX),SR/20.0)
          DEALLOCATE(WEIGH)
        ENDIF
        IF(IPRINT.GT.1) WRITE(6,'(/32H GRAD: REDUCES QUADRATIC CONSTRA,
     1  13HINT RADIUS TO,1P,E11.4)') SR
        IF(SR.LE.EPS4) THEN
          WRITE(6,140)
          ICONV=1
        ENDIF
        DEALLOCATE(DERIV0,VARV0,CSTV0,VARV)
*----
*  COMPUTE NEW GRADIENTS
*----
      ELSE
*       count the number of iterations without step back
        ISTEP=ISTEP+1
        IF(ISTEP.GT.10) THEN
          SR=2.0*SR
          ISTEP=5
          IF(IPRINT.GT.1) WRITE(6,'(/30H GRAD: INCREASES QUADRATIC CON,
     1    17HSTRAINT RADIUS TO,1P,E11.4)') SR
        ENDIF
        ALLOCATE(VARV(NVAR))
        CALL LCMGET(IPGRAD,'VAR-VALUE',VARV)
        CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
        CALL LCMPUT(IPGRAD,'VAR-VALUE2',NVAR,2,VARV)
        CALL LCMSIX(IPGRAD,' ',2)
        DEALLOCATE(VARV)
        ALLOCATE(DERIV(NVAR*(NCST+1)))
        CALL GRA001(IPFLX,IPGPT,NVAR,NCST,DERIV)
        CALL LCMPUT(IPGRAD,'GRADIENT',NVAR*(NCST+1),2,DERIV)
        DEALLOCATE(DERIV)
      ENDIF
*----
*  PRINT INFORMATION
*----
      IF(IPRINT.GT.0) THEN
        WRITE(6,'(/48H GRAD: INFORMATION AT QUADRATIC CONSTRAINT ITERA,
     1  4HTION,I5)') IEXT
        WRITE(6,100) 'QUADRATIC CONSTRAINT RADIUS:',SR
        ALLOCATE(CSTV(NCST+1))
        CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',CSTV)
        WRITE(6,100) 'OBJECTIVE FUNCTION:',CSTV(1)
        IF(NCST.GT.0) WRITE(6,100) 'CONSTRAINTS:',(CSTV(ICST),
     1  ICST=2,NCST+1)
        DEALLOCATE(CSTV)
        CALL LCMLEN(IPGRAD,'VAR-VALUE',ILONG,ITYLCM)
        IF(ILONG.GT.0) THEN 
          ALLOCATE(VARV(NVAR))
          CALL LCMGET(IPGRAD,'VAR-VALUE',VARV)
          WRITE(6,100) 'CONTROL VARIABLES:',(VARV(IVAR),IVAR=1,NVAR)
          DEALLOCATE(VARV)
        ENDIF
        ALLOCATE(DERIV(NVAR*(NCST+1)))
        CALL LCMGET(IPGRAD,'GRADIENT',DERIV)
        WRITE(6,'(/29H GRADIENTS-------------------)')
        WRITE(6,100) 'OBJECTIVE FUNCTION:',(DERIV(IVAR),IVAR=1,NVAR)
        DO 60 ICST=1,NCST
        WRITE(TEXT16,'(10HCONSTRAINT,I4,1H:)') ICST
        WRITE(6,100) TEXT16,(DERIV(ICST*NVAR+IVAR),IVAR=1,NVAR)
   60   CONTINUE
        IF(LBACK) WRITE(6,'(28H *** STEP BACK ITERATION ***)')
      ENDIF
*----
*  SAVE THE SIGNATURE AND STATE VECTORS
*----
      CALL XDISET(ISTATE,NSTATE,0)
      ISTATE(1)=NVAR
      ISTATE(2)=NCST
      ISTATE(3)=IOPT
      ISTATE(4)=ICONV
      ISTATE(5)=IEXT
      ISTATE(6)=IEDSTP
      ISTATE(9)=IMETH
      ISTATE(10)=ISTEP
      IF(IPRINT.GT.0) WRITE(6,110) (ISTATE(I),I=1,6),ISTATE(9),
     1 ISTATE(10)
      CALL LCMPUT(IPGRAD,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL XDRSET(OPTPRR,NSTATE,0.0)
      OPTPRR(1)=SR
      OPTPRR(2)=EPS1
      OPTPRR(3)=EPS2
      OPTPRR(4)=EPS3
      OPTPRR(5)=EPS4
      IF(IPRINT.GT.0) WRITE(6,120) (OPTPRR(I),I=1,5)
      CALL LCMPUT(IPGRAD,'OPT-PARAM-R',NSTATE,2,OPTPRR)
      IF(IPRINT.GT.1) CALL LCMLIB(IPGRAD)
      RETURN
*
  100 FORMAT(1X,A28,1P,8E12.4/(29X,8E12.4))
  110 FORMAT(/8H OPTIONS/8H -------/
     1 7H NVAR  ,I8,32H   (NUMBER OF CONTROL VARIABLES)/
     2 7H NCST  ,I8,26H   (NUMBER OF CONSTRAINTS)/
     3 7H IOPT  ,I8,37H   (=1/-1: MINIMIZATION/MAXIMIZATION)/
     4 7H ICONV ,I8,34H   (=0/1: NOT CONVERGED/CONVERGED)/
     5 7H IEXT  ,I8,44H   (ITERATION INDEX OF QUADRATIC CONSTRAINT)/
     6 7H IEDSTP,I8,43H   (=1/2: HALF REDUCTION/PARABOLIC FORMULA)/
     7 7H IMETH ,I8,42H   (=1/2/3: SIMPLEX-LEMKE/LEMKE-LEMKE/MAP)/
     8 7H ISTEP ,I8,43H   (NUMBER OF ITERATIONS WITHOUT STEP-BACK))
  120 FORMAT(/
     1 12H REAL PARAM:,1P/12H -----------/
     2 7H SR    ,E12.4,39H   (RADIUS OF THE QUADRATIC CONSTRAINT)/
     3 7H EPS1  ,E12.4,13H   (NOT USED)/
     4 7H EPS2  ,E12.4,31H   (EXTERNAL CONVERGENCE LIMIT)/
     5 7H EPS3  ,E12.4,31H   (INTERNAL CONVERGENCE LIMIT)/
     6 7H EPS4  ,E12.4,43H   (QUADRATIC CONSTRAINT CONVERGENCE LIMIT))
  130 FORMAT(/39H GRAD: OBJECTIVE FUNCTION INCREASE FROM,1P,E12.4,
     1 3H TO,E12.4/35H RETURN BACK TO PREVIOUS ITERATION.)
  140 FORMAT(/1X,'GRAD: THE QUADRATIC CONSTRAINT RADIUS CANNOT BE FUR',
     1 'THER REDUCED')
      END
