      SUBROUTINE MIVAR4(X,A,B,NN,B1,NM,FM,IPAR,PAR,IPA,IPAA)
      COMMON/STATIS/IFAIL,ICT,ICTMIN,LFUN/INW/IN
      COMMON/MIVF/F(100)
      DIMENSION IPAR(30),PAR(30)
      DIMENSION A(NN),B(NN),X(NN),B1(NM)
      COMMON/MIVDE/DELT(101)/GRZ/ZET(100)
      COMMON /MIVNFN/IFN
      COMMON /MIVY/Y(100)/MIVP/P(100)/MIVOLP/OLDP(100)
      COMMON /MIVRVT/RVT(100)/B3/FVT(100)/MIVUPD/UPD(100)
      COMMON /MIVGRA/PM,IPM,FN2,KFF,FF,OFMAX,OXNOR1
     -/MIV3/INEXT/MIVJQ/JQ(100)
      COMMON/MIVDEL/DEL,DL/MIVRV/RV(100)/MIVOLF/OLDF(100)
      COMMON/MIVBMI/BMI(100)/MIVAMA/AMA(100)
      COMMON/MIVLIN/SQPNM,PMAX,IFV,SC,OLDFF,EPSC,ISC,ICON,ISGRAD,
     *SCM,FVTMAX,FMAX,IFM,FNM,FNM2,EPS,XEPS,IAP,SFO,
     *OPNM,PNM,OXNOR
      COMMON/MIVIG/IGRA
      COMMON/MIVKEY/KEY
      COMMON/MIVYM/YMAX/MIVPRI/SOFPRI
      COMMON/MIVLIB/OPMAX,ETA
      COMMON/LIN1/SCIN,IXT,PF,ICOSTA
      DOUBLE PRECISION PI
      IN=1
      NB1=(NN*(NN+1))/2
      N=NN
       IFAIL=0
      CALL INWR31(X,A,B,N,NM,FF,IPAR,PAR,IPA,IPAA)
      IF(IFAIL.EQ.10) RETURN
      AN=FLOAT(N)
      DEL=PAR(IPAA+4)
      XEPS=PAR(IPAA+1)
      RLRS=R1MACH(4)*AN*AN
      RMAX=R1MACH(2)
      RMIN=R1MACH(1)
      SRMAX=SQRT(RMAX)/10.
      SRMIN=SQRT(RMIN)*10.
      ICT=0
      IFV=0
      IFN=0
      EPSC=AMIN1(SRMIN,XEPS)
      EPSC=AMAX1(RMIN*AN,EPSC)
      SC=0.
      SCM=RMAX
      EPS=PAR(IPAA+2)
      EPS1=PAR(IPAA+3)
      IMAX=IPAR(IPA+4)
      NSTOP=IPAR(IPA+3)
      LFUNMA=IPAR(IPA+2)
      IPRINT=IPAR(IPA+1)
      IGRA=0
      IXT1=0
      XNOR=SRMAX
      OXNOR=XNOR
      OXNOR1=OXNOR
      INEXT=IPRINT
      MSTOP=0
      DO 20 I=1,N
      AMA(I)=AMAX1(A(I)*(1.+RLRS),A(I)+RMIN+R1MACH(4)/10.)
      BMI(I)=AMIN1(B(I)*(1.-RLRS),B(I)-RMIN-R1MACH(4)/10.)
      IF(X(I).GE.BMI(I)) X(I)=B(I)
      IF(X(I).LE.AMA(I)) X(I)=A(I)
   20 RVT(I)=0.
      IQM=0
      IQM1=1
      KFF=0
      LFUN=1
      CALL GRABP1(X,N,A,B)
      IF(KFF.EQ.0) IGRA=11
      IFV=IFV+1
      DO 60 I=1,N
      RV(I)=0.
      OLDF(I)=FVT(I)
      IF(FVT(I))50,34,40
   34 IF(X(I).EQ.B(I)) GOTO 52
   40 IF(X(I).GT.A(I))GOTO 60
      OLDF(I)=0.
      RVT(I)=1.
      GOTO 60
   50 IF(X(I).LT.B(I)) GOTO 60
   52 OLDF(I)=0.
      RVT(I)=-1.
   60 CONTINUE
      CALL VMAX(OLDF,N,OFMAX,IFMA)
      CALL ENORM(OLDF,N,OFMAX,OFNM)
      SQOFNM=SQRT(OFNM)
      ICOSTA=0
      IF(OFNM.EQ.0.) GOTO 80
      IF(SQOFNM*OFMAX.LE.EPS) ICOSTA=1
      GOTO 85
   80 FM=FF
      IN=2
      CALL INWR31(X,A,B,N,NM,FF,IPAR,PAR,IPA,IPAA)
      RETURN
   85 FVTMAX=OFMAX
       IF(LFUN.LT.LFUNMA) GOTO 87
      IF(ICOSTA.NE.1) IFAIL=3
      GOTO 940
  87  DAUG=1.
      ISGRAD=0
       IAP=0
      ICON=0
      OLDFF=FF
  100 DO 110 I=2,NB1
  110 B1(I)=0.
      J=0
      DO 120 I=1,N
      J=J+I
  120 B1(J)=1.0
      ISGRAD=1
  140 IF(IQM.EQ.0 ) GOTO 170
      DO 160 I=IQM1,IQM
      IQ=JQ(I)
      IF(X(IQ).NE.A(IQ).AND.X(IQ).NE.B(IQ)) GOTO 160
      RVT(IQ)=RV(IQ)
      OLDF(IQ)=0.
      IF(RVT(IQ).EQ.-1.) GOTO 150
      X(IQ)=A(IQ)
      GOTO 160
  150 X(IQ)=B(IQ)
  160 CONTINUE
      CALL VMAX(OLDF,N,OFMAX,IFMA)
      CALL ENORM(OLDF,N,OFMAX,OFNM)
  170 SC=0.
      IQM1=1
      SQOFNM=SQRT(OFNM)
      SCM=RMAX
      ISGR=0
  180 IF(IAP.NE.1) ICT=ICT+1
      ISC=0
      DO 200 I=1,N
      PI=0.D0
      IF(RVT(I).NE.0.) GOTO 195
      IJ=(I*(I-1))/2+1
      DO 190 J=1,N
      IF(RVT(J).NE.0.) GOTO 184
      PI=PI-B1(IJ)*OLDF(J)
  184 IF(I.GT.J) GOTO 186
      IJ=IJ+J
      GOTO 190
  186 IJ=IJ+1
  190 CONTINUE
  195 P(I)=SNGL(PI)
  200 CONTINUE
      CALL VMAX(P,N,PMAX,IPM)
      CALL ENORM(P,N,PMAX,PNM)
      SQPNM=SQRT(PNM)
      CALL PROD(OLDF,P,N,OFMAX,PMAX,SFO)
      IF(OFNM.LE.0.)GOTO 270
      IF(PNM.GT.0.)GOTO 240
  220 DO 230 I=1,N
  230 P(I)=-OLDF(I)
      IXT1=1
      IF(ISGRAD.NE.1) ISGR=1
      SQPNM=SQOFNM
      IPM=IFMA
      PMAX=OFMAX
      PNM=OFNM
      SFO=-OFNM
      ISGRAD=1
      GOTO 260
  240 PFN=SQPNM*SQOFNM
      IF(SFO.LT.-0.01*PFN)GOTO 260
      IPM=IFMA
      IF(ISGRAD.NE.1) ISGR=1
      ISGRAD=1
      PMAX=PMAX*(SQPNM/SQOFNM)
      DO 250 I=1,N
  250 P(I)=-PMAX*(OLDF(I)/OFMAX)
      PNM=OFNM
      SQPNM=SQOFNM
      SFO=-OFNM
  260 SC=AMIN1(0.1,1.0/(SQPNM*PMAX))
  270 IF(FVTMAX.EQ.0.) GOTO 940
      ALF=0.
      I1=0
      DO 290 I=1,N
      IF(RVT(I).EQ.0..OR.FVT(I).EQ.0.)GOTO 290
  280 AL=-0.5*RVT(I)*FVT(I)*DAUG
      IF(SQPNM*PMAX.GE.AL)GOTO 290
      I1=I1+1
      IF(ALF.GE.AL)GOTO 290
      ALF=AL
      IQ=I
  290 CONTINUE
      IF(I1) 300,310,300
  300 FVTIQ=FVT(IQ)
      RVT(IQ)=0.
      OLDF(IQ)=FVTIQ
      IQQ=(IQ*(IQ+1))/2
      AFVTIQ=ABS(FVTIQ)
      B1IQ=AMAX1(B1(IQQ),(PMAX* SQPNM)/AFVTIQ)
      B1(IQQ)=AMIN1(1.,B1IQ)
      P(IQ)=-FVTIQ*B1(IQQ)
      IF(ABS(P(IQ)).LT.RMIN*AN) P(IQ)=-FVTIQ
      IF(ISGRAD.NE.1) ISGR=1
      ISGRAD=1
      PMAX1=PMAX
      APIQ=ABS(P(IQ))
      IF(PMAX.GT.APIQ) GOTO 304
      PMAX1=APIQ
      IPM=IQ
  304 PNMI=P(IQ)/PMAX1
      PNMA=PMAX/PMAX1
      PMAX=PMAX1
      PNM=PNM*PNMA*PNMA+PNMI*PNMI
      OFMAX1=OFMAX
      IF(OFMAX.GT.AFVTIQ) GOTO 306
      OFMAX1=AFVTIQ
      IFMA=IQ
  306 OFNMI=FVTIQ/OFMAX1
      OFNMA=OFMAX/OFMAX1
      OFMAX=OFMAX1
      OFNM=OFNM*OFNMA*OFNMA+OFNMI*OFNMI
      SFO=SFO*OFNMA*PNMA+OFNMI*PNMI
      IF(I1.GT.1)GOTO 270
      SQOFNM=SQRT(OFNM)
      SQPNM=SQRT(PNM)
  310 IF(OFNM.LE.0.) GOTO 940
       ICOSTA =0
      IF(SQOFNM*OFMAX.GT.EPS) GOTO 320
      ICOSTA=1
      IF(ICT.GT.1.AND.XNOR.LE.XEPS) GOTO 940
  320 IF(IAP.EQ.0) GOTO 330
       IF(ICT.LE.IMAX) GOTO 322
      IF(ICOSTA.NE.1) IFAIL=2
      GOTO 940
  322 IF(LFUN.LT.LFUNMA) GOTO 324
      IF(ICOSTA.NE.1) IFAIL=3
      GOTO 940
  324 ICT=ICT+1
  330 IAP=0
      IF(I1.EQ.0)GOTO 360
      IF(IXT1.EQ.1 )GOTO 350
      PFN=SQPNM*SQOFNM
      IF(SFO.LT.-0.01*PFN)GOTO 350
  335 IPM=IFMA
      IF(ISGRAD.NE.1) ISGR=1
      ISGRAD=1
      PMAX=PMAX*SQPNM/SQOFNM
      DO 340 I=1,N
  340 P(I)=-PMAX*(OLDF(I)/OFMAX)
      PNM=OFNM
      SQPNM=SQOFNM
      SFO=-OFNM
      IF(ISC.EQ.1) GOTO 360
  350 SC=AMIN1(0.1,1.0/(SQPNM*PMAX))
  360 DAUG=1.
      IQM=0
      IXT1=0
      DO 460 I=1,N
      RV(I)=0.
      IF(RVT(I).NE.0.) GOTO 460
      IF(P(I))370,460,380
  370 B2=A(I)-X(I)
      GOTO 390
  380 B2=B(I)-X(I)
  390 IF(I-1)400,400,420
  400 IF(ABS(P(1)).GT.1.) GOTO 410
      IF(ABS(B2).GT.RMAX*ABS(P(1)))GOTO 460
  410 SCM=B2/P(1)
      JQ(1)=1
      IQM=1
      RV(1)=-SIGN(1.0,P(1))
      GOTO 460
  420 IF(ABS(P(I)).GT.1.)GOTO 430
      IF(ABS(B2).GE.RMAX*ABS(P(I)))GOTO 460
  430 SCMI=B2/P(I)
      IF(SCMI-SCM)440,450,460
  440 SCM=SCMI
      IF (IQM.EQ.0) GO TO 444
      DO 442 J=1,IQM
      IQ=JQ(J)
  442 RV(IQ)=0.
  444 IQM=1
      RV(I)=-SIGN(1.0,P(I))
      JQ(1)=I
      GOTO 460
  450 IQM=IQM+1
      RV(I)=-SIGN(1.0,P(I))
      JQ(IQM)=I
  460 CONTINUE
      DO 464 I=1,N
      IF(RVT(I).NE.0..OR.RV(I).NE.0.) GOTO 464
      YI=X(I)+SCM*P(I)
      IF((YI.LT.BMI(I).OR.X(I).GE.BMI(I)).AND.(YI.GT.AMA(I).
     1OR.X(I).LE.AMA(I))) GOTO 464
      IQM=IQM+1
      RV(I)=-SIGN(1.,P(I))
      JQ(IQM)=I
  464 CONTINUE
      IF(SCM.NE.0.)GOTO 500
      IF(ISC.NE.1) GOTO 465
      IF(ISGRAD.NE.1) GOTO 335
      FF=OLDFF
      IF(ICOSTA.NE.1) IFAIL=4
      GOTO 940
  465 CONTINUE
      DO 470 J=1,N
  470 Y(J)=X(J)
      DO 490 I=1,IQM
      IQ=JQ(I)
      IF(P(IQ).LT.0.)GOTO 480
      Y(IQ)=B(IQ)
      GOTO 490
  480 Y(IQ)=A(IQ)
  490 CONTINUE
      SC=SCM
      KEY=2
      CALL LINE1(A,B,X,N)
      GOTO (335,360,921,940),KEY
  500 SC=AMIN1(SC,SCM)
      IF(ISC.EQ.1) GOTO 505
  501 IF(ICT.LE.N.OR.ISGRAD.EQ.1) GOTO 505
      SC=AMIN1(1.0,SCM)
  505 KEY=1
      CALL LINE1(A,B,X,N)
      GOTO (335,360,921,940),KEY
  921 IF (KFF.NE.1) SQFNM=SQRT(FNM)
      CALL ENORM(OLDP,N,OPMAX,OPNM)
      SQOPNM=SQRT(OPNM)
      XNOR=SQPNM*OPMAX
      OXNOR1=XNOR
      OXNOR=XNOR
      IF(KFF.NE.1) GOTO 926
      KFF=2
      PM=SQPNM*PMAX
      CALL GRABP1(X,N,A,B)
      IFV=IFV+1
      DO 919 I=1,N
      IF(RVT(I))917,918,917
  917 F(I)=0.
      GOTO 919
  918 F(I)=FVT(I)
  919 CONTINUE
      CALL VMAX(FVT,N,FVTMAX,IFVTMA)
      CALL VMAX(F,N,FMAX,IFM)
      CALL ENORM(F,N,FMAX,FNM)
      CALL ENORM(FVT,N,FVTMAX,FNM2)
      SQFNM=SQRT(FNM)
      IF(FNM.LE.0.)GOTO 920
      IF(ICT.LE.1.OR.SQFNM*FMAX.GT.EPS)GOTO 926
  920 IF(FNM2.LE.0.) GOTO 398
      ICOSTA=0
      IF(SQRT(FNM2)*FVTMAX.GT.EPS) GOTO 922
      ICOSTA=1
      IF(XNOR.LE.XEPS) GOTO 398
  922 IAP=1
  926 IF(ABS(FF-OLDFF).GT.EPS1) GOTO 928
      MSTOP=MSTOP+1
      IF(MSTOP.LT.NSTOP.OR.XNOR.GT.XEPS) GOTO 930
      IF(ICOSTA.NE.1) IFAIL=1
      GOTO 398
  928 MSTOP=0
  930 CONTINUE
      IF(IAP.EQ.1) GOTO 934
      IF(ICT.LT.IMAX) GOTO 932
      IF(ICOSTA.NE.1) IFAIL=2
      GOTO 398
  932 IF(LFUN.LT.LFUNMA) GOTO 934
      IF(ICOSTA.NE.1) IFAIL=3
      GOTO 398
 934  IF (ICON.EQ.1) GO TO 398
      IF (ICT.NE.INEXT) GO TO 990
      SOFPRI=FMAX*SQFNM
      IN=1
      CALL SPAU31(X,N,FF,ICT,IPRINT)
      INEXT=ICT+IPRINT
      GO TO 990
  398 OFMAX=FMAX
      SQOFNM=SQFNM
  940 FM=FF
      IN=2
      ICTMIN=ICT
      SOFPRI=SQOFNM*OFMAX
      IF (IPRINT.GE.0) CALL SPAU31(X,N,FF,ICT,IPRINT)
      RETURN
  990 OFNM=FNM
      OLDFF=FF
      IFMA=IFM
      OFMAX=FMAX
      SQOFNM=SQFNM
      YMAX=ABS(F(1)-OLDF(1))
      DO 1000 I=1,N
      Y(I)=F(I)-OLDF(I)
      AY=ABS(Y(I))
      IF(YMAX.LT.AY)YMAX=AY
 1000 OLDF(I)=F(I)
      IF(IAP.NE.1)GOTO 1020
      DAUG=3.
      IF(XNOR.GT.0.0)GOTO 1020
      IF(SC.EQ.SCM)GOTO 1010
      SC=0.
      SCM=RMAX
      GOTO 180
 1010 IF(ISGRAD.EQ.0)GOTO 1110
      IF(ISGR)140,140,1110
 1020 CONTINUE
      IF(YMAX.EQ.0.)GOTO 1110
      CALL MIVB1(N,M,B1)
      GOTO (100,1110,1021),KEY
 1021 ISGRAD=0
 1110 IF(IQM.EQ.0) GOTO 1170
      DO 1160 K=1,IQM
      IQ=JQ(K)
      IF(X(IQ).NE.A(IQ).AND.X(IQ).NE.B(IQ)) GOTO 1160
      IQQ=(IQ*(IQ+1))/2
      B1IQ=B1(IQQ)
      IQM1=K
      IF(B1IQ.EQ.0.)GOTO 100
      RVT(IQ)=RV(IQ)
      OLDF(IQ)=0.
 1130 IQJ=(IQ*(IQ-1))/2+1
      IIQ1=IQJ
      DO 1146 J=1,N
      IF(J.EQ.IQ) GOTO 1142
      IF(RVT(J).NE.0.) GOTO 1140
      B1IQJ=B1(IQJ)/B1IQ
      IJ1=(J*(J-1))/2
      IIQ=IIQ1
      DO 1138 I=1,J
      IJ=IJ1+I
      IF(I.EQ.IQ) GOTO 1134
      IF(RVT(I).NE.0.) GOTO 1132
      B1(IJ)=B1(IJ)-B1IQJ*B1(IIQ)
 1132 IF(IQ.GT.I)GOTO 1136
 1134 IIQ=IIQ+I
      GOTO 1138
 1136 IIQ=IIQ+1
 1138 CONTINUE
 1140 IF(IQ.GT.J) GOTO 1144
 1142 IQJ=IQJ+J
      GOTO 1146
 1144 IQJ=IQJ+1
 1146 CONTINUE
      DO 1150 I=1,N
      IF(IIQ1.EQ.IQQ) GOTO 1147
      B1(IIQ1)=0.
 1147 IF(IQ.GT.I) GOTO 1148
      IIQ1=IIQ1+I
      GOTO 1150
 1148 IIQ1=IIQ1+1
 1150 CONTINUE
 1160 CONTINUE
      CALL VMAX(OLDF,N,OFMAX,IFMA)
      CALL ENORM(OLDF,N,OFMAX,OFNM)
      SQOFNM=SQRT(OFNM)
      IQM1=1
 1170 SC=0.
      SCM=RMAX
      GOTO 180
      END
      SUBROUTINE LINE1(A,B,X,N)
      DIMENSION A(N),B(N),X(N)
      COMMON/STATIS/IFAIL,ICT,ICTMIN,LFUN
      COMMON/MIVF/F(100)
      COMMON/MIVP/P(100)/MIVOLP/OLDP(100)
      COMMON/MIVRVT/RVT(100)/B3/FVT(100)
      COMMON/MIVUPD/UPD(100)
      COMMON/MIVGRA/PM,IPM,FN2,KFF,FF,OFMAX,OXNOR1
      COMMON/MIV3/INEXT
      COMMON/MIVBMI/BMI(100)/MIVAMA/AMA(100)
      COMMON/GRZ/ZET(100)
      COMMON/MIVLIN/SQPNM,PMAX,IFV,SC,OLDFF,EPSC,ISC,ICON,ISGRAD,
     *SCM,FVTMAX,FMAX,IFM,FNM,FNM2,EPS,XEPS,IAP,SFO,
     *OPNM,PNM,OXNOR
      COMMON/MIVIG/IGRA
      COMMON/MIVKEY/KEY
      COMMON/MIVY/Y(100)
      COMMON/MIVLIB/OPMAX,ETA
      COMMON/LIN1/SCIN,IXT,PF,ICOSTA
      AN=FLOAT(N)
      RMIN=R1MACH(1)
      RLRS=R1MACH(4)*AN*AN
      RMAX=R1MACH(2)
      SRMAX=SQRT(RMAX)/10.
      SRMIN=SQRT(RMIN)*10
      KAP=0
      SCMIN=SC
      FFREC=OLDFF
      IF(ISC.EQ.1) GOTO 880
      SCIN=SC
      IXT=0
      IF(KEY.EQ.2) GOTO 538
      IF(ICT.LE.N.OR.ISGRAD.EQ.1) GOTO 880
      SQOPNM=SQRT(OPNM)
      IF(OPNM.LE.0..OR.PNM.LE.0.)GOTO 880
      CALL PROD(OLDP,P,N,OPMAX,PMAX,PARA)
      PARA=PARA/(SQOPNM*SQPNM)
  520 IF(ABS(PARA)-0.995)880,530,530
  530 IXT=1
      IF(PF.GT.1.5.AND.PF.LE.2.0) GOTO 880
      SC=AMIN1(SCM,0.5)
      IF(PF.LE.1.5) GOTO 535
      SC=AMIN1(PF-1.0,SCM)
      IXT=0
  535 SCMIN=SC
      GOTO 880
  538 XNOR=0
      KAP=1
  540 KFF=1+IGRA
      FF=FI(Y,N)
      LFUN=LFUN+1
      PM=SQPNM*PMAX
      CALL GRABP1(Y,N,A,B)
      IF(KFF.NE.1) IFV=IFV+1
      FN=FN2
      IF(KFF.GT.2) GOTO 544
      IF(FF.GE.FFREC) GOTO 544
      FNREC=FN
      KFFREC=KFF
      SCMIN=SC
      FFREC=FF
  544 CONTINUE
      IF(OLDFF.GE.FF) GOTO 570
      IF(XNOR.LT.EPSC) GOTO 545
      IF(SC.GT.SCIN*0.001) GOTO 570
      IF(FFREC.LT.OLDFF) GOTO 568
      GOTO 566
  545 IF(FFREC.LT.OLDFF) GOTO 568
  546 IF(ISC.NE.1 )GOTO 550
      KEY=4
      IF(ICOSTA.NE.1) IFAIL=4
      FF=OLDFF
      RETURN
  550 ISC=1
      IF(ISGRAD.EQ.1) GOTO 551
      KEY=1
      RETURN
  551 DO 560 I=1,N
  560 P(I)=-P(I)
      KEY=2
      RETURN
  566 GP=0.5*EPSC/(PMAX*SQPNM)
      IF(GP.EQ.0.)GOTO 546
      IXT=1
      SC=GP
      GOTO 880
  568 ISC=2
  570 PF=2.
      ETA=1.0
      IF(OLDFF.EQ.FF.AND.XNOR.EQ.0.) KAP=1
  576 IF(KFF.NE.1) GOTO 580
      FN1=FN
      FN=FN*SQPNM
      FMAX1=1.
      IPRO=0
      IF(ABS(FN1).GT.EPS) GOTO 660
      KFF=2
      FN2=FN1
      PM=SQPNM*PMAX
      CALL GRABP1(Y,N,A,B)
      IFV=IFV+1
  580 CONTINUE
      DO 606 I=1,N
      IF(RVT(I))590,600,590
  590 F(I)=0.
      GOTO 606
  600 F(I)=FVT(I)
  606 CONTINUE
      CALL VMAX(FVT,N,FVTMAX,IFVTMA)
      CALL VMAX(F,N,FMAX,IFM)
      CALL ENORM(F,N,FMAX,FNM)
      CALL ENORM(FVT,N,FVTMAX,FNM2)
      IF(KFF.LE.2) GOTO 608
      CALL PROD1(F,P,N,FMAX,PMAX,FN,IPRO)
      FMAX1=FMAX
  608 SQFNM=SQRT(FNM)
  610 IF(FF.GE.FFREC) GOTO 614
      SCMIN=SC
      FFREC=FF
      KFFREC=KFF
      FVMARE=FVTMAX
      FNM2RE=FNM2
      IFMREC=IFM
      FMAXRE=FMAX
      FNMREC=FNM
      SQFNMR=SQFNM
      DO 612 I=1,N
  612 UPD(I)=FVT(I)
  614 CONTINUE
      IF(FNM.LE.0.)GOTO 620
      IF(SQFNM*FMAX.GT.EPS)GOTO 660
  620 IF(OLDFF.GT.FF-RLRS*ABS(FF)-RMIN.OR.KAP.EQ.1) GOTO 630
      IF(FFREC.LT.OLDFF) GOTO 900
      SC=0.5*SC
      IXT=1
      GOTO 880
  630 SCMIN=SC
      ICOSTA=0
      IF(SQRT(FNM2)*FVTMAX.GT.EPS) GOTO 640
      ICOSTA=1
      IF(XNOR.LE.XEPS.OR.FNM2.LE.0.) ICON=1
      GOTO 900
  640 IAP=1
      GOTO 900
  660 IF(KAP.EQ.1.OR.ISC.EQ.2)GOTO 900
      IF(IPRO.EQ.0) GOTO 680
      IF(PMAX.LE.1.) GOTO 665
      IF(OFMAX.GE.(SRMAX/AN)/PMAX) GOTO 670
  665 SFO1=OFMAX*SFO*PMAX
      IF(SFO1.GE.1.) GOTO 668
      IF(ABS(FN).GT.SRMAX*ABS(SFO1)) GOTO 675
  668 DD=FN/SFO1
      GOTO 700
  670 DD=FN/(SRMAX*SFO)
      GOTO 700
  675 DD=-SRMAX*SIGN(1.0,FN)
      GOTO 700
  680 IF(ABS(OFMAX).GE.1.) GOTO 690
      IF(ABS(FMAX1).LT.SRMAX*ABS(OFMAX)) GOTO 690
      DD=SRMAX*(FN/SFO)
      GOTO 700
  690 DD=(FMAX1/OFMAX)*(FN/SFO)
  700 FO=(SC*PMAX)*(OFMAX*SFO)
      IF(ABS(FO).GT.SRMIN*ABS(OLDFF).AND.ABS(FO).GT.SRMIN*ABS(FF))
     -GOTO 730
      DFF=FF-OLDFF
      IF(ABS(FO).GT.SRMIN*ABS(DFF)) GOTO 720
      IF(ABS(DFF).LT.(SRMIN/100.)) GOTO 710
      D=-SRMIN*SIGN(1.0,DFF)
      GOTO 740
  710 D=-DFF/RMIN
      GOTO 740
  720 D=(FF-OLDFF)/FO
      GOTO 740
  730 D=1.+(FF-FO)/FO-OLDFF/FO
  740 G7=1.0
      P1=2.0
      GO=1.+2.*DD-3.*D
      IF(ABS(GO).LE.0.01)GOTO 750
      G7=(DD-1.)/(2.*GO)
  750 G1=3.*(DD+1.-2.*D)
      G2=2.*(3.*D-DD-2.)
      G3=G2*G2-4.*G1
      IF(ABS(G1).LE.0.003*ABS(G2).OR.G3.LE.0.0)GOTO 760
      G4=(-G2-SQRT(G3))/(2.*G1)
      IF(G4.LE.0.01)GOTO 760
      IF(G7.LT.0.1.OR.G7.GT.10.0) GOTO 760
      GP=G4*SC
      IF(ABS(DD).LT.0.01) GOTO 755
      PF=1.0+2.*(1.-G4)*GO/DD
  755 P1=1.0-0.5*G4*G2
      PF=AMIN1(3.0,PF)
      PF=AMAX1(2.0,PF)
      ETA=G7
      GOTO 780
  760 GP=2.5*SC
      IF(IXT.NE.1) GP=10.*SC
      ETA=1.0
      IF(DD.GT.0.99) GOTO 770
      GP=SC/(1.0-DD)
  770 IF(D.GT.0.99) GOTO 840
      GP=0.5*SC/(1.0-D)
  780 IF(D.GT.0.99.OR.DD.GT.0.99) GOTO 840
      IF(D*(1.+DD).LT.0.0.OR.DD.GT.D) GOTO 840
      IF(ABS(DD).LT.0.05)GOTO 840
      Z=2.0
      IKT=0
      Q=SC/(AMIN1(5*SC,AMAX1(GP,0.05*SC)))
      IF(Q.EQ.1.) Q=1.01
      F1=(1.0-DD)/(Z*Q)+DD/Z-D
      F2=((ABS(1.-Q))**Z)/(1.-Q)-DD
      R=ABS(F1)+ABS(F2)
  790 Z1=-((1.-DD)/(Z*Z*Q)+DD/(Z*Z))
      IF(Q.GE.SRMAX)GOTO 840
      Z2=-(1.-DD)/(Z*Q*Q)
      Z3=(ABS(1.-Q))**Z*ALOG(ABS(1.-Q))/(1.-Q)
      Z4=-(Z-1.)*(ABS(1.-Q))**(Z-2.)
      DET=Z1*Z4-Z2*Z3
      IF(ABS(DET).LE.SRMIN)GOTO 840
      DZ=(Z2*F2-Z4*F1)/DET
      DQ=(Z3*F1-Z1*F2)/DET
      T=1.0
      IF(IKT.GT.50) GOTO 840
      IKT=IKT+1
  800 ZN=Z+T*DZ
      QN=Q+T*DQ
      IF(QN.EQ.1.) GOTO 810
      IF(ZN.GE.5..OR.ZN.LE.1.1.OR.QN.LE.EPS) GOTO 810
      IF(ALOG10(ABS(1.-QN))*ZN.LT.14.)GOTO 820
  810 T=0.5*T
      IF(T.LE.SQRT(SRMIN))GOTO 840
      GOTO 800
  820 F1=(1.-DD)/(ZN*QN)+DD/ZN-D
      F2=((ABS(1.-QN))**ZN)/(1.-QN)-DD
      RN=ABS(F1)+ABS(F2)
      IF(RN.LE.SQRT(SRMIN))GOTO 830
      IF(RN.GE.R)GOTO 810
      R=RN
      Z=ZN
      Q=QN
      GOTO 790
  830 IF(DD*(Q-1.).GT.0.)GOTO 840
      G5=SC/QN
      G6=(1.-DD)*(G5-SC)/(DD*SC*(ZN-1.))
      IF(G6.LT.0.1.OR.G6.GT.10.)GOTO 840
      P1=ZN
      PF=ZN
      GP=G5
      ETA=G6
  840 IF(D.LT.0.01)GOTO 860
      IF(DD.GE.1.0)GOTO 850
      IF(GP/SC.GE.2..AND.(D.GT.0.99.OR.P1.GT.3.0))GOTO 850
      GOTO 900
 850  IF(IXT.EQ.1)GOTO 900
 860  IF(GP.GT.SC)GOTO 870
      IF(FF.LE.OLDFF.AND.IXT.EQ.1) GOTO 900
      IXT=1
 870  SCC=SC
      SCMA=5.
      IF(IXT.NE.1)SCMA=10.
      GP=AMIN1(GP,SCMA*SC)
      SC=AMAX1(GP,0.05*SC)
      IF(SC.GT.SCM)SC=SCM
      IF(SC.NE.SCC) GOTO 880
      IF(OLDFF.GE.FF) GOTO 900
      SC=0.5*SC
 880  ZMAX=0.
      DO 890 I=1,N
      XI=X(I)
      YI=XI+SC*P(I)
      IF(YI.GE.BMI(I)) YI=B(I)
      IF(YI.LE.AMA(I)) YI=A(I)
      Y(I)=YI
      ZET(I)=XI-YI
  890 ZMAX=AMAX1(ZMAX,ABS(ZET(I)))
      CALL ENORM(ZET,N,ZMAX,XNOR)
      XNOR=SQRT(XNOR)*ZMAX
      OXNOR1=AMAX1(OXNOR,XNOR)
      GOTO 540
  900 OPMAX=0.
      IF(FFREC.EQ.OLDFF.OR.SC.EQ.SCMIN) GOTO 912
      KFF=KFFREC
      SC=SCMIN
      FF=FFREC
      IF(KFF.EQ.1) GOTO 901
      FNM=FNMREC
      IFM=IFMREC
      FMAX=FMAXRE
      FVTMAX=FVMARE
      SQFNM=SQFNMR
  901 FN1=FNREC
      DO 910 I=1,N
      IF(KFF.EQ.1) GOTO 906
      UPDI=UPD(I)
      IF(RVT(I).EQ.0.) GOTO 902
      F(I)=0.
      GOTO 904
  902 F(I)=UPDI
  904 FVT(I)=UPDI
  906 OLDP(I)=SC*P(I)
      IF(RVT(I).NE.0.)GOTO 910
      XI=X(I)
      YI=XI+OLDP(I)
      IF(YI.LT.BMI(I)) GOTO 907
      YI=B(I)
      OLDP(I)=YI-XI
  907 IF(YI.GT.AMA(I)) GOTO 908
      YI=A(I)
      OLDP(I)=YI-XI
  908 X(I)=YI
      OPMAX=AMAX1(OPMAX,ABS(OLDP(I)))
  910 CONTINUE
      GOTO 916
  912 CONTINUE
      DO 915 I=1,N
      OLDP(I)=SC*P(I)
      IF(RVT(I).NE.0.) GOTO 915
      YI=Y(I)
      IF(YI.NE.A(I).AND.YI.NE.B(I)) GOTO 914
      OLDP(I)=YI-X(I)
  914 OPMAX=AMAX1(OPMAX,ABS(OLDP(I)))
      X(I)=YI
  915 CONTINUE
  916 KEY=3
      FN2=FN1
      RETURN
      END
      SUBROUTINE MIVB1(N,NM,B1)
      DOUBLE PRECISION SG,UPDI,GHG,ZZ,PI,PJ,ZER
      DIMENSION B1(NM)
      COMMON/MIVUPD/UPD(100)
      COMMON/MIVOLP/OLDP(100)
      COMMON/MIVRVT/RVT(100)
      COMMON/MIVY/Y(100)/MIVKEY/KEY/MIVYM/YMAX
      COMMON/MIVLIB/OPMAX,ETA
      AN=FLOAT(N)
      ZER=0.D0
      RMAX=R1MACH(2)
      DO 1030 I=1,N
 1030 Y(I)=Y(I)/YMAX
 1040 SG=ZER
      GHG=ZER
      DO 1060 I=1,N
      UPDI=ZER
      YI=Y(I)
      IF(RVT(I).NE.0.)GOTO 1060
      IJ=(I*(I-1))/2+1
      DO 1050 J=1,N
      IF(RVT(J).NE.0.) GOTO 1042
      UPDI=UPDI+B1(IJ)*Y(J)
 1042 IF(I.GT.J) GOTO 1044
      IJ=IJ+J
      GOTO 1050
 1044 IJ=IJ+1
 1050 CONTINUE
      SG=SG+OLDP(I)*YI
      GHG=GHG+UPDI*YI
 1060 UPD(I)=SNGL(UPDI)
      IF(GHG.GT.ZER) GOTO 1061
      KEY=1
      RETURN
 1061 IF(SG.GT.ZER) GOTO 1062
      KEY=2
      RETURN
 1062 IF(SG.GT.1.D0) GOTO 1070
      IF(DBLE(OPMAX).LE.SG*RMAX/(AN*AN)) GOTO 1070
      KEY=2
      RETURN
 1070 IF(YMAX.GE.1.) GOTO 1080
      IF(DBLE(YMAX*RMAX).GE.SG) GOTO 1080
      KEY=2
      RETURN
 1080 ZZ=ETA*(SG/YMAX)+GHG
      DO 1095 I=1,N
      IF(RVT(I).NE.0.) GOTO 1095
      UPDI=UPD(I)
      PI=OLDP(I)/SG
      IJ1=(I*(I-1))/2
      DO 1090 J=1,I
      IF(RVT(J).NE.0.) GOTO 1090
      IJ=IJ1+J
      PJ=OLDP(J)/SG
      B1(IJ)=SNGL(B1(IJ)-UPDI*PJ-UPD(J)*PI+ZZ*PI*PJ)
 1090 CONTINUE
 1095 CONTINUE
      KEY=3
      RETURN
      END
      SUBROUTINE SPAU31(X,N,FF,IM,IPRINT)
      DIMENSION X(N)
      COMMON /INW/IN/STATIS/IFAIL,ICT,ICTM,L
      COMMON/MIVPRI/SOFPRI
      NOUT=I1MACH(2)
      IF (IN.EQ.2) GO TO 10
      WRITE(NOUT,100)
      IF (IM.EQ.IPRINT) WRITE (NOUT,210)
      WRITE (NOUT,110) IM
      WRITE(NOUT,120) FF
      WRITE(NOUT,220) SOFPRI
      WRITE(NOUT,140)
      WRITE(NOUT,130) (X(I),I=1,N)
      RETURN
   10 WRITE(NOUT,170)
      WRITE(NOUT,180)
      WRITE (NOUT,150) FF
      WRITE(NOUT,220) SOFPRI
      WRITE(NOUT,160)
      WRITE(NOUT,130) (X(I),I=1,N)
      WRITE(NOUT,190) L
      WRITE (NOUT,390) IM
      IF (IFAIL.EQ.0) WRITE (NOUT,400)
      IF (IFAIL.EQ.4) WRITE (NOUT,410)
      IF (IFAIL.EQ.3) WRITE (NOUT,420)
      IF (IFAIL.EQ.2) WRITE (NOUT,430)
      IF (IFAIL.EQ.1) WRITE (NOUT,440)
      WRITE (NOUT,200)
      WRITE(NOUT,170)
      RETURN
  100 FORMAT (/1X,34(2H -))
  110 FORMAT(2X,23HI T E R A T I O N  NR =,I6)
  120 FORMAT (/2X,19HFUNCTION VALUE F = ,E15.8)
  130 FORMAT(4(2X,E15.8))
  140 FORMAT (2X,13HCURRENT POINT)
  150 FORMAT (/2X,28HOPTIMAL FUNCTION VALUE FM = ,E15.8)
  160 FORMAT(2X,13HOPTIMAL POINT)
  170 FORMAT (/1X,34(2H *)/1X,34(2H *))
  180 FORMAT (/2X,13HR E S U L T S)
  190 FORMAT (/2X,34HNUMBER OF FUNCTION EVALUATIONS L =,I6)
  200 FORMAT (/7X,17HMIVAR4 TERMINATED)
  210 FORMAT (1X,34(2H -))
  220 FORMAT (2X,30HNORM OF CONSTRAINED GRADIENT =,E15.8)
  370 FORMAT (/7X,17HMIVAR4 TERMINATED)
  390 FORMAT (2X,25HNUMBER OF ITERATIONS NR =,I6)
  400 FORMAT (/2X,61HIFAIL = 0. TERMINATION CRITERION: GRADIENT NORM LES
     CS THAN EPS)
  410 FORMAT (/2X,65HIFAIL = 4. TERMINATION CRITERION: IMPOSSIBLE TO DEC
     1REASE FUNCTION)
  420 FORMAT (/2X,64HIFAIL = 3. TERMINATION CRITERION: NUMBER OF FUNCTIO
     1N EVALUATIONS/2X,14HGREATER THAN M)
  430 FORMAT (/2X,54HIFAIL = 2. TERMINATION CRITERION: NUMBER OF ITERATI
     CONS/2X,14HEXCEEDED LIMIT)
  440 FORMAT (/2X,53HIFAIL = 1. TERMINATION CRITERION: CHANGE OF FUNCTIO
     1N,/2X,35HLESS THAN EPS1, OCCURED NSTOP TIMES)
      END
      SUBROUTINE GRABP1(X,NN,A,B)
      DIMENSION X(NN),A(NN),B(NN)
      COMMON /MIVDEL/DEL,DL/GRZ/Z(100)/STATIS/IFAIL,ICT,ICTM,LFUN
     C/MIV3/IEXT
      COMMON /MIVGRA/PM,IP,FN,KFF,FF,FMAX,XNOR
      COMMON /MIVNFN/IFN
      COMMON /B3/F(100)/MIVP/P(100)/MIVDE/DELT(101)
      N=NN
      iprad=1
      icom=1
      RBASE=FLOAT(I1MACH(10))
      RDIG=FLOAT(I1MACH(11))
      TOL1=RBASE**(-RDIG*0.15)
      TOL2=RBASE**(-RDIG*0.2)
      TOL3=RBASE**((-RDIG)*0.5)
      TOL4=RBASE**((-RDIG)*0.75)
      RLRS=R1MACH(4)
      SRL1=SQRT(RLRS)
      SRL=SQRT(SRL1)
       IF(ICT.NE.0)GOTO 30
      FMAX=0.
      DL=B(1)-A(1)
      IF (DEL.LE.0.) DEL=RLRS
      DELT(1)=DEL
      DELT(N+1)=DEL
      DO 20 I=2,N
      DELT(I)=DEL
   20 DL=AMIN1(DL,B(I)-A(I))
      DL=DL*0.05
   30 FMA=ABS(FMAX)
      IF (DEL.LE.0) DEL=RLRS
      DO 40 I=1,N
   40 Z(I)=X(I)
      IPP=IP
      IF(KFF.EQ.2) GOTO 200
      IF(KFF.EQ.0) GOTO 190
      DEL=AMIN1(DELT(N+1),DL)
      IF(DEL.LE.XNOR) GOTO 50
      DEL=AMAX1(XNOR,0.1*DEL)
   50 DEL=AMAX1(DEL,RLRS)
      DI=DEL
      S1=1.
   90 SK=1.
      IK=0
  100 CONTINUE
      DO 120 I=1,N
      IF(P(I).EQ.0.) GOTO 120
  102 Z(I)=X(I)+SK*DI*S1*(P(I)/PM)
      IF(IP.NE.I) GO TO 104
      IF(Z(I).NE.X(I)) GOTO 104
      DI=DI*10.
      GO TO 100
  104 IF(Z(I).LE.B(I).AND.Z(I).GE.A(I)) GOTO 120
      IF(IK.NE.0) GOTO 410
      IF(S1.EQ.-1.) GOTO 110
      S1=-1.
      GOTO 100
  110 KFF=3
      DO 112 J=1,I
  112 Z(J)=X(J)
      GOTO 190
  120 CONTINUE
      I=0
      IF(IK.NE.0) GOTO 400
      IK=1
      GOTO 300
  190  IPP=N+1
  200 PN=0.
  202 continue
      DO 260 I=iprad,N
      goto (204,210,220,250),icom
  204 IF(IPP.EQ.I) GOTO 260
      XI=X(I)
      AI=A(I)
      BI=B(I)
      DEL=AMIN1(DELT(I),DL)
       IF(DEL.LE.XNOR)GOTO 206
      DEL=AMAX1(XNOR,0.1*DEL)
  206 DEL=AMAX1(DEL,RLRS)
      DI=DEL
      S1=1.
  210 Z(I)=XI+DI*S1
      IF(Z(I).NE.XI) GOTO 214
      DI=DI*10.
      GOTO 210
  214 SK=1.
      IF(Z(I).LE.BI)GOTO 300
      S1=-1.
      GOTO 210
  220 Z(I)=XI-SK*DI
      IF(Z(I).LT.AI)GOTO 410
      GOTO 400
  250 IF(KFF.NE.2) GOTO 256
      PN=PN+(P(I)/PM)*FNI
  256 F(I)=FNI
      Z(I)=XI
      DELT(I)=DI
      icom=1
  260 CONTINUE
      IF(KFF.EQ.0) KFF=1
      IF(KFF.NE.2) RETURN
      F(IP)=(FN-PN)/(P(IP)/PM)
      DELT(IP)=DELT(N+1)
      RETURN
  300 FF1=FI(Z,N)
      KK2=1
  310 LFUN=LFUN+1
      DIF=ABS(FF1-FF)
      AF=ABS(FF)
      IF(DIF.GT.TOL2*AF)SK=0.5
      IF(DI.NE.DEL)GOTO 320
      IF(DIF.LE.TOL1*AF)GOTO 320
      IF(DEL.EQ.RLRS) GOTO 330
      DI=0.25*DEL
      IF(KFF.EQ.1) GOTO 90
      iprad=i
      icom=2
      GOTO 202
  320 IF(DIF.GT.TOL3*AF) GOTO 330
      SK=2.
      IF(DI.NE.DEL.OR.(S1.EQ.-1..AND.I.EQ.0)) GOTO 330
      IF(DIF.GT.TOL4*AF)GOTO 330
      IF(DEL.GE.XNOR) GOTO 326
      DI=4.*DEL
      IF(KFF.EQ.1) GOTO 90
      iprad=i
      icom=2
      GOTO 202
  326 SK=4.
      IF(DIF.EQ.0.)SK=10.
  330 IF(XNOR.LT.AMAX1(SRL,DI*100.).OR.DEL.EQ.RLRS.OR.FMA.LT.SRL)GOTO332
      GOTO 410
  332 IF(S1.EQ.-1.) GOTO 410
      IF(KFF.eq.1) GOTO 340
      iprad=i
      icom=3
      goto 202
  340 S1=-1.
      GOTO 100
  400 DEN=(SK**2+SK)*DI
      DI=DI*SK
      FF2=FI(Z,N)
      KK2=2
  405 LFUN=LFUN+1
      FNI=(SK**2*(FF1-FF)-FF2+FF)/DEN
      GOTO 420
  410 FNI=(FF1-FF)/(DI*S1)
      DI=DI*SK
  420 IF(KFF.eq.1) GOTO 430
      iprad=i
      icom=4
      goto 202
  430 FN=FNI
      IFN=IFN+1
      DELT(N+1)=DI
      RETURN
      END
      SUBROUTINE VMAX(V,N,VM,IM)
