      SUBROUTINE CALFUN(X,N,M,FF,G)
      COMMON/STATIS/IFAIL,K,ITM,L
      DIMENSION X(N),G(M)
      FF=FI(X,N)
      L=L+1
      CALL CONSTR(X,N,G,M)
      RETURN
      END
      SUBROUTINE CALGRD(X,N,G,M,A)
      COMMON /B3/F(100)/DIF/DELTA
      DIMENSION X(N),A(100,N),G(M),G1(100),G2(100)
      DO 9 I=1,M
    9 G2(I)=G(I)
      CALL CALFUN(X,N,M,F1,G)
      DO 8 I=1,M
    8 G1(I)=G(I)
      DO 2 I=1,N
      X(I)=X(I)+DELTA
      CALL CALFUN(X,N,M,F2,G)
      F(I)=(F2-F1)/DELTA
      DO 1 J=1,M
    1 A(J,I)=(G (J)-G1(J))/DELTA
    2 X(I)=X(I)-DELTA
      DO 7 I=1,M
    7 G(I)=G2(I)
      RETURN
      END
      SUBROUTINE REQP(X,B1,Q,A,N,FM,IPAR,PAR,IPA,IPAA)
      DIMENSION B1(N,N),A(100,N),Q(N,N),X(N)
      DIMENSION IPAR(30),PAR(30),G(100),U(100)
      COMMON /DIF/DELTA/FUN/FF,LG/STATIS/IFAIL,K,ITM,LF
      IFAIL=0
      LF=0
      CALL INWR35(X,G,N,IPAR,PAR,IPA,IPAA)
      IF (IFAIL.EQ.10) RETURN
      ME=IPAR(IPA+3)
      MC=IPAR(IPA+3)+IPAR(IPA+4)
      IPRINT=IPAR(IPA+1)
      IMAX=IPAR(IPA+2)
      R1=PAR(IPAA+1)
      SCALE=PAR(IPAA+2)
      DELTA=PAR(IPAA+3)
      EPS=PAR(IPAA+4)
      DO 1 I=1,N
      DO 1 J=1,N
      B1(I,J)=0.
    1 B1(I,I)=1.
      CALL RQP(N,MC,ME,X,B1,G,A,U,R1,SCALE,EPS,IPRINT,IMAX,Q)
      ITM=K
      FM=FF
      RETURN
      END
      SUBROUTINE PENFUN(X,N,M,ME,FF,FF1,G,EPS,IFEAS)
      DIMENSION X(100),G(100)
      COMMON/PEN/RSTAR
      CALL CALFUN(X,N,M,FF,G)
      IFEAS=1
      GTG=0.
      DO 1 I=1,M
      IF(G(I).LT.0.0.OR.I.LE.ME)GTG=GTG+G(I)*G(I)
      IF(I.LE.ME.AND.ABS(G(I)).GT.EPS)IFEAS=0
      IF(I.GT.ME.AND.G(I).LT.-EPS)IFEAS=0
    1 CONTINUE
      FF1=FF+GTG/RSTAR
      RETURN
      END
      SUBROUTINE UPDBIG(B1,N,SC,P,OLDF,F)
      DIMENSION B1(N,N),P(100),F(100),OLDF(100)
      COMMON/W4/Y(100)
      COMMON/W8/UH(100)
      PNM=0.0
      YNM=0.0
      D1=0.
      D2=0.
      DO 1 I=1,N
      P(I)=SC*P(I)
      PNM=PNM+P(I)*P(I)
      Y(I)=F(I)-OLDF(I)
      D1=D1+P(I)*F(I)
      D2=D2+P(I)*OLDF(I)
1     YNM=YNM+Y(I)*Y(I)
      SG=D1-D2
      GOTO 103
12    DO 13 I=1,N
      DO 13 J=1,N
      B1(I,J)=0.
      IF(I.EQ.J)B1(I,J)=1.
13    CONTINUE
103   GHG=0.
      DO 2 I=1,N
      UH(I)=0.
      DO 3 J=1,N
3     UH(I)=UH(I)+B1(I,J)*Y(J)
2     GHG=GHG+UH(I)*Y(I)
      IF(SG.LE.1E-3*SQRT(PNM*YNM))RETURN
      IF(GHG.LE.0.)GO TO 12
      DO 9 I=1,N
      DO 9 J=1,N
      CH=GHG*P(I)*P(J)/SG-(UH(I)*P(J)+UH(J)*P(I))
      B1(I,J)=B1(I,J)+(P(I)*P(J)+CH)/SG
