      SUBROUTINE GLOPT(XM,A,B,M,FM,IPAR,IPA)
      DIMENSION XM(M),IPAR(30)
      INTEGER GUESS,FNMAX,CNMAX,GNMAX,D,PN,SN,FN,CN,OUT,RKEY
      INTEGER ND(20),REDUC(20),PG(150),FNP(150)
      INTEGER MARKM(150),MARK(150),PNC(150),WI1(150)
      INTEGER WI2(150)
      REAL A(M),B(M),STPLX(150),C(20)
      COMMON /INW/IN/ATT/AT(15)/STATIS/IFAIL,IT,ITM,FN
      REAL WR1(150),WR2(150),WR3(21),WR4(21),WR5(21)
      REAL S(21,21)
      REAL X(21,150)
      GNMAX=150
      CNMAX=20
      MMAX=20
      M1MAX=MMAX+1
      IFAIL=0
      CALL INWR16(A,B,M,IPAR,IPA)
      IF (IFAIL.EQ.10) RETURN
      IPR=IPAR(IPA+1)
      PN=IPAR(IPA+3)
      FNMAX=IPAR(IPA+2)
      IFAIL=1
      RKEY=1
      NDP=1
      M1=M+1
      IRD=10
      GUESS=0
      FN=0
      D1=0
      DO 10 I=1,M
      C(I)=B(I)-A(I)
   10 D1=D1+C(I)**2
      STPL=SQRT(D1/FLOAT(M))*(1./FLOAT(PN))**(1./FLOAT(M))*0.1
      DO 40 I=1,CNMAX
      REDUC(I)=IRD
   40 ND(I)=NDP
      DO 50 II=1,PN
      MARKM(II)=0
      STPLX(II)=STPL
   50 FNP(II)=1
C**  SAMPLING OF GLOBAL POINTS
      CALL GLOPO(M,NDP,PN,GUESS,A,C,ND,PG,X,WI1,WR1,WR2)
      FN=FN+PN-GUESS
  100 DO 150 SN=1,CNMAX
      CALL CLUST(FNMAX,M,SN,FN,PN,STPL,STPLX,PG,FNP,X,WR1,WR2,WR3,
     CM1,A,C,M2)
      PN=M2
C**  RADIUS IN SEPARATION ALGORITHM DETERMINED ONCE OR
C**  EVERY TIME DEPENDING ON RKEY
      IF (.NOT.(SN.EQ.1.OR.RKEY.EQ.1)) GO TO 110
      CALL RADUS(M,M1MAX,PN,ALFA,X,PG,D,R1,S,OUT,
     ,WR1,WR2,WR3,WR4,WR5)
C**  POINTS ARE SORTED AFTER DECENDING F-VALUES
  110 DO 120 II=1,PN
      JJ=PG(II)
  120 WR1(II)=X(M1,JJ)
      CALL MSORT(PN,WR1,WI2,ISTRT,WI1)
      DO 125 II=1,PN
  125 WI1(II)=PG(II)
      DO 130 II=1,PN
      JJ=PN-II+1
      PG(JJ)=WI1(ISTRT)
      ISTRT=WI2(ISTRT)
  130 CONTINUE
      CALL SEPAR(M,PN,D,R1,PG,X,CN,MARK,WI1,WR3,WR1,PNC,WI2,WR2,M1)
      M2=PN
      CALL OUTRE(M,SN,PN,CN,REDUC,PG,MARKM,MARK,PNC,GNMAX,M2)
      IT=SN
      ITM=SN
      IN=0
      IF (IPR.LE.0) GO TO 140
      IF (MOD(SN,IPR).EQ.0) CALL SPAU16(IPR,CN,PNC,GNMAX,MARK,M,
     CX,FM,XM)
  140 CONTINUE
      IF (PN.GT.1) GO TO 145
      IFAIL=2
      GO TO 199
  145 CONTINUE
      IF (FN.GE.FNMAX) GO TO 199
  150 CONTINUE
      IFAIL=0
  199 K2=0
      DO 210 MC=1,CN
      K1=K2+1
      K2=K2+PNC(MC)
      DO 220 K3=K1,K2
      J=MARK(K3)
      XK=X(M1,J)
      IF (K3.EQ.1) GO TO 200
      IF (XK.LE.FM) GO TO 220
  200 CONTINUE
      FM=XK
      DO 230 I=1,M
  230 XM(I)=X(I,J)
  220 CONTINUE
  210 CONTINUE
      FM=-FM
      IN=100
      IF (IPR.GE.0) CALL SPAU16(IPR,CN,PNC,GNMAX,MARK,M,X,FM,XM)
      RETURN
      END
      SUBROUTINE EIGVAL(LP,E,A,B,W,F)
C    LP IS THE SIZE OF ARRAY A. E IS A VECTOR OF LP ELEMENTS
C    WHICH WILL HOLD THE EIGENVALUES IN DESCENDING ABSOLUTE ORDER.
C    A IS A VECTOR OF LP ELEMENTS GIVING THE DIAGONAL ELEMENTS
C    OF THE TRIDIAGONAL MATRIX. B IS A VECTOR OF LP ELEMENTS.
C    THE LAST LP - 1. W IS A VECTOR OF LP ELEMENTS USED FOR
C    TEMPORARY STORAGE. F IS A VECTOR OF LP ELEMENTS USED FOR
C    TEMPORARY STORAGE.
      DIMENSION E(LP),A(LP),B(LP),W(LP)
      DIMENSION F(LP)
