      SUBROUTINE ANAL2(A,B,N,XX,X,NM,IPAR,IPA)
      DIMENSION A(N),B(N),IPAR(30),XX(NM),X(NM)
      COMMON /ANA1/R(20,20)/ANA2/VK(20,20)/ANA3/DX(20)/ANA4/DY(20)
      COMMON /BS1/F(1000)/STATIS/IFAIL,IT,ITM,NF
      IFAIL=0
      CALL INWR22(A,B,N,XX,NM,IPAR,IPA)
      IF (IFAIL.EQ.10) RETURN
      ISP=IPAR(IPA+1)
      M=IPAR(IPA+2)
      NF=M
      IT=M
      ITM=M
      DO 1 I=1,N
      AIN=B(I)-A(I)
      DO 1 J=1,M
      I1=(J-1)*N+I
    1 X(I1)=(XX(I1)-A(I))/AIN
      VID=0.
      DO 5 I=1,M
    5 VID=VID+F(I)
      VID=VID/FLOAT(M)
      CALL FAKTKK(X,NM,F,M,R,N,20)
      DISP=0.
      DO 6 I=1,N
    6 DISP=DISP+R(I,I)
      IF (DISP.GT.1.E-10) GO TO 10
      IFAIL=10
      CALL INWR22(A,B,N,XX,NM,IPAR,IPA)
      RETURN
   10 CONTINUE
      DO 7 I=1,N
    7 DX(I)=R(I,I)/DISP
      CALL VKNVR(R,20,N,VK,DY,1.E-5,200)
      DO 16 I=1,N
   16 DY(I)=DY(I)/DISP
      CALL SPAU22(ISP,VID,DISP,N)
      RETURN
      END
      SUBROUTINE MAXNVR(R,M,N,VK,RNR,EPS,ITER)
      DIMENSION R(M,M),VK(N),VK1(100)
      DO 1 I=1,N
    1 VK(I)=1.
      DO 2 IT=1,ITER
      DO 12 I=1,N
      VK1(I)=0.
      DO 12 J=1,N
   12 VK1(I)=VK1(I)+VK(J)*R(J,I)
      RNR=VK1(1)
      DO 9 I=2,N
      R1=VK1(I)
      IF(ABS(R1).GT.ABS(RNR)) RNR=R1
    9 CONTINUE
      DO 3 I=1,N
    3 VK1(I)=VK1(I)/RNR
      S=0.
      DO 4 I=1,N
      S=S+(VK1(I)-VK(I))**2
    4 VK(I)=VK1(I)
      S=SQRT(S)
      IF(S.LT.EPS) GO TO 5
    2 CONTINUE
    5 S=0.
      DO 6 I=1,N
    6 S=S+VK(I)*VK(I)
      S=SQRT(S)
      DO 7 I=1,N
    7 VK(I)=VK(I)/S
      RETURN
      END
      SUBROUTINE FAKTKK(X,NM,F,M,R,N,MR)
      DIMENSION X(NM),F(M),R(MR,MR)
      RL=FLOAT(M)
      RL=RL*RL-RL
      DO 3 I=1,N
      DO 3 J=I,N
    3 R(I,J)=0.
      M1=M-1
      NM1=0
      DO 11 K=1,M1
      K2=K+1
      NM2=NM1+N
      DO 12 K1=K2,M
      Z=0.
      DO 5 JJ=1,N
      NM3=NM1+JJ
      NM4=NM2+JJ
    5 Z=Z+(X(NM3)-X(NM4))**2
      IF (Z.LT.1.E-10) GO TO 12
      FK=(F(K)-F(K1))**2
      DO 33 I=1,N
      NM3=NM1+I
      NM4=NM2+I
      DO 33 J=I,N
      NM5=NM1+J
      NM6=NM2+J
   33 R(I,J)=R(I,J)+FK*(X(NM3)-X(NM4))*(X(NM5)-X(NM6))/Z
   12 NM2=NM2+N
      NM1=NM1+N
   11 CONTINUE
      DO 34 I=1,N
      DO 34 J=I,N
      R(I,J)=R(I,J)/RL
      IF(I.EQ.J) GO TO 34
      R(J,I)=R(I,J)
   34 CONTINUE
      RETURN
      END
      SUBROUTINE VKNVR(R,M,N,VK,RNRX,EPS,ITER)
      DIMENSION R(M,M),VK(M,M),RNRX(N),V(20,20),VK1(20)
      DO 14 I=1,N
      DO 14 J=1,N
   14 V(I,J)=R(I,J)
      DO 15 I=1,N
      CALL MAXNVR(V,20,N,VK1,RNRX(I),EPS,ITER)
      DO 12 J1=1,N
      DO 12 J2=1,N
   12 V(J1,J2)=V(J1,J2)-RNRX(I)*VK1(J1)*VK1(J2)
      DO 13 J=1,N
   13 VK(J,I)=VK1(J)
   15 CONTINUE
      RETURN
      END
      SUBROUTINE INWR22(A,B,N,X,NM,IPAR,IPA)
      DIMENSION A(N),B(N),X(NM),IPAR(30)
      COMMON /STATIS/IFAIL,IT,ITM,NF/BS1/F(1000)
      MIM=10
      MN=20
      MIP=30
      MM=300
      NOUT=I1MACH(2)
      K=2
      R1M=SQRT(R1MACH(2))/100.
      IF (IFAIL.EQ.0) GO TO 3
      WRITE (NOUT,970)
      RETURN
    3 CONTINUE
      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,960)
      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)
      IF (IPRINT.LT.0) GO TO 40
      WRITE (NOUT,640) IPRINT
      WRITE (NOUT,650) M
   40 IF (M.GE.MIM.AND.M.LE.MM) GO TO 47
      WRITE(NOUT,530) MIM,MM
      IF (IPRINT.LT.0) WRITE (NOUT,650) M
      GO TO 5
   47 IF (NM.GE.N*M) GO TO 50
      WRITE (NOUT,730)
      IF (IPRINT.GE.0) GO TO 48
      WRITE (NOUT,630) N
      WRITE (NOUT,650) M
   48 WRITE (NOUT,635) NM
      GO TO 5
   50 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.NE.1) GO TO 260
      IF (IPRINT.GE.0) GO TO 5
      WRITE (NOUT,570)
      WRITE (NOUT,580) A
      WRITE (NOUT,590)
      WRITE (NOUT,580) B
      GO TO 5
  260 NER=0
      DO 270 I=1,M
      IF (ABS(F(I)).LT.R1M) GO TO 275
      WRITE (NOUT,860) F(I)
      J1=(I-1)*N+1
      J2=I*N
      WRITE (NOUT,580) (X(J),J=J1,J2)
      GO TO 5
  275 CONTINUE
      DO 285 J=1,N
      J1=(I-1)*N+J
      IF(X(J1).LE.B(J).AND.X(J1).GE.A(J)) GOTO 285
      IF (NER.NE.0) GO TO 280
      WRITE(NOUT,830) I
      GO TO 290
  280 WRITE(NOUT,840) I
  290 NER=1
      GO TO 270
  285 CONTINUE
  270 CONTINUE
      IF (NER.EQ.1) GO TO 5
      RETURN
  500 FORMAT (/2X,61H**E R R O R  I N  A N A L 2** N LESS THAN 1 OR N GR
     CEATER THAN,I3)
  510 FORMAT (/2X,20HNUMBER OF PARAMETERS,11X,5HIPA =,I6)
  520 FORMAT (/2X,45H**E R R O R  I N  A N A L 2** IPA LESS THAN 0/2X,
     C7HOR IPA+,I2,13H GREATER THAN,I3)
  530 FORMAT(/2X,41H**E R R O R  I N  A N A L 2** M LESS THAN,I3/2X,
     C17HOR M GREATER THAN,I6/)
  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,32H**E R R O R  I N  A N A L 2** A(,I2,22H) GREATER OR
     C EQUALS B(,I2,1H))
  605 FORMAT (32X,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,14X,3HN =,I6)
  635 FORMAT (2X,26HDIMENSION OF WORKING ARRAY,6X,4HNM =,I6)
  640 FORMAT(/2X,18HPRINTING PARAMETER,13X,5HIPR =,I6)
  650 FORMAT(2X,36HNUMBER OF FUNCTION EVALUATIONS   M =,I6)
  730 FORMAT (/2X,46H**E R R O R  I N  A N A L 2** NM LESS THAN N*M)
  830 FORMAT(/2X,42H**E R R O R  I N  A N A L 2** POINT NUMBER,I4,
     C14H OUT OF BOUNDS)
  840 FORMAT(32X,12HPOINT NUMBER,I4,14H OUT OF BOUNDS)
  860 FORMAT (/2X,54H**E R R O R  I N  A N A L 2** TOO LARGE FUNCTION VA
     CLUE//2X,3HF =,E15.8,2X,3HX =)
  960 FORMAT (////12X,9HA N A L 2)
  970 FORMAT (/2X,61H**E R R O R  I N  A N A L 2** VARIATION OF OBJECTIV
     CE FUNCTION/2X,12HIS TOO SMALL)
      END
      SUBROUTINE SPAU22(ISP,VID,DISP,N)
      COMMON /ANA1/R(20,20)/ANA2/VK(20,20)/ANA3/DX(20)/ANA4/DY(20)
      DIMENSION V4(60)
      DATA V1,V2/1HX,1HY/
      NOUT=I1MACH(2)
      IF (ISP.LT.0) GO TO 100
      WRITE (NOUT,170)
      WRITE (NOUT,180)
      WRITE (NOUT,210) VID,DISP
      WRITE (NOUT,500)
      N1=1
   10 N2=MIN0(N,N1+4)
      CALL LENT22(V1,N1,N2,V4)
      DO 20 I=1,N
      IF (I.LE.9) WRITE (NOUT,550) I,(R(I,J),J=N1,N2)
      IF (I.GT.9) WRITE (NOUT,560) I,(R(I,J),J=N1,N2)
   20 CONTINUE
      WRITE (NOUT,570) V4
      IF (N2.EQ.N) GO TO 30
      N1=N2+1
      GO TO 10
   30 CONTINUE
      WRITE (NOUT,590)
      N1=1
   40 N2=MIN0(N,N1+4)
      CALL LENT22(V2,N1,N2,V4)
      DO 50 I=1,N
      IF (I.LE.9) WRITE (NOUT,550) I,(VK(I,J),J=N1,N2)
      IF (I.GT.9) WRITE (NOUT,560) I,(VK(I,J),J=N1,N2)
   50 CONTINUE
      WRITE (NOUT,570) V4
      IF (N2.EQ.N) GO TO 60
      N1=N2+1
      GO TO 40
   60 CONTINUE
      WRITE (NOUT,510)
      DO 70 I=1,N
      IF (I.LE.9) WRITE (NOUT,520) I,DX(I),I,DY(I)
      IF (I.GT.9) WRITE (NOUT,530) I,DX(I),I,DY(I)
   70 CONTINUE
      WRITE (NOUT,540)
  100 DO 110 I=1,N
      IF (DY(I).GT.0.) GO TO 110
      WRITE (NOUT,300) I
  110 CONTINUE
      IF (ISP.LT.0) RETURN
      WRITE (NOUT,450)
      WRITE (NOUT,170)
      RETURN
  170 FORMAT (/1X,34(2H *)/1X,34(2H *))
  180 FORMAT (/2X,13HR E S U L T S)
  210 FORMAT (/2X,16HMEAN VALUE MV = ,E15.8,3X,16HDISPERSION DS = ,
     CE15.8)
  300 FORMAT (2X,12HWARNING: DY(,I2,13H) LESS THAN 0)
  450 FORMAT (/7X,16HANAL2 TERMINATED)
  500 FORMAT (/2X,18HCOVARIACION MATRIX)
  510 FORMAT (/4X,33HDEGREES OF INFLUENCE OF VARIABLES/2X,37(1H-)/4X,
     C33HINITIAL SYSTEM  I  OPTIMAL SYSTEM/2X,18(1H-),1HI,18(1H-)/
     C3X,1HX,8X,2HDX,6X,1HI,2X,1HY,8X,2HDY/2X,18(1H-),1HI,18(1H-))
  520 FORMAT (2X,1HX,I1,3X,E12.5,3H I ,1HY,I1,3X,E12.5)
  530 FORMAT (2X,1HX,I2,2X,E12.5,3H I ,1HY,I2,2X,E12.5)
  540 FORMAT (2X,37(1H-))
  550 FORMAT (2X,1HX,I1,3X,5(E12.5))
  560 FORMAT (2X,1HX,I2,2X,5(E12.5))
  570 FORMAT (2X,5(1H-),60A1/)
  580 FORMAT (/)
  590 FORMAT (/2X,25HOPTIMAL COORDINATE SYSTEM)
      END
      SUBROUTINE LENT22(V3,N1,N2,V4)
      DIMENSION V(51),V1(10),V4(60)
      DATA V2,V5/1H ,1H-/
      DATA V1/1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H0/
      NOUT=I1MACH(2)
      DO 10 I=1,51
   10 V(I)=V2
      J=1
      DO 40 I=N1,N2
      V(J)=V3
      IF (I.GT.9) GO TO 20
      V(J+1)=V1(I)
      GO TO 30
   20 K=MOD(I,10)
      K1=K
      IF (K1.EQ.0) K1=10
      V(J+2)=V1(K1)
      K=(I-K)/10
      V(J+1)=V1(K)
   30 J=J+12
   40 CONTINUE
      WRITE (NOUT,100) V
      DO 50 I=1,60
   50 V4(I)=V2
      J=12*(N2-N1+1)
      DO 60 I=1,J
   60 V4(I)=V5
      WRITE (NOUT,110) V4
      RETURN
  100 FORMAT (12X,51A1)
  110 FORMAT (2X,5(1H-),60A1)
      END