9     CONTINUE
4     RETURN
      END
      SUBROUTINE SOLVE(N1,N,Q,RHS,VAR,DIAG)
      DIMENSION RHS(100),VAR(100),DIAG(100),Q(N1,N1)
      DOUBLE PRECISION Z
      IF(N.GT.1)GO TO 21
      VAR(1)=RHS(1)/Q(1,1)
      RETURN
21    VAR(1)=RHS(1)*DIAG(1)
      DO 1 I=2,N
      Z=DBLE(RHS(I))
      II=I-1
      DO 2 L=1,II
      K=I-L
2     Z=Z-DBLE(Q(I,K)*VAR(K))
1     VAR(I)=SNGL(Z)*DIAG(I)
      VAR(N)=VAR(N)*DIAG(N)
      JJ=N-1
      DO 3 J=1,JJ
      I=N-J
      Z=DBLE(VAR(I))
      KK=I+1
      DO 4 K=KK,N
4     Z=Z-DBLE(Q(K,I)*VAR(K))
3     VAR(I)=SNGL(Z)*DIAG(I)
      RETURN
      END
      SUBROUTINE DECOMP(N1,N,Q,DIAG,ISING)
      DIMENSION DIAG(100),Q(N1,N1)
      DOUBLE PRECISION X
      IF(N.GT.1) GO TO 21
      IF(Q(1,1).NE.0.0)GO TO 19
      ISING=1
19    RETURN
21    XBIG=Q(1,1)
      DO 1 I=1,N
      DO 1 J=I,N
      X=DBLE(Q(I,J))
      IF(I.EQ.1)GO TO 2
      II=I-1
      DO 3 L=1,II
      K=I-L
3     X=X-DBLE(Q(J,K)*Q(I,K))
2     IF(J.GT.I)GO TO 5
      IF(SNGL(X).GT.XBIG)XBIG=SNGL(X)
      IF(SNGL(X).GT.1E-7*XBIG)GO TO 6
      ISING=1
      RETURN
6     DIAG(I)=SNGL(1./DSQRT(X))
      GO TO 1
5     Q(J,I)=SNGL(X)*DIAG(I)
1     CONTINUE
      RETURN
      END
      SUBROUTINE LS(N,M,ME,X,Y,P,SC,FF,OLDFF,FF1,G1,G2,SF0,PNM,IFV,
     1ISTOP,EPS,IFEAS)
      DIMENSION X(N),Y(100),P(100),G1(100),G2(100)
      COMMON /INW/INWR
      IDC=0
      IQ=1
      E1=.01
      E2=.7
      SL=0.
      DL=1.
      FL=OLDFF
      IFL=IFEAS
      FF2=FF1
      DF=5E-7*(ABS(FL)+5E-7)
118   FF=OLDFF
      IXT=0
      IKT=0
      IF(SC.LT.1.0)IXT=1
119   DO 600 I=1,N
600   Y(I)=X(I)+SC*P(I)
      CALL PENFUN(Y,N,M,ME,FF1,FF,G1,EPS,IFEAS)
      IFV=IFV+1
171   IF(FF.GT.OLDFF)GO TO 601
604   IKT=IKT+1
      D=(FF-(OLDFF+SC*SF0))/(SC*SF0) +1.
      IF(D.LE.E2)GO TO 602
      IF(FF.GE.FL)GO TO 602
      IF(IKT.GT.1.AND.ABS(1.-D).GE.E1)GO TO 602
      IF(IXT.EQ.1)GO TO 603
      SL=SC
      DL=D
      FL=FF
      IFL=IFEAS
      DO 650 I=1,M
650   G2(I)=G1(I)
      FF2=FF1
      IF(IKT.GT.5)GO TO 607
      IF(D.GE.0.75)SC=2.*SC
      IF(D.LT.0.75)SC=.5*SC/(1.-D)
      DO 605 I=1,N
605   Y(I)=X(I)+SC*P(I)
      CALL PENFUN(Y,N,M,ME,FF1,FF,G1,EPS,IFEAS)
      IFV=IFV+1
      GO TO 604