C    FIND ABSOLUTE BOUND FOR THE EIGENVALUES
      AM=ABS(A(1))
      BM=0.
      DO 1 I=2,LP
      AM=AMAX1(AM,ABS(A(I)))
    1 BM=AMAX1(BM,ABS(B(I)))
      BD=AM+BM+BM
      DO 6 I=1,LP
C    THIS LOOP FORCES THE EIGENVALUES TO LIE BETWEEN PLUS AND MINUS
C    ONE. THE E AND W VECTORS ARE RESPECTIVELY LOW AND HIGH ESTIMATES
C    TO ALL THE EIGENVALUES.
      A(I)=A(I)/BD
      B(I)=B(I)/BD
      E(I)=-1.
    6 W(I)=1.
      DO 50 K=1,LP
C    FIND THE K-TH EIGENVALUE. ALSO LOW AND HIGH ESTIMATES FOR THE
C    K+1-ST TO LP-TH EIGENVALUES ARE IMPROVED. THE EIGENVALUES ARE
C    FOUND IN ASCENDING ORDER. THE K-TH EIGENVALUE IS CONSIDERED
C    FOUND IF THE THE HIGH AND LOW PLACES AGREE TO SEVEN DECIMAD
C    PLACES.
    8 IF ((W(K)-E(K))/AMAX1(ABS(W(K))+ABS(E(K)),1.E-10)-R1MACH(4)*1000.)
     C50,50,10
   10 X=(W(K)+E(K))*0.5