C
      DIMENSION V(N)
C   *******************************************
C   SEARCH OF MAXIMAL ABSOLUTE VALUE OF ELEMENT
C
C   VM = MAX ABS(V(N)) - /OUTPUT/
C   IM = ARG (VM)      - /OUTPUT/
C   *******************************************
      NN=N
      VMM=ABS(V(1))
      IMM=1
      DO 10 I=2,NN
      VV=ABS(V(I))
      IF(VMM.GE.VV) GOTO 10
      VMM=VV
      IMM=I
   10 CONTINUE
      VM=VMM
      IM=IMM
      RETURN
      END
      SUBROUTINE ENORM(V,N,VM,EN)
C
      DIMENSION V(N)
C   *******************************
C   EUKLIDIAN NORM OF (V/VM)
C
C   VM = MAX ABS(V(N))	-  /INPUT /
C   EN = NORM(V/VM)**2	-  /OUTPUT/
C   *******************************
      EN=0.
      IF(VM.EQ.0.) RETURN
      ENN=0.
      VMM=VM
      NN=N
      DO 10 I=1,NN
      VI=V(I)/VMM
   10 ENN=ENN+VI*VI
      EN=ENN
      RETURN
      END
      SUBROUTINE PROD(V,Z,N,VMAX,ZMAX,PRO)