602   IF(D.GE.E1)GO TO 603
      IF(ABS(1.-DL).GE.E1)GO TO 607
      GO TO 609
601   F0=SC*SF0
      D=(FF-(OLDFF+SC*SF0))/F0+1.
639   IF(D.LT.E1)GO TO 609
      IF(ABS(1.-D).GE.E1)GO TO 603
      SL=SC
      DL=D
      FL=FF
      IFL=IFEAS
      DO 651 I=1,M
651   G2(I)=G1(I)
      FF2=FF1
      IF(IQ.EQ.0)GO TO 608
      GO TO 610
609   SR=SC
      DR=D
      FR=FF
      IF(ABS(SC*SF0).LE.DF)GO TO 608
610   IF((SR-SL).LE.5E-7*SR)GO TO 607
      SC=SL+(SR-SL)*AMAX1(.001,(.5-DL)/(DR-DL))
      IQ=0
      DO 612 I=1,N
612   Y(I)=X(I)+SC*P(I)
      CALL PENFUN(Y,N,M,ME,FF1,FF,G1,EPS,IFEAS)
      IFV=IFV+1
      GO TO 601
608   SC=.5*(SR+SL)
      DO 619 I=1,N
619   Y(I)=X(I)+SC*P(I)
      CALL PENFUN(Y,N,M,ME,FF1,FF,G1,EPS,IFEAS)
      IFV=IFV+1
      IF(FF.LT.OLDFF)GO TO 640
      IF(ABS(SR*SF0).GT.DF)GO TO 640
      IF(SL.GT.0.)GO TO 607
      IF(IDC.EQ.1)GO TO 607
      IDC=1
      SFL=SF0
      SF0=(4.*FF-FR-3.*OLDFF)/SR
      IF(SF0.GE.0.)GO TO 641
      DR=DR*SFL/SF0
640   IQ=1
      GO TO 601
641   IF(SF0.EQ.0)GO TO 607
      DO 642 I=1,N
642   Y(I)=X(I)-SC*P(I)
      CALL PENFUN(Y,N,M,ME,FF1,FFN,G1,EPS,IFEAS)
      IFV=IFV+1
      IF(FFN.GE.OLDFF)GO TO 607
      DO 643 I=1,N
643   P(I)=-P(I)
      SF0=(FFN-FF)/SC
      DL=1.
      SL=0.
      FF=FFN
      FL=OLDFF
      IKT=0
      GO TO 604
607   SC=SL
      D=DL
      FF=FL
      IFEAS=IFL
      FF1=FF2
      DO 652 I=1,M
652   G1(I)=G2(I)
603   DO 618 I=1,N
618   X(I)=X(I)+SC*P(I)
      IF(FF.LT.OLDFF) RETURN
      ISTOP=1
      INWR=1
      RETURN
      END
      SUBROUTINE RQP(N,M,ME,X,B1,G,A,U,R1,
     1SCALE,EPS,IPRINT,IMAX,Q)
      DIMENSION X(N),G(100),U(100)
      DIMENSION B1(N,N),A(100,N),Q(N,N)
      COMMON/W1/C(100)/W9/G1(100)/W10/G2(100)
      COMMON/W2/P(100)/W3/OLDF(100)/W4/DIAG(100)/W5/BETA(100)
      COMMON/W6/ATG(100)/W11/Z1(100)
      COMMON/W7/Y(100)/W8/Z(100)
      COMMON/PEN/RSTAR
      COMMON /FUN/FF,IGV/B3/F(100)/STATIS/ISTOP,ICT,ITM,LFUN/INW/INWR
      COMMON /CONST/IVSET(100),IV /DIF/DELTA
      INWR=0
      NW99=6
      ICT=0
      ISTOP=0
      INEXT=IPRINT
      DO 2 I=1,M
      Y(I)=0.
2     U(I)=0.
      RLAST=R1
      CALL CALFUN(X,N,M,FF,G)
      CALL CALGRD(X,N,G,M,A)
      IGV=1
      GO TO 500
900   ICT=ICT-1
      DO 1 I=1,N
      DO 1 J=1,N
      B1(I,J)=0.
      IF(I.EQ.J)B1(I,J)=1.
1     CONTINUE
500   ISGRAD=1
      IF(IPRINT.EQ.1)GO TO 1170
      GO TO 1000