C    X IS A GUESS FOR THE K-TH EIGENVALUE. COMPUTE NUMBER OF
C    EIGENVALUES EQUAL OR EXCEEDING X BY USING STURM SEQUENCE
C    (ORTEGA'S METHOD).
      S2=1.
      F(1)=A(1)-X
      IF (F(1)) 102,104,104
  102 S1=-1.
      N=0
      GO TO 105
  104 S1=1.
      N=1
  105 DO 120 I=2,LP
      IF (ABS(B(I)).LE.R1MACH(1)) GO TO 113
  106 IF (ABS(B(I-1)).LE.R1MACH(1)) GO TO 114
  107 IF (ABS(F(I-1))+ABS(F(I-2))-1.E-10   ) 111,112,112
C    IF THE PREVIOUS TWO TERMS OF THE STURM SEQUENCE WERE VERY
C    SMALL, THEY ARE FORCED TO BE CLOSER TO ONE IN MAGNITUDE TO
C    AVOID UNDERFLOW PROBLEMS.
  111 F(I-1)=F(I-1)*1.E10
      F(I-2)=F(I-2)*1.E10
  112 F(I)=(A(I)-X)*F(I-1)-B(I)*B(I)*F(I-2)
      GO TO 115
  113 F(I)=(A(I)-X)*S1
      GO TO 115
  114 F(I)=(A(I)-X)*F(I-1)-SIGN(B(I)*B(I),S2)
  115 S2=S1
      IF (ABS(F(I)).LE.R1MACH(1)) GO TO 117
  116 S1=SIGN(S1,F(I))
      IF (ABS(S1+S2).LE.R1MACH(1)) GO TO 120
  117 N=N+1
  120 CONTINUE
C    NOW LET N BE THE NUMBER OF EIGENVALUES SMALLER THAN X.
      N=LP-N
      IF (N.LT.K) GO TO 20
C    X BECOMES AN UPPER BOUND FOR THE K-TH TO N-TH EIGENVALUES.
   12 DO 15 J=K,N
   15 W(J)=X
   20 N=N+1
C    IF ALL THE EIGENVALUES ARE SMALLER THAN X, TEST WHETHER WE
C    HAVE CONVERGED TO THE K-TH EIGENVALUE.
      IF (LP.LT.N) GO TO 8
   24 DO 26 J=N,LP
C    IF X IS LARGER THAN PREVIOUS LOWER BOUND. INCREASE THE LOWER BOUND.
      IF (X-E(J)) 8,8,26
   26 E(J)=X
      GO TO 8
   50 CONTINUE
C    RESTORE INPUT AND SCALE EIGENVALUES.
      DO 60 I=1,LP
      A(I)=A(I)*BD
      B(I)=B(I)*BD
   60 W(I)=(W(I)+E(I))*BD*0.5
C    SORT EIGENVALUES IN ABSOLUTE DESCENDING ORDER
      J=LP
      K=1
      DO 80 I=1,LP
      IF (ABS(W(K))-ABS(W(J))) 63,63,65
   63 E(I)=W(J)
      J=J-1
      GO TO 80
   65 E(I)=W(K)
      K=K+1
   80 CONTINUE
      RETURN
      END
      SUBROUTINE TRIDMX(N,NM,A,D,B)
C    TRIDIAGONALIZATION OF REAL SYMMETRIC MATRIX.
      DIMENSION A(NM,NM),D(N),B(N)
      DOUBLE PRECISION SUM
C    SAVE ORIGINAL DIAGONALS IN ARRAY D.
      DO 10 I=1,N
   10 D(I)=A(I,I)
C    FOR N-2 RETURN WITHOUT COMPUTING.
      IF (N-2)60,55,15
C    K INDEX CONTROLS THE (N-2) SIMILARITY TRANSFORMATION.
   15 DO 46 K=3,N
      KK=K-1
C    SUM CONTAINS THE SUM OF THE SQUARE ELEMENTS
C    OF A COLUMN. EXCEPT THE FIRST K-2 ELEMENTS.
      SUM=DBLE(A(K-1,K-2)*A(K-1,K-2))
      DO 20 J=K,N
   20 SUM=SUM+DBLE(A(J,K-2)*A(J,K-2))
C    THE B ARRAY CONTAINS THE BETA VALUES.(I.E.,BETA=SUM**(1/2))
      B(K-2)=SIGN(SNGL(DSQRT(SUM)),-A(K-1,K-2))
C    IF BETA=0 NO TRANSFORMATION IS INITIATED.
      IF (ABS(B(K-2)).LE.R1MACH(1)) GO TO 46
C    THE COMPONENTS OF THE COLUMN VECTOR W ARE STORED IN THEPOSITIONS
C    OF THE ANNIHILATED ELEMENTS OF A (I.E.,LOWER HALF OF A)
   24 A(K-1,K-2)=SQRT(0.5*ABS(A(K-1,K-2)/B(K-2))+0.5)
      DENOM=-2.*A(K-1,K-2)*B(K-2)
      DO 30 I=K,N
   30 A(I,K-2)=A(I,K-2)/DENOM
      SCAL=0.
   37 DO 36 J=KK,N
C    THE BETAS ARE FORMED ONE BY ONE. WHEN R OF THEM HAVE BEEN
C    FORMED,P AND Q CONTAIN ONLY (N-R) ELEMENTS. THE B ARRAY IS
C    USED TO STORE SUCCESIVE P,S AND Q,S.
      B(J)=0.
      IF (J.EQ.KK) GO TO 350
      DO 349 L=KK,JJ
  349 B(J)=B(J)+A(J,L)*A(L,K-2)
  350 DO 35 L=J,N
   35 B(J)=B(J)+A(L,J)*A(L,K-2)
C    SCAL=W(TRANSPOSE)*P
      JJ=J
   36 SCAL=SCAL+B(J)*A(J,K-2)
      DO 40 J=KK,N
   40 B(J)=B(J)-SCAL*A(J,K-2)
C    TRANSFORM ALL ELEMENTS OF A EXCEPT PIVOTAL ROW AND COLUMN.
      DO 45 J=KK,N
      DO 45 L=J,N
   45 A(L,J)=A(L,J)-2.*(A(L,K-2)*B(J)+A(J,K-2)*B(L))
   46 CONTINUE
C    RESTORE ORIGINAL DIAGONALS OF A. STORE DIAGONAL OF
C    TRANSFORMED MATRIX IN ARRAY D.
      DO 50 I=1,N
      T=A(I,I)
      A(I,I)=D(I)
      J=N-I
      B(J+1)=B(J)
   50 D(I)=T
   55 B(N)=A(N,N-1)
   60 B(1)=0.
      RETURN
      END
      SUBROUTINE GLOPO(M,NDP,N,GUESS,A,C,ND,PG,X,STEP,R,Z)
      INTEGER M,NDP,N,GUESS,ND(M),PG(N),STEP(M)
      REAL A(M),C(M),R(M),Z(M)
      REAL X(21,150)
C    N-K=NUMBER OF POINTS TO	SAMPLE, NDP=1 CRUDE MC, =2 STRATIFIED.
C    ND DIVISIONS PER COORDINATE, M DIMENSION OF INDEPENDENT VARIABLE.
C    A AND C DETERMINES H. RI MULTIPLIER IN RANDOM NUMBER GENERATOR.
C    RN RANDOM NUMBER COUNTER. X CONTAINS THE GLOBAL POINTS. X(M+1,K)
C    THE FUNCTION VALUE, PG(K)=K
      K=GUESS
      GO TO (10,7),NDP
C    EVALUATE F. STORE R. UPDATE PG. TEST FOR READY
    4 K=K+1
      X(M+1,K)=-FI(R,M)
      DO 5 I=1,M
    5 X(I,K)=R(I)
      PG(K)=K
      IF (K.LT.N) GO TO (10,30),NDP
      RETURN
C    STRATIFIED SAMPLING
C    ALL POINTS IN A UNIFORM NET WITH THE RANDOM STARTING POINT R IN HS
C    ARE TESTED FOR BEING IN A. THE COORDINATE VALUE R(M) IS CHANGING
C    MOST RAPIDLY THEN R(M-1) AND SO ON. THE PROCESS IS REPEATED WITH
C    A NEW RANDOM START UNTIL ALL POINTS ARE FOUND. STEP IS A VECTOR
C    GOVERNING THE SAMPLING. FOR M=2, ND(1)=3, ND(2)=2 STEP ATTAINS THE
C    SUCCESSIVE VALUES 1 1, 1 2, 2 1, 2 2, 3 1, 3 2.
    7 DO 8 I=1,M
    8 STEP(I)=1
C    RANDOM NUMBERS IN HS
   10 DO 12 I=1,M
      CALL UNDEV(RI)
      R(I)=A(I)+C(I)*RI
C    REMEMBER ORIGINAL POINT R
   12 Z(I)=R(I)
   20 J=M
C    TEST R
      IF (IRA(R,A,C,M).EQ.1) GO TO 4
      GO TO (10,30),NDP
C    NEXT POINT IN HS
   30 STEP(J)=STEP(J)+1
      IF (STEP(J).GT.ND(J)) GO TO 40
      R(J)=R(J)+C(J)
      GO TO 20
C    THE J:TH ELEMENT HAS REACHED UPPER BOUND, IS SET TO 1
C    THE J-1:TH ELEMENT IS A CANDIDATE TO BE INCREASED BY 1
   40 STEP(J)=1
      R(J)=Z(J)
      J=J-1
      IF (J) 10,10,30
      END
      SUBROUTINE CLUST(FENMX,M,CC,FEN,N,STPL,STPLX,PG,FENP,X,Y,Z,S,
     CM1,A,C,M2)
      INTEGER FENMX,M,CC,FEN,N,PG(N),FENP(N)
      REAL S(M1),Y(M1),Z(M1),STPLX(N)
      DIMENSION A(M),C(M)
      REAL X(21,150)
C    N = NUMBER OF POINTS. CC = NUMBER OF CLUSTERINGS, STPL = VECTOR
C    GIVING STEPLENGTHS FOR SUCCESSIVE CLUSTERINGS, STPL(1) = FIRST
C    STEPLENGTH OF FIRST CLUSTERING, STPL(2) LEAST STEPLENGTH FOR FIRST
C    CLUSTERING = FIRST-LENGTH FOR SECOND CLUSTERING AND SO ON, X
C    = STARTING POINTS,PG = POINTER TO STARTING POINTS, M =DIMENSION OF
C     INDEPENDENT VARIABLE, FEN COUNTS NUM-
C    BER OF FUNCTION EVALUATIONS, FENMX = MAXIMUM NUMBER OF FUNCTION
C    EVALUATIONS PERMITTED. SF =FIRST STEPLENGTH, SL = LEAST STEP-
C    LENGTH.STPLX INDIVIDUAL STEPLENGTHS FOR THE POINTS X. MAKES SMALL
C    FIRST STEPLENGTH POSSIBLE
      M2=N
      SL=STPL
      STPL=0.3-STPL
      IF (STPL .LT. R1MACH(1)) STPL=R1MACH(1)
      DO 100 J=1,N
      K=PG(J)
      IF (FEN.GE.FENMX) GO TO 90
      SF=STPLX(K)
      DO 10 I=1,M1
   10 Y(I)=X(I,K)
      L=FEN
      CALL LOCOP(M,Y,SF,SS,SL,NEW,FEN,FENMX,Z,S,M1,A,C)
      FENP(K)=FENP(K)+FEN-L
      STPLX(K)=SS
      IF (NEW) 90,100,17
   17 DO 20 I=1,M1
   20 X(I,K)=Y(I)
      GO TO 100
   90 CONTINUE
      IF (CC.EQ.1) GO TO 110
  100 CONTINUE
      RETURN
  110 M2=J
      RETURN
      END
      SUBROUTINE LOCOP(M,Y,SF,SL,SLL,NEW,FEN,FENMX,X,S,M1,A,C)
      INTEGER M,NEW,FEN,FENMX,HALF,DUB
      REAL Y(M1),X(M1),S(M),SF,SL,SLL,A(M),C(M)
C    M = NUMBER OF DIMENSIONS,Y=STARTING POINT, FINAL POINT, SF = FIRST
C    STEPLENGTH, SL = CURRENT STEPLENGTH. SLL = LEAST STEPLENGTH, NEW
C    IS SET TO 1 IF BETTER POINT IS FOUND OTHERWISE IT IS 0. RI = MUL-
C    TIPLIER IN RANDOM NUMBER GENERATOR, RN =NUMBER OF R.N. USED, FEN =
C    NUMBER OF FUNCTION EVALUATIONS PERFORMED, FENMX = MAX NUMBER OF
C    FUNCTION EVALUATIONS PERMITTED. X = WORKING AREA
      NEW=0
      SL=SF
      HALF=2
      DUB=1
   20 DO 200 J=1,HALF
      IF (FEN.EQ.FENMX) RETURN
C    NEW DIRECTION S
      L=1
      Q=0
      DO 50 I=1,M
      CALL NORMD (S(I))
   50 Q=Q+S(I)*S(I)
      Q=SL/SQRT(Q)
   60 DO 65 I=1,M
   65 S(I)=Q*S(I)
C    NEW BASE POINT
   70 DO 75 I=1,M
   75 X(I)=Y(I)+S(I)
C    POINTS ON THE LINE THROUGH X AND DIRECTION S
   80 DO 150 K=1,DUB
      IF (FEN.LT.FENMX) GO TO 90
      NEW=-1-NEW
      RETURN
   90 CONTINUE
C    TEST FOR X IN A
      IF (IRA(X,A,C,M).EQ.0) GO TO (160,200),L
      X(M1)=-FI(X,M)
      FEN=FEN+1
C    BETTER POINT
      IF (X(M1).LE.Y(M1)) GO TO (160,200),L
C    BETTER POINT IS STORED,NEW POINT ON LINE
      DO 100 I=1,M
      Y(I)=X(I)
  100 X(I)=X(I)+S(I)
      Y(M1)=X(M1)
      NEW=NEW+1
  150 CONTINUE
C    STEPLENGTH IS DOUBLED
      SL=2.*SL
      Q=2.
      GO TO 60
C    OPPOSITE DIRECTION
  160 L=2
      DO 170 I=1,M
  170 S(I)=-S(I)
      GO TO 70
  200 CONTINUE
C    STEPLENGTH IS HALVED
      SL=0.5*SL
      IF (SL.GT.SLL) GO TO 20
      RETURN
      END
      SUBROUTINE RADUS(DIM,DIMAX,N,ALFA,X,P,D,R1,S,OUT,A,B,E,W,F)
      INTEGER DIM,DIMAX,D,P(N),OUT
      REAL X(21,150),A(DIM),B(DIM),E(DIM),W(DIM),F(DIM)
      REAL S(21,21),NINV
      LOGICAL ODD
      NINV=1./FLOAT(N)
      SQIN=SQRT(NINV)
      PHI=3.141593
      ALFA=2.
C    COMPUTE THE COVARIANCE MATRIX
      DO 14 I=1,DIM
      XH=0.
      DO 12 JJ=1,N
      J=P(JJ)
   12 XH=XH+X(I,J)
      W(I)=XH*SQIN
   14 CONTINUE
      DO 18 I1=1,DIM
      DO 17 I2=1,I1
      XH=0.
      DO 16 JJ=1,N
      J=P(JJ)
   16 XH=XH+X(I1,J)*X(I2,J)
      XH=XH-W(I1)*W(I2)
      S(I1,I2)=XH
      S(I2,I1)=XH
   17 CONTINUE
   18 CONTINUE
C    THE CASE DIM=1
      R1=ALFA*ALFA*S(1,1)*NINV**3
      IF(DIM.EQ.1) GO TO 39
C    TRIDIAGONALIZATION OF S. RESULT IN A AND B
      CALL TRIDMX(DIM,DIMAX,S,A,B)
C    EIGENVALUES OF TRIDIAGONAL MATRIX
      CALL EIGVAL(DIM,E,A,B,W,F)
C    DETERMINE R1
      R1=-1.
      F2D=1.
      F1M=1.
      ODD=.TRUE.
      M=0
      EH=1.
C    N INSTEAD OF N-1 AS A CORRECTION FOR SMALL N
      TOALF=4.*ALFA*ALFA*NINV
      DO 38 K=1,DIM
C    COMPUTE THE VOLUME E(K)=V(L,K,LAMDA)
      IF (E(K).LT.0.) E(K)=0.
      EH=EH*E(K)*TOALF
      E(K)=SQRT(EH)
C    COMPUTE R1N BY USING E(K)
      DINV=2./FLOAT(K)
      IF (ODD) GO TO 32
C    EVEN CASE
      R1N=(F1M*E(K)*NINV)**DINV/PHI
      ODD=.TRUE.
      F2D=F2D*FLOAT(K+1)
      GO TO 34
C    ODD CASE
   32 R1N=(F2D*E(K)*NINV/(2.*(2.*PHI)**M))**DINV
      M=M+1
      F1M=F1M*FLOAT(M)
      ODD=.FALSE.
   34 IF (R1.GE.R1N) GO TO 40
      R1=R1N
   38 CONTINUE
   39 D=DIM
      RETURN
C    DIMENSION OF VOLUME IS K-1
   40 D=K-1
      RETURN
      END
      SUBROUTINE MSORT(N,A,LIST,START,HDS)
C    ALGORITHM 45 IN THE COMPUTER JOURNAL VOLUME 13 NUMBER 1 FEBRUARY
C    1970  N IS THE NUMBER OF KEYS TO BE SORTED. THE ACTUAL PARAMETER
C    CORRESPONDING TO LIST SHOLD HAVE BOUNDS 1 TO N. A(1) TO A(N)
C    SHOULD CONTAIN THE N KEYS TO BE SORTED. AFTER MSORT HAS BEEN
C    CALLED, A WILL BE UNCHANGED. START WILL HAVE THE INDEX OF THE
C    START OF THE ORDERED LIST, SO THAT A(START) IS THE SMALLEST KEY,
C    AND THE REMAINING ORDER IS DEFINED BY LIST. TO PICK UP THE ITEMS
C    IN ORDER AFTER CALLING MSORT IS SIMPLE. FOR EXAMPLE IF PRINT(X)
C    IS A PROCEDURE WHICH PRINTS THE VALUE OF X ON A NEW LINE, THEN
C    ALL OF THE ITEMS OF A(I) WOULD BE PRINTED IN ORDER BY THE STATE-
C    MENT FOR I=START,LIST(I) WHILE I.NE. 0 DO PRINT(A(I))
      DIMENSION LIST(N),A(N)
      INTEGER HDS(N)
      INTEGER START,T,TRY1,TRY2
      REAL NEXT
C    FROM HERE TO LABEL 150 THE FIRST PASS LINKS ADJACENT ITEMS INTO
C    ORDERED LISTS, USING EXISTING RUNS IN THE DATA. A LIST MAY BE
C    EITHER FORWARD, IF THE RUN IS IN ORDER, OR BACKWARD IF IT IS IN
C    REVERSE ORDER
      START=1
      LIST(1)=0
      IF (N.LE.1) RETURN
      J=1
      T=1
      K=2
      TRY=A(1)
   10 NEXT=A(K)
      IF (TRY.GT.NEXT) GO TO 110
      HDS(J)=T
   50 LIST(T)=K
      IF (K-N) 70,60,70
   60 LIST(K)=0
      GO TO 150
   70 TRY=NEXT
      T=K
      K=K+1
      NEXT=A(K)
      IF (TRY.LE.NEXT) GO TO 50
      LIST(T)=0
   80 T=K
      K=K+1
      J=J+1
      IF (T-N) 100,90,100
   90 HDS(J)=N
      LIST(N)=0
C    THE LAST LIST HAS ONE MEMBER
      GO TO 150
  100 TRY=NEXT
      GO TO 10
  110 LIST(T)=0
  120 LIST(K)=T
      IF (K-N) 140,130,140
  130 HDS(J)=K
      GO TO 150
  140 TRY=NEXT
      T=K
      K=K+1
      NEXT=A(K)
      IF (TRY.GE.NEXT) GO TO 120
      HDS(J)=T
      GO TO 80
  150 IF (J.EQ.1) GO TO 320
C    THIS WOULD IMPLY THAT THE DATA WAS ALREADY IN ORDER
C    OR REVERSE ORDER
      NOL=J
C    NOL IS  THE NUMBER OF LISTS AFTER EACH PASS
      IT=1
  155 IF (IT.GE.NOL) GO TO 160
      K=IT
      IT=IT+IT
      GO TO 155
  160 J=K+K+1-NOL
      T=J
      GO TO 180
C    MERGING STARTS PART-WAY THROUGH, AT A POINT CHOSEN TO REDUCE THE
C    NUMBER OF LISTS TO A POWER OF 2 AFTER THE FIRST MERGING PASS
  170 T=1
      J=1
C    LISTS STARTING FROM HDS(T) AND HDS(T+1) ARE MERGED
C    INTO A LIST STARTING FROM HDS(J)
  180 TRY1=HDS(T)
      TRY2=HDS(T+1)
      AT1=A(TRY1)
      AT2=A(TRY2)
      IF (AT1-AT2) 190,190,200
  190 HDS(J)=TRY1
      GO TO 260
  200 HDS(J)=TRY2
  210 K=LIST(TRY2)
      IF (K) 230,220,230
  220 LIST(TRY2)=TRY1
      GO TO 310
  230 AT2=A(K)
      IF (AT1-AT2) 250,240,240
  240 TRY2=K
      GO TO 210
  250 LIST(TRY2)=TRY1
      TRY2=K
  260 K=LIST(TRY1)
      IF (K) 280,270,280
  270 LIST(TRY1)=TRY2
      GO TO 310
  280 AT1=A(K)
      IF (AT2-AT1) 290,300,300
  290 LIST(TRY1)=TRY2
      TRY1=K
      GO TO 210
  300 TRY1=K
      GO TO 260
  310 J=J+1
      T=T+2
      IF (NOL.GT.T) GO TO 180
      NOL=J-1
      IF (NOL.GT.1) GO TO 170
  320 START=HDS(1)
      RETURN
      END
      SUBROUTINE SEPAR(DIM,N,D,R1,P,X,NCL,MARK,MARKR,C,R,NMCV,DISTP,
     CDIST,M1)
      INTEGER DIM,N,NCL,D
      INTEGER P(N),MARK(N),MARKR(N),NMCV(N),DISTP(N)
      INTEGER NEXTP(150),LASTP(150)
      REAL X(21,150),DIST(N),C(M1),R(N)
C    INITIALIZE MARKERARRAY MARKR. NUMBER OF CLUSTERS NCL, TOTAL NUMBER
C    OF MARKED POINTS NMT, INDEX TO SEED POINT IN MARKS IS, NUMBER OF
C    POINTS LEFT TO MARK LEFT, NUMBER OF COMPUTED RADIES NRR
      DO 15 I=1,N
   15 MARKR(I)=0
      NCL=0
      NMT=0
      LEFT=N
      IS=1
      DINV=2./FLOAT(D)
      R(1)=R1
      NRR=1
C    START NEXT CLUSTER. X(K) IS THE NEXT SEED POINT NMC COUNTS THE
C    NUMBER OF POINTS IN A CLUSTER
   20 NCL=NCL+1
      NMC=1
      NMT=NMT+1
      LEFT=LEFT-1
      K=P(IS)
      MARK(NMT)=K
      MARKR(IS)=NCL
C    CHECK IF ALL MARKED
      IF (LEFT.EQ.0) GO TO 60
C    COMPUTE DISTANCES FROM SEED POINT C TO THOSE POINTS NOT YET
C    MARKED. DIM DIMENSION OF ARGUMENT SPACE
      DO 42 I=1,DIM
   42 C(I)=X(I,K)
      KL=IS
      DO 48 KK=1,LEFT
   44 KL=KL+1
      IF (MARKR(KL).NE.0) GO TO 44
      D2=0.
      IX=P(KL)
      DO 46 I=1,DIM
      E=C(I)-X(I,IX)
      D2=D2+E*E
   46 CONTINUE
      DIST(KK)=D2
      DISTP(KK)=KL
   48 CONTINUE
C    MARK POINTS
      KK2=LEFT
      DO 58 I=1,KK2
      KK1=LEFT
      IF (I.LE.NRR) GO TO 505
      R(I)=R1*(FLOAT(I))**DINV
      NRR=NRR+1
  505 RR=R(I)
      IF (I.EQ.1) GO TO 510
      DO 507 II=1,NNEXT
  507 LASTP(II)=NEXTP(II)
      NLAST=NNEXT
  510 NNEXT=0
      J=0
      DO 56 JL=1,KK1
  512 J=J+1
      IF (DISTP(J).EQ.0) GO TO 512
      IF (DIST(J).GT.RR) GO TO 56
C    DISTANCE TO A POINT IN LASTP SHOULD BE LE R1
      IC=DISTP(J)
      IC=P(IC)
      IF (I.EQ.1) GO TO 548
      DO 542 II=1,DIM
  542 C(II)=X(II,IC)
      DO 546 JJ=1,NLAST
      D2=0.
      ILAST=LASTP(JJ)
      DO 544 II=1,DIM
      E=C(II)-X(II,ILAST)
  544 D2=D2+E*E
      IF (D2.LE.R1) GO TO 548
  546 CONTINUE
      GO TO 56
  548 NNEXT=NNEXT+1
      NEXTP(NNEXT)=IC
      NMC=NMC+1
      NMT=NMT+1
      LEFT=LEFT-1
      JP=DISTP(J)
      MARK(NMT)=P(JP)
      MARKR(JP)=NCL
      DISTP(J)=0
      IF (LEFT.EQ.0) GO TO 60
   56 CONTINUE
      IF (LEFT.EQ.KK1) GO TO 60
   58 CONTINUE
C    UPDATE VECTOR NMCV CONTAINING THE NUMBER OF POINTS IN CLUSTER
C    NCL  TEST IF ALL MARKED
   60 NMCV(NCL)=NMC
      IF (LEFT.EQ.0) RETURN
C    SEARCH FOR NEXT SEED POINT
      IS1=IS+1
      DO 78 IS=IS1,N
      IF (MARKR(IS).EQ.0) GO TO 20
   78 CONTINUE
      RETURN
      END
      SUBROUTINE OUTRE(M,SN,PN,CN,REDUC,PG,MARKM,MARK,PNC,NM,M2)
      INTEGER SN,PN,CN,REDUC(M),PG(M2),PNC(M2),MARKM(NM),MARK(M2)
C    POINTS ARE SORTED CLUSTER WIESE
   10 PN=0
      JS=REDUC(SN)
      M1=M+1
      JL=0
      DO 100 MC=1,CN
      JF=JL+1
      JL=JL+PNC(MC)
      DO 50 J=JF,JL
      K=MARK(J)
      MARKM(K)=MC
   50 CONTINUE
C    REDUCTION OF POINTS FOR NEXT CLUSTERING
      DO 70 J=JF,JL,JS
      PN=PN+1
   70 PG(PN)=MARK(J)
  100 CONTINUE
      RETURN
      END
      SUBROUTINE UNDEV(A)
      A=ATS(1)
      RETURN
      END
      SUBROUTINE NORMD(A)
      A=SIN(6.283185*ATS(1))*SQRT(-2.*ALOG(ATS(1)))
      RETURN
      END
      FUNCTION IRA(X,A,C,M)
      DIMENSION X(M),A(M),C(M)
      IR =1
      DO 1 I=1,M
      X1=X(I)-A(I)
      IF (X1.LT.0..OR.X1.GT.C(I))IR=0
    1 CONTINUE
      IRA=IR
      RETURN
      END
      SUBROUTINE INWR16(A,B,N,IPAR,IPA)
      DIMENSION IPAR(30),A(N),B(N)
      COMMON /STATIS/IFAIL,IT,ITM,NF
      MN=20
      MIP=30
      MIM=1
      MM=150
      K=3
      NOUT=I1MACH(2)
      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,1030)
      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)
      LT=IPAR(IPA+3)
      IF (IPRINT.LT.0) GO TO 40
      WRITE (NOUT,640) IPRINT
      WRITE (NOUT,650) M
      WRITE (NOUT,660) LT
   40 IF (M.GT.0) GO TO 45
      WRITE (NOUT,525)
      IF (IPRINT.LT.0) WRITE (NOUT,650) M
      GO TO 5
   45 CONTINUE
      IF (LT.GE.MIM.AND.LT.LE.MM) GO TO 80
      WRITE (NOUT,550) MIM,MM
      IF (IPRINT.LT.0) WRITE (NOUT,660) LT
      GO TO 5
   80 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
      NER1=0
      DO 90 I=1,N
      IF (A(I).LT.B(I)) GO TO 90
      IF (A(I).NE.B(I)) GO TO 81
      NER1=NER1+1
      GO TO 90
   81 CONTINUE
      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 120
  100 IF (IPRINT.GE.0) GO TO 5
      WRITE (NOUT,570)
      WRITE (NOUT,580) A
      WRITE (NOUT,590)
      WRITE (NOUT,580) B
      GO TO 5
  120 CONTINUE
      IF (NER1.NE.N) RETURN
      WRITE (NOUT,607)
      GO TO 100
  500 FORMAT (/2X,61H**E R R O R  I N  G L O P T** 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  G L O P T** IPA LESS THAN 0/2X,
     C7HOR IPA+,I2,13H GREATER THAN,I3)
  525 FORMAT (/2X,43H**E R R O R  I N  G L O P T** M LESS THAN 1/)
  550 FORMAT (/2X,42H**E R R O R  I N  G L O P T** LT LESS THAN,I2/2X,
     C18HOR LT GREATER THAN,I4/)
  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  G L O P T** A(,I2,17H) GREATER TH
     CAN B(,I2,1H))
  605 FORMAT (32X,2HA(,I2,17H) GREATER THAN B(,I2,1H))
  607 FORMAT (/2X,55H**E R R O R  I N  G L O P T** VECTORS A AND B ARE E
     CQUAL)
  620 FORMAT (/2X,22HI N I T I A L  D A T A)
  630 FORMAT (/2X,19HNUMBER OF VARIABLES,22X,3HN =,I6)
  640 FORMAT (/2X,18HPRINTING PARAMETER,21X,5HIPR =,I6)
  650 FORMAT (2X,44HMAXIMUM NUMBER OF FUNCTION EVALUATIONS   M =,I6)
  660 FORMAT (2X,24HNUMBER OF INITIAL POINTS,16X,4HLT =,I6)
 1030 FORMAT (////12X,9HG L O P T)
      END
      SUBROUTINE SPAU16(IPR,NC,PNC,NMAX,MARK,N,X,FM,XM)
      COMMON /INW/IN/STATIS/IFAIL,NR,ITM,L
      DIMENSION XM(N),X(21,150),MARK(NMAX)
      INTEGER PNC(NMAX)
      NOUT=I1MACH(2)
      M1=N+1
      IF (IN.GT.0) GO TO 10
      WRITE(NOUT,100)
      IF (NR.EQ.IPR) WRITE (NOUT,210)
      WRITE (NOUT,110) NR
      JL=0
      DO 30 MC=1,NC
      JF=JL+1
      JL=JL+PNC(MC)
      DO 20 J=JF,JL
      K=MARK(J)
       F1=X(M1,K)
      IF (J.EQ.JF) GO TO 50
      IF (F1.LE.FM) GO TO 20
   50 CONTINUE
      FM=F1
      DO 40 I=1,N
   40 XM(I)=X(I,K)
   20 CONTINUE
      F1=-FM
      WRITE (NOUT,150) MC,F1
      WRITE(NOUT,160)
      WRITE (NOUT,130) (XM(I),I=1,N)
   30 CONTINUE
      RETURN
   10 WRITE(NOUT,170)
      WRITE(NOUT,180)
      WRITE (NOUT,120) FM
      WRITE(NOUT,160)
      WRITE (NOUT,130) (XM(I),I=1,N)
      WRITE(NOUT,190) L
      IF (IFAIL.EQ.0) WRITE (NOUT,260)
      IF (IFAIL.EQ.1) WRITE (NOUT,240)
      IF (IFAIL.EQ.2) WRITE (NOUT,270)
      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,28HOPTIMAL FUNCTION VALUE FM = ,E15.8)
  130 FORMAT(4(2X,E15.8))
  150 FORMAT (2X,7HCLUSTER,I4,29H OPTIMAL 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,16HGLOPT TERMINATED)
  210 FORMAT (1X,34(2H -))
  240 FORMAT (/2X,52HIFAIL = 1. TERMINATION CRITERION: NUMBER OF FUNCTIO
     CN/2X,20HEVALUATIONS EQUALS M)
  260 FORMAT (/2X,64HIFAIL = 0. TERMINATION CRITERION: NUMBER OF ITERATI
     CONS EQUALS 20)
  270 FORMAT (/2X,52HIFAIL = 2. TERMINATION CRITERION: OBJECTIVE FUNCTIO
     CN/2X,20HIS SUPPOSED UNIMODAL)
      END