C
      DIMENSION V(N),Z(N)
C   ***********************************
C   SCALAR PRODUCT
C
C   VMAX = MAX ABS(V(I))     - /INPUT /
C   ZMAX = MAX ABS(Z(I))     - /INPUT /
C   PRO  = (V/VMAX)*(Z/ZMAX) - /OUTPUT/
C   ***********************************
      PRO=0.
      IF(VMAX.EQ.0.0.OR.ZMAX.EQ.0.0) RETURN
      NN=N
      PRO1=0.
      VMAX1=VMAX
      ZMAX1=ZMAX
      DO 10 I=1,NN
   10 PRO1=PRO1+(V(I)/VMAX1)*(Z(I)/ZMAX1)
      PRO=PRO1
      RETURN
      END
      SUBROUTINE PROD1(V,Z,N,VMAX,ZMAX,PRO,IPRO)
C
      DIMENSION V(N),Z(N)
C   **********************************************
C   SCALAR PRODUCT
C
C   VMAX = MAX ABS(V(I))		- /INPUT /
C   ZMAX = MAX ABS(Z(I))		- /INPUT /
C   PRO  = (V/VMAX)*(Z/ZMAX), IF IPRO=0 - /OUTPUT/
C   PRO  = V*Z		    , IF IPRO=1 - /OUTPUT/
C   IPRO - INDICATOR OF  P R O	EXPRES. - /OUTPUT/
C   **********************************************
      PRO=0.
      IPRO=0
      IF(VMAX.EQ.0.0.OR.ZMAX.EQ.0.0) RETURN
      NN=N
      AN=FLOAT(NN)
      PRO1=0.
      VMAX1=VMAX
      ZMAX1=ZMAX
      RMAX=R1MACH(2)/AN
      RMIN=R1MACH(1)
      IV=0
      IVV=0
      IF(VMAX1.GT.1.) GOTO 10
      VZ=VMAX1*ZMAX1
      IF(VZ.LE.1.) GOTO 20
      IF(VZ.LT.RMAX) GOTO 55
      GOTO 30
   10 RV=RMAX/VMAX1
      VV=1./VMAX1
      IF(ZMAX1.LE.VV) GOTO 20
      IF(ZMAX1.LT.RV) GOTO 55
      GOTO 30
   20 IV=1
   30 PROMAX=0.
      DO 40 I=1,NN
      PROI=(V(I)/VMAX1)*(Z(I)/ZMAX1)
      PRO1=PRO1+PROI
      APROI=ABS(PROI)
   40 PROMAX=AMAX1(PROMAX,APROI)
      PRO=PRO1
      IF(IV.EQ.1.OR.ABS(PRO1).GE.100.*AN*RMIN) RETURN
      IF(ZMAX1.LT.1.) GOTO 45
      IF(VMAX1*PROMAX.GT.RMAX/ZMAX1) RETURN
      GOTO 50
   45 IF(ZMAX1*PROMAX.GT.RMAX/VMAX1) RETURN
   50 IVV=1
   55 IPRO=1
      PRO1=0.
      DO 60 I=1,NN
   60 PRO1=PRO1+V(I)*Z(I)
      PRO=PRO1
      IF(PRO1.NE.0.) GOTO 70
      IPRO=0
      RETURN
   70 IF(IVV.NE.1) GOTO 80
      IF(ABS(PRO1).LE.1.) RETURN
      PRO1=(PRO1/ZMAX1)/VMAX1
      GOTO 90
   80 PRO1=PRO1/(ZMAX1*VMAX1)
   90 IF(ABS(PRO1).LE.0.) RETURN
      PRO=PRO1
      IPRO=0
      RETURN
      END
      SUBROUTINE INWR31(X,A,B,N,NH,FM,IPAR,PAR,IPA,IPAA)
      DIMENSION X(N),A(N),B(N)
      DIMENSION IPAR(30),PAR(30)
      COMMON/INW/INW1/STATIS/IFAIL,ICT,ICTM,NFUN
      NNH=N*(N+1)/2
      MN=100
      MIP=30
      K=4
      K1=4
      NOUT=I1MACH(2)
      IF (INW1.EQ.2) GO TO 300
      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 CONTINUE
      IPRINT=IPAR(IPA+1)
      IF (IPRINT.LT.0) GO TO 110
      WRITE (NOUT,770)
      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
      M=IPAR(IPA+2)
      NSTOP=IPAR(IPA+3)
      IMAX=IPAR(IPA+4)
      IF (IPRINT.LT.0) GO TO 40
      WRITE (NOUT,640) IPRINT
      WRITE (NOUT,650) M
      WRITE (NOUT,780) NSTOP
      WRITE (NOUT,790) IMAX
   40 IF (M.GT.0) GO TO 43
      WRITE (NOUT,525)
      IF (IPRINT.LT.0) WRITE (NOUT,650) M
      GO TO 5
   43 IF (NH.GE.NNH) GO TO 45
      WRITE (NOUT,730)
      IF (IPRINT.GE.0) GO TO 47
      WRITE (NOUT,630) N
   47 WRITE (NOUT,635) NH
      GO TO 5
   45 IF (NSTOP.GT.0) GO TO 50
      WRITE (NOUT,530)
      IF (IPRINT.LT.0) WRITE (NOUT,780) NSTOP
      GO TO 5
   50 IF (IMAX.GT.0) GO TO 120
      WRITE (NOUT,800)
      IF (IPRINT.LT.0) WRITE (NOUT,790) IMAX
      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 IF (IPRINT.LT.0) GO TO 250
      J=IPAA+1
      J1=IPAA+4
      WRITE (NOUT,720) (PAR(I),I=J,J1)
  250 CONTINUE
      IF (IPRINT.LT.0) GO TO 200
      WRITE (NOUT,570)
      WRITE (NOUT,580) (A(I),I=1,N)
      WRITE (NOUT,590)
      WRITE (NOUT,580) (B(I),I=1,N)
  200 NER=0
      DO 90 I=1,N
      IF (A(I).LT.B(I)) GO TO 90
      IF (NER.NE.0) GO TO 86
      WRITE (NOUT,600) I,I
      GO TO 87
   86 WRITE (NOUT,605) I,I
   87 CONTINUE
      NER=1
   90 CONTINUE
      IF (NER.EQ.0) GO TO 150
      IF (IPRINT.GE.0) GO TO 5
      WRITE (NOUT,570)
      WRITE (NOUT,580) A
      WRITE (NOUT,590)
      WRITE (NOUT,580) B
      GO TO 5
  150 CONTINUE
      IF (IPRINT.LT.0) GO TO 260
      WRITE (NOUT,820)
      WRITE (NOUT,580) (X(I),I=1,N)
  260 NER=0
      DO 270 I=1,N
      IF (X(I).LE.B(I).AND.X(I).GE.A(I)) GO TO 270
      WRITE (NOUT,830) I,I,I,I
      NER=1
  270 CONTINUE
      IF (NER.EQ.0) GO TO 160
      IF (IPRINT.GE.0) GO TO 5
      WRITE (NOUT,570)
      WRITE (NOUT,580) A
      WRITE (NOUT,590)
      WRITE (NOUT,580) B
      WRITE (NOUT,820)
      WRITE (NOUT,580) X
      GO TO 5
  160 CONTINUE
      FM=FI(X,N)
      IF (IPRINT.GE.0) WRITE (NOUT,850) FM
      RETURN
  300 WRITE (NOUT,760)
      IF (IPAR(IPA+1).GE.0) GO TO 5
      WRITE (NOUT,820)
      WRITE (NOUT,580) X
      GO TO 5
  500 FORMAT (/2X,61H**E R R O R  I N  M I V A R 4** N LESS THAN 1 OR GR
     CEATER THAN,I4)
  510 FORMAT (/2X,20HNUMBER OF PARAMETERS,11X,5HIPA =,I6)
  520 FORMAT (/2X,47H**E R R O R  I N  M I V A R 4** IPA LESS THAN 0/2X,
     C7HOR IPA+,I2,13H GREATER THAN,I3)
  525 FORMAT (/2X,45H**E R R O R  I N  M I V A R 4** M LESS THAN 1/)
  530 FORMAT (/2X,49H**E R R O R  I N  M I V A R 4** NSTOP LESS THAN 1/)
  570 FORMAT ( /2X,32HVECTOR OF LOWER BOUNDS (A) FOR X)
  580 FORMAT (4(2X,E15.8))
  590 FORMAT (2X,32HVECTOR OF UPPER BOUNDS (B) FOR X)
  600 FORMAT (/2X,34H**E R R O R  I N  M I V A R 4** A(,I2,22H) GREATER
     COR EQUALS B(,I2,1H))
  605 FORMAT (34X,2HA(,I2,22H) GREATER OR EQUALS B(,I2,1H))
  620 FORMAT (/2X,22HI N I T I A L  D A T A)
  630 FORMAT (/2X,19HNUMBER OF VARIABLES,28X,3HN =,I6)
  635 FORMAT (2X,26HDIMENSION OF WORKING ARRAY,20X,4HNH =,I6)
  640 FORMAT (/2X,18HPRINTING PARAMETER,27X,5HIPR =,I6)
  650 FORMAT (2X,38HMAXIMUM NUMBER OF FUNCTION EVALUATIONS,9X,3HM =,I6)
  700 FORMAT (/2X,27HNUMBER OF PARAMETERS IPAA =,I3)
  710 FORMAT (/2X,48H**E R R O R  I N  M I V A R 4** IPAA LESS THAN 0/
     C2X,8HOR IPAA+,I2,13H GREATER THAN,I3)
  720 FORMAT (/2X,20HSMALL STEP TOLERANCE,6X,6HXEPS =,E15.8/2X,
     123HGRADIENT NORM TOLERANCE,4X,5HEPS =,E15.8/2X,
     232HFUNCTION CHANGE TOLERANCE EPS1 =,E15.8/2X,
     320HDIFFERENTIATION STEP,6X,6HDELT =,E15.8)
  730 FORMAT (/2X,54H**E R R O R  I N  M I V A R 4** NH LESS THAN N*(N+1
     C)/2)
  760 FORMAT (/2X,60H**E R R O R  I N  M I V A R 4** STARTING POINT IS S
     CTATIONARY)
  770 FORMAT (////12X,11HM I V A R 4)
  780 FORMAT (2X,50HNUMBER OF SMALL FUNCTION CHANGE RECURRENCE NSTOP =,
     CI6)
  790 FORMAT (2X,28HMAXIMUM NUMBER OF ITERATIONS,16X,6HIMAX =,I6)
  800 FORMAT (/2X,48H**E R R O R  I N  M I V A R 4** IMAX LESS THAN 1/)
  820 FORMAT (/2X,14HSTARTING POINT)
  830 FORMAT (/2X,34H**E R R O R  I N  M I V A R 4** X(,I2,17H) GREATER
     CTHAN B(,I2,1H)/2X,5HOR X(,I2,14H) LESS THAN A(,I2,1H))
  850 FORMAT (2X,19HFUNCTION VALUE F = ,E15.8)
      END