20    ICT=ICT+1
      IF(ICT.LT.IMAX) GO TO 4010
      INWR=1
      ISTOP=2
 4010 CONTINUE
      IBIND=0
      ISING=0
      IREV=0
      IPEN=0
      ILANG=0
      DO 48 I=1,N
      P(I)=0.
      BETA(I)=OLDF(I)
      DO 48 J=1,N
48    P(I)=P(I)-B1(I,J)*C(J)
      IF(IV.EQ.0)GO TO 702
      ILANG=1
      IF(IV.GT.N)GO TO 12
      DO 5 I=1,IV
      II=IVSET(I)
      C(I)=-G(II)-.5*RSTAR*U(II)
      DO 5 J=1,N
5     C(I)=C(I)-A(II,J)*P(J)
      DO 6 I=1,IV
      II=IVSET(I)
      DO 6 J=1,N
      QIJ=0.
      DO 66 K=1,N
66    QIJ=QIJ+A(II,K)*B1(K,J)
6     Q(I,J)=QIJ
      DO 7 I=1,IV
      DO 8 J=I,IV
      IJ=IVSET(J)
      Y(J)=0.
      DO 8 K=1,N
8     Y(J)=Y(J)+Q(I,K)*A(IJ,K)
      DO 7 J=I,IV
      Q(I,J)=Y(J)
      IF(I.EQ.J)Q(I,J)=Q(I,J)+.5*RSTAR
7     CONTINUE
113   CALL DECOMP(N,IV,Q,DIAG,ISING)
      IF(ISING.EQ.0)GO TO 877
      IF(ISGRAD.EQ.0)GO TO 900
      INWR=1
      ISTOP=3
      GO TO 1170
877   CALL SOLVE(N,IV,Q,C,Y,DIAG)
      GO TO 18
12    IPEN=1
      GG=GTG
968   RLAST=RSTAR
      DO 16 I=1,N
      DO 16 J=1,N
16    Q(I,J)=B1(I,J)
      DO 17 K=1,IV
      IK=IVSET(K)
      DEN=.5*RSTAR
      DO 971 I=1,N
      Y(I)=0.
      DO 972 J=1,N
972   Y(I)=Y(I)+Q(I,J)*A(IK,J)
971   DEN=DEN+Y(I)*A(IK,I)
      DO 873 I=1,N
      DO 873 J=1,N
873   Q(I,J)=Q(I,J)-Y(I)*Y(J)/DEN
17    CONTINUE
      DO 871 I=1,N
      P(I)=0.
      DO 871 J=1,N
871   P(I)=P(I)-Q(I,J)*(OLDF(J)+2.*ATG(J)/RSTAR)
      DO 872 I=1,IV
      II=IVSET(I)
      Y(I)=G(II)
      DO 874 J=1,N
874   Y(I)=Y(I)+A(II,J)*P(J)
872   Y(I)=-2.*Y(I)/RSTAR-U(II)
18    IBIND=1
      UU=0.
      GG=0.0
      DO 763 I=1,IV
      II=IVSET(I)
      ERR=.25*ABS(U(II))
      IF(ABS(Y(I)).GT.ERR)ILANG=0
      Z(I)=U(II)+Y(I)
      IF(I.LE.ME.OR.Z(I).GT.0.)UU=UU+Z(I)**2
      IF(I.LE.ME.OR.Z(I).GT.0.)GO TO 763
      IBIND=0
763   GG=GG+G(II)*G(II)
      IF(GTG.LE.0.)GO TO 767
      IF(IREV.GT.0)GO TO 767
      IF(UU.LE.0.)GO TO 767
      IF(.5*RSTAR*SQRT(UU).LT.SQRT(GTG))GO TO 767
      IREV=1
      RLAST=RSTAR
      RSTAR=2.*SCALE*SQRT(GTG)/SQRT(UU)
      RD=.5*(RLAST-RSTAR)
      IF(IPEN.EQ.1)GO TO 968
      DO 1760 I=1,IV
      II=IVSET(I)
      C(I)=C(I)+RD*U(II)
1760  Q(I,I)=Q(I,I)-RD
      GO TO 113
767   RLAST=RSTAR
      DO 4001 I=1,IV
      II=IVSET(I)
4001  U(II)=U(II)+Y(I)
      DO 4000 I=1,N
      Z(I)=0.
      DO 4000 J=1,IV
      IJ=IVSET(J)
      IF(ILANG.EQ.0)GO TO 4000
      UJ=0.
      IF(J.LE.ME.OR.U(IJ).GT.0.)UJ=U(IJ)
      BETA(I)=BETA(I)-A(IJ,I)*UJ
4000  Z(I)=Z(I)+A(IJ,I)*Y(J)
771   CONTINUE
      DO 9999 I=1,IV
      II=IVSET(I)
 9999 Y(I)=U(II)
707   IF(IPEN.EQ.1)GO TO 702
      DO 717 I=1,N
      DO 717 K=1,N
717   P(I)=P(I)+B1(I,K)*Z(K)
702   CONTINUE
      PNM=0.0
      FNM=0.0
      D1=0.
      D2=0.
      DO 727 I=1,N
      PNM=PNM+P(I)*P(I)
      FI=OLDF(I)+2.*ATG(I)/RSTAR
      FNM=FNM+FI*FI
      D1=D1+P(I)*OLDF(I)
727   D2=D2+P(I)*ATG(I)
      SF0=D1+2.*D2/RSTAR
      IF(IV.GT.0)GO TO 950
      IF(SQRT(FNM).LT.EPS)GO TO 26
      IF(SF0.LE.-1E-3*SQRT(PNM*FNM))GO TO 726
      IF(ISGRAD.EQ.0)GO TO 900
      ISTOP=4
      INWR=1
      GO TO 1170
950   IF(IFEAS.EQ.0)GO TO 952
      IF(IBIND.EQ.0)GO TO 952
      IF(SQRT(PNM).LE.EPS)GO TO 26
952   IF(SF0.LT.0.)GO TO 726
      IF(ISGRAD.EQ.0)GO TO 900
      ISTOP=4
      INWR=1
      GO TO 1170
26    CONTINUE
      INWR=1
      GO TO 1170
726   SC=1.0
      DO 811 I=1,M
      IF(I.LE.ME)GO TO 811
      IF(G(I).LE.0.0)GO TO 811
      IF(U(I).GT.0.0)GO TO 811
      ZZ=0.0
      DO 812 J=1,N
812   ZZ=ZZ+A(I,J)*P(J)
      IF(ZZ.GE.0.0)GO TO 811
      SK=-G(I)/ZZ
      SKLINE=(-G(I)-RSTAR)/ZZ
      IF(SK.GT.SC)GO TO 811
      ZZ2=2.0*ZZ*ZZ/RSTAR-SF0
      SK=SK-(1.0-SK)*SF0/ZZ2
      SC=AMIN1(SC,ABS(SK),SKLINE)
811   CONTINUE
      DO 723 I=1,M
723   G2(I)=G(I)
      FF2=OLDFF+GTG/RSTAR
      CALL LS(N,M,ME,X,Y,P,SC,FF1,FF2,FF,G,G2,SF0,PNM,IFV,
     1ISTOP,EPS,IFEAS)
      CALL CALGRD(X,N,G,M,A)
      IGV=IGV+1
      PG=0.
      DO 4006 I=1,N
      ATG(I)=F(I)
      IF(ILANG.EQ.0)GO TO 4006
      DO 4007 J=1,IV
      UJ=0.
      IJ=IVSET(J)
      IF(J.LE.ME.OR.U(IJ).GT.0.)UJ=U(IJ)
4007  ATG(I)=ATG(I)-A(IJ,I)*UJ
4006  PG=PG+ATG(I)*ATG(I)
      IF(SQRT(PG).GT.EPS)GO TO 9
      IF(IBIND.EQ.1.AND.IFEAS.EQ.1)GO TO 26
9     CALL UPDBIG(B1,N,SC,P,BETA,ATG)
      ISGRAD=0
 1170 IF(INWR.EQ.0) GOTO 171
      IF (IPRINT.GE.0) CALL SPAU35(N,M,ME,X,G)
      RETURN
  171 IF(IPRINT.LE.0) GOTO 1000
      IF(ICT.NE.INEXT) GOTO 1000
      INEXT=INEXT+IPRINT
      CALL SPAU35(N,M,ME,X,G)
1000  IV=0
      IFEAS=1
      GTG=0.0
      UU=0.
      DO 1060 I=1,N
1060  ATG(I)=0.0
      IF(ME.EQ.0)GO TO 1001
      DO 1002 I=1,ME
      IV=IV+1
      IVSET(IV)=I
      GTG=GTG+G(I)**2
      IF(ABS(G(I)).GT.EPS)IFEAS=0
      UU=UU+U(I)*U(I)
      DO 1002 J=1,N
1002  ATG(J)=ATG(J)+A(I,J)*G(I)
1001  IF(ME.EQ.M)GO TO 22
      J99=ME+1
      DO 60 I=J99,M
      IF(G(I).LT.-EPS)IFEAS=0
      IF(G(I).GT.0.0.AND.U(I).LE.0.0)U(I)=0.
      IF(G(I).GT.0.0.AND.U(I).LE.0.0)GO TO 60
61    IV=IV+1
      IVSET(IV)=I
      GTG=GTG+(AMIN1(0.0,G(I)))**2
      IF(U(I).GT.0)UU=UU+U(I)*U(I)
      IF(ABS(G(I)).GT.EPS)IFEAS=0
      DO 62 J=1,N
62    ATG(J)=ATG(J)+A(I,J)*AMIN1(0.0,G(I))
60    CONTINUE
22    OLDFF=FF
      DO 114 I=1,N
      C(I)=F(I)
114   OLDF(I)=F(I)
      RSTAR=RLAST
      IF(IV.EQ.0)GO TO 20
      DO 3002 I=1,N
      DO 3002 J=1,IV
      IJ=IVSET(J)
3002  C(I)=C(I)-A(IJ,I)*U(IJ)
      IF(GTG.LE.0.)GO TO 20
      IF(UU.LE.0.)GO TO 20
      RSTAR=2.*SCALE*SQRT(GTG)/SQRT(UU)
      GO TO 20
      END
      SUBROUTINE INWR35(X,G,N,IPAR,PAR,IPA,IPAA)
      COMMON /STATIS/IFAIL,IT,ITM,NF
      DIMENSION X(N),G(100),IPAR(30),PAR(30)
      NOUT=I1MACH(2)
      MIP=30
      K=4
      MN=100
      K1=4
      IPRINT=IPAR(IPA+1)
      MAP=100
      IF (IPA.GE.0.AND.IPA+K.LE.MIP) GO TO 10
      WRITE (NOUT,520) K,MIP
      WRITE (NOUT,510) IPA
    5 IFAIL=10
      RETURN
   10 IF (IPRINT.LT.0) GO TO 110
      WRITE (NOUT,860)
      WRITE (NOUT,620)
      WRITE (NOUT,630) N
  110 IF (N.GT.0.AND.N.LE.MN) GO TO 20
      WRITE (NOUT,500) MN
      IF (IPRINT.LT.0) WRITE (NOUT,630) N
      GO TO 5
   20 CONTINUE
      IMAX=IPAR(IPA+2)
      NC=IPAR(IPA+3)
      NIC=IPAR(IPA+4)
      IF (IPRINT.LT.0) GO TO 30
      WRITE (NOUT,640) IPRINT
      WRITE (NOUT,650) IMAX
      WRITE (NOUT,870) NC
      WRITE (NOUT,890) NIC
   30 IF (IMAX.GE.0) GO TO 40
      WRITE (NOUT,525)
      IF (IPRINT.LT.0) WRITE (NOUT,650) IMAX
      GO TO 5
   40 IF (NC.GE.0) GO TO 50
      WRITE (NOUT,900)
      IF (IPRINT.LT.0) WRITE (NOUT,870) NC
      GO TO 5
   50 IF (NIC.GE.0) GO TO 70
      WRITE (NOUT,910)
      IF (IPRINT.LT.0) WRITE (NOUT,890) NIC
      GO TO 5
   70 IF (NC+NIC.LE.MAP) GO TO 120
      WRITE (NOUT,930) MAP
      IF (IPRINT.GE.0) GO TO 5
      WRITE (NOUT,870) NC
      WRITE (NOUT,890) NIC
      GO TO 5
  120 CONTINUE
      IF (IPAA.GE.0.AND.IPAA+K1.LE.MIP) GO TO 240
      WRITE (NOUT,710) K1,MIP
      WRITE (NOUT,700) IPAA
      GO TO 5
  240 CONTINUE
      MC=NC+NIC
      CALL CALFUN(X,N,MC,FF,G)
      IF (IPRINT.LT.0) RETURN
      I=IPAA+1
      J=IPAA+K1
      WRITE (NOUT,940) (PAR(L),L=I,J)
      IF (MC.EQ.0) GO TO 280
      IF (NC.EQ.0) GO TO 260
      DO 250 I=1,NC
      IF (ABS(G(I)).GT.PAR(IPAA+4)) GO TO 300
  250 CONTINUE
  260 IF (NIC.EQ.0) GO TO 280
      J1=NC+1
      DO 270 I=J1,MC
      IF (G(I).LT.-PAR(IPAA+4)) GO TO 300
  270 CONTINUE
  280 WRITE (NOUT,820)
  285 WRITE (NOUT,580) X
      WRITE (NOUT,950) FF
      IF (MC.EQ.0) GO TO 290
      WRITE (NOUT,960)
      WRITE (NOUT,580) (G(I),I=1,MC)
  290 IF (IPRINT.GT.0) WRITE (NOUT,970)
      RETURN
  300 WRITE (NOUT,980)
      GO TO 285
  500 FORMAT (/2X,59H**E R R O R  I N  R E Q P** N LESS THAN 1 OR N GREA
     CTER THAN,I4)
  510 FORMAT (/2X,26HNUMBER OF PARAMETERS IPA =,I6)
  520 FORMAT (/2X,43H**E R R O R  I N  R E Q P** IPA LESS THAN 0/2X,
     C7HOR IPA+,I2,13H GREATER THAN,I3)
  525 FORMAT (/2X,44H**E R R O R  I N  R E Q P** IMAX LESS THAN 1/)
  580 FORMAT (4(2X,E15.8))
  620 FORMAT (/2X,22HI N I T I A L  D A T A)
  630 FORMAT (/2X,19HNUMBER OF VARIABLES,16X,3HN =,I6)
  640 FORMAT (/2X,18HPRINTING PARAMETER,15X,5HIPR =,I6)
  650 FORMAT (2X,28HMAXIMUM NUMBER OF ITERATIONS,4X,6HIMAX =,I6)
  700 FORMAT (/2X,27HNUMBER OF PARAMETERS IPAA =,I3)
  710 FORMAT (/2X,44H**E R R O R  I N  R E Q P** IPAA LESS THAN 0/2X,
     C8HOR IPAA+,I2,13H GREATER THAN,I3)
  820 FORMAT (/2X,14HSTARTING POINT)
  860 FORMAT (////12X,7HR E Q P)
  870 FORMAT (2X,30HNUMBER OF EQUALITY CONSTRAINTS,4X,4HNC =,I6)
  890 FORMAT (2X,38HNUMBER OF INEQUALITY CONSTRAINTS NIC =,I6)
  900 FORMAT (/2X,42H**E R R O R  I N  R E Q P** NC LESS THAN 0/)
  910 FORMAT (/2X,43H**E R R O R  I N  R E Q P** NIC LESS THAN 0/)
  930 FORMAT (/2X,53H**E R R O R  I N  R E Q P** NUMBER OF ALL CONSTRAIN
     CTS/2X,12HGREATER THAN,I4/)
  940 FORMAT (/2X,17HPENALTY PARAMETER,7X,4HR1 =,E15.8/2X,17HSCALING PAR
     CAMETER,4X,7HSCALE =,E15.8/2X,28HDIFFERENTIATION STEP DELTA =,
     CE15.8/2X,15HTOLERANCE LEVEL,8X,5HEPS =,E15.8)
  950 FORMAT (2X,18HFUNCTION VALUE F =,E15.8)
  960 FORMAT (2X,11HCONSTRAINTS)
  970 FORMAT (1X,34(2H -))
  980 FORMAT (/2X,27HSTARTING POINT = INFEASIBLE)
      END
      SUBROUTINE SPAU35(N,MC,ME,X,G)
      DIMENSION X(N),G(100)
      COMMON /CONST/ICON(100),IV/FUN/FM,LG/STATIS/IFAIL,K,ITM,LF
     C/INW/INWR
      COMMON /B3/F(100)/W7/Y(100)
      NOUT=I1MACH(2)
      IF(INWR.NE.0) GOTO 6
    1 FORMAT(34(2H -))
      WRITE(NOUT,2) K
    2 FORMAT(/2X,23HI T E R A T I O N	K =,I6)
      WRITE(NOUT,3) FM
    3 FORMAT(/2X,18HFUNCTION VALUE F =,E15.8)
      WRITE(NOUT,4)
    4 FORMAT(/2X,13HCURRENT POINT)
      WRITE(NOUT,5) X
    5 FORMAT(4(2X,E15.8))
      IF (MC.EQ.0) GO TO 40
      WRITE(NOUT,31)
      WRITE (NOUT,5) (G(I),I=1,MC)
   40 CONTINUE
      WRITE(NOUT,1)
      RETURN
    6 WRITE(NOUT,7)
    7 FORMAT(2(/34(2H *)))
      WRITE(NOUT,8)
    8 FORMAT(/2X,13HR E S U L T S)
      IF(IFAIL.GE.3) GOTO 30
      WRITE(NOUT,9) FM
    9 FORMAT(/2X,27HOPTIMAL FUNCTION VALUE FM =,E15.8)
      WRITE(NOUT,10)
   10 FORMAT(/2X,13HOPTIMAL POINT)
   29 WRITE(NOUT,5) X
      IF (MC.EQ.0) GO TO 41
      WRITE (NOUT,31)
   31 FORMAT(/2X,11HCONSTRAINTS)
      WRITE(NOUT,5) (G(I),I=1,MC)
      WRITE (NOUT,32)
   32 FORMAT(/2X,20HLAGRANGE MULTIPLIERS)
      WRITE (NOUT,5) (Y(I),I=1,MC)
   41 CONTINUE
      WRITE(NOUT,11) K
   11 FORMAT(/2X,21HNUMBER OF ITERATIONS ,12X,3HK =,I6)
      WRITE(NOUT,12) LF
   12 FORMAT(2X,30HNUMBER OF FUNCTION EVALUATIONS,3X,3HL =,I6)
      WRITE(NOUT,13) LG
   13 FORMAT(2X,30HNUMBER OF GRADIENT EVALUATIONS,2X,4HLG =,I6)
      WRITE(NOUT,14) IV
   14 FORMAT(2X,28HNUMBER OF ACTIVE CONSTRAINTS,4X,4HMA =,I6/)
      IF(IV.LE.0) GOTO 17
      WRITE(NOUT,15)
   15 FORMAT(2X,31HNUMBERS OF ACTIVE CONSTRAINTS : )
      WRITE(NOUT,16) (ICON(I),I=1,IV)
   16 FORMAT(2X,10I6)
   17 CONTINUE
   18 FORMAT (/7X,15HREQP TERMINATED)
      IF (IFAIL.EQ.0) GO TO 19
      GO TO (25,21,23,33),IFAIL
   19 WRITE(NOUT,20)
   20 FORMAT (/2X,66HIFAIL = 0. TERMINATION CRITERION: NORMS OF GRADIENT
     CS LESS THAN EPS)
      GOTO 27
   21 WRITE(NOUT,22) IFAIL
   22 FORMAT (/2X,7HIFAIL =,I2,45H. TERMINATION CRITERION: NUMBER OF ITE
     CRATIONS/2X,14HEXCEEDED LIMIT)
      GOTO 27
   23 WRITE (NOUT,24) IFAIL
   24 FORMAT (/2X,7HIFAIL =,I2,44H. TERMINATION CRITERION: LAGRANGE MULT
     CIPLIER/2X,18HEQUATIONS SINGULAR)
      GOTO 27
   25 WRITE (NOUT,26) IFAIL
   26 FORMAT (/2X,7HIFAIL =,I2,45H. TERMINATION CRITERION: NO FURTHER RE
     CDUCTION/2X,26HIN FUNCTION OR CONSTRAINTS)
      GOTO 27
   33 WRITE (NOUT,34) IFAIL
   34 FORMAT (2X,8HIFAIL = ,I2,25H. TERMINATION CRITERION:  ,
     C 23HSEARCH DIRECTION UPHILL)
   27 WRITE(NOUT,18)
      WRITE(NOUT,7)
      RETURN
   30 WRITE(NOUT,3) FM
      WRITE(NOUT,4)
      GOTO 29
      END
