--- /dev/null
+* SUBROUTINE MXBSBM ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF A BLOCKED SYMMETRIC MATRIX A BY A VECTOR X.
+*
+* PARAMETERS :
+* PARAMETERS :
+* II L BLOCK DIMENSION.
+* RI ABL(L*(L+1)/2) VALUES OF NONZERO ELEMENTS OF THE GIVEN BLOCK.
+* II JBL(L) INDICES OF THE INDIVIDUAL BLOCKS
+* RI X(N) UNPACKED INPUT VECTOR.
+* RI Y(N) UNPACKED OR PACKED OUTPUT VECTOR EQUAL TO A*X.
+* II JOB FORM OF THE VECTOR Y. JOB=1-UNPACKED FORM. JOB=2-PACKED
+* FORM.
+*
+ SUBROUTINE MXBSBM(L,ABL,JBL,X,Y,JOB)
+ INTEGER L,JBL(*),JOB
+ DOUBLE PRECISION ABL(*),X(*),Y(*)
+ INTEGER I,J,IP,JP,K
+ DOUBLE PRECISION TEMP
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO = 0.0D 0)
+ DO 1 I=1,L
+ IP=JBL(I)
+ IF (IP.GT.0) THEN
+ IF (JOB.EQ.1) THEN
+ Y(IP)=ZERO
+ ELSE
+ Y(I)=ZERO
+ END IF
+ END IF
+ 1 CONTINUE
+ K=0
+ DO 4 I=1,L
+ IP=JBL(I)
+ IF (IP.GT.0) TEMP=X(IP)
+ IF (JOB.EQ.1) THEN
+ DO 2 J=1,I-1
+ JP=JBL(J)
+ K=K+1
+ IF (IP.GT.0.AND.JP.GT.0) THEN
+ Y(IP)=Y(IP)+ABL(K)*X(JP)
+ Y(JP)=Y(JP)+ABL(K)*TEMP
+ END IF
+ 2 CONTINUE
+ K=K+1
+ IF (IP.GT.0) Y(IP)=Y(IP)+ABL(K)*TEMP
+ ELSE
+ DO 3 J=1,I-1
+ JP=JBL(J)
+ K=K+1
+ IF (IP.GT.0.AND.JP.GT.0) THEN
+ Y(I)=Y(I)+ABL(K)*X(JP)
+ Y(J)=Y(J)+ABL(K)*TEMP
+ END IF
+ 3 CONTINUE
+ K=K+1
+ IF (IP.GT.0) Y(I)=Y(I)+ABL(K)*TEMP
+ END IF
+ 4 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXBSBU ALL SYSTEMS 92/12/01
+* PURPOSE :
+* CORRECTION OF A BLOCKED SYMMETRIC MATRIX A. THE CORRECTION IS DEFINED
+* AS A:=A+ALF*X*TRANS(X) WHERE ALF IS A GIVEN SCALING FACTOR AND X IS
+* A GIVEN VECTOR.
+*
+* PARAMETERS :
+* II L BLOCK DIMENSION.
+* RI ABL(L*(L+1)/2) VALUES OF NONZERO ELEMENTS OF THE GIVEN BLOCK.
+* II JBL(L) INDICES OF THE INDIVIDUAL BLOCKS
+* RI ALF SCALING FACTOR.
+* RI X(N) UNPACKED OR PACKED INPUT VECTOR.
+* II JOB FORM OF THE VECTOR X. JOB=1-UNPACKED FORM. JOB=2-PACKED
+* FORM.
+*
+ SUBROUTINE MXBSBU(L,ABL,JBL,ALF,X,JOB)
+ INTEGER L,JBL(*),JOB
+ DOUBLE PRECISION ABL(*),ALF,X(*)
+ INTEGER I,J,IP,JP,K
+ K=0
+ IF (JOB.EQ.1) THEN
+ DO 3 I=1,L
+ IP=JBL(I)
+ DO 2 J=1,I
+ JP=JBL(J)
+ K=K+1
+ IF (IP.GT.0.AND.JP.GT.0) THEN
+ ABL(K)=ABL(K)+ALF*X(IP)*X(JP)
+ END IF
+ 2 CONTINUE
+ 3 CONTINUE
+ ELSE
+ DO 5 I=1,L
+ IP=JBL(I)
+ DO 4 J=1,I
+ JP=JBL(J)
+ K=K+1
+ IF (IP.GT.0.AND.JP.GT.0) THEN
+ ABL(K)=ABL(K)+ALF*X(I)*X(J)
+ END IF
+ 4 CONTINUE
+ 5 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXBSMI ALL SYSTEMS 91/12/01
+* PURPOSE :
+* BLOCKS OF THE SYMMETRIC BLOCKED MATRIX ARE SET TO THE UNIT MATRICES.
+*
+* PARAMETERS :
+* II NBLKS NUMBER OF BLOCKS OF THE MATRIX.
+* RI ABL(NBLA) VALUES OF THE NONZERO ELEMENTS OF THE MATRIX.
+* II IBLBG(NBLKS+1) BEGINNINGS OF THE BLOCKS IN THE MATRIX.
+*
+* SUBROUTINES USED :
+* MXDSMI DENSE SYMMETRIC MATRIX IS SET TO THE UNIT MATRIX.
+*
+ SUBROUTINE MXBSMI(NBLKS,ABL,IBLBG)
+ INTEGER NBLKS,IBLBG(*)
+ DOUBLE PRECISION ABL(*)
+ INTEGER I,K,KBEG,KLEN
+ K=1
+ DO 1 I=1,NBLKS
+ KBEG=IBLBG(I)
+ KLEN=IBLBG(I+1)-KBEG
+ CALL MXDSMI(KLEN,ABL(K))
+ K=K+KLEN*(KLEN+1)/2
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDCMD ALL SYSTEMS 91/12/01
+* PURPOSE :
+* MULTIPLICATION OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A
+* BY A VECTOR X AND ADDITION OF THE SCALED VECTOR ALF*Y.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II M NUMBER OF COLUMNS OF THE MATRIX A.
+* RI A(N*M) RECTANGULAR MATRIX STORED COLUMNWISE IN THE
+* ONE-DIMENSIONAL ARRAY.
+* RI X(M) INPUT VECTOR.
+* RI ALF SCALING FACTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR EQUAL TO A*X+ALF*Y.
+*
+* SUBPROGRAMS USED :
+* S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* S MXVSCL SCALING OF A VECTOR.
+*
+ SUBROUTINE MXDCMD(N,M,A,X,ALF,Y,Z)
+ INTEGER N,M
+ DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
+ INTEGER J,K
+ CALL MXVSCL(N,ALF,Y,Z)
+ K=0
+ DO 1 J=1,M
+ CALL MXVDIR(N,X(J),A(K+1),Z,Z)
+ K=K+N
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDCMU ALL SYSTEMS 91/12/01
+* PURPOSE :
+* UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A. THIS MATRIX
+* IS UPDATED BY THE RULE A:=A+ALF*X*TRANS(Y).
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II M NUMBER OF COLUMNS OF THE MATRIX A.
+* RU A(N*M) RECTANGULAR MATRIX STORED COLUMNWISE IN THE
+* ONE-DIMENSIONAL ARRAY.
+* RI ALF SCALAR PARAMETER.
+* RI X(N) INPUT VECTOR.
+* RI Y(M) INPUT VECTOR.
+*
+ SUBROUTINE MXDCMU(N,M,A,ALF,X,Y)
+ INTEGER N,M
+ DOUBLE PRECISION A(*),ALF,X(*),Y(*)
+ DOUBLE PRECISION TEMP
+ INTEGER I,J,K
+ K=0
+ DO 2 J=1,M
+ TEMP=ALF*Y(J)
+ DO 1 I=1,N
+ A(K+I)=A(K+I)+TEMP*X(I)
+ 1 CONTINUE
+ K=K+N
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDCMV ALL SYSTEMS 91/12/01
+* PURPOSE :
+* RANK-TWO UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A.
+* THIS MATRIX IS UPDATED BY THE RULE A:=A+ALF*X*TRANS(U)+BET*Y*TRANS(V).
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II M NUMBER OF COLUMNS OF THE MATRIX A.
+* RU A(N*M) RECTANGULAR MATRIX STORED COLUMNWISE IN THE
+* ONE-DIMENSIONAL ARRAY.
+* RI ALF SCALAR PARAMETER.
+* RI X(N) INPUT VECTOR.
+* RI U(M) INPUT VECTOR.
+* RI BET SCALAR PARAMETER.
+* RI Y(N) INPUT VECTOR.
+* RI V(M) INPUT VECTOR.
+*
+ SUBROUTINE MXDCMV(N,M,A,ALF,X,U,BET,Y,V)
+ INTEGER N,M
+ DOUBLE PRECISION A(*),ALF,X(*),U(*),BET,Y(*),V(*)
+ DOUBLE PRECISION TEMPA,TEMPB
+ INTEGER I,J,K
+ K=0
+ DO 2 J=1,M
+ TEMPA=ALF*U(J)
+ TEMPB=BET*V(J)
+ DO 1 I=1,N
+ A(K+I)=A(K+I)+TEMPA*X(I)+TEMPB*Y(I)
+ 1 CONTINUE
+ K=K+N
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDPGB ALL SYSTEMS 91/12/01
+* PURPOSE :
+* SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A DENSE SYMMETRIC
+* POSITIVE DEFINITE MATRIX A+E USING THE FACTORIZATION A+E=L*D*TRANS(L)
+* OBTAINED BY THE SUBROUTINE MXDPGF.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(N*(N+1)/2) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXDPGF.
+* RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR
+* EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR
+* EQUATIONS.
+* II JOB OPTION. IF JOB=0 THEN X:=(A+E)**(-1)*X. IF JOB>0 THEN
+* X:=L**(-1)*X. IF JOB<0 THEN X:=TRANS(L)**(-1)*X.
+*
+* METHOD :
+* BACK SUBSTITUTION
+*
+ SUBROUTINE MXDPGB(N,A,X,JOB)
+ INTEGER JOB,N
+ DOUBLE PRECISION A(*),X(*)
+ INTEGER I,II,IJ,J
+ IF (JOB.GE.0) THEN
+*
+* PHASE 1 : X:=L**(-1)*X
+*
+ IJ = 0
+ DO 20 I = 1,N
+ DO 10 J = 1,I - 1
+ IJ = IJ + 1
+ X(I) = X(I) - A(IJ)*X(J)
+ 10 CONTINUE
+ IJ = IJ + 1
+ 20 CONTINUE
+ END IF
+ IF (JOB.EQ.0) THEN
+*
+* PHASE 2 : X:=D**(-1)*X
+*
+ II = 0
+ DO 30 I = 1,N
+ II = II + I
+ X(I) = X(I)/A(II)
+ 30 CONTINUE
+ END IF
+ IF (JOB.LE.0) THEN
+*
+* PHASE 3 : X:=TRANS(L)**(-1)*X
+*
+ II = N* (N-1)/2
+ DO 50 I = N - 1,1,-1
+ IJ = II
+ DO 40 J = I + 1,N
+ IJ = IJ + J - 1
+ X(I) = X(I) - A(IJ)*X(J)
+ 40 CONTINUE
+ II = II - I
+ 50 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXDPGF ALL SYSTEMS 89/12/01
+* PURPOSE :
+* FACTORIZATION A+E=L*D*TRANS(L) OF A DENSE SYMMETRIC POSITIVE DEFINITE
+* MATRIX A+E WHERE D AND E ARE DIAGONAL POSITIVE DEFINITE MATRICES AND
+* L IS A LOWER TRIANGULAR MATRIX. IF A IS SUFFICIENTLY POSITIVE
+* DEFINITE THEN E=0.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RU A(N*(N+1)/2) ON INPUT A GIVEN DENSE SYMMETRIC (USUALLY POSITIVE
+* DEFINITE) MATRIX A STORED IN THE PACKED FORM. ON OUTPUT THE
+* COMPUTED FACTORIZATION A+E=L*D*TRANS(L).
+* IO INF AN INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. IF
+* INF=0 THEN A IS SUFFICIENTLY POSITIVE DEFINITE AND E=0. IF
+* INF<0 THEN A IS NOT SUFFICIENTLY POSITIVE DEFINITE AND E>0. IF
+* INF>0 THEN A IS INDEFINITE AND INF IS AN INDEX OF THE
+* MOST NEGATIVE DIAGONAL ELEMENT USED IN THE FACTORIZATION
+* PROCESS.
+* RU ALF ON INPUT A DESIRED TOLERANCE FOR POSITIVE DEFINITENESS. ON
+* OUTPUT THE MOST NEGATIVE DIAGONAL ELEMENT USED IN THE
+* FACTORIZATION PROCESS (IF INF>0).
+* RO TAU MAXIMUM DIAGONAL ELEMENT OF THE MATRIX E.
+*
+* METHOD :
+* P.E.GILL, W.MURRAY : NEWTON TYPE METHODS FOR UNCONSTRAINED AND
+* LINEARLY CONSTRAINED OPTIMIZATION, MATH. PROGRAMMING 28 (1974)
+* PP. 311-350.
+*
+ SUBROUTINE MXDPGF(N,A,INF,ALF,TAU)
+ DOUBLE PRECISION ALF,TAU
+ INTEGER INF,N
+ DOUBLE PRECISION A(*)
+ DOUBLE PRECISION BET,DEL,GAM,RHO,SIG,TOL
+ INTEGER I,IJ,IK,J,K,KJ,KK,L
+ L = 0
+ INF = 0
+ TOL = ALF
+*
+* ESTIMATION OF THE MATRIX NORM
+*
+ ALF = 0.0D0
+ BET = 0.0D0
+ GAM = 0.0D0
+ TAU = 0.0D0
+ KK = 0
+ DO 20 K = 1,N
+ KK = KK + K
+ BET = MAX(BET,ABS(A(KK)))
+ KJ = KK
+ DO 10 J = K + 1,N
+ KJ = KJ + J - 1
+ GAM = MAX(GAM,ABS(A(KJ)))
+ 10 CONTINUE
+ 20 CONTINUE
+ BET = MAX(TOL,BET,GAM/N)
+* DEL = TOL*BET
+ DEL = TOL*MAX(BET,1.0D0)
+ KK = 0
+ DO 60 K = 1,N
+ KK = KK + K
+*
+* DETERMINATION OF A DIAGONAL CORRECTION
+*
+ SIG = A(KK)
+ IF (ALF.GT.SIG) THEN
+ ALF = SIG
+ L = K
+ END IF
+ GAM = 0.0D0
+ KJ = KK
+ DO 30 J = K + 1,N
+ KJ = KJ + J - 1
+ GAM = MAX(GAM,ABS(A(KJ)))
+ 30 CONTINUE
+ GAM = GAM*GAM
+ RHO = MAX(ABS(SIG),GAM/BET,DEL)
+ IF (TAU.LT.RHO-SIG) THEN
+ TAU = RHO - SIG
+ INF = -1
+ END IF
+*
+* GAUSSIAN ELIMINATION
+*
+ A(KK) = RHO
+ KJ = KK
+ DO 50 J = K + 1,N
+ KJ = KJ + J - 1
+ GAM = A(KJ)
+ A(KJ) = GAM/RHO
+ IK = KK
+ IJ = KJ
+ DO 40 I = K + 1,J
+ IK = IK + I - 1
+ IJ = IJ + 1
+ A(IJ) = A(IJ) - A(IK)*GAM
+ 40 CONTINUE
+ 50 CONTINUE
+ 60 CONTINUE
+ IF (L.GT.0 .AND. ABS(ALF).GT.DEL) INF = L
+ RETURN
+ END
+* SUBROUTINE MXDRMM ALL SYSTEMS 91/12/01
+* PURPOSE :
+* MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR MATRIX A BY
+* A VECTOR X.
+*
+* PARAMETERS :
+* II N NUMBER OF COLUMNS OF THE MATRIX A.
+* II M NUMBER OF ROWS OF THE MATRIX A.
+* RI A(M*N) RECTANGULAR MATRIX STORED ROWWISE IN THE
+* ONE-DIMENSIONAL ARRAY.
+* RI X(N) INPUT VECTOR.
+* RO Y(M) OUTPUT VECTOR EQUAL TO A*X.
+*
+ SUBROUTINE MXDRMM(N,M,A,X,Y)
+ INTEGER N,M
+ DOUBLE PRECISION A(*),X(*),Y(*)
+ DOUBLE PRECISION TEMP
+ INTEGER I,J,K
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO=0.0D 0)
+ K=0
+ DO 2 J=1,M
+ TEMP=ZERO
+ DO 1 I=1,N
+ TEMP=TEMP+A(K+I)*X(I)
+ 1 CONTINUE
+ Y(J)=TEMP
+ K=K+N
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDRCB ALL SYSTEMS 91/12/01
+* PURPOSE :
+* BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION OF
+* THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRICES A AND B.
+* II M NUMBER OF COLUMNS OF THE MATRICES A AND B.
+* RI A(N*M) RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
+* RI B(N*M) RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
+* RI U(M) VECTOR OF SCALAR COEFFICIENTS.
+* RO V(M) VECTOR OF SCALAR COEFFICIENTS.
+* RU X(N) PREMULTIPLIED VECTOR.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+* SUBPROGRAM USED :
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDOT DOT PRODUCT OF VECTORS.
+*
+* METHOD :
+* H.MATTHIES, G.STRANG: THE SOLUTION OF NONLINEAR FINITE ELEMENT
+* EQUATIONS. INT.J.NUMER. METHODS ENGN. 14 (1979) 1613-1626.
+*
+ SUBROUTINE MXDRCB(N,M,A,B,U,V,X,IX,JOB)
+ INTEGER N,M,IX(*),JOB
+ DOUBLE PRECISION A(*),B(*),U(*),V(*),X(*)
+ DOUBLE PRECISION MXUDOT
+ INTEGER I,K
+ K=1
+ DO 1 I=1,M
+ V(I)=U(I)*MXUDOT(N,X,A(K),IX,JOB)
+ CALL MXUDIR(N,-V(I),B(K),X,X,IX,JOB)
+ K=K+N
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDRCF ALL SYSTEMS 91/12/01
+* PURPOSE :
+* FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION OF
+* THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRICES A AND B.
+* II M NUMBER OF COLUMNS OF THE MATRICES A AND B.
+* RI A(N*M) RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
+* RI B(N*M) RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
+* RI U(M) VECTOR OF SCALAR COEFFICIENTS.
+* RI V(M) VECTOR OF SCALAR COEFFICIENTS.
+* RU X(N) PREMULTIPLIED VECTOR.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+* SUBPROGRAM USED :
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDOT DOT PRODUCT OF VECTORS.
+*
+* METHOD :
+* H.MATTHIES, G.STRANG: THE SOLUTION OF NONLINEAR FINITE ELEMENT
+* EQUATIONS. INT.J.NUMER. METHODS ENGN. 14 (1979) 1613-1626.
+*
+ SUBROUTINE MXDRCF(N,M,A,B,U,V,X,IX,JOB)
+ INTEGER N,M,IX(*),JOB
+ DOUBLE PRECISION A(*),B(*),U(*),V(*),X(*)
+ DOUBLE PRECISION TEMP,MXUDOT
+ INTEGER I,K
+ K=(M-1)*N+1
+ DO 1 I=M,1,-1
+ TEMP=U(I)*MXUDOT(N,X,B(K),IX,JOB)
+ CALL MXUDIR(N,V(I)-TEMP,A(K),X,X,IX,JOB)
+ K=K-N
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDRSU ALL SYSTEMS 91/12/01
+* PURPOSE :
+* SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B. SHIFT OF
+* ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN THE LIMITED
+* MEMORY BFGS METHOD.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A AND B.
+* II M NUMBER OF COLUMNS OF THE MATRIX A AND B.
+* RU A(N*M) RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
+* RU B(N*M) RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
+* RU U(M) VECTOR.
+*
+ SUBROUTINE MXDRSU(N,M,A,B,U)
+ INTEGER N,M
+ DOUBLE PRECISION A(*),B(*),U(*)
+ INTEGER I,K,L
+ K=(M-1)*N+1
+ DO 1 I=M-1,1,-1
+ L=K-N
+ CALL MXVCOP(N,A(L),A(K))
+ CALL MXVCOP(N,B(L),B(K))
+ U(I+1)=U(I)
+ K=L
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDSMI ALL SYSTEMS 88/12/01
+* PURPOSE :
+* DENSE SYMMETRIC MATRIX A IS SET TO THE UNIT MATRIX WITH THE SAME
+* ORDER.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RO A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM
+* WHICH IS SET TO THE UNIT MATRIX (I.E. A:=I).
+*
+ SUBROUTINE MXDSMI(N,A)
+ INTEGER N
+ DOUBLE PRECISION A(*)
+ INTEGER I, M
+ DOUBLE PRECISION ZERO,ONE
+ PARAMETER (ZERO=0.0D 0,ONE=1.0D 0)
+ M = N * (N+1) / 2
+ DO 1 I = 1, M
+ A(I) = ZERO
+ 1 CONTINUE
+ M = 0
+ DO 2 I = 1, N
+ M = M + I
+ A(M) = ONE
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXDSMS ALL SYSTEMS 91/12/01
+* PURPOSE :
+* SCALING OF A DENSE SYMMETRIC MATRIX.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RU A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM
+* WHICH IS SCALED BY THE VALUE ALF (I.E. A:=ALF*A).
+* RI ALF SCALING FACTOR.
+*
+ SUBROUTINE MXDSMS( N, A, ALF)
+ INTEGER N
+ DOUBLE PRECISION A(*), ALF
+ INTEGER I,M
+ M = N * (N+1) / 2
+ DO 1 I = 1, M
+ A(I) = A(I) * ALF
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXLIIM ALL SYSTEMS 96/12/01
+* PURPOSE :
+* MATRIX MULTIPLICATION FOR LIMITED STORAGE INVERSE COLUMN UPDATE
+* METHOD.
+*
+* PARAMETERS :
+* II N NUMBER OF VARIABLES.
+* II M NUMBER OF QUASI-NEWTON STEPS.
+* RI D(N) DIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
+* RI DL(N) SUBDIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
+* RI DU(N) SUPERDIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
+* RI DU2(N) SECOND SUPERDIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
+* II ID(N) PERMUTATION VECTOR.
+* RI XM(N*M) SET OF VECTORS FOR INVERSE COLUMN UPDATE.
+* RI GM(M) SET OF VALUES FOR INVERSE COLUMN UPDATE.
+* II IM(M) SET OF INDICES FOR INVERSE COLUMN UPDATE.
+* RI U(N) INPUT VECTOR.
+* RO V(N) OUTPUT VECTOR.
+*
+* SUBPROGRAMS USED :
+* S MXSGIB BACK SUBSTITUTION AFTER INCOMPLETE LU DECOMPOSITION.
+* S MXVCOP COPYING OF A VECTOR.
+* S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+*
+ SUBROUTINE MXLIIM(N,M,A,IA,JA,IP,ID,XM,GM,IM,U,V,S)
+ INTEGER M,N
+ DOUBLE PRECISION A(*),GM(*),S(*),U(*),V(*),XM(*)
+ INTEGER IA(*),ID(*),IM(*),IP(*),JA(*)
+ INTEGER I,L
+ CALL MXVCOP(N,U,V)
+ CALL MXSGIB(N,A,IA,JA,IP,ID,V,S,0)
+ L = 1
+ DO 10 I = 1,M
+ CALL MXVDIR(N,U(IM(I))/GM(I),XM(L),V,V)
+ L = L + N
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSCMD ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF A DENSE RECTANGULAR MATRIX A BY A VECTOR X AND
+* ADDITIOON OF THE SCALED VECTOR ALF*Y.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II NA NUMBER OF COLUMNS OF THE MATRIX A.
+* II MA NUMBER OF ELEMENTS IN THE FIELD A.
+* RI A(MA) RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
+* II IA(NA+1) POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
+* II JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
+* RI X(NA) INPUT VECTOR.
+* RI ALF SCALING FACTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR EQUAL TO A*X+ALF*Y.
+*
+* SUBPROGRAMS USED :
+* S MXVSCL SCALING OF A VECTOR.
+*
+ SUBROUTINE MXSCMD(N,NA,A,IA,JA,X,ALF,Y,Z)
+ INTEGER N,NA,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
+ INTEGER I,J,K,L,JP
+ CALL MXVSCL(N,ALF,Y,Z)
+ DO 2 I=1,NA
+ K=IA(I)
+ L=IA(I+1)-K
+ DO 1 J=1,L
+ JP=JA(K)
+ IF (JP.GT.0) Z(JP)=Z(JP)+A(K)*X(I)
+ K=K+1
+ 1 CONTINUE
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSCMM ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF A DENSE RECTANGULAR MATRIX A BY A VECTOR X.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II NA NUMBER OF COLUMNS OF THE MATRIX A.
+* II MA NUMBER OF ELEMENTS IN THE FIELD A.
+* RI A(MA) RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
+* II IA(NA+1) POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
+* II JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
+* RI X(NA) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR EQUAL TO A*X.
+*
+* SUBPROGRAMS USED :
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE MXSCMM(N,NA,A,IA,JA,X,Y)
+ INTEGER N,NA,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),Y(*)
+ INTEGER I,J,K,L,JP
+ CALL MXVSET(N,0.0D 0,Y)
+ DO 2 I=1,NA
+ K=IA(I)
+ L=IA(I+1)-K
+ DO 1 J=1,L
+ JP=JA(K)
+ IF (JP.GT.0) Y(JP)=Y(JP)+A(K)*X(I)
+ K=K+1
+ 1 CONTINUE
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSGIB ALL SYSTEMS 95/12/01
+* PURPOSE :
+* SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A SPARSE UNSYMMETRIC
+* MATRIX A USING INCOMPLETE FACTORIZATION OBTAINED BY THE SUBROUTINE
+* MXSGIF.
+*
+* PARAMETERS :
+* II N MATRIX DIMENSION.
+* II M NUMBER OF MATRIX NONZERO ELEMENTS.
+* RU A(M) NONZERO ELEMENTS OF THE MATRIX A.
+* II IA(N+1) ROW POINTERS OF THE MATRIX A.
+* II JA(M) COLUMN INDICES OF THE MATRIX A.
+* IO IP(N) PERMUTATION VECTOR.
+* II ID(N) DIAGONAL POINTERS OF THE MATRIX A.
+* RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR
+* EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR
+* EQUATIONS.
+* RA Y(N) AUXILIARY VECTOR.
+* JOB OPTION. JOB=0 - SOLUTION WITH THE ORIGINAL MATRIX.
+* JOB=1 - SOLUTION WITH THE MATRIX TRANSPOSE.
+*
+ SUBROUTINE MXSGIB(N,A,IA,JA,IP,ID,X,Y,JOB)
+ DOUBLE PRECISION CON
+ PARAMETER (CON=1.0D120)
+ INTEGER JOB,N
+ DOUBLE PRECISION A(*),X(*),Y(*)
+ INTEGER IA(*),ID(*),IP(*),JA(*)
+ DOUBLE PRECISION APOM
+ INTEGER J,JJ,JP,K,KSTOP,KSTRT
+ IF (JOB.LE.0) THEN
+ DO 20 K = 1,N
+ KSTRT = IA(K)
+ KSTOP = IA(K+1) - 1
+ DO 10 JJ = KSTRT,KSTOP
+ J = JA(JJ)
+ JP = IP(J)
+ IF (JP.LT.K) THEN
+ X(K) = X(K) - A(JJ)*X(JP)
+ IF (ABS(X(K)).GE.CON) X(K) = SIGN(CON,X(K))
+ END IF
+ 10 CONTINUE
+ 20 CONTINUE
+ DO 40 K = N,1,-1
+ KSTRT = IA(K)
+ KSTOP = IA(K+1) - 1
+ DO 30 JJ = KSTRT,KSTOP
+ J = JA(JJ)
+ JP = IP(J)
+ IF (JP.GT.K) X(K) = X(K) - A(JJ)*X(JP)
+ IF (JP.EQ.K) APOM = A(JJ)
+ 30 CONTINUE
+ X(K) = X(K)/APOM
+ 40 CONTINUE
+ CALL MXVSFP(N,IP,X,Y)
+ ELSE
+ CALL MXVSBP(N,IP,X,Y)
+ DO 60 K = 1,N
+ X(K) = X(K)/A(ID(K))
+ KSTRT = IA(K)
+ KSTOP = IA(K+1) - 1
+ DO 50 JJ = KSTRT,KSTOP
+ J = JA(JJ)
+ JP = IP(J)
+ IF (JP.GT.K) X(JP) = X(JP) - A(JJ)*X(K)
+ 50 CONTINUE
+ 60 CONTINUE
+ DO 80 K = N,1,-1
+ KSTRT = IA(K)
+ KSTOP = IA(K+1) - 1
+ DO 70 JJ = KSTRT,KSTOP
+ J = JA(JJ)
+ JP = IP(J)
+ IF (JP.LT.K) X(JP) = X(JP) - A(JJ)*X(K)
+ 70 CONTINUE
+ 80 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXSGIF ALL SYSTEMS 95/12/01
+* PURPOSE :
+* INCOMPLETE FACTORIZATION OF A GENERAL SPARSE MATRIX A.
+*
+* PARAMETERS :
+* II N MATRIX DIMENSION.
+* II M NUMBER OF MATRIX NONZERO ELEMENTS.
+* RU A(M) NONZERO ELEMENTS OF THE MATRIX A.
+* II IA(N+1) ROW POINTERS OF THE MATRIX A.
+* II JA(M) COLUMN INDICES OF THE MATRIX A.
+* IO IP(N) PERMUTATION VECTOR.
+* IO ID(N) DIAGONAL POINTERS OF THE MATRIX A.
+* RA IW(N) AUXILIARY VECTOR.
+* RI TOL PIVOT TOLERANCE.
+* IO INF INFORMATION.
+*
+ SUBROUTINE MXSGIF(N,A,IA,JA,IP,ID,IW,TOL,INF)
+ DOUBLE PRECISION ZERO,ONE,CON
+ PARAMETER (ZERO=0.0D0,ONE=1.0D0,CON=1.0D-30)
+ DOUBLE PRECISION TOL
+ INTEGER INF,N
+ DOUBLE PRECISION A(*)
+ INTEGER IA(*),ID(*),IP(*),IW(*),JA(*)
+ DOUBLE PRECISION TEMP
+ INTEGER I,II,J,JJ,JSTOP,JSTRT,K,KK,KSTOP,KSTRT
+ INF = 0
+ DO 10 I = 1,N
+ IF (IP(I).LE.0 .OR. IP(I).GT.N) THEN
+ CALL MXVINP(N,IP)
+ GO TO 20
+ END IF
+ 10 CONTINUE
+ 20 CALL MXVINS(N,0,IW)
+ DO 70 K = 1,N
+ KSTRT = IA(K)
+ KSTOP = IA(K+1) - 1
+ ID(K) = 0
+ DO 30 JJ = KSTRT,KSTOP
+ J = JA(JJ)
+ IW(J) = JJ
+ IF (IP(J).EQ.K) ID(K) = JJ
+ 30 CONTINUE
+ IF (ID(K).EQ.0) THEN
+ INF = -45
+ RETURN
+ END IF
+ IF (TOL.GT.ZERO) A(ID(K)) = (ONE+TOL)*A(ID(K))
+ IF (ABS(A(ID(K))).LT.TOL) A(ID(K)) = A(ID(K)) +
+ * SIGN(TOL,A(ID(K)))
+ DO 50 JJ = KSTRT,KSTOP
+ J = IP(JA(JJ))
+ IF (J.LT.K) THEN
+ JSTRT = IA(J)
+ JSTOP = IA(J+1) - 1
+ TEMP = A(JJ)/A(ID(J))
+ A(JJ) = TEMP
+ DO 40 II = JSTRT,JSTOP
+ I = JA(II)
+ IF (IP(I).GT.J) THEN
+ KK = IW(I)
+ IF (KK.NE.0) A(KK) = A(KK) - TEMP*A(II)
+ END IF
+ 40 CONTINUE
+ END IF
+ 50 CONTINUE
+ KK = ID(K)
+ IF (ABS(A(KK)).LT.CON) THEN
+ INF = K
+ IF (A(KK).EQ.ZERO) THEN
+ A(KK) = CON
+ ELSE
+ A(KK) = SIGN(CON,A(KK))
+ END IF
+ END IF
+ DO 60 JJ = KSTRT,KSTOP
+ J = JA(JJ)
+ IW(J) = 0
+ 60 CONTINUE
+ 70 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSPCA ALL SYSTEMS 93/12/01
+* PURPOSE :
+* REWRITE SYMMETRIC MATRIX INTO THE PERMUTED FACTORIZED COMPACT SCHEME.
+* MOIDIFIED VERSION FOR THE USE WITH MXSPCJ.
+*
+* PARAMETERS:
+* II N SIZE OF THE SYSTEM SOLVED.
+* II NB NUMBER OF NONZEROS IN THE UPPER TRIANGLE OF THE ORIGINAL
+* MATRIX.
+* II ML SIZE OF THE COMPACT FACTOR.
+* RU A(MMAX) NUMERICAL VALUES OF THE SPARSE HESSIAN APPROXIMATION
+* STORED AT THE POSITIONS 1, ...,NB.
+* IU JA(MMAX) INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
+* THE PACKED ROW FORM AT THE FIRST NB POSITIONS.
+* NEW POSITIONS
+* IN THE PERMUTED FACTOR STORED IN A(NB+1), ..., A(2*NB),
+* INDICES OF COMPACT SCHEME IN A(2*NB+1), ..., A(2*NB+ML).
+* II PSL(N+1) POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION.
+* RI T CORRECTION FACTOR THAT IS ADDED TO THE DIAGONAL.
+*
+*
+ SUBROUTINE MXSPCA(N,NB,ML,A,IA,JA,T)
+ INTEGER N,NB,ML,IA(*),JA(*)
+ DOUBLE PRECISION A(*),T
+ INTEGER I,J
+ DO 100 I=1,N
+ J=ABS(JA(IA(I)+NB+ML))
+ A(NB+J)=A(NB+J)+T
+ 100 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSPCB ALL SYSTEMS 92/12/01
+* PURPOSE :
+* SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A SPARSE SYMMETRIC
+* POSITIVE DEFINITE MATRIX A+E USING THE FACTORIZATION A+E=L*D*TRANS(L)
+* STORED IN THE COMPACT SCHEME. THIS FACTORIZATION CAN BE OBTAINED
+* USING THE SUBROUTINE MXSPCF.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(MMAX) FACTORS L,D OF THE FACTORIZATION A+E=L*D*TRANS(L)
+* STORED USING THE COMPACT SCHEME OF STORING.
+* II PSL(N+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
+* II SL(MMAX) ARRAY OF COLUMN INDICES OF THE FACTORS L AND D
+* STORED USING THE COMPACT SCHEME.
+* RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR
+* EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR
+* EQUATIONS.
+* II JOB OPTION. IF JOB=0 THEN X:=(A+E)**(-1)*X. IF JOB>0 THEN
+* X:=L**(-1)*X. IF JOB<0 THEN X:=TRANS(L)**(-1)*X.
+*
+* METHOD :
+* BACK SUBSTITUTION
+*
+ SUBROUTINE MXSPCB(N,A,PSL,SL,X,JOB)
+ INTEGER N
+ DOUBLE PRECISION A(*),X(*)
+ INTEGER PSL(*),SL(*),JOB
+ INTEGER I,J,IS
+*
+* FIRST PHASE
+*
+ IF (JOB.GE.0) THEN
+ DO 300 I=1,N
+ IS=SL(I)+N+1
+ DO 200 J=PSL(I)+I,PSL(I+1)+I-1
+ X(SL(IS))=X(SL(IS)) - A(J)*X(I)
+ IS=IS+1
+200 CONTINUE
+300 CONTINUE
+ END IF
+*
+* SECOND PHASE
+*
+ IF (JOB.EQ.0) THEN
+ DO 400 I=1,N
+ X(I) = X(I)/A(PSL(I)+I-1)
+400 CONTINUE
+ END IF
+*
+* THIRD PHASE
+*
+ IF (JOB.LE.0) THEN
+ DO 600 I=N,1,-1
+ IS=SL(I)+N+1
+ DO 500 J=PSL(I)+I,PSL(I+1)+I-1
+ X(I)=X(I)-A(J)*X(SL(IS))
+ IS=IS+1
+500 CONTINUE
+600 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXSPCC ALL SYSTEMS 92/12/01
+* PURPOSE :
+* SPARSE MATRIX REORDER, SYMBOLIC FACTORIZATION, DATA STRUCTURES
+* TRANSFORMATION - INITIATION OF THE DIRECT SPARSE SOLVER.
+* MODIFIED VERSION WITH CHANGED DATA STRUCTURES.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* II NJA NUMBER OF NONZERO ELEMENTS OF THE MATRIX.
+* IO ML SIZE OF THE COMPACT STRUCTURE OF THE TRIANGULAR FACTOR
+* OF THE HESSIAN APPROXIMATION.
+* II MMAX SIZE OF THE ARRAYS JA,A.
+* RO A(MMAX) NUMERICAL VALUES OF THE SPARSE HESSIAN APPROXIMATION
+* STORED AT THE POSITIONS 1, ...,NJA. LOWER TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION STORED AT THE
+* POSITIONS NJA+1, ..., NJA+MB.
+* II IA(N) POINTERS OF THE DIAGONAL ELEMENTS OF THE HESSIAN MATRIX.
+* II JA(MMAX) INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
+* THE PACKED ROW FORM AT THE FIRST NJA POSITIONS. COMPACT
+* STRUCTURE OF INDICES OF ITS TRIANGULAR FACTOR IS ROWWISE
+* STORED.
+* II PSL(N+1) POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION.
+* IO PERM(N) PERMUTATION VECTOR.
+* IO INVP(N) INVERSE PERMUTATION VECTOR.
+* IA WN11(N) AUXILIARY VECTOR.
+* IA WN12(N) AUXILIARY VECTOR.
+* IA WN13(N) AUXILIARY VECTOR.
+* IA WN14(N) AUXILIARY VECTOR.
+* IO ITERM TERMINATION INDICATOR. TERMINATION IF ITERM .NE. 0.
+*
+* COMMON DATA :
+*
+* SUBPROGRAMS USED :
+* S MXSTG1 WIDTHENING OF THE PACKED FORM OF THE SPARSE MATRIX.
+* S MXSSMN SPARSE MATRIX REORDERING.
+* S MXVSIP INVERSE PERMUTATION COMPUTING.
+* S MXSPCI SYMBOLIC FACTORIZATION.
+* S MXSTL1 PACKING OF THE WIDTHENED FORM OF THE SPARSE MATRIX.
+*
+ SUBROUTINE MXSPCC(N,NJA,ML,MMAX,A,IA,JA,PSL,PERM,INVP,WN11,WN12,
+ * WN13,WN14,ITERM)
+ INTEGER N,NJA,MMAX,ML,ITERM
+ INTEGER PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*)
+ INTEGER PSL(*),IA(*),JA(*)
+ INTEGER JSTRT,JSTOP,I,J,K,L,NJASAVE
+ INTEGER LL,LL1,NJABIG,KSTRT
+ DOUBLE PRECISION A(*)
+ IF (ML.GT.0) RETURN
+ IF (2*NJA.GE.MMAX) THEN
+ ITERM=-41
+ GO TO 1000
+ END IF
+*
+* WIDTHENING OF THE PACKED FORM
+*
+ NJASAVE=NJA
+ CALL MXSTG1(N,NJA,IA,JA,WN12,WN11)
+ NJABIG=NJA
+*
+* REORDERING OF THE SPARSE MATRIX
+*
+ CALL MXSSMN(N,IA,JA,PERM,WN11,WN12,WN13)
+*
+* FIND THE INVERSE PERMUTATION VECTOR INVP
+*
+ CALL MXVSIP(N,PERM,INVP)
+*
+* SHRINK THE STRUCTURE
+*
+ CALL MXSTL1(N,NJA,IA,JA,WN11)
+ DO 40 I=1,N
+ WN11(I)=0
+ WN12(I)=0
+ 40 CONTINUE
+*
+* WN11 CONTAINS BEGINNINGS OF THE FACTOR ROWS
+*
+ DO 50 I=1,N
+ K=PERM(I)
+ JSTRT=IA(K)
+ JSTOP=IA(K+1)-1
+ DO 60 J=JSTRT,JSTOP
+ L=JA(J)
+ L=INVP(L)
+ IF (L.GE.I) THEN
+ WN12(I)=WN12(I)+1
+ ELSE
+ WN12(L)=WN12(L)+1
+ END IF
+ 60 CONTINUE
+ 50 CONTINUE
+ WN11(1)=1
+ DO 69 I=1,N-1
+ WN11(I+1)=WN11(I)+WN12(I)
+ 69 CONTINUE
+*
+* CREATE UPPER TRIANGULAR STRUCTURE NECESSARY FOR THE TRANSFER
+*
+ DO 300 I=1,N
+ K=PERM(I)
+ JSTRT=IA(K)
+ JSTOP=IA(K+1)-1
+ DO 200 J=JSTRT,JSTOP
+ L=JA(J)
+ L=INVP(L)
+ IF (L.GE.I) THEN
+ LL1=WN11(I)
+ WN11(I)=LL1+1
+ JA(NJABIG+LL1)=L
+ A(J)=LL1
+ A(NJA+LL1)=J
+ ELSE
+ LL1=WN11(L)
+ WN11(L)=LL1+1
+ JA(NJABIG+LL1)=I
+ A(J)=LL1
+ A(NJA+LL1)=J
+ END IF
+ 200 CONTINUE
+ 300 CONTINUE
+*
+* SORT INDICES IN THE PERMUTED UPPER TRIANGLE
+*
+ DO 599 I=1,N
+ WN11(I)=0
+ 599 CONTINUE
+ WN11(1)=1
+ WN14(1)=1
+ DO 67 I=2,N+1
+ WN11(I)=WN11(I-1)+WN12(I-1)
+ WN14(I)=WN11(I)
+ 67 CONTINUE
+ DO 602 I=1,N
+ WN12(I)=0
+ 602 CONTINUE
+ JSTOP=WN11(N+1)
+ DO 499 I=N,1,-1
+ JSTRT=WN11(I)
+ CALL MXVSR5(JSTOP-JSTRT,JSTRT-1,JA(NJABIG+JSTRT),
+ & A,A(NJASAVE+JSTRT))
+ JSTOP=JSTRT
+ 499 CONTINUE
+*
+* WIDTHENING OF THE PERMUTED PACKED FORM.
+*
+ NJASAVE=NJA
+ CALL MXSTG1(N,NJA,IA,JA,WN12,WN11)
+ NJABIG=NJA
+*
+* SYMBOLIC FACTORIZATION.
+*
+ CALL MXSPCI(N,ML,MMAX-2*NJA,IA,JA,PSL,A(2*NJASAVE+1),PERM,
+ & INVP,WN11,WN12,WN13,ITERM)
+ IF (ITERM.NE.0) THEN
+ ITERM=-42
+ GO TO 1000
+ END IF
+*
+* RETRIEVE PARAMETERS
+*
+ CALL MXSTL1(N,NJA,IA,JA,WN11)
+*
+* SHIFT PERMUTED UPPER TRIANGLE.
+*
+ DO 73 I=1,NJASAVE
+ JA(NJA+I)=JA(NJABIG+I)
+ 73 CONTINUE
+*
+* SHIFT STRUCTURE SL.
+*
+ IF (2*NJASAVE+ML.GE.MMAX) THEN
+ ITERM=-41
+ GO TO 1000
+ END IF
+ DO 70 I=1,ML
+ JA(2*NJASAVE+I)=A(2*NJASAVE+I)
+ 70 CONTINUE
+*
+* SET POINTERS
+*
+ DO 600 I=1,N
+ WN12(I)=0
+ 600 CONTINUE
+ LL1=PSL(N)+N-1
+ JSTOP=WN14(N+1)
+ DO 500 I=N,1,-1
+ JSTRT=WN14(I)
+ DO 700 J=JSTRT,JSTOP-1
+ K=JA(NJASAVE+J)
+ WN12(K)=J
+ LL=A(NJASAVE+J)
+ WN13(K)=LL
+ 700 CONTINUE
+ JSTOP=JSTRT
+ KSTRT=JA(2*NJASAVE+I)+N+1+2*NJASAVE
+ DO 800 J=KSTRT+PSL(I+1)-PSL(I)-1,KSTRT,-1
+ L=JA(J)
+ IF (WN12(L).NE.0) THEN
+ LL=WN13(L)
+ A(LL)=LL1
+ WN12(L)=0
+ END IF
+ LL1=LL1-1
+ 800 CONTINUE
+ K=WN12(I)
+ WN12(I)=0
+ LL=WN13(I)
+ A(LL)=LL1
+ LL1=LL1-1
+ 500 CONTINUE
+ DO 76 I=1,ML
+ JA(NJASAVE+I)=JA(2*NJASAVE+I)
+ 76 CONTINUE
+ DO 72 I=1,NJASAVE
+ JA(ML+NJASAVE+I)=A(I)
+ 72 CONTINUE
+ 1000 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSPCD ALL SYSTEMS 92/12/01
+* PURPOSE :
+* COMPUTATION OF A DIRECTION OF NEGATIVE CURVATURE WITH RESPECT TO A
+* SPARSE SYMMETRIC MATRIX A USING THE FACTORIZATION A+E=L*D*TRANS(L)
+* STORED IN THE COMPACT SPARSE FORM.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* II MMAX LENGTH OF THE PRINCIPAL MATRIX VECTORS (SL,A).
+* RI A(MMAX) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPGF.IT CONTAINS THE NUMERICAL VALUES OF THE
+* FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
+* INFORMATION IN THE VECTORS PSL,SL.
+* II PSL(N+1) POINTER VECTOR OF THE FACTORIZED MATRIX A.
+* II SL(MMAX) COMPACT SHEME OF THE FACTORIZED MATRIX A.
+* RO X(N) COMPUTED DIRECTION OF NEGATIVE CURVATURE (I.E.
+* TRANS(X)*A*X<0) IF IT EXISTS.
+* II INF INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. THE
+* DIRECTION OF NEGATIVE CURVATURE EXISTS ONLY IF INF>0.
+*
+* METHOD :
+* P.E.GILL, W.MURRAY : NEWTON TYPE METHODS FOR UNCONSTRAINED AND
+* LINEARLY CONSTRAINED OPTIMIZATION, MATH. PROGRAMMING 28 (1974)
+* PP. 311-350.
+*
+ SUBROUTINE MXSPCD(N,A,PSL,SL,X,INF)
+ INTEGER N,INF,PSL(*),SL(*)
+ DOUBLE PRECISION A(*),X(*)
+ INTEGER I, J, IS
+*
+* RIGHT HAND SIDE FORMATION
+*
+ DO 100 I=1,N
+ X(I) = 0.0D 0
+100 CONTINUE
+ IF (INF .LE. 0) RETURN
+ X(INF) = 1.0D 0
+*
+* BACK SUBSTITUTION
+*
+ DO 300 I=INF-1,1,-1
+ IS=SL(I)+N+1
+ DO 200 J=PSL(I)+I,PSL(I+1)+I-1
+ X(I)=X(I)-A(J)*X(SL(IS))
+ IS=IS+1
+200 CONTINUE
+300 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSPCF ALL SYSTEMS 90/12/01
+* PURPOSE :
+* NUMERICAL FACTORIZATION A+E=L*D*TRANS(L) OF A SPARSE
+* SYMMETRIC POSITIVE DEFINITE MATRIX A+E WHERE D AND E ARE DIAGONAL
+* POSITIVE DEFINITE MATRICES AND L IS A LOWER TRIANGULAR MATRIX. IF
+* A IS SUFFICIENTLY POSITIVE DEFINITE THEN E=0. THE STRUCTURE ON
+* INPUT WAS OBTAINED BY THE SYMBOLIC FACTORIZATION AND IT MAKES
+* USE OF THE COMPACT SCHEME OF STORING THE SPARSE MATRIX IN THE
+* POINTER ARRAY PSL ,INDEX ARRAY SL. NUMERICAL VALUES OF THE FACTOR
+* CAN BE FOUND IN THE ARRAY A.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RU A(MMAX) ON INPUT NUMERICAL VALUES OF THE LOWER HALF OF THE
+* MATRIX THAT IS BEEING FACTORIZED(INCLUDING THE DIAGONAL
+* ELEMENTS. ON OUTPUT IT CONTAINS FACTORS L AND D AS IF THEY
+* FORM THE LOWER HALF OF THE MATRIX.STRUCTURE INFORMATION
+* IS SAVED IN THE COMPACT SCHEME IN THE PAIR OF VECTORS PSL
+* AND SL.
+* II PSL(NF+1) POINTER VECTOR OF THE FACTOR
+* II SL(MMAX) STRUCTURE OF THE FACTOR IN THE COMPACT FORM
+* IA WN11(NF+1) AUXILIARY VECTOR.
+* IA WN12(NF+1) AUXILIARY VECTOR.
+* RA RN01(NF+1) AUXILIARY VECTOR.
+* IO INF AN INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. IF
+* INF=0 THEN A IS SUFFICIENTLY POSITIVE DEFINITE AND E=0. IF
+* INF<0 THEN A IS NOT SUFFICIENTLY POSITIVE DEFINITE AND E>0. IF
+* INF>0 THEN THEN A IS INDEFINITE AND INF IS AN INDEX OF THE
+* MOST NEGATIVE DIAGONAL ELEMENT USED IN THE FACTORIZATION
+* PROCESS.
+* RU ALF ON INPUT A DESIRED TOLERANCE FOR POSITIVE DEFINITENESS. ON
+* OUTPUT THE MOST NEGATIVE DIAGONAL ELEMENT USED IN THE
+* FACTORIZATION PROCESS (IF INF>0).
+* RO TAU MAXIMUM DIAGONAL ELEMENT OF THE MATRIX E.
+*
+* METHOD :
+* S.C.EISENSTAT,M.C.GURSKY,M.H.SCHULTZ,A.H.SHERMAN:YALE SPARSE MATRIX
+* PACKAGE I. THE SYMMETRIC CODES,YALE UNIV. RES. REPT.
+* NO.112,1977.
+*
+ SUBROUTINE MXSPCF(N,A,PSL,SL,WN11,WN12,RN01,INF,ALF,TAU)
+ INTEGER N,PSL(*),SL(*),WN11(*),WN12(*),INF
+ DOUBLE PRECISION A(*),RN01(*),ALF
+ DOUBLE PRECISION BET,GAM,DEL,RHO,SIG,TOL,TADD,TBDD,TAU
+ INTEGER I, J, K, L, II
+ INTEGER ISTRT,ISTOP,NEWK,KPB,ISUB
+ L = 0
+ INF = 0
+ TOL = ALF
+ ALF = 0.0D 0
+ BET = 0.0D 0
+ GAM = 0.0D 0
+ TAU = 0.0D 0
+ DO 60 I=1,N
+ BET=MAX(BET,ABS(A(PSL(I)+I-1)))
+ DO 50 J=PSL(I)+I,PSL(I+1)+I-1
+ GAM = MAX( GAM, ABS(A(J)) )
+50 CONTINUE
+60 CONTINUE
+ BET = MAX(TOL,BET,GAM/N)
+ DEL = TOL*BET
+ DO 100 I=1,N
+ WN11(I)=0
+ RN01(I)=0.0D 0
+100 CONTINUE
+ DO 600 J=1,N
+*
+* DETERMINATION OF A DIAGONAL CORRECTION
+*
+ SIG=A(PSL(J)+J-1)
+ RHO=0.0D 0
+ NEWK=WN11(J)
+200 K=NEWK
+ IF (K.EQ.0) GO TO 400
+ NEWK=WN11(K)
+ KPB=WN12(K)
+ TADD=A(KPB+K)
+ TBDD=TADD*A(PSL(K)+K-1)
+ RHO=RHO+TADD*TBDD
+ ISTRT=KPB+1
+ ISTOP=PSL(K+1)-1
+ IF (ISTOP.LT.ISTRT) GO TO 200
+ WN12(K)=ISTRT
+ I=SL(K)+(KPB-PSL(K))+1
+ ISUB=SL(N+1+I)
+ WN11(K)=WN11(ISUB)
+ WN11(ISUB)=K
+ DO 300 II=ISTRT,ISTOP
+ ISUB=SL(N+1+I)
+ RN01(ISUB)=RN01(ISUB)+A(II+K)*TBDD
+ I=I+1
+300 CONTINUE
+ GO TO 200
+400 SIG=A(PSL(J)+J-1)-RHO
+ IF (ALF.GT.SIG) THEN
+ ALF=SIG
+ L=J
+ END IF
+ GAM=0.0D 0
+ ISTRT=PSL(J)
+ ISTOP=PSL(J+1)-1
+ IF (ISTOP.LT.ISTRT) GO TO 370
+ WN12(J)=ISTRT
+ I=SL(J)
+ ISUB=SL(N+1+I)
+ WN11(J)=WN11(ISUB)
+ WN11(ISUB)=J
+ DO 500 II=ISTRT,ISTOP
+ ISUB=SL(N+1+I)
+ A(II+J)=(A(II+J)-RN01(ISUB))
+ RN01(ISUB)=0.0D 0
+ I=I+1
+500 CONTINUE
+ DO 350 K=PSL(J)+J,PSL(J+1)+J-1
+ GAM=MAX(GAM,ABS(A(K)))
+350 CONTINUE
+ GAM=GAM*GAM
+370 RHO=MAX(ABS(SIG),GAM/BET,DEL)
+ IF (TAU.LT.RHO-SIG) THEN
+ TAU=RHO-SIG
+ INF=-1
+ END IF
+*
+* GAUSSIAN ELIMINATION
+*
+ A(PSL(J)+J-1)=RHO
+ DO 550 II=ISTRT,ISTOP
+ A(II+J)=A(II+J)/RHO
+550 CONTINUE
+600 CONTINUE
+ IF (L.NE.0.AND.ABS(ALF).GT.DEL) INF=L
+ RETURN
+ END
+* SUBROUTINE MXSPCI ALL SYSTEMS 89/12/01
+* PURPOSE :
+* SYMBOLIC FACTORIZATION OF A SPARSE SYMMETRIC MATRIX GIVEN IN THE
+* NORMAL SCHEME PA,SA. ON OUTPUT WE HAVE POINTER VECTOR OF THE FACTOR
+* PSL AND VECTOR OF COLUMN INDICES SL. ML IS THE NUMBER OF THE INDICES
+* USED FOR THE VECTOR SL, WHERE WE HAVE FACTOR IN THE COMPACT FORM.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* IO ML NUMBER OF THE NONZERO ELEMENTS IN THE FACTOR'S COMPACT SCHEME
+* II MMAX LENGTH OF THE ARRAY SL. IN THE CASE OF THE
+* INSUFFICIENT SPACE IT IS TO BE INCREASED.
+* II PA(N+1) POINTER VECTOR OF THE INPUT MATRIX
+* II SA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX
+* IO PSL(N+1) POINTER VECTOR OF THE FACTOR
+* RO SL(MMAX) COMPACT SCHEME OF THE INDICES OF THE FACTOR
+* II PERM(N) PERMUTATION VECTOR
+* II INVP(N) INVERSE PERMUTATION VECTOR
+* IA WN11(N+1) WORK VECTOR OF THE LENGTH N+1
+* IA WN12(N+1) WORK VECTOR OF THE LENGTH N+1
+* IA WN13(N+1) WORK VECTOR OF THE LENGTH N+1
+* IO ISPACE AN INFORMATION ON SPACE OBTAINED DURING THE PROCESS
+* OF THE FACTORIZATION.
+* ISPACE=0 THE FACTORIZATION HAS TERMINATED NORMALLY
+* ISPACE=1 INSUFFICIENT SPACE AVAILABLE
+*
+* METHOD :
+* S.C.EISENSTAT,M.C.GURSKY,M.H.SCHULTZ,A.H.SHERMAN:YALE SPARSE MATRIX
+* PACKAGE I. THE SYMMETRIC CODES,ACM TRANS. ON MATH. SOFTWARE.
+*
+* NOTE: TYPE OF SL CHANGED FOR THE UFO APPLICATION.
+*
+ SUBROUTINE MXSPCI(N,ML,MMAX,PA,SA,PSL,SL,PERM,INVP,
+ & WN11,WN12,WN13,ISPACE)
+ INTEGER N,MMAX,PA(*),SA(*),PSL(*)
+ INTEGER PERM(*),INVP(*),WN11(*),WN12(*),WN13(*)
+ INTEGER ISPACE,I,INZ,J,JSTOP,JSTRT,K,KNZ,KXSUB,MRGK,LMAX,ML
+ INTEGER NABOR,NODE,NP1,NZBEG,NZEND,RCHM,MRKFLG,M
+ DOUBLE PRECISION SL(*)
+ NZBEG=1
+ NZEND=0
+ PSL(1)=1
+ DO 100 K=1,N
+ WN11(K)=0
+ WN13(K)=0
+100 CONTINUE
+ NP1=N+1
+ DO 1500 K=1,N
+ KNZ=0
+ MRGK=WN11(K)
+ MRKFLG=0
+ WN13(K)=K
+ IF (MRGK.NE.0) WN13(K)=WN13(MRGK)
+ SL(K)=NZEND
+ NODE=PERM(K)
+ JSTRT=PA(NODE)
+ JSTOP=PA(NODE+1)-1
+ IF (JSTRT.GT.JSTOP) GO TO 1500
+ WN12(K)=NP1
+ DO 300 J=JSTRT,JSTOP
+ NABOR=SA(J)
+ IF (NABOR.EQ.NODE) GO TO 300
+ NABOR=INVP(NABOR)
+ IF (NABOR.LE.K) GO TO 300
+ RCHM=K
+200 M=RCHM
+ RCHM=WN12(M)
+ IF (RCHM.LE.NABOR) GO TO 200
+ KNZ=KNZ+1
+ WN12(M)=NABOR
+ WN12(NABOR)=RCHM
+ IF (WN13(NABOR).NE.WN13(K)) MRKFLG=1
+300 CONTINUE
+ LMAX=0
+ IF (MRKFLG.NE.0.OR.MRGK.EQ.0) GO TO 350
+ IF (WN11(MRGK).NE.0) GO TO 350
+ SL(K)=SL(MRGK)+1
+ KNZ=PSL(MRGK+1)-(PSL(MRGK)+1)
+ GO TO 1400
+350 I=K
+400 I=WN11(I)
+ IF (I.EQ.0) GO TO 800
+ INZ=PSL(I+1)-(PSL(I)+1)
+ JSTRT=SL(I)+1
+ JSTOP=SL(I)+INZ
+ IF (INZ.LE.LMAX) GO TO 500
+ LMAX=INZ
+ SL(K)=JSTRT
+500 RCHM=K
+ DO 700 J=JSTRT,JSTOP
+ NABOR=SL(N+1+J)
+600 M=RCHM
+ RCHM=WN12(M)
+ IF (RCHM.LT.NABOR) GO TO 600
+ IF (RCHM.EQ.NABOR) GO TO 700
+ KNZ=KNZ+1
+ WN12(M)=NABOR
+ WN12(NABOR)=RCHM
+ RCHM=NABOR
+700 CONTINUE
+ GO TO 400
+800 IF (KNZ.EQ.LMAX) GO TO 1400
+ IF (NZBEG.GT.NZEND) GO TO 1200
+ I=WN12(K)
+ DO 900 JSTRT=NZBEG,NZEND
+ IF (SL(N+1+JSTRT)-I .GE.0) THEN
+ IF (SL(N+1+JSTRT).EQ.I) THEN
+ GO TO 1000
+ ELSE
+ GO TO 1200
+ END IF
+ END IF
+900 CONTINUE
+ GO TO 1200
+1000 SL(K)=JSTRT
+ DO 1100 J=JSTRT,NZEND
+ IF (SL(N+1+J).NE.I) GO TO 1200
+ I=WN12(I)
+ IF (I.GT.N) GO TO 1400
+1100 CONTINUE
+ NZEND=JSTRT-1
+1200 NZBEG=NZEND+1
+ NZEND=NZEND+KNZ
+*
+* A VARIANT IS USED WHEN CALLED SO THAT SL(X)=A(NB+X)
+*
+ IF (NZEND.GE.MMAX-N-1) GO TO 1600
+ I=K
+ DO 1300 J=NZBEG,NZEND
+ I=WN12(I)
+ SL(N+1+J)=I
+ WN13(I)=K
+1300 CONTINUE
+ SL(K)=NZBEG
+ WN13(K)=K
+1400 IF (KNZ.GT.1) THEN
+ KXSUB=SL(K)
+ I=SL(N+1+KXSUB)
+ WN11(K)=WN11(I)
+ WN11(I)=K
+ END IF
+ PSL(K+1)=PSL(K)+KNZ
+1500 CONTINUE
+ SL(N)=SL(N)+1
+ SL(N+1)=SL(N)
+ ML=N+SL(N+1)
+ ISPACE=0
+ RETURN
+1600 ISPACE=1
+ RETURN
+ END
+* SUBROUTINE MXSPCM ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF A GIVEN VECTOR X BY A SPARSE SYMMETRIC POSITIVE
+* DEFINITE MATRIX A+E USING THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED
+* BY THE SUBROUTINE MXSPGN. FACTORS ARE STORED IN THE COMPACT FORM.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(MMAX) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPGN.IT CONTAINS THE NUMERICAL VALUES OF THE
+* FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
+* INFORMATION IN THE VECTORS PSL,SL.
+* II PSL(N+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
+* II SL(MMAX) INDICES OF THE COMPACT SCHEME OF THE FACTORS.
+* RU X(N) ON INPUT THE GIVEN VECTOR, ON OUTPUT THE RESULT
+* OF MULTIPLICATION.
+* RA RN01(N) AUXILIARY VECTOR.
+* II JOB OPTION. IF JOB=0 THEN X:=(A+E)*X. IF JOB>0 THEN
+* X:=TRANS(L)*X. IF JOB<0 THEN X:=L*X.
+*
+ SUBROUTINE MXSPCM(N,A,PSL,SL,X,RN01,JOB)
+ INTEGER N
+ INTEGER PSL(*),SL(*),JOB
+ DOUBLE PRECISION A(*),X(*),RN01(*),ZERO
+ PARAMETER(ZERO=0.0D0)
+ INTEGER I,J,IS
+ DO 50 I=1,N
+ RN01(I)=ZERO
+ 50 CONTINUE
+*
+* FIRST PHASE:X=TRANS(L)*X
+*
+ IF (JOB.GE.0) THEN
+ DO 300 I=1,N
+ IS=SL(I)+N+1
+ DO 200 J=PSL(I)+I,PSL(I+1)+I-1
+ X(I)=X(I)+A(J)*X(SL(IS))
+ IS=IS+1
+200 CONTINUE
+300 CONTINUE
+ END IF
+*
+* SECOND PHASE:X=D*X
+*
+ IF (JOB.EQ.0) THEN
+ DO 400 I=1,N
+ X(I) = X(I)*A(PSL(I)+I-1)
+400 CONTINUE
+ END IF
+*
+* THIRD PHASE:X=L*X
+*
+ IF (JOB.LE.0) THEN
+ DO 600 I=N,1,-1
+ IS=SL(I)+N+1
+ DO 500 J=PSL(I)+I,PSL(I+1)+I-1
+ RN01(SL(IS))=RN01(SL(IS))+A(J)*X(I)
+ IS=IS+1
+500 CONTINUE
+600 CONTINUE
+ DO 700 I=1,N
+ X(I)=RN01(I)+X(I)
+700 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXSPCN ALL SYSTEMS 93/12/01
+* PURPOSE :
+* ESTIMATION OF THE MINIMUM EIGENVALUE AND THE CORRESPONDING EIGENVECTOR
+* OF A SPARSE SYMMETRIC POSITIVE DEFINITE MATRIX A+E USING THE
+* FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE SUBROUTINE MXSPCF.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(MMAX) FACTORS L,D OF THE FACTORIZATION A+E=L*D*TRANS(L)
+* STORED USING THE COMPACT SCHEME OF STORING.
+* II PSL(N+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
+* II SL(MMAX) ARRAY OF COLUMN INDICES OF THE FACTORS L AND D
+* STORED USING THE COMPACT SCHEME.
+* SUBROUTINE MXDPGF.
+* RO X(N) ESTIMATED EIGENVECTOR.
+* RO ALF ESTIMATED EIGENVALUE.
+* II JOB OPTION. IF JOB=0 THEN ONLY ESTIMATED EIGENVALUE IS
+* COMPUTED. IS JOB>0 THEN BOTH ESTIMATED EIGENVALUE AND
+* ESTIMATED EIGENVECTOR ARE COMPUTED.
+*
+ SUBROUTINE MXSPCN(N,A,PSL,SL,X,ALF,JOB)
+ INTEGER N
+ DOUBLE PRECISION A(*),X(*),ALF
+ INTEGER PSL(*),SL(*),JOB
+ DOUBLE PRECISION XP,XM,FP,FM,MXVDOT
+ INTEGER I,K,IS
+ DOUBLE PRECISION ZERO,ONE
+ PARAMETER (ZERO=0.0D 0,ONE=1.0D 0)
+*
+* COMPUTATION OF THE VECTOR V WITH POSSIBLE MAXIMUM NORM SUCH
+* THAT L*D**(1/2)*V=U WHERE U HAS ELEMENTS +1 OR -1
+*
+ DO 2 I=1,N
+ X(I)=ZERO
+ 2 CONTINUE
+ DO 6 K=1,N
+ XP=-X(K)+ONE
+ XM=-X(K)-ONE
+ FP=ABS(XP)
+ FM=ABS(XM)
+ IS=SL(K)+N+1
+ DO 3 I=PSL(K)+K,PSL(K+1)+K-1
+ FP=FP+ABS(X(SL(IS))+A(I)*XP)
+ FM=FM+ABS(X(SL(IS))+A(I)*XM)
+ IS=IS+1
+ 3 CONTINUE
+ IF (FP.GE.FM) THEN
+ X(K)=XP
+ IS=SL(K)+N+1
+ DO 4 I=PSL(K)+K,PSL(K+1)+K-1
+ X(SL(IS))=X(SL(IS))+A(I)*XP
+ IS=IS+1
+ 4 CONTINUE
+ ELSE
+ X(K)=XM
+ IS=SL(K)+N+1
+ DO 5 I=PSL(K)+K,PSL(K+1)+K-1
+ X(SL(IS))=X(SL(IS))+A(I)*XM
+ IS=IS+1
+ 5 CONTINUE
+ END IF
+ 6 CONTINUE
+*
+* COMPUTATION OF THE VECTOR X SUCH THAT
+* D**(1/2)*TRANS(L)*X=V
+*
+ FM=ZERO
+ DO 7 K=1,N
+ IF (JOB.LE.0) THEN
+ FP=SQRT(A(PSL(K)+K-1))
+ X(K)=X(K)/FP
+ FM=FM+X(K)*X(K)
+ ELSE
+ X(K)=X(K)/A(PSL(K)+K-1)
+ END IF
+ 7 CONTINUE
+ FP=DBLE(N)
+ IF (JOB.LE.0) THEN
+*
+* FIRST ESTIMATION OF THE MINIMUM EIGENVALUE BY THE FORMULA
+* ALF=(TRANS(U)*U)/(TRANS(V)*V)
+*
+ ALF=FP/FM
+ RETURN
+ END IF
+ FM=ZERO
+ DO 9 K=N,1,-1
+ IS=SL(K)+N+1
+ DO 8 I=PSL(K)+K,PSL(K+1)+K-1
+ X(K)=X(K)-A(I)*X(SL(IS))
+ IS=IS+1
+ 8 CONTINUE
+ FM=FM+X(K)*X(K)
+ 9 CONTINUE
+ FM=SQRT(FM)
+ IF (JOB.LE.1) THEN
+*
+* SECOND ESTIMATION OF THE MINIMUM EIGENVALUE BY THE FORMULA
+* ALF=SQRT(TRANS(U)*U)/SQRT(TRANS(X)*X)
+*
+ ALF=SQRT(FP)/FM
+ ELSE
+*
+* INVERSE ITERATIONS
+*
+ DO 11 K=2,JOB
+*
+* SCALING THE VECTOR X BY ITS NORM
+*
+ DO 10 I=1,N
+ X(I)=X(I)/FM
+ 10 CONTINUE
+ CALL MXSPCB(N,A,PSL,SL,X,0)
+ FM=SQRT(MXVDOT(N,X,X))
+ 11 CONTINUE
+ ALF=ONE/FM
+ END IF
+*
+* SCALING THE VECTOR X BY ITS NORM
+*
+ DO 12 I=1,N
+ X(I)=X(I)/FM
+ 12 CONTINUE
+ RETURN
+ END
+* FUNCTION MXSPCP ALL SYSTEMS 92/12/01
+* PURPOSE :
+* COMPUTATION OF THE NUMBER MXSPCP=TRANS(X)*D**(-1)*X WHERE D IS A
+* DIAGONAL MATRIX IN THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPGN. THE FACTORS ARE STORED IN THE COMPACT FORM.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(MMAX) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPGN.IT CONTAINS THE NUMERICAL VALUES OF THE
+* FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
+* INFORMATION IN THE VECTORS PSL,SL.
+* II PSL(N+1) POINTER VECTOR OF THE FACTORIZED MATRIX A.
+* RI X(N) INPUT VECTOR
+* RR MXSPCP COMPUTED NUMBER MXSPCP=TRANS(X)*D**(-1)*X
+*
+ FUNCTION MXSPCP(N,A,PSL,X)
+ INTEGER N
+ DOUBLE PRECISION A(*), X(*), MXSPCP
+ DOUBLE PRECISION TEMP
+ INTEGER PSL(*),I
+ TEMP = 0.0D 0
+ DO 100 I=1,N
+ TEMP = TEMP + X(I)*X(I)/A(PSL(I)+I-1)
+100 CONTINUE
+ MXSPCP = TEMP
+ RETURN
+ END
+* FUNCTION MXSPCQ ALL SYSTEMS 92/12/01
+* PURPOSE :
+* COMPUTATION OF THE NUMBER MXSPCQ=TRANS(X)*D*X WHERE D IS A
+* DIAGONAL MATRIX IN THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPGN. FACTORS ARE STORED IN THE COMPACT FORM.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(MMAX) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPGN.IT CONTAINS THE NUMERICAL VALUES OF THE
+* FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
+* INFORMATION IN THE VECTORS PSL,SL.
+* II PSL(N+1) POINTER VECTOR OF THE FACTORIZED MATRIX A
+* RI X(N) INPUT VECTOR
+* RR MXSPCQ COMPUTED NUMBER MXSPCQ=TRANS(X)*D*X
+*
+ FUNCTION MXSPCQ(N,A,PSL,X)
+ INTEGER N
+ DOUBLE PRECISION A(*), X(*), MXSPCQ
+ DOUBLE PRECISION TEMP
+ INTEGER PSL(N+1),I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO = 0.0D0)
+ TEMP = ZERO
+ DO 100 I=1,N
+ TEMP = TEMP + X(I)*X(I)*A(PSL(I)+I-1)
+100 CONTINUE
+ MXSPCQ = TEMP
+ RETURN
+ END
+* SUBROUTINE MXSPCT ALL SYSTEMS 92/12/01
+* PURPOSE :
+* REWRITE SYMMETRIC MATRIX INTO THE PERMUTED FACTORIZED COMPACT SCHEME.
+* MOIDIFIED VERSION FOR THE USE WITH MXSPCJ.
+*
+* PARAMETERS:
+* II N SIZE OF THE SYSTEM SOLVED.
+* II NB NUMBER OF NONZEROS IN THE UPPER TRIANGLE OF THE ORIGINAL
+* MATRIX.
+* II ML SIZE OF THE COMPACT FACTOR.
+* II MMAX DECLARED LENGTH OF THE ARRAYS JA,A.
+* RU A(MMAX) NUMERICAL VALUES OF THE SPARSE HESSIAN APPROXIMATION
+* STORED AT THE POSITIONS 1, ...,NB.
+* IU JA(MMAX) INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
+* THE PACKED ROW FORM AT THE FIRST NB POSITIONS.
+* NEW POSITIONS
+* IN THE PERMUTED FACTOR STORED IN A(NB+1), ..., A(2*NB),
+* INDICES OF COMPACT SCHEME IN A(2*NB+1), ..., A(2*NB+ML).
+* II PSL(N+1) POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION.
+* IO ITERM ERROR FLAG. IF ITERM < 0 - LACK OF SPACE IN JA.
+*
+*
+ SUBROUTINE MXSPCT(N,NB,ML,MMAX,A,JA,PSL,ITERM)
+ INTEGER N,NB,ML,MMAX,JA(*)
+ INTEGER PSL(*),ITERM
+ DOUBLE PRECISION A(*)
+ INTEGER I,J
+*
+* WN11 CONTAINS BEGINNINGS OF THE FACTOR ROWS
+*
+ ITERM=0
+*
+* LACK OF SPACE
+*
+ IF (MMAX.LE.NB+PSL(N+1)+N-1) THEN
+ ITERM=-43
+ RETURN
+ END IF
+ IF (MMAX.LE.2*NB+ML) THEN
+ ITERM=-44
+ RETURN
+ END IF
+ DO 50 I=NB+1,NB+PSL(N+1)+N-1
+ A(I)=0.0D 0
+ 50 CONTINUE
+ DO 100 I=NB+ML+1,2*NB+ML
+ J=JA(I)
+ A(NB+J)=A(I-NB-ML)
+ 100 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSPTB ALL SYSTEMS 94/12/01
+* PURPOSE :
+* SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A SPARSE SYMMETRIC
+* POSITIVE DEFINITE MATRIX A+E USING INCOMPLETE ILUT-TYPE FACTORIZATION
+* A+E=L*D*TRANS(L) OBTAINED BY THE SUBROUTINE MXSPTF.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(MMAX) INCOMPLETE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
+* SUBROUTINE MXSPTF.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(MMAX) INDICES OF THE NONZERO ELEMENTS OF A.
+* RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR
+* EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR
+* EQUATIONS.
+* II JOB OPTION. IF JOB=0 THEN X:=(A+E)**(-1)*X. IF JOB>0 THEN
+* X:=L**(-1)*X. IF JOB<0 THEN X:=TRANS(L)**(-1)*X.
+*
+* METHOD :
+* BACK SUBSTITUTION
+*
+ SUBROUTINE MXSPTB(N,A,IA,JA,X,JOB)
+ INTEGER N,IA(*),JA(*),JOB
+ DOUBLE PRECISION A(*),X(*)
+ INTEGER I,J,K
+ DOUBLE PRECISION TEMP,SUM
+*
+* FIRST PHASE
+*
+ IF (JOB.GE.0) THEN
+ DO 300 I=1,N
+ K=IA(I)
+ IF (K.LE.0) GO TO 300
+ TEMP=X(I)*A(K)
+ DO 200 J=IA(I)+1,IA(I+1)-1
+ K=JA(J)
+ IF (K.GT.0) X(K)=X(K)-A(J)*TEMP
+200 CONTINUE
+ IF (JOB.EQ.0) X(I)=TEMP
+300 CONTINUE
+ END IF
+*
+* THIRD PHASE
+*
+ IF (JOB.LE.0) THEN
+ DO 600 I=N,1,-1
+ K=IA(I)
+ IF (K.LE.0) GO TO 600
+ SUM=0.0D 0
+ TEMP=A(K)
+ DO 500 J=IA(I)+1,IA(I+1)-1
+ K=JA(J)
+ IF (K.GT.0) SUM=SUM+A(J)*X(K)
+500 CONTINUE
+ SUM=SUM*TEMP
+ X(I)=X(I)-SUM
+600 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXSPTF ALL SYSTEMS 03/12/01
+* PURPOSE :
+* INCOMPLETE CHOLESKY FACTORIZATION A+E=L*D*TRANS(L) OF A SPARSE
+* SYMMETRIC POSITIVE DEFINITE MATRIX A+E WHERE D AND E ARE DIAGONAL
+* POSITIVE DEFINITE MATRICES AND L IS A LOWER TRIANGULAR MATRIX.
+* METHOD IS BASED ON THE SIMPLE IC(0) ALGORITHM WITHOUT DIAGONAL
+* COMPENSATION. SPARSE RIGHT-LOOKING IMPLEMENTATION.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(M) SPARSE SYMMETRIC (USUALLY POSITIVE DEFINITE) MATRIX.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+* IA WN01(N+1) AMXILIARY ARRAY.
+* IO INF AN INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. IF
+* INF=0 THEN A IS SUFFICIENTLY POSITIVE DEFINITE AND E=0. IF
+* INF<0 THEN A IS NOT SUFFICIENTLY POSITIVE DEFINITE AND E>0. IF
+* INF>0 THEN A IS INDEFINITE AND INF IS AN INDEX OF THE
+* MOST NEGATIVE DIAGONAL ELEMENT USED IN THE FACTORIZATION
+* PROCESS.
+* RU ALF ON INPUT A DESIRED TOLERANCE FOR POSITIVE DEFINITENESS.
+* ON OUTPUT THE MOST NEGATIVE DIAGONAL ELEMENT USED IN THE
+* FACTORIZATION PROCESS (IF INF>0).
+* RO TAU MAXIMUM DIAGONAL ELEMENT OF THE MATRIX E.
+*
+* METHOD :
+* P.E.GILL, W.MURRAY : NEWTON TYPE METHODS FOR UNCONSTRAINED AND
+* LINEARLY CONSTRAINED OPTIMIZATION, MATH. PROGRAMMING 28 (1974)
+* PP. 311-350.
+*
+ SUBROUTINE MXSPTF(N,A,IA,JA,WN01,INF,ALF,TAU)
+ INTEGER N,IA(*),JA(*),WN01(*),INF
+ DOUBLE PRECISION A(*),ALF,TAU
+ INTEGER I,J,K,L,II,LL,K1,L1,L2,JSTRT,JSTOP,IDIAG,KSTRT,KSTOP,NJA
+ DOUBLE PRECISION PTOL,BET,GAM,TEMP,DEL,DIAG,NDIAG,INVDIAG
+ PTOL=ALF
+ NJA=IA(N+1)-1
+*
+* INITIALIZE AMXILIARY VECTOR
+*
+ INF=0
+ CALL MXVINS(N,0,WN01)
+*
+* GILL-MURRAY MODIFICATION
+*
+ ALF=0.0D 0
+ BET=0.0D 0
+ GAM=0.0D 0
+ TAU=0.0D 0
+ DO 2 I=1,N
+ IDIAG=IA(I)
+ IF (JA(IDIAG).LE.0) GO TO 2
+ TEMP=A(IDIAG)
+ BET=MAX(BET,ABS(TEMP))
+ DO 1 J=IA(I)+1,IA(I+1)-1
+ IF (JA(J).LE.0) GO TO 1
+ TEMP=A(J)
+ GAM=MAX(GAM,ABS(TEMP))
+ 1 CONTINUE
+ 2 CONTINUE
+ BET=MAX(PTOL,BET,GAM/DBLE(N))
+ DEL=PTOL*BET
+*
+* COMPUTE THE PRECONDITIONER
+*
+ LL=0
+ DO 8 K=1,N
+ KSTRT=IA(K)
+ KSTOP=IA(K+1)-1
+ IF (JA(KSTRT).LE.0) GO TO 8
+ DIAG=A(KSTRT)
+ IF (ALF.GT.DIAG) THEN
+ ALF=DIAG
+ LL=K
+ END IF
+ GAM=0.0D 0
+ DO 3 J=KSTRT+1,KSTOP
+ IF (JA(J).LE.0) GO TO 3
+ TEMP=A(J)
+ GAM=MAX(GAM,ABS(TEMP))
+ 3 CONTINUE
+ GAM=GAM*GAM
+ INVDIAG=MAX(ABS(DIAG),GAM/BET,DEL)
+ IF (TAU.LT.INVDIAG-DIAG) THEN
+ TAU=INVDIAG-DIAG
+ INF=-1
+ END IF
+ INVDIAG=1.0D 0/INVDIAG
+ A(KSTRT)=INVDIAG
+*
+* RIGHT-LOOKING UPDATE
+*
+*
+* SET POINTERS
+*
+ DO 4 II=KSTRT,KSTOP
+ K1=JA(II)
+ IF (K1.GT.0) WN01(K1)=II
+ 4 CONTINUE
+*
+* INNER LOOP
+*
+ DO 6 I=KSTRT+1,KSTOP
+ J=JA(I)
+ IF (J.LE.0) GO TO 6
+ NDIAG=A(I)
+ JSTRT=IA(J)
+ JSTOP=IA(J+1)-1
+ DO 5 L=JSTRT,JSTOP
+ L1=JA(L)
+ IF (L1.LE.0) GO TO 5
+ L2=WN01(L1)
+ IF (L2.NE.0) THEN
+ A(L)=A(L)-(A(L2)*INVDIAG)*NDIAG
+ END IF
+ 5 CONTINUE
+ 6 CONTINUE
+*
+* CLEAR THE POINTERS
+*
+ DO 7 II=KSTRT,KSTOP
+ K1=JA(II)
+ IF (K1.GT.0) WN01(K1)=0
+ 7 CONTINUE
+ 8 CONTINUE
+ IF (LL.GT.0.AND.ABS(ALF).GT.DEL) INF=LL
+ RETURN
+ END
+* SUBROUTINE MXSRMD ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF TRANSPOSE OF A DENSE RECTANGULAR MATRIX A BY
+* A VECTOR X AND ADDITION OF A SCALED VECTOR ALF*Y.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II NA NUMBER OF COLUMNS OF THE MATRIX A.
+* II MA NUMBER OF ELEMENTS IN THE FIELD A.
+* RI A(MA) RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
+* II IA(NA+1) POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
+* II JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
+* RI X(N) INPUT VECTOR.
+* RI ALF SCALING FACTOR.
+* RI Y(NA) INPUT VECTOR.
+* RO Z(NA) OUTPUT VECTOR EQUAL TO TRANS(A)*X+ALF*Y.
+*
+ SUBROUTINE MXSRMD(NA,A,IA,JA,X,ALF,Y,Z)
+ INTEGER NA,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
+ DOUBLE PRECISION TEMP
+ INTEGER I,J,K,L,JP
+ DO 2 I=1,NA
+ K=IA(I)
+ L=IA(I+1)-K
+ TEMP=ALF*Y(I)
+ DO 1 J=1,L
+ JP=JA(K)
+ IF (JP.GT.0) TEMP=TEMP+A(K)*X(JP)
+ K=K+1
+ 1 CONTINUE
+ Z(I)=TEMP
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSRMM ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF TRANSPOSE OF A DENSE RECTANGULAR MATRIX A BY
+* A VECTOR X.
+*
+* PARAMETERS :
+* II N NUMBER OF ROWS OF THE MATRIX A.
+* II NA NUMBER OF COLUMNS OF THE MATRIX A.
+* II MA NUMBER OF ELEMENTS IN THE FIELD A.
+* RI A(MA) RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
+* II IA(NA+1) POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
+* II JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
+* RI X(N) INPUT VECTOR.
+* RO Y(M) OUTPUT VECTOR EQUAL TO TRANS(A)*X.
+*
+ SUBROUTINE MXSRMM(NA,A,IA,JA,X,Y)
+ INTEGER NA,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),Y(*)
+ DOUBLE PRECISION TEMP
+ INTEGER I,J,K,L,JP
+ DO 2 I=1,NA
+ K=IA(I)
+ L=IA(I+1)-K
+ TEMP=0.0D 0
+ DO 1 J=1,L
+ JP=JA(K)
+ IF (JP.GT.0) TEMP=TEMP+A(K)*X(JP)
+ K=K+1
+ 1 CONTINUE
+ Y(I)=TEMP
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSRSP ALL SYSTEMS 95/12/01
+* PURPOSE : CREATE ROW PERMUTATIONS FOR OBTAINING DIAGONAL NONZEROS.
+*
+* PARAMETERS :
+* II N NUMBER OF COLUMNS OF THE MATRIX.
+* II M NUMBER OF NONZEROS MEMBERS IN THE MATRIX.
+* II IA(M+1) ROW POINTERS OF THE SPARSE MATRIX.
+* II JA(M) COLUMN INDICES OF THE SPARSE MATRIX.
+* IO IP(N) PERMUTATION VECTOR.
+* II NR NUMBER OF STRUCTURALLY INDEPENDENT ROWS.
+* IA IW1(N) AMXILIARY VECTOR.
+* IA IW2(N) AMXILIARY VECTOR.
+* IA IW3(N) AMXILIARY VECTOR.
+* IA IW4(N) AMXILIARY VECTOR.
+*
+ SUBROUTINE MXSRSP(N,IA,JA,IP,NR,IW1,IW2,IW3,IW4)
+ INTEGER N,NR
+ INTEGER IA(*),IP(*),IW1(*),IW2(*),IW3(*),IW4(*),JA(*)
+ INTEGER I,I1,I2,II,J,J1,K,KK,L
+ DO 10 I = 1,N
+ IW2(I) = IA(I+1) - IA(I) - 1
+ IW3(I) = 0
+ IP(I) = 0
+ 10 CONTINUE
+ NR = 0
+*
+* MAIN LOOP.
+* EACH PASS ROUND THIS LOOP EITHER RESULTS IN A NEW ASSIGNMENT
+* OR GIVES A ROW WITH NO ASSIGNMENT.
+*
+ DO 100 L = 1,N
+ J = L
+ IW1(J) = -1
+ DO 70 K = 1,L
+*
+* LOOK FOR A CHEAP ASSIGNMENT
+*
+ I1 = IW2(J)
+ IF (I1.LT.0) GO TO 30
+ I2 = IA(J+1) - 1
+ I1 = I2 - I1
+ DO 20 II = I1,I2
+ I = JA(II)
+ IF (IP(I).EQ.0) GO TO 80
+ 20 CONTINUE
+*
+* NO CHEAP ASSIGNMENT IN ROW.
+*
+ IW2(J) = -1
+*
+* BEGIN LOOKING FOR ASSIGNMENT CHAIN STARTING WITH ROW J.
+*
+ 30 CONTINUE
+ IW4(J) = IA(J+1) - IA(J) - 1
+*
+* INNER LOOP. EXTENDS CHAIN BY ONE OR BACKTRACKS.
+*
+ DO 60 KK = 1,L
+ I1 = IW4(J)
+ IF (I1.LT.0) GO TO 50
+ I2 = IA(J+1) - 1
+ I1 = I2 - I1
+*
+* FORWARD SCAN.
+*
+ DO 40 II = I1,I2
+ I = JA(II)
+ IF (IW3(I).EQ.L) GO TO 40
+*
+* COLUMN I HAS NOT YET BEEN ACCESSED DURING THIS PASS.
+*
+ J1 = J
+ J = IP(I)
+ IW3(I) = L
+ IW1(J) = J1
+ IW4(J1) = I2 - II - 1
+ GO TO 70
+ 40 CONTINUE
+*
+* BACKTRACKING STEP.
+*
+ 50 CONTINUE
+ J = IW1(J)
+ IF (J.EQ.-1) GO TO 100
+ 60 CONTINUE
+ 70 CONTINUE
+*
+* NEW ASSIGNMENT IS MADE.
+*
+ 80 CONTINUE
+ IP(I) = J
+ IW2(J) = I2 - II - 1
+ NR = NR + 1
+ DO 90 K = 1,L
+ J = IW1(J)
+ IF (J.EQ.-1) GO TO 100
+ II = IA(J+1) - IW4(J) - 2
+ I = JA(II)
+ IP(I) = J
+ 90 CONTINUE
+ 100 CONTINUE
+*
+* IF MATRIX IS STRUCTURALLY SINGULAR, WE NOW COMPLETE THE
+* PERMUTATION IP.
+*
+ IF (NR.EQ.N) RETURN
+ DO 110 I = 1,N
+ IW2(I) = 0
+ 110 CONTINUE
+ K = 0
+ DO 130 I = 1,N
+ IF (IP(I).NE.0) GO TO 120
+ K = K + 1
+ IW4(K) = I
+ GO TO 130
+ 120 CONTINUE
+ J = IP(I)
+ IW2(J) = I
+ 130 CONTINUE
+ K = 0
+ DO 140 I = 1,N
+ IF (IW2(I).NE.0) GO TO 140
+ K = K + 1
+ L = IW4(K)
+ IP(L) = I
+ 140 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSSDA ALL SYSTEMS 91/12/01
+* PURPOSE :
+* A SPARSE SYMMETRIC MATRIX A IS AUGMENTED BY THE SCALED UNIT MATRIX
+* SUCH THAT A:=A+ALF*I (I IS THE UNIT MATRIX OF ORDER N).
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* RI ALF SCALING FACTOR.
+*
+ SUBROUTINE MXSSDA(N,A,IA,ALF)
+ INTEGER N,IA(*)
+ DOUBLE PRECISION A(*), ALF
+ INTEGER I
+ DO 100 I=1,N
+ A(IA(I))=A(IA(I))+ALF
+100 CONTINUE
+ RETURN
+ END
+* FUNCTION MXSSDL ALL SYSTEMS 88/12/01
+* PURPOSE :
+* DETERMINATION OF A MINIMUM DIAGONAL ELEMENT OF A SPARSE SYMMETRIC
+* MATRIX
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A
+* RI A(MMAX) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* USUAL FORM.
+* II IA(N+1) POINTER VECTOR OF THE DIAGONAL OF THE SPARSE MATRIX.
+* II JA(MMAX) INDICES OF NONZERO ELEMENTS OF THE SPARSE MATRIX.
+* IO INF INDEX OF INIMUM DIAGONAL ELEMENT OF THE MATRIX A.
+* RR MXSSDL MINIMUM DIAGONAL ELEMENT OF THE MATRIX A.
+*
+ FUNCTION MXSSDL(N,A,IA,JA,INF)
+ INTEGER N,IA(*),JA(*),INF
+ DOUBLE PRECISION A(*),MXSSDL
+ DOUBLE PRECISION CON
+ PARAMETER (CON=1.0D 60)
+ INTEGER I,J
+ INF=0
+ MXSSDL = CON
+ DO 100 I=1,N
+ J=IA(I)
+ IF (JA(J).GT.0.AND.MXSSDL.GT.A(J)) THEN
+ INF=I
+ MXSSDL=A(J)
+ END IF
+100 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSSMD ALL SYSTEMS 93/12/01
+* PURPOSE :
+* MULTIPLICATION OF A SPARSE SYMMETRIC MATRIX A BY A VECTOR X
+* AND ADDITION OF A SCALED VECTOR ALF*Y.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+* RI X(N) INPUT VECTOR.
+* RI ALF SCALING FACTOR.
+* RI Y(NA) INPUT VECTOR.
+* RO Z(NA) OUTPUT VECTOR EQUAL TO A*X+ALF*Y.
+*
+ SUBROUTINE MXSSMD(N,A,IA,JA,X,ALF,Y,Z)
+ INTEGER N,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
+ INTEGER I,J,K,JSTRT,JSTOP
+ DO 100 I=1,N
+ Z(I)=ALF*Y(I)
+100 CONTINUE
+ JSTOP=0
+ DO 300 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ IF (JA(JSTRT).GT.0) THEN
+ DO 200 J=JSTRT,JSTOP
+ K=JA(J)
+ IF (J.EQ.JSTRT) THEN
+ Z(I)=Z(I)+A(J)*X(I)
+ ELSE IF (K.GT.0) THEN
+ Z(K)=Z(K)+A(J)*X(I)
+ Z(I)=Z(I)+A(J)*X(K)
+ END IF
+200 CONTINUE
+ END IF
+300 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSSMG ALL SYSTEMS 91/12/01
+* PURPOSE :
+* GERSHGORIN BOUNDS OF THE EIGENVALUAE OF A DENSE SYMMETRIC MATRIX.
+* AMIN .LE. ANY EIGENVALUE OF A .LE. AMAX.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE MATRIX A.
+* RI A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+* RO AMIN LOWER BOUND OF THE EIGENVALUE OF A.
+* RO AMAX UPPER BOUND OF THE EIGENVALUE OF A.
+*
+ SUBROUTINE MXSSMG(N,A,IA,JA,AMIN,AMAX,X)
+ INTEGER N,IA(*),JA(*)
+ DOUBLE PRECISION A(*),AMIN,AMAX,X(*)
+ INTEGER I,J,K,JSTRT,JSTOP
+ DOUBLE PRECISION CMAX
+ PARAMETER (CMAX=1.0D 60)
+ DO 1 I=1,N
+ X(I)=0.0D 0
+ 1 CONTINUE
+ JSTOP=0
+ DO 3 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ IF (JA(JSTRT).GT.0) THEN
+ DO 2 K=JSTRT+1,JSTOP
+ J=JA(K)
+ IF (J.GT.0) THEN
+ X(I)=X(I)+ABS(A(K))
+ X(J)=X(J)+ABS(A(K))
+ END IF
+ 2 CONTINUE
+ END IF
+ 3 CONTINUE
+ AMIN= CMAX
+ AMAX=-CMAX
+ DO 4 I=1,N
+ K=IA(I)
+ IF (K.GT.0) THEN
+ AMAX=MAX(AMAX,A(K)+X(I))
+ AMIN=MIN(AMIN,A(K)-X(I))
+ END IF
+ 4 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSSMI ALL SYSTEMS 92/12/01
+* PURPOSE :
+* SPARSE SYMMETRIC MATRIX A IS SET TO THE UNIT MATRIX WITH THE SAME
+* ORDER.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RU A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+*
+ SUBROUTINE MXSSMI(N,A,IA)
+ INTEGER N,IA(*)
+ DOUBLE PRECISION A(*)
+ INTEGER I,K
+ DO 100 I=1,IA(N+1)-1
+ A(I)=0.0D 0
+100 CONTINUE
+ DO 200 I=1,N
+ K=ABS(IA(I))
+ A(K)=1.0D 0
+200 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSSMM ALL SYSTEMS 92/12/01
+* PURPOSE :
+* MULTIPLICATION OF A SPARSE SYMMETRIC MATRIX BY A VECTOR X.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* II M NUMBER OF NONZERO ELEMENTS OF THE MATRIX A.
+* RI A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+* RI X(N) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y := A * X.
+*
+ SUBROUTINE MXSSMM(N,A,IA,JA,X,Y)
+ INTEGER N,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),Y(*)
+ INTEGER I,J,K,JSTRT,JSTOP
+ DO 100 I=1,N
+ Y(I)=0.0D 0
+100 CONTINUE
+ JSTOP=0
+ DO 300 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ IF (JA(JSTRT).GT.0) THEN
+ DO 200 J=JSTRT,JSTOP
+ K=JA(J)
+ IF (J.EQ.JSTRT) THEN
+ Y(I)=Y(I)+A(J)*X(I)
+ ELSE IF (K.GT.0) THEN
+ Y(K)=Y(K)+A(J)*X(I)
+ Y(I)=Y(I)+A(J)*X(K)
+ END IF
+200 CONTINUE
+ END IF
+300 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSSMN ALL SYSTEMS 89/12/01
+* PURPOSE :
+* THIS SUBROUTINE FINDS THE PERMUTATION VECTOR PERM FOR THE
+* SPARSE SYMMETRIC MATRIX GIVEN IN THE VECTOR PAIR PA,SA.IT USES
+* THE SO-CALLED NESTED DISSECTION METHOD.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* II MMAX LENGTH OF THE PRINCIPAL MATRIX VECTORS.
+* II PA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
+* II SA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
+* IO PERM(N) PERMUTATION VECTOR.
+* IA WN11(N+1) AMXILIARY VECTOR.
+* IA WN12(N+1) AMXILIARY VECTOR.
+* IA WN13(N+1) AMXILIARY VECTOR.
+*
+* METHOD :
+* NESTED DISSECTION METHOD
+*
+ SUBROUTINE MXSSMN(N,PA,SA,PERM,WN11,WN12,WN13)
+ INTEGER N
+ INTEGER PA(*),SA(*),PERM(*)
+ INTEGER WN11(*),WN12(*),WN13(*)
+ INTEGER I,J,K,NUM,ROOT,NLVL,LVLEND,LBEGIN,ICS
+ INTEGER NN,N1,MINDEG,N2,LVSIZE,NDEG,NUNLVL,MIDLVL
+ INTEGER TEMP,NPUL,NSEP,I1,I2,I3,I4,J1,J2
+ DO 100 I = 1, N
+ WN11(I) = 1
+ 100 CONTINUE
+ NUM= 0
+ DO 2000 I = 1, N
+ 200 IF ( WN11(I) .EQ. 0 ) GO TO 2000
+ ROOT = I
+ WN11(ROOT) = 0
+ WN13(1) = ROOT
+ NLVL = 0
+ LVLEND = 0
+ ICS = 1
+ 300 LBEGIN = LVLEND + 1
+ LVLEND = ICS
+ NLVL = NLVL + 1
+ WN12(NLVL) = LBEGIN
+ DO 500 K = LBEGIN, LVLEND
+ NN = WN13(K)
+ DO 400 J=PA(NN),PA(NN+1)-1
+ N2 = SA(J)
+ IF (N2.EQ.NN) GO TO 400
+ IF (WN11(N2).EQ.0) GO TO 400
+ ICS = ICS + 1
+ WN13(ICS) = N2
+ WN11(N2) = 0
+ 400 CONTINUE
+ 500 CONTINUE
+ LVSIZE=ICS-LVLEND
+ IF (LVSIZE.GT.0) GO TO 300
+ WN12(NLVL+1) = LVLEND + 1
+ DO 600 K = 1, ICS
+ NN = WN13(K)
+ WN11(NN) = 1
+ 600 CONTINUE
+ ICS = WN12(NLVL+1) - 1
+ IF ( NLVL .EQ. 1 .OR. NLVL .EQ. ICS )GO TO 1470
+ 700 J1 = WN12(NLVL)
+ MINDEG = ICS
+ ROOT = WN13(J1)
+ IF ( ICS .EQ. J1 ) GO TO 1000
+ DO 900 J = J1, ICS
+ NN = WN13(J)
+ NDEG = 0
+ DO 800 K=PA(NN),PA(NN+1)-1
+ N1 = SA(K)
+ IF (N1.EQ.NN) GO TO 800
+ IF ( WN11(N1) .GT. 0 ) NDEG = NDEG + 1
+ 800 CONTINUE
+ IF ( NDEG .GE. MINDEG ) GO TO 900
+ ROOT = NN
+ MINDEG = NDEG
+ 900 CONTINUE
+ 1000 CONTINUE
+ WN11(ROOT) = 0
+ WN13(1) = ROOT
+ NUNLVL = 0
+ LVLEND = 0
+ ICS = 1
+ 1100 LBEGIN = LVLEND + 1
+ LVLEND = ICS
+ NUNLVL = NUNLVL + 1
+ WN12(NUNLVL) = LBEGIN
+ DO 1300 K = LBEGIN, LVLEND
+ NN = WN13(K)
+ DO 1200 J=PA(NN),PA(NN+1)-1
+ N2 = SA(J)
+ IF (N2.EQ.NN) GO TO 1200
+ IF (WN11(N2).EQ.0) GO TO 1200
+ ICS = ICS + 1
+ WN13(ICS) = N2
+ WN11(N2) = 0
+ 1200 CONTINUE
+ 1300 CONTINUE
+ LVSIZE=ICS-LVLEND
+ IF (LVSIZE.GT.0) GO TO 1100
+ WN12(NUNLVL+1) = LVLEND + 1
+ DO 1400 K = 1, ICS
+ NN = WN13(K)
+ WN11(NN) = 1
+ 1400 CONTINUE
+ IF (NUNLVL .LE.NLVL) GO TO 1470
+ NLVL=NUNLVL
+ IF (NLVL.LT.ICS) GO TO 700
+1470 CONTINUE
+ IF ( NLVL .GE. 3 ) GO TO 1600
+ NSEP = WN12(NLVL+1) - 1
+ DO 1500 K = 1, NSEP
+ NN = WN13(K)
+ PERM(NUM+K) = NN
+ WN11(NN) = 0
+ 1500 CONTINUE
+ GO TO 1950
+ 1600 MIDLVL = (NLVL+2)/2
+ I3 = WN12(MIDLVL)
+ I1 = WN12(MIDLVL + 1)
+ I4 = I1 - 1
+ I2 = WN12(MIDLVL+2) - 1
+ DO 1700 K = I1, I2
+ NN = WN13(K)
+ PA(NN) = - PA(NN)
+ 1700 CONTINUE
+ NSEP = 0
+ DO 1800 K = I3, I4
+ NN = WN13(K)
+ J1 = PA(NN)
+ J2 = IABS(PA(NN+1)) - 1
+ DO 1750 J = J1, J2
+ N2 = SA(J)
+ IF (N2.EQ.NN) GO TO 1750
+ IF ( PA(N2) .GT. 0 ) GO TO 1750
+ NSEP = NSEP + 1
+ PERM(NSEP+NUM) = NN
+ WN11(NN) = 0
+ GO TO 1800
+ 1750 CONTINUE
+ 1800 CONTINUE
+ DO 1900 K = I1, I2
+ NN = WN13(K)
+ PA(NN) = - PA(NN)
+ 1900 CONTINUE
+ 1950 CONTINUE
+ NUM = NUM + NSEP
+ IF ( NUM .GE. N ) GO TO 2100
+ GO TO 200
+ 2000 CONTINUE
+ 2100 CONTINUE
+ IF (N.LT.2) GO TO 2300
+ NPUL = N/2
+ DO 2200 I=1,NPUL
+ TEMP=PERM(I)
+ PERM(I)=PERM(N-I+1)
+ PERM(N-I+1)=TEMP
+2200 CONTINUE
+2300 CONTINUE
+ RETURN
+ END
+* FUNCTION MXSSMQ ALL SYSTEMS 92/12/01
+* PURPOSE :
+* VALUE OF A QUADRATIC FORM WITH A SPARSE SYMMETRIC MATRIX A.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RR MXSSMQ VALUE OF THE QUADRATIC FORM MXSSMQ=TRANS(Y)*A*X.
+*
+ FUNCTION MXSSMQ(N,A,IA,JA,X,Y)
+ INTEGER N,IA(*),JA(*)
+ DOUBLE PRECISION A(*), X(*), Y(*), MXSSMQ
+ DOUBLE PRECISION TEMP1,TEMP2
+ INTEGER I,J,K,JSTRT,JSTOP
+ JSTOP=0
+ TEMP1=0.0D 0
+ DO 300 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ IF (JA(JSTRT).GT.0) THEN
+ TEMP2=0.0D 0
+ DO 200 J=JSTRT,JSTOP
+ K=JA(J)
+ IF (J.EQ.JSTRT) THEN
+ TEMP2=TEMP2+A(J)*Y(I)
+ ELSE IF (K.GT.0) THEN
+ TEMP2=TEMP2+2*Y(K)*A(J)
+ END IF
+200 CONTINUE
+ TEMP1=TEMP1+X(I)*TEMP2
+ END IF
+300 CONTINUE
+ MXSSMQ=TEMP1
+ RETURN
+ END
+* SUBROUTINE MXSSMY ALL SYSTEMS 93/12/01
+* PURPOSE :
+* CORRECTION OF A SPARSE SYMMETRIC MATRIX A. THE CORRECTION IS DEFINED
+* AS A:=A+SUM OF (HALF*(X*TRANS(Y)+Y*TRANS(X)))(I)/SIGMA(I) WHERE
+* SIGMA(I) IS A DOT PRODUCT TRANS(X)*X WHERE ONLY CONTRIBUTIONS
+* CORRESPONDING TO NONZEROS IN ROW I ARE SUMMED UP, X AND Y ARE GIVEN
+* VECTORS.
+*
+* PARAMETERS :
+* II N ORDER OF THE MATRIX A.
+* RI A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
+* PACKED FORM.
+* II IA(N) POINTERS OF THE DIAGONAL ELEMENTS OF A.
+* II JA(M) INDICES OF THE NONZERO ELEMENTS OF A.
+* RA XS(N) AMXILIARY VECTOR - USED FOR SIGMA(I).
+* RI X(N) VECTOR IN THE CORRECTION TERM.
+* RI Y(N) VECTOR IN THE CORRECTION TERM.
+*
+ SUBROUTINE MXSSMY(N,A,IA,JA,XS,X,Y)
+ INTEGER N,IA(*),JA(*)
+ DOUBLE PRECISION A(*),X(*),Y(*),XS(*),SIGMA,TEMP
+ INTEGER I,J,K,JSTRT,JSTOP
+ CALL MXVSET(N,0.0D 0,XS)
+*
+* COMPUTE SIGMA(I)
+*
+ JSTOP=0
+ DO 200 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ IF (JA(JSTRT).GT.0) THEN
+ SIGMA=0.0D 0
+ DO 100 J=JSTRT,JSTOP
+ K=JA(J)
+ IF (K.GT.0) THEN
+ SIGMA=SIGMA+Y(K)*Y(K)
+ IF (K.NE.I) XS(K)=XS(K)+Y(I)*Y(I)
+ END IF
+100 CONTINUE
+ XS(I)=XS(I)+SIGMA
+ END IF
+200 CONTINUE
+*
+* UPDATE MATRIX
+*
+ JSTOP=0
+ DO 400 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ IF (JA(JSTRT).GT.0) THEN
+ IF (XS(I).EQ.0.0D 0) THEN
+ TEMP=0.0D 0
+ ELSE
+ TEMP=X(I)/XS(I)
+ END IF
+ DO 300 J=JSTRT,JSTOP
+ K=JA(J)
+ IF (K.GT.0) THEN
+ IF (XS(K).EQ.0.0D 0) THEN
+ A(J)=A(J)+0.5D 0*TEMP*Y(K)
+ ELSE
+ A(J)=A(J)+0.5D 0*(TEMP*Y(K)+Y(I)*X(K)/XS(K))
+ END IF
+ END IF
+300 CONTINUE
+ END IF
+400 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSTG1 ALL SYSTEMS 89/12/01
+* PURPOSE :
+* WIDTHENING THE PACKED FORM OF THE VECTORS IA, JA OF THE SPARSE MATRIX
+*
+* PARAMETERS :
+* II N ORDER OF THE SPARSE MATRIX.
+* IU M NUMBER OF NONZERO ELEMENTS IN THE MATRIX.
+* II MMAX LENGTH OF THE ARRAY JA.
+* II IA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
+* II JA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
+* IA PD(N+1) AMXILIARY VECTOR.
+* IA WN11(N+1) AMXILIARY VECTOR.
+*
+ SUBROUTINE MXSTG1(N,M,IA,JA,PD,WN11)
+ INTEGER N,M
+ INTEGER IA(*),PD(*),JA(*),WN11(*)
+ INTEGER I,J,L1,L,K
+*
+* UPPER TRIANGULAR INFORMATION TO THE AMXILIARY ARRAY
+*
+ L1=IA(1)
+ DO 100 I=1,N
+ L=L1
+ L1=IA(I+1)
+ WN11(I)=L1-L
+100 CONTINUE
+*
+* LOWER TRIANGULAR INFORMATION TO THE AMXILIARY ARRAY
+*
+ DO 300 I=1,N
+ DO 200 J=IA(I)+1,IA(I+1)-1
+ K=ABS(JA(J))
+ WN11(K)=WN11(K)+1
+200 CONTINUE
+300 CONTINUE
+*
+* BY PARTIAL SUMMING WE GET POINTERS OF THE WIDE STRUCTURE
+* WN11(I) POINTS AT THE END OF THE ROW I
+*
+ L=0
+ DO 400 I=2,N
+ WN11(I)=WN11(I)+WN11(I-1)
+400 CONTINUE
+*
+* DEFINE LENGTH OF THE WITHENED STRUCTURE
+*
+ M=WN11(N)
+*
+* SHIFT OF UPPER TRIANGULAR ROWS
+*
+ PD(1)=1
+ DO 600 I=N,1,-1
+ L=WN11(I)
+ PD(I+1)=L+1
+ DO 500 J=IA(I+1)-1,IA(I),-1
+ JA(L)=JA(J)
+ L=L-1
+500 CONTINUE
+600 CONTINUE
+*
+* FORMING OF THE LOWER TRIANGULAR PART
+*
+ DO 800 I=1,N
+ DO 700 J=WN11(I)+IA(I)+2-IA(I+1),WN11(I)
+ K=ABS(JA(J))
+ JA(PD(K))=I
+ PD(K)=PD(K)+1
+700 CONTINUE
+800 CONTINUE
+ DO 900 I=1,N
+ IA(I+1)=WN11(I)+1
+900 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXSTL1 ALL SYSTEMS 91/12/01
+* PURPOSE :
+* PACKING OF THE WIDTHENED FORM OF THE VECTORS IA, JA OF THE SPARSE
+* MATRIX
+*
+* PARAMETERS :
+* II N ORDER OF THE SPARSE MATRIX.
+* IU M NUMBER OF NONZERO ELEMENTS IN THE MATRIX.
+* II MMAX LENGTH OF THE ARRAY JA.
+* IU IA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
+* IU JA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
+* IA PD(N+1) AMXILIARY VECTOR.
+*
+ SUBROUTINE MXSTL1(N,M,IA,JA,PD)
+ INTEGER N,M
+ INTEGER IA(*),PD(*),JA(*)
+ INTEGER I,J,L,JSTRT,JSTOP
+ L=1
+*
+* PD DEFINITION
+*
+ JSTOP=0
+ DO 60 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ DO 50 J=JSTRT,JSTOP
+ IF (ABS(JA(J)).EQ.I) THEN
+ PD(I)=J
+ GO TO 60
+ END IF
+ 50 CONTINUE
+ 60 CONTINUE
+*
+* REWRITE THE STRUCTURE
+*
+ DO 200 I=1,N
+ DO 100 J=PD(I),IA(I+1)-1
+ JA(L)=JA(J)
+ L=L+1
+100 CONTINUE
+ IA(I+1)=L
+200 CONTINUE
+ IA(1)=1
+*
+* SET THE LENGTH OF THE PACKED STRUCTURE
+*
+ M=L-1
+ RETURN
+ END
+* SUBROUTINE MXSTL2 ALL SYSTEMS 90/12/01
+* PURPOSE :
+* PACKING OF THE WIDTHENED FORM OF THE VECTORS A,IA,JA OF THE SPARSE
+* MATRIX
+*
+* PARAMETERS :
+* II N ORDER OF THE SPARSE MATRIX.
+* IU M NUMBER OF NONZERO ELEMENTS IN THE MATRIX.
+* II MMAX LENGTH OF THE ARRAY JA.
+* RU A(MMAX) VECTOR OF NUMERICAL VALUES OF THE MATRIX BEING SHRINKED.
+* IU IA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
+* IU JA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
+* IA PD(N+1) AMXILIARY VECTOR.
+*
+ SUBROUTINE MXSTL2(N,M,A,IA,JA,PD)
+ INTEGER N,M
+ INTEGER IA(*),PD(*),JA(*)
+ DOUBLE PRECISION A(*)
+ INTEGER I,J,L,JSTRT,JSTOP
+ L=1
+*
+* PD DEFINITION
+*
+ JSTOP=0
+ DO 60 I=1,N
+ JSTRT=JSTOP+1
+ JSTOP=IA(I+1)-1
+ DO 50 J=JSTRT,JSTOP
+ IF (ABS(JA(J)).EQ.I) THEN
+ PD(I)=J
+ GO TO 60
+ END IF
+ 50 CONTINUE
+ 60 CONTINUE
+*
+* REWRITE THE STRUCTURE
+*
+ DO 200 I=1,N
+ DO 100 J=PD(I),IA(I+1)-1
+ JA(L)=JA(J)
+ A(L)=A(J)
+ L=L+1
+100 CONTINUE
+ IA(I+1)=L
+200 CONTINUE
+ IA(1)=1
+*
+* SET THE LENGTH OF THE PACKED STRUCTURE
+*
+ M=L-1
+ RETURN
+ END
+* SUBROUTINE MXTPGB ALL SYSTEMS 93/12/01
+* PURPOSE :
+* BACK SUBSTITUTION FOR A DECOMPOSED TRIDIAGONAL MATRIX.
+*
+* PARAMETERS :
+* II N ORDER OF THE TRIDIAGONAL MATRIX T.
+* RI D(N) ELEMENTS OF THE DIAGONAL MATRIX D IN THE DECOMPOSITION
+* T=L*D*TRANS(L).
+* RI E(N) SUBDIAGONAL ELEMENTS OF THE LOWER TRIANGULAR MATRIX L IN
+* THE DECOMPOSITION T=L*D*TRANS(L).
+* RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR
+* EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR
+* EQUATIONS.
+* II JOB OPTION. IF JOB=0 THEN X:=T**(-1)*X. IF JOB>0 THEN
+* X:=L**(-1)*X. IF JOB<0 THEN X:=TRANS(L)**(-1)*X.
+*
+ SUBROUTINE MXTPGB(N,D,E,X,JOB)
+ INTEGER N,JOB
+ DOUBLE PRECISION D(*),E(*),X(*)
+ INTEGER I
+ IF (JOB.GE.0) THEN
+*
+* PHASE 1 : X:=L**(-1)*X
+*
+ DO 1 I=2,N
+ X(I)=X(I)-X(I-1)*E(I-1)
+ 1 CONTINUE
+ END IF
+ IF (JOB.EQ.0) THEN
+*
+* PHASE 2 : X:=D**(-1)*X
+*
+ DO 2 I=1,N
+ X(I)=X(I)/D(I)
+ 2 CONTINUE
+ END IF
+ IF (JOB.LE.0) THEN
+*
+* PHASE 3 : X:=TRANS(L)**(-1)*X
+*
+ DO 3 I=N-1,1,-1
+ X(I)=X(I)-X(I+1)*E(I)
+ 3 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXTPGF ALL SYSTEMS 03/12/01
+* PURPOSE :
+* CHOLESKI DECOMPOSITION OF A TRIDIAGONAL MATRIX.
+*
+* PARAMETERS :
+* II N ORDER OF THE TRIDIAGONAL MATRIX T.
+* RU D(N) ON INPUT DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX T.
+* ON OUTPUT ELEMENTS OF THE DIAGONAL MATRIX D IN THE
+* DECOMPOSITION T=L*D*TRANS(L).
+* RU E(N) ON INPUT SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX T.
+* ON OUTPUT SUBDIAGONAL ELEMENTS OF THE LOWER TRIANGULAR MATRIX L
+* IN THE DECOMPOSITION T=L*D*TRANS(L).
+* IO INF AN INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. IF
+* INF=0 THEN A IS SUFFICIENTLY POSITIVE DEFINITE AND E=0. IF
+* INF<0 THEN A IS NOT SUFFICIENTLY POSITIVE DEFINITE AND E>0. IF
+* INF>0 THEN A IS INDEFINITE AND INF IS AN INDEX OF THE
+* MOST NEGATIVE DIAGONAL ELEMENT USED IN THE FACTORIZATION
+* PROCESS.
+* RU ALF ON INPUT A DESIRED TOLERANCE FOR POSITIVE DEFINITENESS. ON
+* OUTPUT THE MOST NEGATIVE DIAGONAL ELEMENT USED IN THE
+* FACTORIZATION PROCESS (IF INF>0).
+* RO TAU MAXIMUM DIAGONAL ELEMENT OF THE MATRIX E.
+*
+ SUBROUTINE MXTPGF(N,D,E,INF,ALF,TAU)
+ INTEGER N,INF
+ DOUBLE PRECISION D(*),E(*),ALF,TAU
+ DOUBLE PRECISION DI,EI,BET,GAM,DEL,TOL
+ INTEGER I,L
+ DOUBLE PRECISION ZERO,ONE,TWO
+ PARAMETER (ZERO=0.0D 0,ONE=1.0D 0,TWO=2.0D 0)
+ L=0
+ INF=0
+ TOL=ALF
+*
+* ESTIMATION OF THE MATRIX NORM
+*
+ ALF=ZERO
+ GAM=ZERO
+ TAU=ZERO
+ BET=ABS(D(1))
+ DO 1 I=1,N-1
+ BET=MAX(BET,ABS(D(I+1)))
+ GAM=MAX(GAM,ABS(E(I)))
+ 1 CONTINUE
+ BET=MAX(TOL,TWO*BET,GAM/MAX(ONE,DBLE(N-1)))
+ DEL=TOL*MAX(BET,ONE)
+ DO 2 I=1,N
+ EI=D(I)
+ IF (ALF.GT.EI) THEN
+ ALF=EI
+ L=I
+ END IF
+ GAM=ZERO
+ IF (I.LT.N) GAM=E(I)**2
+ DI=MAX(ABS(EI),GAM/BET,DEL)
+ IF (TAU.LT.DI-EI) THEN
+ TAU=DI-EI
+ INF=-1
+ END IF
+*
+* GAUSSIAN ELIMINATION
+*
+ D(I)=DI
+ IF (I.LT.N) THEN
+ EI=E(I)
+ E(I)=EI/DI
+ D(I+1)=D(I+1)-E(I)*EI
+ END IF
+ 2 CONTINUE
+ IF (L.GT.0.AND.ABS(ALF).GT.DEL) INF = L
+ RETURN
+ END
+* SUBROUTINE MXUCOP ALL SYSTEMS 99/12/01
+* PURPOSE :
+* COPY OF THE VECTOR WITH INITIATION OF THE ACTIVE PART.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y:= X.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+ SUBROUTINE MXUCOP(N,X,Y,IX,JOB)
+ INTEGER N,IX(*),JOB
+ DOUBLE PRECISION X(*),Y(*)
+ INTEGER I
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ Y(I)=X(I)
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) THEN
+ Y(I)=X(I)
+ ELSE
+ Y(I)=0.0D 0
+ END IF
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) THEN
+ Y(I)=X(I)
+ ELSE
+ Y(I)=0.0D 0
+ END IF
+ 3 CONTINUE
+ END IF
+ RETURN
+ END
+* FUNCTION MXUDEL ALL SYSTEMS 99/12/01
+* PURPOSE :
+* SQUARED NORM OF A SHIFTED VECTOR IN A BOUND CONSTRAINED CASE.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI A SCALING FACTOR.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+* RR MXUDEL SQUARED NORM OF Y+A*X.
+*
+ FUNCTION MXUDEL(N,A,X,Y,IX,JOB)
+ INTEGER N,IX(N),JOB
+ DOUBLE PRECISION A,X(N),Y(N),MXUDEL
+ INTEGER I
+ DOUBLE PRECISION TEMP
+ TEMP=0.0D 0
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ TEMP=TEMP+(Y(I)+A*X(I))**2
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) TEMP=TEMP+(Y(I)+A*X(I))**2
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) TEMP=TEMP+(Y(I)+A*X(I))**2
+ 3 CONTINUE
+ END IF
+ MXUDEL=TEMP
+ RETURN
+ END
+* SUBROUTINE MXUDIF ALL SYSTEMS 99/12/01
+* PURPOSE :
+* VECTOR DIFFERENCE IN A BOUND CONSTRAINED CASE.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR WHERE Z:= X - Y.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+ SUBROUTINE MXUDIF(N,X,Y,Z,IX,JOB)
+ INTEGER N,IX(N),JOB
+ DOUBLE PRECISION X(*),Y(*),Z(*)
+ INTEGER I
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ Z(I)=X(I)-Y(I)
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) Z(I)=X(I)-Y(I)
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) Z(I)=X(I)-Y(I)
+ 3 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXUDIR ALL SYSTEMS 99/12/01
+* PURPOSE :
+* VECTOR AUGMENTED BY THE SCALED VECTOR IN A BOUND CONSTRAINED CASE.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI A SCALING FACTOR.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR WHERE Z:= Y + A*X.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+ SUBROUTINE MXUDIR(N,A,X,Y,Z,IX,JOB)
+ INTEGER N,IX(*),JOB
+ DOUBLE PRECISION A, X(*), Y(*), Z(*)
+ INTEGER I
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ Z(I) = Y(I) + A*X(I)
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) Z(I) = Y(I) + A*X(I)
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) Z(I) = Y(I) + A*X(I)
+ 3 CONTINUE
+ END IF
+ RETURN
+ END
+* FUNCTION MXUDOT ALL SYSTEMS 99/12/01
+* PURPOSE :
+* DOT PRODUCT OF VECTORS IN A BOUND CONSTRAINED CASE.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+* RR MXUDOT VALUE OF DOT PRODUCT MXUDOT=TRANS(X)*Y.
+*
+ FUNCTION MXUDOT(N,X,Y,IX,JOB)
+ INTEGER N,IX(*),JOB
+ DOUBLE PRECISION X(*),Y(*),MXUDOT
+ DOUBLE PRECISION TEMP
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO = 0.0D 0)
+ TEMP = ZERO
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ TEMP=TEMP+X(I)*Y(I)
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) TEMP=TEMP+X(I)*Y(I)
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) TEMP=TEMP+X(I)*Y(I)
+ 3 CONTINUE
+ END IF
+ MXUDOT=TEMP
+ RETURN
+ END
+* SUBROUTINE MXUNEG ALL SYSTEMS 00/12/01
+* PURPOSE :
+* COPY OF THE VECTOR WITH INITIATION OF THE ACTIVE PART.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y:= X.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+ SUBROUTINE MXUNEG(N,X,Y,IX,JOB)
+ INTEGER N,IX(*),JOB
+ DOUBLE PRECISION X(*),Y(*)
+ INTEGER I
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ Y(I)=-X(I)
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) THEN
+ Y(I)=-X(I)
+ ELSE
+ Y(I)=0.0D 0
+ END IF
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) THEN
+ Y(I)=-X(I)
+ ELSE
+ Y(I)=0.0D 0
+ END IF
+ 3 CONTINUE
+ END IF
+ RETURN
+ END
+* FUNCTION MXUNOR ALL SYSTEMS 99/12/01
+* PURPOSE :
+* EUCLIDEAN NORM OF A VECTOR IN A BOUND CONSTRAINED CASE.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+* RR MXUNOR EUCLIDEAN NORM OF X.
+*
+ FUNCTION MXUNOR(N,X,IX,JOB)
+ INTEGER N,IX(*),JOB
+ DOUBLE PRECISION X(*),MXUNOR
+ DOUBLE PRECISION POM,DEN
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO=0.0D 0)
+ DEN=ZERO
+ IF (JOB.EQ.0) THEN
+ DO 1 I=1,N
+ DEN=MAX(DEN,ABS(X(I)))
+ 1 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 2 I=1,N
+ IF (IX(I).GE. 0) DEN=MAX(DEN,ABS(X(I)))
+ 2 CONTINUE
+ ELSE
+ DO 3 I=1,N
+ IF (IX(I).NE.-5) DEN=MAX(DEN,ABS(X(I)))
+ 3 CONTINUE
+ END IF
+ POM=ZERO
+ IF (DEN.GT.ZERO) THEN
+ IF (JOB.EQ.0) THEN
+ DO 4 I=1,N
+ POM=POM+(X(I)/DEN)**2
+ 4 CONTINUE
+ ELSE IF (JOB.GT.0) THEN
+ DO 5 I=1,N
+ IF (IX(I).GE. 0) POM=POM+(X(I)/DEN)**2
+ 5 CONTINUE
+ ELSE
+ DO 6 I=1,N
+ IF (IX(I).NE.-5) POM=POM+(X(I)/DEN)**2
+ 6 CONTINUE
+ END IF
+ END IF
+ MXUNOR=DEN*SQRT(POM)
+ RETURN
+ END
+* SUBROUTINE MXUZER ALL SYSTEMS 99/12/01
+* PURPOSE :
+* VECTOR ELEMENTS CORRESPONDING TO ACTIVE BOUNDS ARE SET TO ZERO.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RO X(N) OUTPUT VECTOR SUCH THAT X(I)=A FOR ALL I.
+* II IX(N) VECTOR CONTAINING TYPES OF BOUNDS.
+* II JOB OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
+* IX(I).EQ.-5.
+*
+ SUBROUTINE MXUZER(N,X,IX,JOB)
+ INTEGER N,IX(*),JOB
+ DOUBLE PRECISION X(*)
+ INTEGER I
+ IF (JOB.EQ.0) RETURN
+ DO 1 I=1,N
+ IF (IX(I).LT.0) X(I)=0.0D 0
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVCOP ALL SYSTEMS 88/12/01
+* PURPOSE :
+* COPYING OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y:= X.
+*
+ SUBROUTINE MXVCOP(N,X,Y)
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*)
+ INTEGER I
+ DO 10 I = 1,N
+ Y(I) = X(I)
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVCOR ALL SYSTEMS 93/12/01
+* PURPOSE :
+* CORRECTION OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI A CORRECTION FACTOR.
+* RU X(N) CORRECTED VECTOR. ZERO ELEMENTS OF X ARE SET TO BE EQUAL A.
+*
+ SUBROUTINE MXVCOR(N,A,X)
+ INTEGER N
+ DOUBLE PRECISION A,X(*)
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO=0.0D 0)
+ INTEGER I
+ DO 1 I=1,N
+ IF (X(I).EQ.ZERO) X(I)=A
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVDIF ALL SYSTEMS 88/12/01
+* PURPOSE :
+* VECTOR DIFFERENCE.
+*
+* PARAMETERS :
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR WHERE Z:= X - Y.
+*
+ SUBROUTINE MXVDIF(N,X,Y,Z)
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*),Z(*)
+ INTEGER I
+ DO 10 I = 1,N
+ Z(I) = X(I) - Y(I)
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVDIR ALL SYSTEMS 91/12/01
+* PURPOSE :
+* VECTOR AUGMENTED BY THE SCALED VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI A SCALING FACTOR.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR WHERE Z:= Y + A*X.
+*
+ SUBROUTINE MXVDIR(N,A,X,Y,Z)
+ DOUBLE PRECISION A
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*),Z(*)
+ INTEGER I
+ DO 10 I = 1,N
+ Z(I) = Y(I) + A*X(I)
+ 10 CONTINUE
+ RETURN
+ END
+* FUNCTION MXVDOT ALL SYSTEMS 91/12/01
+* PURPOSE :
+* DOT PRODUCT OF TWO VECTORS.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RR MXVDOT VALUE OF DOT PRODUCT MXVDOT=TRANS(X)*Y.
+*
+ FUNCTION MXVDOT(N,X,Y)
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*),MXVDOT
+ DOUBLE PRECISION TEMP
+ INTEGER I
+ TEMP = 0.0D0
+ DO 10 I = 1,N
+ TEMP = TEMP + X(I)*Y(I)
+ 10 CONTINUE
+ MXVDOT = TEMP
+ RETURN
+ END
+* SUBROUTINE MXVICP ALL SYSTEMS 93/12/01
+* PURPOSE :
+* COPYING OF AN INTEGER VECTOR.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE INTEGER VECTOR.
+* II IX(N) INPUT INTEGER VECTOR.
+* IO IY(N) OUTPUT INTEGER VECTOR SUCH THAT IY(I):= IX(I) FOR ALL I.
+*
+ SUBROUTINE MXVICP(N,IX,IY)
+ INTEGER N,IX(*),IY(*)
+ INTEGER I
+ DO 1 I=1,N
+ IY(I)=IX(I)
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVINB ALL SYSTEMS 91/12/01
+* PURPOSE :
+* UPDATE OF AN INTEGER VECTOR.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE INTEGER VECTOR.
+* II M DIMENSION OF THE CHANGED INTEGER VECTOR.
+* II IX(N) INTEGER VECTOR.
+* IU JA(M) INTEGER VECTOR WHICH IS UPDATED SO THAT JA(I)=-JA(I)
+* IF IX(JA(I)).LT.0.
+*
+ SUBROUTINE MXVINB(M,IX,JA)
+ INTEGER M,IX(*),JA(*)
+ INTEGER I
+ DO 1 I=1,M
+ JA(I)=ABS(JA(I))
+ IF (IX(JA(I)).LT.0) JA(I)=-JA(I)
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVINE ALL SYSTEMS 94/12/01
+* PURPOSE :
+* ELEMENTS OF THE INTEGER VECTOR ARE REPLACED BY THEIR ABSOLUTE VALUES.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE INTEGER VECTOR.
+* IU IX(N) INTEGER VECTOR WHICH IS UPDATED SO THAT IX(I):=ABS(IX(I))
+* FOR ALL I.
+*
+ SUBROUTINE MXVINE(N,IX)
+ INTEGER N,IX(*)
+ INTEGER I
+ DO 1 I=1,N
+ IX(I)=ABS(IX(I))
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVINI ALL SYSTEMS 99/12/01
+* PURPOSE :
+* ELEMENTS CORRESPONDING TO FIXED VARIABLES ARE SET TO -5.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE INTEGER VECTOR.
+* IU IX(N) INTEGER VECTOR WHICH IS UPDATED SO THAT IX(I):=ABS(IX(I))
+* FOR ALL I.
+*
+ SUBROUTINE MXVINI(N,IX)
+ INTEGER N,IX(*)
+ INTEGER I
+ DO 1 I=1,N
+ IF (ABS(IX(I)).EQ.5) IX(I)=-5
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVINP ALL SYSTEMS 91/12/01
+* PURPOSE :
+* INITIATION OF A INTEGER PERMUTATION VECTOR.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE INTEGER VECTOR.
+* IO IP(N) INTEGER VECTOR SUCH THAT IP(I)=I FOR ALL I.
+*
+ SUBROUTINE MXVINP(N,IP)
+ INTEGER N
+ INTEGER IP(*)
+ INTEGER I
+ DO 10 I = 1,N
+ IP(I) = I
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVINS ALL SYSTEMS 90/12/01
+* PURPOSE :
+* INITIATION OF THE INTEGER VECTOR.
+*
+* PARAMETERS :
+* II N DIMENSION OF THE INTEGER VECTOR.
+* II IP INTEGER PARAMETER.
+* IO IX(N) INTEGER VECTOR SUCH THAT IX(I)=IP FOR ALL I.
+*
+ SUBROUTINE MXVINS(N,IP,IX)
+ INTEGER IP,N
+ INTEGER IX(*)
+ INTEGER I
+ DO 10 I = 1,N
+ IX(I) = IP
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVLIN ALL SYSTEMS 92/12/01
+* PURPOSE :
+* LINEAR COMBINATION OF TWO VECTORS.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI A SCALING FACTOR.
+* RI X(N) INPUT VECTOR.
+* RI B SCALING FACTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR WHERE Z:= A*X + B*Y.
+*
+ SUBROUTINE MXVLIN(N,A,X,B,Y,Z)
+ INTEGER N
+ DOUBLE PRECISION A, X(*), B, Y(*), Z(*)
+ INTEGER I
+ DO 1 I=1,N
+ Z(I) = A*X(I) + B*Y(I)
+ 1 CONTINUE
+ RETURN
+ END
+* FUNCTION MXVMAX ALL SYSTEMS 91/12/01
+* PURPOSE :
+* L-INFINITY NORM OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RR MXVMAX L-INFINITY NORM OF THE VECTOR X.
+*
+ FUNCTION MXVMAX(N,X)
+ INTEGER N
+ DOUBLE PRECISION X(*),MXVMAX
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO=0.0D 0)
+ MXVMAX=ZERO
+ DO 1 I=1,N
+ MXVMAX=MAX(MXVMAX,ABS(X(I)))
+ 1 CONTINUE
+ RETURN
+ END
+* FUNCTION MXVMX1 ALL SYSTEMS 91/12/01
+* PURPOSE :
+* L-INFINITY NORM OF A VECTOR WITH INDEX DETERMINATION.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* IO K INDEX OF ELEMENT WITH MAXIMUM ABSOLUTE VALUE.
+* RR MXVMX1 L-INFINITY NORM OF THE VECTOR X.
+*
+ FUNCTION MXVMX1(N,X,K)
+ INTEGER K,N
+ DOUBLE PRECISION X(*),MXVMX1
+ INTEGER I
+ K = 1
+ MXVMX1 = ABS(X(1))
+ DO 10 I = 2,N
+ IF (ABS(X(I)).GT.MXVMX1) THEN
+ K = I
+ MXVMX1 = ABS(X(I))
+ END IF
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVMUL ALL SYSTEMS 89/12/01
+* PURPOSE :
+* VECTOR IS PREMULTIPLIED BY THE POWER OF A DIAGONAL MATRIX.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI D(N) DIAGONAL MATRIX STORED AS A VECTOR WITH N ELEMENTS.
+* RI X(N) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y:=(D**K)*X.
+* II K INTEGER EXPONENT.
+*
+ SUBROUTINE MXVMUL(N,D,X,Y,K)
+ INTEGER K,N
+ DOUBLE PRECISION D(*),X(*),Y(*)
+ INTEGER I
+ IF (K.EQ.0) THEN
+ CALL MXVCOP(N,X,Y)
+ ELSE IF (K.EQ.1) THEN
+ DO 10 I = 1,N
+ Y(I) = X(I)*D(I)
+ 10 CONTINUE
+ ELSE IF (K.EQ.-1) THEN
+ DO 20 I = 1,N
+ Y(I) = X(I)/D(I)
+ 20 CONTINUE
+ ELSE
+ DO 30 I = 1,N
+ Y(I) = X(I)*D(I)**K
+ 30 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE MXVNEG ALL SYSTEMS 88/12/01
+* PURPOSE :
+* CHANGE THE SIGNS OF VECTOR ELEMENTS.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y:= - X.
+*
+ SUBROUTINE MXVNEG(N,X,Y)
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*)
+ INTEGER I
+ DO 10 I = 1,N
+ Y(I) = -X(I)
+ 10 CONTINUE
+ RETURN
+ END
+* FUNCTION MXVNOR ALL SYSTEMS 91/12/01
+* PURPOSE :
+* EUCLIDEAN NORM OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RR MXVNOR EUCLIDEAN NORM OF X.
+*
+ FUNCTION MXVNOR(N,X)
+ INTEGER N
+ DOUBLE PRECISION X(*),MXVNOR
+ DOUBLE PRECISION DEN,POM
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO=0.0D0)
+ DEN = ZERO
+ DO 10 I = 1,N
+ DEN = MAX(DEN,ABS(X(I)))
+ 10 CONTINUE
+ POM = ZERO
+ IF (DEN.GT.ZERO) THEN
+ DO 20 I = 1,N
+ POM = POM + (X(I)/DEN)**2
+ 20 CONTINUE
+ END IF
+ MXVNOR = DEN*SQRT(POM)
+ RETURN
+ END
+* SUBROUTINE MXVSAB ALL SYSTEMS 91/12/01
+* PURPOSE :
+* L-1 NORM OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RR MXVSAB L-1 NORM OF THE VECTOR X.
+*
+ FUNCTION MXVSAB(N,X)
+ INTEGER N
+ DOUBLE PRECISION X(N),MXVSAB
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO=0.0D 0)
+ MXVSAB=ZERO
+ DO 1 I=1,N
+ MXVSAB=MXVSAB+ABS(X(I))
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSAV ALL SYSTEMS 91/12/01
+* PORTABILITY : ALL SYSTEMS
+* 91/12/01 LU : ORIGINAL VERSION
+*
+* PURPOSE :
+* DIFFERENCE OF TWO VECTORS RETURNED IN THE SUBSTRACTED ONE.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RU Y(N) UPDATE VECTOR WHERE Y:= X - Y.
+*
+ SUBROUTINE MXVSAV(N,X,Y)
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*)
+ DOUBLE PRECISION TEMP
+ INTEGER I
+ DO 10 I = 1,N
+ TEMP = Y(I)
+ Y(I) = X(I) - Y(I)
+ X(I) = TEMP
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSBP ALL SYSTEMS 91/12/01
+* PURPOSE :
+* VECTOR X(N) IS PERMUTED ACCORDING TO THE FORMULA
+* X(PERM(I)):=X(I).
+*
+* PARAMETERS :
+* II N LENGTH OF VECTORS.
+* II PERM(N) INPUT PERMUTATION VECTOR.
+* RU X(N) VECTOR THAT IS TO BE PERMUTED.
+* RA RN01(N) AMXILIARY VECTOR.
+*
+ SUBROUTINE MXVSBP(N,PERM,X,RN01)
+ INTEGER N,PERM(*),I
+ DOUBLE PRECISION RN01(*),X(*)
+ DO 100 I=1,N
+ RN01(PERM(I))=X(I)
+100 CONTINUE
+ DO 200 I=1,N
+ X(I)=RN01(I)
+200 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSCL ALL SYSTEMS 88/12/01
+* PURPOSE :
+* SCALING OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RI A SCALING FACTOR.
+* RO Y(N) OUTPUT VECTOR WHERE Y:= A*X.
+*
+ SUBROUTINE MXVSCL(N,A,X,Y)
+ INTEGER N
+ DOUBLE PRECISION A, X(*), Y(*)
+ INTEGER I
+ DO 1 I=1,N
+ Y(I) = A*X(I)
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSET ALL SYSTEMS 88/12/01
+* PURPOSE :
+* A SCALAR IS SET TO ALL THE ELEMENTS OF A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI A INITIAL VALUE.
+* RO X(N) OUTPUT VECTOR SUCH THAT X(I)=A FOR ALL I.
+*
+ SUBROUTINE MXVSET(N,A,X)
+ DOUBLE PRECISION A
+ INTEGER N
+ DOUBLE PRECISION X(*)
+ INTEGER I
+ DO 10 I = 1,N
+ X(I) = A
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSFP ALL SYSTEMS 91/12/01
+* PURPOSE :
+* VECTOR X(N) IS PERMUTED ACCORDING TO THE FORMULA
+* X(I)=X(PERM(I)).
+*
+* PARAMETERS :
+* II N LENGTH OF VECTORS.
+* II PERM(N) INPUT PERMUTATION VECTOR.
+* RU X(N) VECTOR THAT IS TO BE PERMUTED.
+* RA RN01(N) AMXILIARY VECTOR.
+*
+ SUBROUTINE MXVSFP(N,PERM,X,RN01)
+ INTEGER N,PERM(*),I
+ DOUBLE PRECISION RN01(*),X(*)
+C
+ DO 100 I=1,N
+ RN01(I)=X(PERM(I))
+100 CONTINUE
+ DO 200 I=1,N
+ X(I)=RN01(I)
+200 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSIP ALL SYSTEMS 91/12/01
+* PURPOSE :
+* THE VECTOR OF THE INVERSE PERMUTATION IS COMPUTED.
+*
+* PARAMETERS :
+* II N LENGTH OF VECTORS.
+* II PERM(N) INPUT PERMUTATION VECTOR.
+* IO INVP(N) INVERSE PERMUTATION VECTOR.
+*
+ SUBROUTINE MXVSIP(N,PERM,INVP)
+ INTEGER N,PERM(*),INVP(*)
+ INTEGER I,J
+ DO 100 I=1,N
+ J=PERM(I)
+ INVP(J)=I
+100 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSR2 ALL SYSTEMS 92/12/01
+* PURPOSE :
+* RADIXSORT.
+*
+* PARAMETERS :
+* II MCOLS NUMBER OF INTEGER VALUES OF THE SORTED ARRAY.
+* RI DEG(MCOLS) VALUES OF THE SORTED ARRAY.
+* RO ORD(MCOLS) SORTED OUTPUT.
+* RA RADIX(MCOLS+1) AUXILIARY ARRAY.
+* II WN01(MCOLS) INDICES OF THE SORTED ARRAY.
+* II LENGTH NUMBER OF SORTED PIECES.
+*
+ SUBROUTINE MXVSR2(MCOLS,DEG,ORD,RADIX,WN01,LENGTH)
+ INTEGER MCOLS,WN01(*)
+ DOUBLE PRECISION DEG(*),ORD(*),RADIX(*)
+ INTEGER LENGTH,I,L,L1,L2
+*
+* RADIX IS SHIFTED : 0-(MCOLS-1) --- 1-MCOLS
+*
+ DO 50 I=1,MCOLS+1
+ RADIX(I)=0
+50 CONTINUE
+ DO 100 I=1,LENGTH
+ L2=WN01(I)
+ L=DEG(L2)
+ RADIX(L+1)=RADIX(L+1)+1
+100 CONTINUE
+*
+* RADIX COUNTS THE NUMBER OF VERTICES WITH DEG(I)>=L
+*
+ L=0
+ DO 200 I=MCOLS,0,-1
+ L=RADIX(I+1)+L
+ RADIX(I+1)=L
+200 CONTINUE
+*
+* ARRAY ORD IS FILLED
+*
+ DO 300 I=1,LENGTH
+ L2=WN01(I)
+ L=DEG(L2)
+ L1=RADIX(L+1)
+ ORD(L1)=L2
+ RADIX(L+1)=L1-1
+300 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSR5 ALL SYSTEMS 92/12/01
+* PURPOSE :
+* SHELLSORT.
+*
+* PARAMETERS :
+* II K NUMBER OF INTEGER VALUES OF THE SORTED ARRAY.
+* II L CORRECTION FOR THE ABSOLUTE INDEX IN THE SORTED ARRAY
+* IU ARRAY(K) INTEGER SORTED ARRAY.
+* RO ARRAYC(K) REAL OUTPUT ARRAY.
+* RU ARRAYD(K) REAL ARRAY WHICH IS PERMUTED IN THE SAME WAY
+* AS THE INTEGER SORTED ARRAY.
+*
+ SUBROUTINE MXVSR5(K,L,ARRAY,ARRAYC,ARRAYD)
+ INTEGER K,L
+ INTEGER ARRAY(*)
+ DOUBLE PRECISION ARRAYC(*),ARRAYD(*)
+ INTEGER IS,LA,LT,LS,LLS,I,J,JS,KHALF
+ DOUBLE PRECISION LD
+*
+* NOTHING TO BE SORTED
+*
+ IF (K.LE.1) GO TO 400
+*
+* SHELLSORT
+*
+* L - CORRECTION FOR THE ABSOLUTE INDEX IN THE SORTED ARRAY
+*
+ LS=131071
+ KHALF=K/2
+ DO 300 LT=1,17
+ IF (LS.GT.KHALF) THEN
+ LS=LS/2
+ GO TO 300
+ END IF
+ LLS=K-LS
+ DO 200 I=1,LLS
+ IS=I+LS
+ LA=ARRAY(IS)
+ LD=ARRAYD(IS)
+ J=I
+ JS=IS
+ 100 IF (LA.GE.ARRAY(J)) THEN
+ ARRAY(JS)=LA
+ ARRAYD(JS)=LD
+ ARRAYC(INT(LD))=JS+L
+ GO TO 200
+ ELSE
+ ARRAY(JS)=ARRAY(J)
+ ARRAYD(JS)=ARRAYD(J)
+ ARRAYC(INT(ARRAYD(J)))=JS+L
+ JS=J
+ J=J-LS
+ END IF
+ IF (J.GE.1) GO TO 100
+ ARRAY(JS)=LA
+ ARRAYD(JS)=LD
+ ARRAYC(INT(LD))=JS+L
+ 200 CONTINUE
+ LS=LS/2
+ 300 CONTINUE
+ 400 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSR7 ALL SYSTEMS 94/12/01
+* PURPOSE :
+* SHELLSORT
+*
+* PARAMETERS :
+* II K LENGTH OF SORTED VECTOR.
+* IU ARRAY(K) SORTED ARRAY.
+* IU ARRAYB(K) SECOND SORTED ARRAY.
+*
+ SUBROUTINE MXVSR7(K,ARRAY,ARRAYB)
+ INTEGER K
+ INTEGER ARRAY(*),ARRAYB(*)
+ INTEGER IS,LA,LB,LT,LS,LLS,I,J,JS,KHALF
+*
+* NOTHING TO BE SORTED
+*
+ IF (K.LE.1) GO TO 400
+*
+* SHELLSORT
+*
+ LS=131071
+ KHALF=K/2
+ DO 300 LT=1,17
+ IF (LS.GT.KHALF) THEN
+ LS=LS/2
+ GO TO 300
+ END IF
+ LLS=K-LS
+ DO 200 I=1,LLS
+ IS=I+LS
+ LA=ARRAY(IS)
+ LB=ARRAYB(IS)
+ J=I
+ JS=IS
+ 100 IF (LA.GE.ARRAY(J)) THEN
+ ARRAY(JS)=LA
+ ARRAYB(JS)=LB
+ GO TO 200
+ ELSE
+ ARRAY(JS)=ARRAY(J)
+ ARRAYB(JS)=ARRAYB(J)
+ JS=J
+ J=J-LS
+ END IF
+ IF (J.GE.1) GO TO 100
+ ARRAY(JS)=LA
+ ARRAYB(JS)=LB
+ 200 CONTINUE
+ LS=LS/2
+ 300 CONTINUE
+ 400 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSRT ALL SYSTEMS 91/12/01
+* PURPOSE :
+* SHELLSORT
+*
+* PARAMETERS :
+* II K LENGTH OF SORTED VECTOR.
+* IU ARRAY(K) SORTED ARRAY.
+*
+ SUBROUTINE MXVSRT(K,ARRAY)
+ INTEGER K
+ INTEGER ARRAY(*)
+ INTEGER IS,LA,LT,LS,LLS,I,J,JS,KHALF
+*
+* NOTHING TO BE SORTED
+*
+ IF (K.LE.1) GO TO 400
+*
+* SHELLSORT
+*
+ LS=131071
+ KHALF=K/2
+ DO 300 LT=1,17
+ IF (LS.GT.KHALF) THEN
+ LS=LS/2
+ GO TO 300
+ END IF
+ LLS=K-LS
+ DO 200 I=1,LLS
+ IS=I+LS
+ LA=ARRAY(IS)
+ J=I
+ JS=IS
+ 100 IF (LA.GE.ARRAY(J)) THEN
+ ARRAY(JS)=LA
+ GO TO 200
+ ELSE
+ ARRAY(JS)=ARRAY(J)
+ JS=J
+ J=J-LS
+ END IF
+ IF (J.GE.1) GO TO 100
+ ARRAY(JS)=LA
+ 200 CONTINUE
+ LS=LS/2
+ 300 CONTINUE
+ 400 CONTINUE
+ RETURN
+ END
+* SUBROUTINE MXVSUM ALL SYSTEMS 88/12/01
+* PURPOSE :
+* SUM OF TWO VECTORS.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RO Z(N) OUTPUT VECTOR WHERE Z:= X + Y.
+*
+ SUBROUTINE MXVSUM(N,X,Y,Z)
+ INTEGER N
+ DOUBLE PRECISION X(*),Y(*),Z(*)
+ INTEGER I
+ DO 10 I = 1,N
+ Z(I) = X(I) + Y(I)
+ 10 CONTINUE
+ RETURN
+ END
+* FUNCTION MXVVDP ALL SYSTEMS 92/12/01
+* PURPOSE :
+* COMPUTATION OF THE NUMBER MXVVDP=TRANS(X)*D**(-1)*Y WHERE D IS A
+* DIAGONAL MATRIX STORED AS A VECTOR.
+*
+* PARAMETERS :
+* II N VECTOR DIMENSION.
+* RI D(N) DIAGONAL MATRIX STORED AS A VECTOR.
+* RI X(N) INPUT VECTOR.
+* RI Y(N) INPUT VECTOR.
+* RR MXVVDP COMPUTED NUMBER MXVVDP=TRANS(X)*D**(-1)*Y.
+*
+ FUNCTION MXVVDP(N,D,X,Y)
+ INTEGER N
+ DOUBLE PRECISION D(*), X(*), Y(*), MXVVDP
+ DOUBLE PRECISION TEMP
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER (ZERO = 0.0D 0)
+ TEMP = ZERO
+ DO 1 I = 1, N
+ TEMP = TEMP + X(I)*Y(I)/D(I)
+ 1 CONTINUE
+ MXVVDP = TEMP
+ RETURN
+ END
+* SUBROUTINE MXWDIR ALL SYSTEMS 92/12/01
+* PURPOSE :
+* VECTOR AUGMENTED BY THE SCALED VECTOR IN THE PACKED CASE.
+*
+* PARAMETERS :
+* II L PACKED VECTOR DIMENSION.
+* II N VECTOR DIMENSION.
+* II JBL(L) INDICES OF PACKED VECTOR.
+* RI A SCALING FACTOR.
+* RI X(L) PACKED INPUT VECTOR.
+* RI Y(N) UNPACKED INPUT VECTOR.
+* RO Z(N) UNPACKED OR PACKED OUTPUT VECTOR WHERE Z:= Y + A*X.
+* II JOB FORM OF THE VECTOR Z. JOB=1-UNPACKED FORM. JOB=2-PACKED
+* FORM.
+*
+ SUBROUTINE MXWDIR(L,JBL,A,X,Y,Z,JOB)
+ INTEGER L,JBL(*),JOB
+ DOUBLE PRECISION A, X(*), Y(*), Z(*)
+ INTEGER I,IP
+ IF (JOB.EQ.1) THEN
+ DO 1 I=1,L
+ IP=JBL(I)
+ IF (IP.GT.0) Z(IP)=Y(IP)+A*X(I)
+ 1 CONTINUE
+ ELSE
+ DO 2 I=1,L
+ IP=JBL(I)
+ IF (IP.GT.0) Z(I)=Y(IP)+A*X(I)
+ 2 CONTINUE
+ END IF
+ RETURN
+ END
+* FUNCTION MXWDOT ALL SYSTEMS 92/12/01
+* PURPOSE :
+* DOT PRODUCT OF TWO VECTORS IN THE PACKED CASE.
+*
+* PARAMETERS :
+* II L PACKED OR UNPACKED VECTOR DIMENSION.
+* II N UNPACKED VECTOR DIMENSION.
+* II JBL(L) INDICES OF PACKED VECTOR.
+* RI X(L) UNPACKED OR PACKED INPUT VECTOR.
+* RI Y(N) UNPACKED INPUT VECTOR.
+* II JOB FORM OF THE VECTOR X. JOB=1-UNPACKED FORM. JOB=2-PACKED
+* FORM.
+* RR MXWDOT VALUE OF DOT PRODUCT MXWDOT=TRANS(X)*Y.
+*
+ FUNCTION MXWDOT(L,JBL,X,Y,JOB)
+ INTEGER L,JBL(*),JOB
+ DOUBLE PRECISION X(*), Y(*), MXWDOT
+ DOUBLE PRECISION TEMP
+ INTEGER I,IP
+ TEMP=0.0D0
+ IF (JOB.EQ.1) THEN
+ DO 1 I=1,L
+ IP=JBL(I)
+ IF (IP.GT.0) TEMP=TEMP+X(IP)*Y(IP)
+ 1 CONTINUE
+ ELSE
+ DO 2 I=1,L
+ IP=JBL(I)
+ IF (IP.GT.0) TEMP=TEMP+X(I)*Y(IP)
+ 2 CONTINUE
+ END IF
+ MXWDOT=TEMP
+ RETURN
+ END
--- /dev/null
+* SUBROUTINE PA0GS3 ALL SYSTEMS 91/12/01
+* PURPOSE :
+* NUMERICAL COMPUTATION OF THE GRADIENT OF THE APPROXIMATED
+* FUNCTION.
+*
+* PARAMETERS :
+* II N NUMBER OF VARIABLES.
+* II KA INDEX OF THE APPROXIMATED FUNCTION.
+* RI X(N) VECTOR OF VARIABLES.
+* RO FA VALUE OF THE APPROXIMATED FUNCTION.
+* RA GA(N) GRADIENT OF THE APPROXIMATED FUNCTION.
+* II IAG(N+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI ETA1 PRECISION OF THE COMPUTED FUNCTION VALUES.
+* IU NAV NUMBER OF APPROXIMATED FUNCTION EVALUATIONS.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+*
+ SUBROUTINE PA0GS3(N,KA,X,FA,GA,IAG,JAG,ETA1,NAV)
+ DOUBLE PRECISION ETA1,FA
+ INTEGER KA,N,NAV
+ DOUBLE PRECISION GA(*),X(*)
+ INTEGER IAG(*),JAG(*)
+ DOUBLE PRECISION ETA,FTEMP,XSTEP,XTEMP
+ INTEGER IVAR,KVAR
+ ETA = SQRT(ETA1)
+ FTEMP = FA
+ DO 10 KVAR = IAG(KA),IAG(KA+1) - 1
+ IVAR = JAG(KVAR)
+*
+* STEP SELECTION
+*
+ XSTEP = ETA*MAX(ABS(X(IVAR)),1.0D0)*SIGN(1.0D0,X(IVAR))
+ XTEMP = X(IVAR)
+ X(IVAR) = X(IVAR) + XSTEP
+ XSTEP = X(IVAR) - XTEMP
+ NAV = NAV + 1
+ CALL FUN(N,KA,X,FA)
+*
+* NUMERICAL DIFFERENTIATION
+*
+ GA(IVAR) = (FA-FTEMP)/XSTEP
+ X(IVAR) = XTEMP
+ 10 CONTINUE
+ FA = FTEMP
+ RETURN
+ END
+* SUBROUTINE PA0HS3 ALL SYSTEMS 99/12/01
+* PURPOSE :
+* NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE APPROXIMATED
+* FUNCTION USING ITS VALUES.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II KA INDEX OF THE SELECTED FUNCTION.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RO HA(M) HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
+* RA GO(NF) AUXILIARY VECTOR.
+* RA GS(NF) AUXILIARY VECTOR.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI FA VALUE OF THE SELECTED FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED VALUES.
+* II KBF TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
+* BOUNDS. KBF=1-TWO SIDED BOUNDS.
+* IO NAV NUMBER OF APPROXIMATED FUNTION VALUES.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+*
+ SUBROUTINE PA0HS3(NF,KA,X,IX,HA,GO,GS,IAG,JAG,FA,ETA1,KBF,NAV)
+ INTEGER NF,KA,IX(*),IAG(*),JAG(*),KBF,NAV
+ DOUBLE PRECISION X(*),HA(*),GO(*),GS(*),FA,ETA1
+ DOUBLE PRECISION XTEMPI,XTEMPJ,FTEMP,ETA
+ INTEGER I,J,IJ
+ INTEGER IVAR,JVAR,KVAR,LVAR,MVAR
+ ETA=ETA1**(1.0D 0/3.0D 0)
+ FTEMP=FA
+ MVAR=IAG(KA)-1
+ DO 4 KVAR=MVAR+1,IAG(KA+1)-1
+ IVAR=ABS(JAG(KVAR))
+ IF (KBF.GT.0) THEN
+ IF (IX(IVAR).LE.-5) GO TO 4
+ END IF
+*
+* STEP SELECTION
+*
+ XTEMPI=X(IVAR)
+ IF (XTEMPI.GE.0.0D 0) THEN
+ GO(IVAR)= ETA*MAX(ABS(XTEMPI),1.0D 0)
+ ELSE
+ GO(IVAR)=-ETA*MAX(ABS(XTEMPI),1.0D 0)
+ END IF
+ X(IVAR)=X(IVAR)+GO(IVAR)
+ GO(IVAR)=X(IVAR)-XTEMPI
+ CALL FUN(NF,KA,X,FA)
+ NAV=NAV+1
+ GS(IVAR)=FA
+ X(IVAR)=XTEMPI
+ 4 CONTINUE
+*
+* NUMERICAL DIFFERENTIATION
+*
+ DO 10 KVAR=MVAR+1,IAG(KA+1)-1
+ IVAR=ABS(JAG(KVAR))
+ IF (KBF.GT.0) THEN
+ IF (IX(IVAR).LE.-5) GO TO 10
+ END IF
+ XTEMPI=X(IVAR)
+ X(IVAR)=XTEMPI+GO(IVAR)
+ DO 9 LVAR=KVAR,IAG(KA+1)-1
+ JVAR=ABS(JAG(LVAR))
+ IF (KBF.GT.0) THEN
+ IF (IX(JVAR).LE.-5) GO TO 9
+ END IF
+ XTEMPJ=X(JVAR)
+ X(JVAR)=X(JVAR)+GO(JVAR)
+ CALL FUN(NF,KA,X,FA)
+ NAV=NAV+1
+ I=KVAR-MVAR
+ J=LVAR-MVAR
+ IJ=MAX(I,J)*(MAX(I,J)-1)/2+MIN(I,J)
+ HA(IJ)=((FTEMP-GS(IVAR))+(FA-GS(JVAR)))/(GO(IVAR)*GO(JVAR))
+ X(JVAR)=XTEMPJ
+ 9 CONTINUE
+ X(IVAR)=XTEMPI
+ 10 CONTINUE
+ FA=FTEMP
+ RETURN
+ END
+* SUBROUTINE PA0SQ3 ALL SYSTEMS 92/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE FUNCTION
+* WHICH IS DEFINED AS A SUM OF SQUARES.
+*
+* PARAMETERS:
+* II N NUMBER OF VARIABLES.
+* RI X(N) VECTOR OF VARIABLES.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RO AF(N) VALUES OF THE APPROXIMATED FUNCTIONS.
+* RA GA(N) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RI AG(IAG(N+1)-1) SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
+* DIRECTION VECTOR DETERMINATION.
+* II IAG(N+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI G(N) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED FUNCTION VALUES.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IU LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* IO NFV NUMBER OF FUNCTION EVALUATIONS.
+* IO NFG NUMBER OF GRADIENT EVALUATIONS.
+* II IDER DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* S PA0GS3 NUMERICAL DIFFERENTIATION.
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE PA0SQ3(N,X,F,AF,GA,AG,IAG,JAG,G,ETA1,KD,LD,NFV,NFG,
+ & IDER)
+ DOUBLE PRECISION ETA1,F
+ INTEGER IDER,KD,LD,N,NFV,NFG
+ DOUBLE PRECISION AF(*),AG(*),G(*),GA(*),X(*)
+ INTEGER IAG(*),JAG(*)
+ DOUBLE PRECISION FA
+ INTEGER J,JP,K,KA,L,NAV
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0 .AND. LD.LT.0) THEN
+ F = 0.0D0
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1 .AND. LD.LT.1) THEN
+ CALL MXVSET(N,0.0D0,G)
+ IF (IDER.GT.0) NFG=NFG+1
+ END IF
+ NAV=0
+ DO 30 KA = 1,N
+ IF (KD.LT.0) GO TO 30
+ IF (LD.GE.0) THEN
+ FA = AF(KA)
+ ELSE
+ CALL FUN(N,KA,X,FA)
+ AF(KA) = FA
+ END IF
+ IF (LD.GE.0) GO TO 10
+ F = F + FA*FA
+ 10 IF (KD.LT.1) GO TO 30
+ IF (IDER.EQ.0) THEN
+ CALL PA0GS3(N,KA,X,FA,GA,IAG,JAG,ETA1,NAV)
+ ELSE
+ CALL DFUN(N,KA,X,GA)
+ END IF
+ K = IAG(KA)
+ L = IAG(KA+1) - K
+ DO 20 J = 1,L
+ JP = JAG(K)
+ G(JP) = G(JP) + FA*GA(JP)
+ AG(K) = GA(JP)
+ K = K + 1
+ 20 CONTINUE
+ 30 CONTINUE
+ IF (KD.GE.0 .AND. LD.LT.0) F = 0.5D0*F
+ IF (IDER.EQ.0) NFV=NFV+NAV/N
+ LD = KD
+ RETURN
+ END
+* SUBROUTINE PA1HS3 ALL SYSTEMS 99/12/01
+* PURPOSE :
+* NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE APPROXIMATED
+* FUNCTION USING ITS GRADIENTS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II KA INDEX OF THE SELECTED FUNCTION.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RO HA(M) HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
+* RI GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RA GO(NF) AUXILIARY VECTOR.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI FA VALUE OF THE SELECTED FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED VALUES.
+* II KBF TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
+* BOUNDS. KBF=2-TWO SIDED BOUNDS.
+* IO NAG NUMBER OF APPROXIMATED FUNTION GRADIENTS.
+*
+* SUBPROGRAMS USED :
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+*
+ SUBROUTINE PA1HS3(NF,KA,X,IX,HA,GA,GO,IAG,JAG,FA,ETA1,KBF,NAG)
+ INTEGER NF,KA,IX(*),IAG(*),JAG(*),KBF,NAG
+ DOUBLE PRECISION X(*),HA(*),GA(*),GO(*),FA,ETA1
+ DOUBLE PRECISION XSTEP,XTEMP,FTEMP,ETA
+ INTEGER I,J,IJ
+ INTEGER IVAR,JVAR,KVAR,LVAR,MVAR
+ ETA=SQRT(ETA1)
+ FTEMP=FA
+ MVAR=IAG(KA)-1
+ DO 5 KVAR=MVAR+1,IAG(KA+1)-1
+ IVAR=ABS(JAG(KVAR))
+ IF (KBF.GT.0) THEN
+ IF (IX(IVAR).LE.-5) GO TO 5
+ END IF
+*
+* STEP SELECTION
+*
+ XTEMP=X(IVAR)
+ IF (XTEMP.GE.0.0D 0) THEN
+ XSTEP= ETA*MAX(ABS(XTEMP),1.0D 0)
+ ELSE
+ XSTEP=-ETA*MAX(ABS(XTEMP),1.0D 0)
+ END IF
+ X(IVAR)=XTEMP+XSTEP
+ XSTEP=X(IVAR)-XTEMP
+ CALL DFUN(NF,KA,X,GA)
+ NAG=NAG+1
+*
+* NUMERICAL DIFFERENTIATION
+*
+ DO 4 LVAR=MVAR+1,IAG(KA+1)-1
+ JVAR=ABS(JAG(LVAR))
+ IF (KBF.GT.0) THEN
+ IF (IX(JVAR).LE.-5) GO TO 4
+ END IF
+ I=KVAR-MVAR
+ J=LVAR-MVAR
+ IJ=MAX(I,J)*(MAX(I,J)-1)/2+MIN(I,J)
+ IF (LVAR .GE. KVAR) THEN
+ HA(IJ)=(GA(JVAR)-GO(JVAR))/XSTEP
+ ELSE
+ HA(IJ)=0.5D 0*(HA(IJ)+(GA(JVAR)-GO(JVAR))/XSTEP)
+ END IF
+ 4 CONTINUE
+ X(IVAR)=XTEMP
+ 5 CONTINUE
+ FA=FTEMP
+ RETURN
+ END
+* SUBROUTINE PA1SF3 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE FUNCTION
+* WHICH IS DEFINED AS A SUM OF SQUARES.
+*
+* PARAMETERS:
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI X(NF) VECTOR OF VARIABLES.
+* RU GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RO AG(MA) SPARSE JACOBIAN MATRIX.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED
+* FUNCTIONS.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* II ISNA SAVING SPECIFICATION. ISNA=0-NO SAVING. ISNA=1-FUNCTION
+* VALUES ARE SAVED. ISNA=2-FUNCTION VALUES AND GRADIENTS ARE
+* SAVED.
+* IU NFV NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
+* IU NFG NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE PA1SF3(NF,NA,X,GA,G,AG,IAG,JAG,F,AF,KD,LD,ISNA,
+ & NFV,NFG)
+ INTEGER NF,NA,IAG(*),JAG(*),KD,LD,ISNA,NFV,NFG
+ DOUBLE PRECISION X(*),GA(*),G(*),AG(*),F,AF(*)
+ INTEGER J,JP,K,L,KA
+ DOUBLE PRECISION FA
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0.AND.LD.LT.0) THEN
+ F=0.0D 0
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1.AND.LD.LT.1) THEN
+ CALL MXVSET(NF,0.0D 0,G)
+ NFG=NFG+1
+ END IF
+ DO 5 KA=1,NA
+ IF (KD.LT.0) GO TO 5
+ IF (LD.LT.0) THEN
+ CALL FUN(NF,KA,X,FA)
+ F=F+FA
+ AF(KA)=FA
+ ELSE
+ FA=AF(KA)
+ END IF
+ IF (KD.LT.1) GO TO 5
+ IF (LD.LT.1) THEN
+ CALL DFUN(NF,KA,X,GA)
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 4 J=1,L
+ JP=ABS(JAG(K))
+ G(JP)=G(JP)+GA(JP)
+ IF (ISNA.GT.1) AG(K)=GA(JP)
+ K=K+1
+ 4 CONTINUE
+ END IF
+ 5 CONTINUE
+ LD=KD
+ RETURN
+ END
+* SUBROUTINE PA2SF4 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT AND THE HESSIAN MATRIX
+* OF THE OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES.
+*
+* PARAMETERS:
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RU GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA GO(NF) AUXILIARY VECTOR.
+* RU HA(MB) HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
+* RO H(M) SPARSE HESSIAN MATRIX OF THE OBJECTIVE FUNCTION.
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED
+* FUNCTIONS.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED FUNCTION VALUES.
+* II KBF TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
+* BOUNDS. KBF=2-TWO SIDED BOUNDS.
+* II KD DEGREE OF REQUIRED DERVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* IU NFV NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
+* IU NFG NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
+* IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+* S MXVSET INITIATION OF A VECTOR.
+* S PA1HS3 NUMERICAL COMPUTATION OF THE PARTIAL HESSIAN MATRIX.
+* S PASSH2 ADDITION OF THE PARTIAL HESSIAN MATRIX TO THE SPARSE
+* HESSIAN MATRIX.
+*
+ SUBROUTINE PA2SF4(NF,NA,X,IX,GA,G,GO,HA,H,IH,JH,IAG,JAG,AF,F,
+ & ETA1,KBF,KD,LD,NFV,NFG,IDECF)
+ INTEGER NF,NA,IX(*),IH(*),JH(*),IAG(*),JAG(*),KBF,KD,LD,NFV,NFG,
+ & IDECF
+ DOUBLE PRECISION X(*),GA(*),G(*),GO(*),HA(*),H(*),AF(*),F,ETA1
+ DOUBLE PRECISION FA
+ INTEGER J,JP,K,KA,L,NAG
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0.AND.LD.LT.0) THEN
+ F=0.0D 0
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1.AND.LD.LT.1) THEN
+ CALL MXVSET(NF,0.0D 0,G)
+ NFG=NFG+1
+ END IF
+ IF (KD.GE.2.AND.LD.LT.2) CALL MXVSET(IH(NF+1)-1,0.0D 0,H)
+ NAG=0
+ DO 9 KA=1,NA
+ IF (KD.LT.0) GO TO 9
+ IF (LD.LT.0) THEN
+ CALL FUN(NF,KA,X,FA)
+ F=F+FA
+ AF(KA)=FA
+ ELSE
+ FA=AF(KA)
+ END IF
+ IF (KD.LT.1) GO TO 9
+ CALL DFUN(NF,KA,X,GA)
+ IF (LD.LT.1) THEN
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 1 J=1,L
+ JP=ABS(JAG(K))
+ G(JP)=G(JP)+GA(JP)
+ K=K+1
+ 1 CONTINUE
+ END IF
+ IF (KD.LT.2) GO TO 9
+ IDECF=0
+ CALL PA1HS3(NF,KA,X,IX,HA,GO,GA,IAG,JAG,FA,ETA1,KBF,NAG)
+ CALL PASSH2(H,IH,JH,HA,IAG,JAG,KA,1.0D 0)
+ 9 CONTINUE
+ NFG=NFG+NAG/NA
+ LD=KD
+ RETURN
+ END
+* SUBROUTINE PA2SQ4 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT AND THE HESSIAN MATRIX
+* OF THE OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES.
+*
+* PARAMETERS:
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI X(NF) VECTOR OF VARIABLES.
+* RU GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RO AG(MA) SPARSE JACOBIAN MATRIX.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RO H(M) SPARSE HESSIAN MATRIX OF THE OBJECTIVE FUNCTION.
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED
+* FUNCTIONS.
+* RI F VALUE OF THE OBJECTIVE FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED FUNCTION VALUES.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* II ISNA SAVING SPECIFICATION. ISNA=0-NO SAVING. ISNA=1-FUNCTION
+* VALUES ARE SAVED. ISNA=2-FUNCTION VALUES AND GRADIENTS ARE
+* SAVED.
+* IU NFV NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
+* IU NFG NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
+* II IDER DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
+* IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+* S MXVSET INITIATION OF A VECTOR.
+* S PASSH1 ADDITION OF THE PARTIAL GAUSS-NEWTON TERM TO THE SPARSE
+* HESSIAN MATRIX.
+*
+ SUBROUTINE PA2SQ4(NF,NA,X,GA,AG,G,H,IH,JH,IAG,JAG,AF,F,ETA1,KD,
+ & LD,ISNA,NFV,NFG,IDER,IDECF)
+ INTEGER NF,NA,IH(*),JH(*),IAG(*),JAG(*),KD,LD,ISNA,NFV,NFG,IDER,
+ & IDECF
+ DOUBLE PRECISION X(*),GA(*),AG(*),G(*),H(*),AF(*),F,ETA1
+ INTEGER J,JP,K,KA,L,NAV
+ DOUBLE PRECISION FA
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0.AND.LD.LT.0) THEN
+ F=0.0D 0
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1.AND.LD.LT.1) THEN
+ CALL MXVSET(NF,0.0D 0,G)
+ IF (IDER.GT.0) NFG=NFG+1
+ END IF
+ IF (KD.GE.2.AND.LD.LT.2) CALL MXVSET(IH(NF+1)-1,0.0D 0,H)
+ NAV=0
+ DO 3 KA=1,NA
+ IF (KD.LT.0) GO TO 3
+ IF (LD.LT.0) THEN
+ CALL FUN(NF,KA,X,FA)
+ F=F+FA*FA
+ AF(KA)=FA
+ ELSE
+ FA=AF(KA)
+ END IF
+ IF (KD.LT.1) GO TO 3
+ IF (IDER.EQ.0) THEN
+ CALL PA0GS3(NF,KA,X,FA,GA,IAG,JAG,ETA1,NAV)
+ ELSE
+ CALL DFUN(NF,KA,X,GA)
+ END IF
+ IF (LD.GE.1) GO TO 2
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 1 J=1,L
+ JP=ABS(JAG(K))
+ G(JP)=G(JP)+FA*GA(JP)
+ IF (ISNA.GT.1) AG(K)=GA(JP)
+ K=K+1
+ 1 CONTINUE
+ 2 IF (KD.LT.2) GO TO 3
+ IDECF=0
+ CALL PASSH1(H,IH,JH,IAG,JAG,GA,KA,1.0D 0)
+ 3 CONTINUE
+ IF (KD.GE.0.AND.LD.LT.0) F=5.0D-1*F
+ IF (IDER.EQ.0) NFV=NFV+NAV/NA
+ LD=KD
+ RETURN
+ END
+* SUBROUTINE PA2SQ8 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT AND THE HESSIAN MATRIX
+* OF THE OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES.
+*
+* PARAMETERS:
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RU GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA GO(NF) AUXILIARY VECTOR.
+* RA GS(NF) AUXILIARY VECTOR.
+* RU HA(ME) HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
+* RO H(M) SPARSE HESSIAN MATRIX OF THE OBJECTIVE FUNCTION.
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED
+* FUNCTIONS.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED FUNCTION VALUES.
+* II KBF TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
+* BOUNDS. KBF=2-TWO SIDED BOUNDS.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* IU NFV NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
+* IU NFG NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
+* II IPOM1 CORRECTION OPTION. IPOM1=0-THE NEWTON CORRECTION IS USED.
+* IPOM1=1-CORRECTION IS NOT USED.
+* II IDER DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
+* IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+* S MXVSET INITIATION OF A VECTOR.
+* S PA0HS3 NUMERICAL COMPUTATION OF THE PARTIAL HESSIAN MATRIX.
+* S PA1HS3 NUMERICAL COMPUTATION OF THE PARTIAL HESSIAN MATRIX.
+* S PASSH1 ADDITION OF THE PARTIAL GAUSS-NEWTON TERM TO THE SPARSE
+* HESSIAN MATRIX.
+* S PASSH2 ADDITION OF THE PARTIAL HESSIAN MATRIX TO THE SPARSE
+* HESSIAN MATRIX.
+*
+ SUBROUTINE PA2SQ8(NF,NA,X,IX,GA,G,GO,GS,HA,H,IH,JH,IAG,JAG,AF,F,
+ & ETA1,KBF,KD,LD,NFV,NFG,IPOM1,IDER,IDECF)
+ INTEGER NF,NA,IX(*),IH(*),JH(*),IAG(*),JAG(*),KBF,KD,LD,NFV,NFG,
+ & IPOM1,IDER,IDECF
+ DOUBLE PRECISION X(*),GA(*),G(*),GO(*),GS(*),HA(*),H(*),AF(*),F,
+ & ETA1
+ INTEGER J,JP,K,KA,L,NAV,NAG
+ DOUBLE PRECISION FA
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0.AND.LD.LT.0) THEN
+ F=0.0D 0
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1.AND.LD.LT.1) THEN
+ CALL MXVSET(NF,0.0D 0,G)
+ IF (IDER.GT.0) NFG=NFG+1
+ END IF
+ IF (KD.GE.2.AND.LD.LT.2) CALL MXVSET(IH(NF+1)-1,0.0D 0,H)
+ NAV=0
+ NAG=0
+ DO 9 KA=1,NA
+ IF (KD.LT.0) GO TO 9
+ IF (LD.LT.0) THEN
+ CALL FUN(NF,KA,X,FA)
+ F=F+FA*FA
+ AF(KA)=FA
+ ELSE
+ FA=AF(KA)
+ END IF
+ IF (KD.LT.1) GO TO 9
+ IF (IDER.EQ.0) THEN
+ CALL PA0GS3(NF,KA,X,FA,GA,IAG,JAG,ETA1,NAV)
+ ELSE
+ CALL DFUN(NF,KA,X,GA)
+ END IF
+ IF (LD.LT.1) THEN
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 1 J=1,L
+ JP=ABS(JAG(K))
+ G(JP)=G(JP)+FA*GA(JP)
+ K=K+1
+ 1 CONTINUE
+ END IF
+ IF (KD.LT.2) GO TO 9
+ IDECF=0
+ IF (IPOM1.EQ.0) THEN
+ IF (IDER.EQ.0) THEN
+ CALL PA0HS3(NF,KA,X,IX,HA,GO,GS,IAG,JAG,FA,ETA1,KBF,NAV)
+ ELSE
+ CALL PA1HS3(NF,KA,X,IX,HA,GO,GA,IAG,JAG,FA,ETA1,KBF,NAG)
+ END IF
+ END IF
+ CALL PASSH1(H,IH,JH,IAG,JAG,GA,KA,1.0D 0)
+ IF (IPOM1.EQ.0) CALL PASSH2(H,IH,JH,HA,IAG,JAG,KA,FA)
+ 9 CONTINUE
+ IF (KD.GE.0.AND.LD.LT.0) F=5.0D-1*F
+ IF (IDER.EQ.0) NFV=NFV+NAV/NA
+ IF (IDER.GT.0) NFG=NFG+NAG/NA
+ LD=KD
+ RETURN
+ END
+* SUBROUTINE PALNG3 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE GRADIENT OF THE LINEAR APPROXIMATED FUNCTION.
+*
+* PARAMETERS :
+* RO AG(MA) SPARSE JACOBIAN MATRIX.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RO GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* II KA INDEX OF THE SELECTED FUNCTION.
+*
+ SUBROUTINE PALNG3(AG,IAG,JAG,GA,KA)
+ DOUBLE PRECISION AG(*),GA(*)
+ INTEGER IAG(*),JAG(*),KA
+ INTEGER J,JP,K,L
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 2 J=1,L
+ JP=ABS(JAG(K))
+ GA(JP)=AG(K)
+ K=K+1
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PASED3 ALL SYSTEMS 07/12/01
+* PURPOSE :
+* COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS COMPUTED FROM
+* THE COORDINATE FORM.
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* II MA NUMBER OF NONZERO ELEMENTS IN THE SPARSE JACOBIAN MATRIX.
+* IU IAG(MA+NA) ON INPUT ROW INDICES OF NONZERO ELEMENTS IN THE FIELD AG.
+* ON OUTPUT POSITIONS OF THE FIRST ROW ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* IO IER ERROR MESAGE. IER=0-THE STANDARD INPUT DATA ARE CORRECT.
+* IER=1-ERROR IN THE ARRAY IAG. IER=2-ERROR IN THE ARRAY JAG.
+*
+ SUBROUTINE PASED3(NA,MA,IAG,JAG,IER)
+ INTEGER NA,MA,IAG(*),JAG(*),IER
+ INTEGER I,J,K,L,KA
+ IER=0
+ CALL MXVSR7(MA,IAG,JAG)
+ IF (IAG(1).LT.1.OR.IAG(MA).GT.NA) THEN
+ IER=1
+ RETURN
+ END IF
+ CALL MXVINS(NA,0,IAG(MA+1))
+ DO 1 J=1,MA
+ IAG(IAG(J)+MA)=IAG(IAG(J)+MA)+1
+ 1 CONTINUE
+ IAG(1)=1
+ DO 2 KA=1,NA
+ IAG(KA+1)=IAG(KA)+IAG(KA+MA)
+ 2 CONTINUE
+ I=0
+ DO 4 KA=1,NA
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ IF (L.GT.0) THEN
+ CALL MXVSRT(L,JAG(K))
+ IF (JAG(K).LT.1.OR.JAG(K+L-1).GT.NA) THEN
+ IER=2
+ RETURN
+ END IF
+ END IF
+ IAG(KA)=IAG(KA)-I
+ DO 3 J=1,L
+ IF (J.GT.1.AND.JAG(K).EQ.JAG(K-1)) THEN
+ I=I+1
+ ELSE
+ JAG(K-I)=JAG(K)
+ END IF
+ K=K+1
+ 3 CONTINUE
+ 4 CONTINUE
+ IAG(NA+1)=IAG(NA+1)-I
+ MA=IAG(NA+1)-1
+ RETURN
+ END
+* SUBROUTINE PASSH1 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE SPARSE JACOBIAN
+* MATRIX.
+*
+* PARAMETERS :
+* RU H(M) NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) COLUMN INDICES OF THE NONZERO ELEMENTS OF H.
+* II IAG(NA+1) POSITIONS OF THE FIRST ROWS ELEMENTS IN THE SPARSE
+* JACOBIAN STRUCTURE.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE SPARSE JACOBIAN
+* STRUCTURE.
+* RI GA(NF) GRADIENT OF THE SELECTED FUNCTION.
+* II KA INDEX OF THE SELECTED FUNCTION (ROW OF THE SPARSE JACOBIAN
+* MATRIX).
+* RI FACTOR SCALING FACTOR.
+*
+ SUBROUTINE PASSH1(H,IH,JH,IAG,JAG,GA,KA,FACTOR)
+ INTEGER IH(*),JH(*),IAG(*),JAG(*),KA
+ DOUBLE PRECISION H(*),GA(*),FACTOR
+ DOUBLE PRECISION TEMP
+ INTEGER I,J,JF,JA,K,LA
+ LA=IAG(KA+1)-1
+ DO 6 K=IAG(KA),LA
+ I=ABS(JAG(K))
+ TEMP=FACTOR*GA(I)
+ JF=IH(I)
+ DO 5 JA=K,LA
+ J=ABS(JAG(JA))
+ 2 IF (ABS(JH(JF)).LT.J) THEN
+ JF=JF+1
+ GO TO 2
+ END IF
+ H(JF)=H(JF)+TEMP*GA(J)
+ 5 CONTINUE
+ 6 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PASSH2 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE SPARSE JACOBIAN
+* MATRIX.
+*
+* PARAMETERS :
+* RU H(M) NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) COLUMN INDICES OF THE NONZERO ELEMENTS OF H.
+* II HA(ME) PACKED HESSIAN MATRIX OF THE SELECTED FUNCTION.
+* II IAG(NA+1) POSITIONS OF THE FIRST ROWS ELEMENTS IN THE SPARSE
+* JACOBIAN STRUCTURE.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE SPARSE JACOBIAN
+* STRUCTURE.
+* II KA INDEX OF THE SELECTED FUNCTION (ROW OF THE SPARSE JACOBIAN
+* MATRIX).
+* RI FACTOR SCALING FACTOR.
+*
+ SUBROUTINE PASSH2(H,IH,JH,HA,IAG,JAG,KA,FACTOR)
+ INTEGER IH(*),JH(*),IAG(*),JAG(*),KA
+ DOUBLE PRECISION H(*),HA(*),FACTOR
+ INTEGER I,II,IA,J,JJ,JA,JF,K,KK,L
+ KK=0
+ II=IAG(KA)
+ L=IAG(KA+1)-II
+ DO 6 IA=1,L
+ KK=KK+IA
+ I=ABS(JAG(II))
+ JF=IH(I)
+ JJ=II
+ K=KK
+ DO 4 JA=IA,L
+ J=ABS(JAG(JJ))
+ 2 IF (ABS(JH(JF)).LT.J) THEN
+ JF=JF+1
+ GO TO 2
+ END IF
+ H(JF)=H(JF)+FACTOR*HA(K)
+ K=K+JA
+ JJ=JJ+1
+ 4 CONTINUE
+ II=II+1
+ 6 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PASSH3 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE SPARSE JACOBIAN
+* MATRIX.
+*
+* PARAMETERS :
+* RU H(M) NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) COLUMN INDICES OF THE NONZERO ELEMENTS OF H.
+* II IAG(NA+1) POSITIONS OF THE FIRST ROWS ELEMENTS IN THE SPARSE
+* JACOBIAN STRUCTURE.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE SPARSE JACOBIAN
+* STRUCTURE.
+* RI GA(NF) GRADIENT OF THE SELECTED FUNCTION.
+* II KA INDEX OF THE SELECTED FUNCTION (ROW OF THE SPARSE JACOBIAN
+* MATRIX).
+* RI FACTOR SCALING FACTOR.
+*
+ SUBROUTINE PASSH3(H,IH,JH,IAG,JAG,GA,KA,FACTOR)
+ INTEGER IH(*),JH(*),IAG(*),JAG(*),KA
+ DOUBLE PRECISION H(*),GA(*),FACTOR
+ DOUBLE PRECISION TEMP
+ INTEGER I,J,JF,JA,K,LA
+ LA=IAG(KA+1)-1
+ DO 6 K=IAG(KA),LA
+ I=ABS(JAG(K))
+ IF (I.LE.0) GO TO 6
+ TEMP=FACTOR*GA(I)
+ JF=IH(I)
+ DO 5 JA=K,LA
+ J=ABS(JAG(JA))
+ IF (J.LE.0) GO TO 5
+ 2 IF (ABS(JH(JF)).LT.J) THEN
+ JF=JF+1
+ GO TO 2
+ END IF
+ H(JF)=H(JF)+TEMP*GA(J)
+ 5 CONTINUE
+ 6 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PCBS04 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* INITIATION OF THE VECTOR CONTAINING TYPES OF CONSTRAINTS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES.
+* RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES.
+* RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+*
+ SUBROUTINE PCBS04(NF,X,IX,XL,XU,EPS9,KBF)
+ INTEGER NF,IX(*),KBF
+ DOUBLE PRECISION X(*),XL(*),XU(*),EPS9
+ DOUBLE PRECISION TEMP
+ INTEGER I,IXI
+ IF (KBF.GT.0) THEN
+ DO 1 I=1,NF
+ TEMP=1.0D 0
+ IXI=ABS(IX(I))
+ IF ((IXI.EQ.1.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).LE.XL(I)+
+ & EPS9*MAX(ABS(XL(I)),TEMP)) X(I)=XL(I)
+ IF ((IXI.EQ.2.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).GE.XU(I)-
+ & EPS9*MAX(ABS(XU(I)),TEMP)) X(I)=XU(I)
+ 1 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE PDSGM1 ALL SYSTEMS 01/09/22
+* PURPOSE :
+* COMPUTATION OF A TRUST-REGION STEP BY THE DOG-LEG METHOD WITH DIRECT
+* MATRIX DECOMPOSITIONS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II MMAX MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
+* II MH POINTER OBTAINED BY THE SUBROUTINE MXSPCC.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
+* X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I).
+* IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
+* XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA H(MMAX) NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
+* HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
+* THE NUMERICAL DIFFERENTIATION.
+* II IH(NF+1) POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
+* IU JH(MMAX) INDICES OF NONZERO ELEMENTS OF THE MATRIX H
+* TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
+* DIFFERENTIATION.
+* RO S(NF) DIRECTION VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI GO(NF) GRADIENTS DIFFERENCE.
+* RA XS(NF) AUXILIARY VECTOR.
+* II PSL(NF+1) POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION.
+* IA PERM(NF) PERMUTATION VECTOR.
+* IA WN11(NF+1) AUXILIARY VECTOR.
+* IA WN12(NF+1) AUXILIARY VECTOR.
+* RI XMAX MAXIMUM STEPSIZE.
+* RU XDEL TRUST REGION RADIUS.
+* RO GNORM NORM OF THE GRADIENT VECTOR.
+* RO SNORM NORM OF THE DIRECTION VECTOR.
+* RI FMIN ESTIMATION OF THE MINIMUM FUNCTION VALUE.
+* RI F VALUE OF THE OBJECTIVE FUNCTION.
+* RO P VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO PP VALUE OF THE QUADRATIC TERM.
+* RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS.
+* RI ALF2 TOLERANCE FOR THE GRADIENT NORM.
+* II KD ORDER OF COMPUTED DERIVATIVES.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* II IEST ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
+* IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
+* IU IDEC DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
+* IU NDEC NUMBER OF MATRIX DECOMPOSITIONS.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO ITERM VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
+* ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
+* MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
+* MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
+* ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
+* ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
+* BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
+* ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
+* ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
+* VALUES ITERM<=-40 DETECT A LACK OF SPACE.
+*
+* SUBPROGRAMS USED :
+* S PNSTEP COMPUTATION OF THE BOUNDARY STEP.
+* S MXSPCB BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* S MXSPCD COMPUTATION OF A DIRECTION OF NEGATIVE CURVATURE USING
+* THE SPARSE DECOMPOSITION OBTAINED BY MXSPCF.
+* S MXSPCF GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
+* S MXSPCM MATRIX-VECTOR PRODUCT USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* RF MXSPCQ GENERALIZED DOT PRODUCT USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* S MXSPCT COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
+* FACTORIZED COMPACT SCHEME.
+* RF MXSSMQ COMPUTATION OF THE SPARSE QUADRATIC TERM.
+* S MXUCOP COPYING OF A VECTOR.
+* S MXUDIF DIFFERENCE OF TWO VECTORS.
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDOT DOT PRODUCT OF TWO VECTORS.
+* S MXUNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
+* S MXVSBP INVERSE PERMUTATION OF A VECTOR
+* S MXVSCL SCALING OF A VECTOR.
+* S MXVSET INITIATION OF A VECTOR.
+* S MXVSFP PERMUTATION OF A VECTOR.
+*
+* METHOD :
+* J.E.DENNIS, H.H.W.MEI: AN UNCONSTRAINED OPTIMIZATION ALGORITHM WHICH
+* USES FUNCTION AND GRADIENT VALUES. REPORT NO. TR-75-246, DEPT. OF
+* COMPUTER SCIENCE, CORNELL UNIVERSITY 1975.
+*
+ SUBROUTINE PDSGM1(NF,MMAX,MH,IX,G,H,IH,JH,S,XO,GO,XS,PSL,PERM,
+ & WN11,WN12,XMAX,XDEL,GNORM,SNORM,FMIN,F,P,PP,ETA2,ALF2,KD,KBF,
+ & IEST,IDEC,NDEC,ITERD,ITERM)
+ INTEGER NF,MMAX,MH,IX(*),IH(*),JH(*),PSL(*),PERM(*),WN11(*),
+ & WN12(*),KD,KBF,IEST,IDEC,NDEC,ITERD,ITERM
+ DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XS(*),XMAX,XDEL,
+ & GNORM,SNORM,FMIN,F,P,PP,ETA2,ALF2
+ INTEGER MM,INF,MODE
+ DOUBLE PRECISION B1,B2,B3,D3,S1,S2
+ DOUBLE PRECISION MXSSMQ,MXSPCQ,MXUDOT
+ SAVE INF
+*
+* DIRECTION DETERMINATION
+*
+ IF (IDEC.LT.0) IDEC=0
+ IF (IDEC.EQ.0) THEN
+ ELSE IF (IDEC.EQ.1) THEN
+ ELSE
+ ITERD=-1
+ GO TO 13130
+ END IF
+ MM=IH(NF+1)-1
+ B2=MXUDOT(NF,G,G,IX,KBF)
+ GNORM=SQRT(B2)
+ MODE=1
+ IF (ALF2*GNORM.LE.XDEL) THEN
+ MODE=2
+ IF (IDEC.EQ.0) THEN
+ CALL MXSPCT(NF,MM,MH,MMAX,H,JH,PSL,ITERM)
+ IF (ITERM.NE.0) GO TO 13130
+*
+* SPARSE GILL-MURRAY DECOMPOSITION
+*
+ S1=ETA2
+ CALL MXSPCF(NF,H(MM+1),PSL,JH(MM+1),WN11,WN12,XS,INF,S1,S2)
+ NDEC=NDEC+1
+ IDEC=1
+ END IF
+ IF (INF.GT.0) THEN
+ CALL MXSPCD(NF,H(MM+1),PSL,JH(MM+1),S,INF)
+ CALL MXVSBP(NF,PERM,S,XS)
+*
+* DIRECTION OF NEGATIVE CURVATURE
+*
+ SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
+ IF (SNORM*SNORM*GNORM+S1*XDEL.LE.0.0D 0) THEN
+ CALL MXVSCL(NF,XDEL/SNORM,S,S)
+ SNORM=XDEL
+ ITERD=4
+ GO TO 13120
+ END IF
+ ELSE IF (GNORM.LE.0.0D 0) THEN
+*
+* ZERO DIRECTION
+*
+ SNORM=0.0D 0
+ CALL MXVSET(NF,0.0D 0,S)
+ GO TO 13120
+ END IF
+ END IF
+ IF (IDEC.EQ.0) THEN
+ B1=MXSSMQ(NF,H,IH,JH,G,G)
+ ELSE
+ CALL MXUCOP(NF,G,GO,IX,KBF)
+ CALL MXVSFP(NF,PERM,GO,XS)
+ CALL MXSPCM(NF,H(MM+1),PSL,JH(MM+1),GO,XS,1)
+ B1=MXSPCQ(NF,H(MM+1),PSL,GO)
+ END IF
+ IF (XDEL.LE.0.0D 0) THEN
+*
+* INITIAL TRUST REGION BOUND
+*
+ IF (B1.LE.0.0D 0) THEN
+ XDEL=GNORM
+ ELSE
+ XDEL=(B2/B1)*GNORM
+ END IF
+ IF (IEST.EQ.1) XDEL=MIN(XDEL,4.0D 0*(F-FMIN)/GNORM)
+ XDEL=MIN(XDEL,XMAX)
+ END IF
+ IF (B1.LE.0.0D 0.OR.B2*GNORM.GE.B1*XDEL) THEN
+*
+* SCALED STEEPEST DESCENT DIRECTION IS ACCEPTED
+*
+ CALL MXVSCL(NF,-XDEL/GNORM,G,S)
+ SNORM=XDEL
+ ITERD=3
+ GO TO 13120
+ END IF
+ IF (IDEC.EQ.0) THEN
+ CALL MXSPCT(NF,MM,MH,MMAX,H,JH,PSL,ITERM)
+ IF (ITERM.NE.0) THEN
+ GO TO 13130
+ END IF
+*
+* SPARSE GILL-MURRAY DECOMPOSITION
+*
+ S1=ETA2
+ CALL MXSPCF(NF,H(MM+1),PSL,JH(MM+1),WN11,WN12,XS,INF,S1,S2)
+ NDEC=NDEC+1
+ IDEC=1
+ END IF
+*
+* COMPUTATION OF THE NEWTON DIRECTION
+*
+ CALL MXUCOP(NF,G,GO,IX,KBF)
+ CALL MXVSFP(NF,PERM,GO,XS)
+ CALL MXSPCB(NF,H(MM+1),PSL,JH(MM+1),GO,0)
+ CALL MXVSBP(NF,PERM,GO,XS)
+ D3=SQRT(MXUDOT(NF,GO,GO,IX,KBF))
+*
+* COMPUTATION OF THE STEEPEST DESCENT DIRECTION
+*
+ B2=B2/B1
+ SNORM=B2*GNORM
+ CALL MXVSCL(NF,-B2,G,S)
+ CALL MXUNEG(NF,GO,GO,IX,KBF)
+ CALL MXUDIF(NF,GO,S,XO,IX,KBF)
+ B1=MXUDOT(NF,S,XO,IX,KBF)
+ B2=MXUDOT(NF,XO,XO,IX,KBF)
+ IF (B2.LE.1.0D-8*XDEL*XDEL) THEN
+*
+* NEWTON AND THE STEEPEST DESCENT DIRECTION ARE
+* APPROXIMATELY EQUAL
+*
+ CALL MXUCOP(NF,GO,S,IX,KBF)
+ SNORM=D3
+ ITERD=1
+ ELSE IF (B1.LE.0.0D 0) THEN
+*
+* BOUNDARY STEP WITH NEGATIVE INCREMENT
+*
+ CALL PNSTEP(XDEL,SNORM,-B1,B2,B3)
+ CALL MXUDIR(NF,-B3,XO,S,S,IX,KBF)
+ SNORM=XDEL
+ ITERD=3
+ ELSE IF (D3.LE.XDEL) THEN
+*
+* NEWTON DIRECTION IS ACCEPTED
+*
+ CALL MXUCOP(NF,GO,S,IX,KBF)
+ SNORM=D3
+ ITERD=1
+ ELSE
+*
+* DOUBLE DOGLEG STRATEGY
+*
+ D3=XDEL/D3
+ B3=MXUDOT(NF,S,GO,IX,KBF)
+ D3=MAX(D3,SNORM*SNORM/B3)
+ CALL MXUDIR(NF,-D3,GO,S,XO,IX,KBF)
+ B1=SNORM*SNORM-D3*B3
+ B2=MXUDOT(NF,XO,XO,IX,KBF)
+ CALL PNSTEP(XDEL,SNORM,-B1,B2,B3)
+ CALL MXUDIR(NF,-B3,XO,S,S,IX,KBF)
+ SNORM=XDEL
+ ITERD=3
+ END IF
+13120 CONTINUE
+ IF (IDEC.EQ.0) THEN
+ PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D 0
+ ELSE
+ CALL MXUCOP(NF,S,GO,IX,KBF)
+ CALL MXVSFP(NF,PERM,GO,XS)
+ CALL MXSPCM(NF,H(MM+1),PSL,JH(MM+1),GO,XS,1)
+ PP=MXSPCQ(NF,H(MM+1),PSL,GO)*0.5D 0
+ IF (ITERD.EQ.1.AND.INF.NE.0) ITERD=2
+ END IF
+13130 CONTINUE
+ IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
+ RETURN
+ END
+* SUBROUTINE PDSGM4 ALL SYSTEMS 01/09/22
+* PURPOSE :
+* COMPUTATION OF A TRUST-REGION STEP BY THE SHIFTED STEIHAUG-TOINT
+* METHOD WITH CONJUGATE GRADIENT ITERATIONS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II MMAX MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
+* X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I).
+* IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
+* XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA H(MMAX) NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
+* HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
+* THE NUMERICAL DIFFERENTIATION.
+* II IH(NF+1) POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
+* IU JH(MMAX) INDICES OF NONZERO ELEMENTS OF THE MATRIX H
+* TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
+* DIFFERENTIATION.
+* RO S(NF) DIRECTION VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI GO(NF) GRADIENTS DIFFERENCE.
+* RA XS(NF) AUXILIARY VECTOR.
+* RA GS(NF) AUXILIARY VECTOR.
+* IA IW(NF+1) AUXILIARY VECTOR.
+* RI XMAX MAXIMUM STEPSIZE.
+* RU XDEL TRUST REGION RADIUS.
+* RO GNORM NORM OF THE GRADIENT VECTOR.
+* RO GNORMO OLD NORM OF THE GRADIENT VECTOR.
+* RO SNORM NORM OF THE DIRECTION VECTOR.
+* RI FMIN ESTIMATION OF THE MINIMUM FUNCTION VALUE.
+* RI F VALUE OF THE OBJECTIVE FUNCTION.
+* RO P VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO PP VALUE OF THE QUADRATIC TERM.
+* RI ETA0 MACHINE PRECISION.
+* RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS.
+* RI DEL1 LOWER TOLERANCE FOR THE TRUST-REGION RADIUS.
+* II KD ORDER OF COMPUTED DERIVATIVES.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* II MOS1 NUMBER OF LANCZOS STEPS IN THE SHIFTED STEIHAUG-TOINT
+* METHOD.
+* II MOS2 TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
+* USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
+* DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
+* GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
+* THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
+* THE TERMINATION CRITERION.
+* II MOS3 PRECONDITIONING IN ILL-CONTITIONED AND INDEFINITE CASES.
+* MOS3=0-PRECONDITIONING IN BOTH THESE CASES IS SUPPRESSED.
+* MOS3=1-PRECONDITIONING IN ILL-CONDITIONED CASE IS SUPPRESSED.
+* MOS3=2-PRECONDITIONING IS ALWAYS USED.
+* II IEST ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
+* IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
+* IU IDEC DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
+* IU NDEC NUMBER OF MATRIX DECOMPOSITIONS.
+* II NIT NUMBER OF OUTER ITERATIONS.
+* IU NIN NUMBER OF INNER CONJUGATE GRADIENT ITERATIONS.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO ITERM VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
+* ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
+* MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
+* MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
+* ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
+* ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
+* BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
+* ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
+* ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
+* VALUES ITERM<=-40 DETECT A LACK OF SPACE.
+*
+* SUBPROGRAMS USED :
+* S PNSTEP COMPUTATION OF THE BOUNDARY STEP.
+* S MXSPTB BACK SUBSTITUTION AFTER THE GILL-MURRAY DECOMPOSITION.
+* S MXSPTF INCOMPLETE GILL-MURRAY DECOMPOSITION.
+* S MXSSDA SPARSE SYMMETRIC MATRIX IS AUGMENTED BY THE SCALED UNIT
+* MATRIX.
+* S MXSSMD MATRIX-VECTOR PRODUCT FOLLOWED BY THE ADDITION OF A
+* SCALED VECTOR.
+* S MXSSMM MATRIX-VECTOR PRODUCT.
+* RF MXSSMQ COMPUTATION OF THE SPARSE QUADRATIC TERM.
+* S MXTPGB BACK SUBSTITUTION FOR A DECOMPOSED TRIDIAGONAL MATRIX.
+* S MXTPGF CHOLESKI DECOMPOSITION OF A TRIDIAGONAL MATRIX.
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDEL NORM OF VECTOR DIFFERENCE.
+* RF MXUDOT DOT PRODUCT OF TWO VECTORS.
+* RF MXUNOR EUCLIDEAN NORM OF A VECTOR.
+* S MXVCOP COPYING OF A VECTOR.
+* S MXVCOR CORRECTION OF A VECTOR (ZERO ELEMENTS ARE REPLACED BY
+* THE NONZERO NUMBER).
+* RF MXVDOT DOT PRODUCT OF TWO VECTORS.
+* S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
+* S MXVSCL SCALING OF A VECTOR.
+* S MXVSET INITIATION OF A VECTOR.
+* S MXVSUM SUM OF TWO VECTORS.
+* RF MXVVDP GENERALIZED DOT PRODUCT.
+*
+* METHOD :
+* L.LUKSAN, C.MATONOHA, J.VLCEK: A SHIFTED STEIHAUG-TOINT METHOD FOR
+* COMPUTING TRUST-REGION STEP. REPORT NO. V-914, INST. OF COMPUTER
+* SCIENCE, CZECH ACADEMY OF SCIENCES, 2004.
+*
+ SUBROUTINE PDSGM4(NF,MMAX,IX,G,H,IH,JH,S,XO,GO,XS,GS,IW,XMAX,
+ & XDEL,GNORM,GNORMO,SNORM,FMIN,F,P,PP,ETA0,ETA2,DEL1,KD,KBF,
+ & MOS1,MOS2,MOS3,IEST,IDEC,NDEC,NIT,NIN,ITERD,ITERM)
+ INTEGER NF,MMAX,IX(*),IH(*),JH(*),IW(*),KD,KBF,MOS1,MOS2,MOS3,
+ & IEST,IDEC,NDEC,NIT,NIN,ITERD,ITERM
+ DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XS(*),GS(*),XMAX,
+ & XDEL,GNORM,GNORMO,SNORM,FMIN,F,P,PP,ETA0,ETA2,DEL1
+ INTEGER NOS1,NOS2,NRED,I,M,INF
+ DOUBLE PRECISION T,EL,EU,PAR,ALF,EPS,RHO,RHO1,RHO2,SIG,TAU
+ DOUBLE PRECISION MXSSMQ,MXUDOT,MXUDEL,MXUNOR,MXVDOT,MXVVDP
+ SAVE EPS
+*
+* DIRECTION DETERMINATION
+*
+ IF (NIT.LE.1) THEN
+ EPS=0.9D 0
+ GNORMO=1.0D 60
+ END IF
+ IF (IDEC.LT.0) IDEC=0
+ IF (IDEC.NE.0.AND.IDEC.NE.1) THEN
+ ITERD=-1
+ GO TO 13180
+ END IF
+ GNORM=SQRT(MXUDOT(NF,G,G,IX,KBF))
+ IF (GNORM.GE.1.0D 3*GNORMO) EPS=1.0D-6
+ GNORMO=GNORM
+ RHO1=MXUDOT(NF,G,G,IX,KBF)
+ IF (XDEL.LE.0.0D 0) THEN
+*
+* INITIAL TRUST REGION BOUND
+*
+ RHO2=MXSSMQ(NF,H,IH,JH,G,G)
+ IF (RHO2.LE.0.0D 0) THEN
+ XDEL=GNORM
+ ELSE
+ XDEL=(GNORM*GNORM/RHO2)*GNORM
+ END IF
+ IF (IEST.EQ.1) XDEL=MIN(XDEL,4.0D 0*(F-FMIN)/GNORM)
+ XDEL=MIN(XDEL,XMAX)
+ END IF
+ PAR=MIN(EPS,SQRT(GNORM))
+ IF (PAR.GT.1.0D-2) THEN
+ PAR=MIN(PAR,1.0D 0/DBLE(NIT))
+ END IF
+ PAR=PAR*PAR
+ NOS1=MIN(NF,MOS1)
+ IF (NOS1.LE.1) THEN
+ T=0.0D 0
+ ELSE
+*
+* INCOMPLETE LANCZOS TRIDIAGONALIZATION
+*
+ INF=0
+ CALL MXVCOP(NF,G,XS)
+ CALL MXVSET(NF,0.0D 0,GS)
+ CALL MXVSCL(NF,1.0D 0/MXUNOR(NF,XS,IX,KBF),XS,XS)
+ DO 13111 NRED=1,NOS1
+ IF (NRED.GT.1) THEN
+ DO 13112 I=1,NF
+ EL=XS(I)
+ XS(I)=GS(I)/EU
+ GS(I)=-EU*EL
+13112 CONTINUE
+ END IF
+ CALL MXSSMD(NF,H,IH,JH,XS,1.0D 0,GS,GS)
+ EL=MXUDOT(NF,XS,GS,IX,KBF)
+ CALL MXUDIR(NF,-EL,XS,GS,GS,IX,KBF)
+ EU=MXUNOR(NF,GS,IX,KBF)
+ IF (EU.LE.0.0D 0) THEN
+ INF=NRED
+ GO TO 13116
+ END IF
+ XO(NRED)=EL
+ GO(NRED)=EU
+13111 CONTINUE
+13116 CONTINUE
+ CALL MXVCOR(NOS1,ETA0,XO)
+ T=0.0D 0
+ RHO2=DEL1*XDEL
+ DO 13117 NRED=1,10
+ T=MIN(T,1.0D 5)
+ IF (T.GE.1.0D 5) GO TO 13118
+*
+* SOLUTION OF THE TRIDIAGONAL SYSTEM
+*
+ ALF=ETA0
+ CALL MXVSET(NOS1,T,XS)
+ CALL MXVSUM(NOS1,XO,XS,XS)
+ CALL MXVCOP(NOS1,GO,GS)
+ CALL MXTPGF(NOS1,XS,GS,INF,ALF,TAU)
+ CALL MXVSET(NOS1,0.0D 0,S)
+ S(1)=GNORM
+ CALL MXTPGB(NOS1,XS,GS,S,0)
+ RHO=MXVDOT(NOS1,S,S)
+ IF (RHO.LE.XDEL**2) GO TO 13118
+ CALL MXTPGB(NOS1,XS,GS,S,1)
+*
+* MARQUARDT PARAMETER T IS COMPUTED USING THE ONE-DIMENSIONAL
+* NEWTON METHOD
+*
+ T=T+(RHO/MXVVDP(NOS1,XS,S,S))*((SQRT(RHO)-RHO2)/RHO2)
+13117 CONTINUE
+ END IF
+13118 CONTINUE
+ CALL MXVNEG(NF,G,XO)
+ NOS2=MOS2-1
+ IF (NOS2.GT.0) THEN
+*
+* INCOMPLETE GILL-MURRAY DECOMPOSITION
+*
+ ALF=ETA2
+ M=IH(NF+1)-1
+ IF (2*M.GE.MMAX) THEN
+ ITERM=-48
+ GO TO 13180
+ END IF
+ CALL MXVCOP(M,H,H(M+1))
+ IF (T.GT.0.0D 0) CALL MXSSDA(NF,H(M+1),IH,T)
+ CALL MXSPTF(NF,H(M+1),IH,JH,IW,INF,ALF,SIG)
+ IF (INF+10.LT.0) THEN
+ ITERM=-48
+ GO TO 13180
+ END IF
+ IF (MOS3.EQ.0) THEN
+ IF (INF.NE.0) NOS2=0
+ ELSE IF (MOS3.EQ.1) THEN
+ IF (INF.LT.0) NOS2=0
+ END IF
+ NDEC=NDEC+1
+ IDEC=1
+ IF (NOS2.GT.1) THEN
+*
+* PRELIMINARY INEXACT SOLUTION
+*
+ CALL MXSPTB(NF,H(M+1),IH,JH,XO,0)
+ SNORM=SQRT(MXUDOT(NF,XO,XO,IX,KBF))
+ IF (SNORM.LE.XDEL*1.0D 5) THEN
+ CALL MXVCOP(NF,XO,S)
+ IF (SNORM.LE.XDEL) THEN
+ ITERD=2
+ ELSE
+ CALL MXVSCL(NF,XDEL/SNORM,S,S)
+ SNORM=XDEL
+ ITERD=3
+ END IF
+ CALL MXSSMD(NF,H,IH,JH,S,1.0D 0,G,GO)
+ IF (MXUDOT(NF,GO,GO,IX,KBF).LE.1.0D-2*PAR*RHO1) GO TO 13180
+ END IF
+ END IF
+ END IF
+*
+* CG INITIATION
+*
+ RHO=RHO1
+ SNORM=0.0D 0
+ CALL MXVSET(NF,0.0D 0,S)
+ CALL MXVNEG(NF,G,XS)
+ IF (NOS2.EQ.0) THEN
+ ELSE IF (NOS2.EQ.1) THEN
+ CALL MXSPTB(NF,H(M+1),IH,JH,XO,0)
+ RHO=MXUDOT(NF,XS,XO,IX,KBF)
+ ELSE
+ RHO=MXUDOT(NF,XS,XO,IX,KBF)
+ END IF
+ DO 13120 NRED=1,NF+3
+ IF (T.GT.0.0D 0) THEN
+ CALL MXSSMD(NF,H,IH,JH,XO,T,XO,GO)
+ ELSE
+ CALL MXSSMM(NF,H,IH,JH,XO,GO)
+ END IF
+ ALF=MXUDOT(NF,XO,GO,IX,KBF)
+ IF (ALF.LE.0.0D 0) GO TO 13160
+ ALF=RHO/ALF
+ RHO2=SQRT(MXUDEL(NF,ALF,XO,S,IX,KBF))
+ IF (RHO2.GE.XDEL) GO TO 13160
+*
+* CG STEP
+*
+ CALL MXUDIR(NF, ALF,XO,S,S,IX,KBF)
+ CALL MXUDIR(NF,-ALF,GO,XS,XS,IX,KBF)
+ NIN=NIN+1
+ SNORM=RHO2
+ RHO2=MXUDOT(NF,XS,XS,IX,KBF)
+ IF (RHO2.LE.PAR*RHO1) GO TO 13150
+ IF (NRED.GE.NF+3) GO TO 13150
+ IF (NOS2.NE.0) THEN
+ CALL MXVCOP(NF,XS,GO)
+ CALL MXSPTB(NF,H(M+1),IH,JH,GO,0)
+ RHO2=MXUDOT(NF,XS,GO,IX,KBF)
+ ALF=RHO2/RHO
+ CALL MXUDIR(NF,ALF,XO,GO,XO,IX,KBF)
+ ELSE
+ ALF=RHO2/RHO
+ CALL MXUDIR(NF,ALF,XO,XS,XO,IX,KBF)
+ END IF
+ RHO=RHO2
+13120 CONTINUE
+*
+* AN INEXACT SOLUTION IS OBTAINED
+*
+13150 CONTINUE
+ SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
+ ITERD=2
+ GO TO 13180
+*
+* BOUNDARY STEP IS COMPUTED
+*
+13160 CONTINUE
+ RHO1=MXUDOT(NF,XO,S,IX,KBF)
+ RHO2=MXUDOT(NF,XO,XO,IX,KBF)
+ CALL PNSTEP(XDEL,SNORM,RHO1,RHO2,ALF)
+ CALL MXUDIR(NF,ALF,XO,S,S,IX,KBF)
+ SNORM=XDEL
+ ITERD=3
+ NRED=-NRED
+13180 CONTINUE
+ PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D 0
+ IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
+ RETURN
+ END
+* SUBROUTINE PDSGM7 ALL SYSTEMS 01/09/22
+* PURPOSE :
+* COMPUTATION OF A TRUST-REGION STEP BY THE MORE-SORENSEN METHOD WITH
+* DIRECT MATRIX DECOMPOSITIONS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II MMAX MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
+* II MH POINTER OBTAINED BY THE SUBROUTINE MXSPCC.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
+* X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I).
+* IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
+* XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA H(MMAX) NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
+* HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
+* THE NUMERICAL DIFFERENTIATION.
+* II IH(NF+1) POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
+* IU JH(MMAX) INDICES OF NONZERO ELEMENTS OF THE MATRIX H
+* TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
+* DIFFERENTIATION.
+* RO S(NF) DIRECTION VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI GO(NF) GRADIENTS DIFFERENCE.
+* II PSL(NF+1) POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION.
+* IA PERM(NF) PERMUTATION VECTOR.
+* IA WN11(NF+1) AUXILIARY VECTOR.
+* IA WN12(NF+1) AUXILIARY VECTOR.
+* RI XMAX MAXIMUM STEPSIZE.
+* RI XDEL TRUST REGION RADIUS.
+* RO XDELO OLD TRUST REGION RADIUS.
+* RO GNORM NORM OF THE GRADIENT VECTOR.
+* RO SNORM NORM OF THE DIRECTION VECTOR.
+* RI FMIN ESTIMATION OF THE MINIMUM FUNCTION VALUE.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RO P VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO PP VALUE OF THE QUADRATIC TERM.
+* RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS.
+* RI DEL1 LOWER TOLERANCE FOR THE TRUST-REGION RADIUS.
+* RI DEL2 UPPER TOLERANCE FOR THE TRUST-REGION RADIUS.
+* II KD ORDER OF COMPUTED DERIVATIVES.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* II IEST ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
+* IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
+* II IDIR TRUST-REGION CHANGE INDICATOR.
+* IU IDEC DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
+* IU NDEC NUMBER OF MATRIX DECOMPOSITIONS.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO ITERM VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
+* ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
+* MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
+* MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
+* ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
+* ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
+* BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
+* ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
+* ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
+* VALUES ITERM<=-40 DETECT A LACK OF SPACE.
+*
+* SUBPROGRAMS USED :
+* S PNSTEP COMPUTATION OF THE BOUNDARY STEP.
+* S MXSPCA ADDITION OF THE LEVENBERG-MARQUARDT TERM TO THE SPARSE
+* SYMMETRIC MATRIX.
+* S MXSPCB BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* S MXSPCD COMPUTATION OF A DIRECTION OF NEGATIVE CURVATURE USING
+* THE SPARSE DECOMPOSITION OBTAINED BY MXSPCF.
+* S MXSPCF GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
+* S MXSPCN ESTIMATION OF THE MINIMUM EIGENVALUE AND THE
+* CORRESPONDING EIGENVECTOR OF A SYMMETRIC MATRIX USING THE
+* SPARSE DECOMPOSITION OBTAINED BY MXSPCF.
+* RF MXSPCP GENERALIZED DOT PRODUCT USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* S MXSPCT COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
+* FACTORIZED COMPACT SCHEME.
+* RF MXSSDL DETERMINATION OF A MINIMUM DIAGONAL ELEMENT OF A SPARSE
+* SYMMETRIC MATRIX.
+* S MXSSMG GERSHGORIN BOUNDS FOR EIGENVALUES OF A SPARSE SYMMETRIC
+* MATRIX
+* RF MXSSMQ COMPUTATION OF THE SPARSE QUADRATIC TERM.
+* S MXUCOP COPYING OF A VECTOR.
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDOT DOT PRODUCT OF TWO VECTORS.
+* S MXUNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
+* S MXVSBP INVERSE PERMUTATION OF A VECTOR
+* S MXVSFP PERMUTATION OF A VECTOR.
+*
+* METHOD :
+* J.J.MORE, D.C.SORENSEN: COMPUTING A TRUST REGION STEP. REPORT NO.
+* ANL-81-83, ARGONNE NATIONAL LAB. 1981.
+*
+ SUBROUTINE PDSGM7(NF,MMAX,MH,IX,G,H,IH,JH,S,XO,GO,PSL,PERM,WN11,
+ & WN12,XMAX,XDEL,XDELO,GNORM,SNORM,FMIN,F,P,PP,ETA2,DEL1,DEL2,KD,
+ & KBF,IEST,IDIR,IDEC,NDEC,ITERD,ITERM)
+ INTEGER NF,MMAX,MH,IX(*),IH(*),JH(*),PSL(*),PERM(*),WN11(*),
+ & WN12(*),KD,KBF,IEST,IDIR,IDEC,NDEC,ITERD,ITERM
+ DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XMAX,XDEL,XDELO,
+ & GNORM,SNORM,FMIN,F,P,PP,ETA2,DEL1,DEL2
+ INTEGER NRED,MM,INF,MODE
+ DOUBLE PRECISION T,TL,TU,E,EL,EU,ALF,RHO,RHO1,RHO2,CON
+ DOUBLE PRECISION MXSSMQ,MXSPCP,MXSSDL,MXUDOT
+ SAVE T,TL,TU,E,EL,EU
+*
+* DIRECTION DETERMINATION
+*
+ IF (IDEC.LT.0) IDEC=0
+ IF (IDEC.NE.0) THEN
+ ITERD=-1
+ GO TO 13250
+ END IF
+ MM=IH(NF+1)-1
+ GNORM=SQRT(MXUDOT(NF,G,G,IX,KBF))
+ IF (XDEL.LE.0.0D 0) THEN
+*
+* INITIAL TRUST REGION BOUND
+*
+ RHO1=MXSSMQ(NF,H,IH,JH,G,G)
+ RHO2=GNORM*GNORM
+ IF (RHO1.LE.0.0D 0) THEN
+ XDEL=GNORM
+ ELSE
+ XDEL=(RHO2/RHO1)*GNORM
+ END IF
+ IF (IEST.EQ.1) XDEL=MIN(XDEL,4.0D 0*(F-FMIN)/GNORM)
+ XDEL=MIN(XDEL,XMAX)
+ END IF
+*
+* INITIAL BOUNDS FOR THE PARAMETER T
+*
+ NRED=0
+ IF (IDIR.LE.0) THEN
+ T=0.0D 0
+ E=-MXSSDL(NF,H,IH,JH,INF)
+ CALL MXSSMG(NF,H,IH,JH,EL,EU,S)
+ TL=GNORM/XDEL-EU
+ TU=GNORM/XDEL-EL
+ ELSE IF (IDIR.EQ.1) THEN
+ T=T*XDELO/XDEL
+ TL=MAX(TL,GNORM/XDEL-EU)
+ TU=GNORM/XDEL-EL
+ ELSE IF (IDIR.EQ.2) THEN
+ T=T*XDELO/XDEL
+ TL=GNORM/XDEL-EU
+ TU=MIN(TU,GNORM/XDEL-EL)
+ END IF
+ TL=MAX(TL,0.0D 0,E)
+ TU=MAX(TL,TU)
+ T=MAX(T,TL)
+ T=MIN(T,TU)
+13220 CONTINUE
+ TL=MAX(TL,E)
+ IF (T.LE.E.AND.NRED.NE.0) THEN
+*
+* THE PARAMETER T IS SHIFTED
+*
+ T=SQRT(TL*TU)
+ T=MAX(T,TL+0.1D 0*(TU-TL))
+ T=MIN(T,TL+0.9D 0*(TU-TL))
+ END IF
+ ALF=ETA2
+ CALL MXSPCT(NF,MM,MH,MMAX,H,JH,PSL,ITERM)
+ IF (ITERM.NE.0) THEN
+ GO TO 13250
+ END IF
+*
+* SPARSE GILL-MURRAY DECOMPOSITION
+*
+ CALL MXSPCA(NF,MM,MH,H,IH,JH,T)
+ CALL MXSPCF(NF,H(MM+1),PSL,JH(MM+1),WN11,WN12,GO,INF,ALF,RHO)
+ NDEC=NDEC+1
+ IF (INF.GT.0) THEN
+*
+* NEW ESTIMATION E IS COMPUTED (THE MATRIX IS NOT POSITIVE DEFINITE)
+*
+ IF (E.GE.TU) THEN
+ ITERD=-2
+ GO TO 13250
+ ELSE
+ MODE=2
+ CALL MXSPCD(NF,H(MM+1),PSL,JH(MM+1),S,INF)
+ CALL MXVSBP(NF,PERM,S,GO)
+ E=MAX(E,T-ALF/MXUDOT(NF,S,S,IX,KBF))
+ NRED=NRED+1
+ GO TO 13220
+ END IF
+ ELSE
+*
+* STEP S IS COMPUTED
+*
+ CALL MXUNEG(NF,G,S,IX,KBF)
+ CALL MXVSFP(NF,PERM,S,GO)
+ CALL MXSPCB(NF,H(MM+1),PSL,JH(MM+1),S,0)
+ CALL MXVSBP(NF,PERM,S,GO)
+ SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
+ MODE=1
+ END IF
+ IF (TU-TL.LE.1.0D-8) THEN
+*
+* INTERVAL IS TOO SMALL
+*
+ IF (T.NE.0.0D 0) THEN
+ ITERD=5
+ ELSE
+ ITERD=1
+ END IF
+ GO TO 13240
+ ELSE IF (NRED.GE.20) THEN
+*
+* MAXIMUM NUMBER OF OLC REDUCTIONS
+*
+ ITERD=6
+ GO TO 13240
+ ELSE IF (SNORM.GT.DEL2*XDEL) THEN
+*
+* STEP IS TOO LARGE
+*
+ TL=MAX(TL,T)
+ GO TO 13230
+ ELSE IF (SNORM.LT.DEL1*XDEL) THEN
+ IF (T.NE.0.0D 0) THEN
+*
+* STEP IS TOO SMAL
+*
+ TU=MIN(TU,T)
+ ELSE
+*
+* STEP IS ACCEPTABLE
+*
+ ITERD=1
+ GO TO 13240
+ END IF
+ ELSE
+ ITERD=3
+ GO TO 13240
+ END IF
+*
+* TRYING TO USE BOUNDARY STEP
+*
+ CALL MXSPCN(NF,H(MM+1),PSL,JH(MM+1),XO,RHO,1)
+ CALL MXVSBP(NF,PERM,XO,GO)
+ RHO1=MXUDOT(NF,XO,S,IX,KBF)
+ RHO2=MXUDOT(NF,XO,XO,IX,KBF)
+ CALL PNSTEP(XDEL,SNORM,ABS(RHO1),RHO2,ALF)
+ CON=(1.0D 0-DEL1)*(1.0D 0+DEL1)
+ IF (ALF*ALF*RHO.LE.CON*(T*XDEL*XDEL-MXUDOT(NF,G,S,IX,KBF))) THEN
+ IF (RHO1.LT.0.0D 0) ALF=-ALF
+ CALL MXUDIR(NF,ALF,XO,S,S,IX,KBF)
+ SNORM=XDEL
+ ITERD=3
+ GO TO 13240
+ ELSE
+ E=MAX(E,T-RHO)
+ END IF
+13230 CONTINUE
+ IF (GNORM.LE.0.0D 0) THEN
+ T=E
+ ELSE
+*
+* NEW T IS COMPUTED USING ONE STEP OF THE NEWTON METHOD FOR
+* NONLINEAR EQUATION
+*
+ CALL MXUCOP(NF,S,XO,IX,KBF)
+ CALL MXVSFP(NF,PERM,XO,GO)
+ CALL MXSPCB(NF,H(MM+1),PSL,JH(MM+1),XO,1)
+ T=T+(SNORM*SNORM/MXSPCP(NF,H(MM+1),PSL,XO))*(SNORM-XDEL)/XDEL
+ CALL MXVSBP(NF,PERM,XO,GO)
+ END IF
+ NRED=NRED+1
+ GO TO 13220
+13240 CONTINUE
+ PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D 0
+13250 CONTINUE
+ IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
+ RETURN
+ END
+* SUBROUTINE PDSLM1 ALL SYSTEMS 01/09/22
+* PURPOSE :
+* DIRECTION DETERMINATION FOR LINE SEARCH USING DIRECT MATRIX
+* DECOMPOSITIONS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II MMAX MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
+* II MH POINTER OBTAINED BY THE SUBROUTINE MXSPCC.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
+* X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I).
+* IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
+* XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA H(MMAX) NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
+* HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
+* THE NUMERICAL DIFFERENTIATION.
+* II IH(NF+1) POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
+* IU JH(MMAX) INDICES OF NONZERO ELEMENTS OF THE MATRIX H
+* TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
+* DIFFERENTIATION.
+* RO S(NF) DIRECTION VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* II PSL(NF+1) POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
+* FACTOR OF THE HESSIAN APPROXIMATION.
+* IA PERM(NF) PERMUTATION VECTOR.
+* IA WN11(NF+1) AUXILIARY VECTOR.
+* IA WN12(NF+1) AUXILIARY VECTOR.
+* RO GNORM NORM OF THE GRADIENT VECTOR.
+* RO SNORM NORM OF THE DIRECTION VECTOR.
+* RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* IU IDEC DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
+* IU NDEC NUMBER OF MATRIX DECOMPOSITIONS.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO ITERM VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
+* ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
+* MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
+* MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
+* ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
+* ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
+* BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
+* ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
+* ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
+* VALUES ITERM<=-40 DETECT A LACK OF SPACE.
+*
+* SUBPROGRAMS USED :
+* S MXSPCB BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* S MXSPCF GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
+* S MXSPCT COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
+* FACTORIZED COMPACT SCHEME.
+* RF MXUDOT DOT PRODUCT OF TWO VECTORS.
+* S MXUNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
+* S MXVSBP INVERSE PERMUTATION OF A VECTOR
+* S MXVSFP PERMUTATION OF A VECTOR.
+*
+ SUBROUTINE PDSLM1(NF,MMAX,MH,IX,G,H,IH,JH,S,XO,PSL,PERM,WN11,
+ & WN12,GNORM,SNORM,ETA2,KBF,IDEC,NDEC,ITERD,ITERM)
+ INTEGER NF,MMAX,MH,IX(*),IH(*),JH(*),PSL(*),PERM(*),WN11(*),
+ & WN12(*),KBF,IDEC,NDEC,ITERD,ITERM
+ DOUBLE PRECISION G(*),H(*),S(*),XO(*),GNORM,SNORM,ETA2
+ INTEGER MM,INF
+ DOUBLE PRECISION ALF,BET
+ DOUBLE PRECISION MXUDOT
+*
+* DIRECTION DETERMINATION
+*
+ IF (IDEC.LT.0) IDEC=0
+ MM=IH(NF+1)-1
+ IF (IDEC.EQ.0) THEN
+ CALL MXSPCT(NF,MM,MH,MMAX,H,JH,PSL,ITERM)
+ IF (ITERM.NE.0) RETURN
+*
+* SPARSE GILL-MURRAY DECOMPOSITION
+*
+ ALF=ETA2
+ CALL MXSPCF(NF,H(MM+1),PSL,JH(MM+1),WN11,WN12,XO,INF,ALF,BET)
+ NDEC=NDEC+1
+ IDEC=1
+ ELSE IF (IDEC.EQ.1) THEN
+ ELSE
+ ITERD=-1
+ RETURN
+ END IF
+ GNORM=SQRT(MXUDOT(NF,G,G,IX,KBF))
+*
+* NEWTON LIKE STEP
+*
+ CALL MXUNEG(NF,G,S,IX,KBF)
+ CALL MXVSFP(NF,PERM,S,XO)
+ CALL MXSPCB(NF,H(MM+1),PSL,JH(MM+1),S,0)
+ CALL MXVSBP(NF,PERM,S,XO)
+ ITERD=1
+ SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
+ RETURN
+ END
+* SUBROUTINE PDSLM3 ALL SYSTEMS 01/09/22
+* PURPOSE :
+* DIRECTION DETERMINATION FOR LINE SEARCH USING CONJUGATE GRADIENT
+* ITERATIONS.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II M NUMBER OF NONZERO ELEMENTS IN THE HESSIAN MATRIX.
+* II MMAX MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
+* X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I).
+* IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
+* XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA H(MMAX) NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
+* HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
+* THE NUMERICAL DIFFERENTIATION.
+* II IH(NF+1) POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
+* IU JH(MMAX) INDICES OF NONZERO ELEMENTS OF THE MATRIX H
+* TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
+* DIFFERENTIATION.
+* RO S(NF) DIRECTION VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI GO(NF) GRADIENTS DIFFERENCE.
+* RA XS(NF) AUXILIARY VECTOR.
+* RA IW(NF+1) AUXILIARY VECTOR.
+* RO GNORM NORM OF THE GRADIENT VECTOR.
+* RO SNORM NORM OF THE DIRECTION VECTOR.
+* RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS.
+* RI ETA9 MAXIMUM FOR REAL NUMBERS.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* II MOS2 TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
+* USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
+* DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
+* GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
+* THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
+* THE TERMINATION CRITERION.
+* IU IDEC DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
+* IU NDEC NUMBER OF MATRIX DECOMPOSITIONS.
+* II NIT NUMBER OF OUTER ITERATIONS.
+* IU NIN NUMBER OF INNER CONJUGATE GRADIENT ITERATIONS.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO ITERM VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
+* ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
+* MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
+* MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
+* ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
+* ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
+* ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
+* BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
+* ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
+* ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
+* VALUES ITERM<=-40 DETECT A LACK OF SPACE.
+*
+* SUBPROGRAMS USED :
+* S MXSPTB BACK SUBSTITUTION AFTER THE GILL-MURRAY DECOMPOSITION.
+* S MXSPTF INCOMPLETE GILL-MURRAY DECOMPOSITION.
+* S MXSSMD MATRIX-VECTOR PRODUCT FOLLOWED BY THE ADDITION OF A
+* SCALED VECTOR.
+* S MXSSMM MATRIX-VECTOR PRODUCT.
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDOT DOT PRODUCT OF TWO VECTORS.
+* S MXVCOP COPYING OF A VECTOR.
+* S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE PDSLM3(NF,M,MMAX,IX,G,H,IH,JH,S,XO,GO,XS,IW,GNORM,
+ & SNORM,ETA2,ETA9,KBF,MOS2,IDEC,NDEC,NIT,NIN,ITERD,ITERM)
+ INTEGER NF,M,MMAX,IX(*),IH(*),JH(*),IW(*),KBF,MOS2,IDEC,NDEC,
+ & NIT,NIN,ITERD,ITERM
+ DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XS(*),GNORM,SNORM,
+ & ETA2,ETA9
+ INTEGER NOS2,NRED,MMX,INF
+ DOUBLE PRECISION PAR,ALF,EPS,RHO,RHO1,RHO2,SIG
+ DOUBLE PRECISION MXUDOT
+ SAVE EPS
+*
+* DIRECTION DETERMINATION
+*
+ IF (NIT.LE.1) THEN
+ EPS=0.9D 0
+ END IF
+ NOS2=MOS2-1
+ IF (IDEC.LT.0) IDEC=0
+ IF (IDEC.NE.0.AND.IDEC.NE.1) THEN
+ ITERD=-1
+ RETURN
+ ELSE IF (IDEC.EQ.0) THEN
+ IF (MOS2.GT.1) THEN
+*
+* INCOMPLETE GILL-MURRAY DECOMPOSITION
+*
+ ALF=ETA2
+ IF (2*M.GE.MMAX) THEN
+ ITERM=-48
+ RETURN
+ END IF
+ CALL MXVCOP(M,H,H(M+1))
+ CALL MXSPTF(NF,H(M+1),IH,JH,IW,INF,ALF,SIG)
+ IF (INF+10.LT.0) THEN
+ ITERM=-48
+ RETURN
+ END IF
+ IF (INF.NE.0) NOS2=0
+ NDEC=NDEC+1
+ IDEC=1
+ END IF
+ END IF
+ RHO1=MXUDOT(NF,G,G,IX,KBF)
+ GNORM=SQRT(RHO1)
+ PAR=MIN(EPS,SQRT(GNORM))
+ IF (PAR.GT.1.0D-2) THEN
+ PAR=MIN(PAR,1.0D 0/DBLE(NIT))
+ END IF
+ PAR=PAR*PAR
+ IF (MOS2.GT.2) THEN
+*
+* PRELIMINARY INEXACT SOLUTION
+*
+ CALL MXVNEG(NF,G,XO)
+ IF (NOS2.NE.0) THEN
+ CALL MXSPTB(NF,H(M+1),IH,JH,XO,0)
+ CALL MXVCOP(NF,XO,S)
+ CALL MXSSMD(NF,H,IH,JH,S,1.0D 0,G,GO)
+ IF (MXUDOT(NF,GO,GO,IX,KBF).LE.1.0D-2*PAR*RHO1) THEN
+ SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
+ ITERD=2
+ RETURN
+ END IF
+ END IF
+ END IF
+*
+* CG INITIATION
+*
+ RHO=RHO1
+ SNORM=0.0D 0
+ CALL MXVSET(NF,0.0D 0,S)
+ CALL MXVNEG(NF,G,XS)
+ IF (NOS2.EQ.0) THEN
+ CALL MXVNEG(NF,G,XO)
+ ELSE IF (MOS2.GT.2) THEN
+ RHO=MXUDOT(NF,XS,XO,IX,KBF)
+ ELSE
+ CALL MXVNEG(NF,G,XO)
+ CALL MXSPTB(NF,H(M+1),IH,JH,XO,0)
+ RHO=MXUDOT(NF,XS,XO,IX,KBF)
+ END IF
+C SIG=RHO
+ MMX=NF+3
+ DO 10 NRED=1,MMX
+ CALL MXSSMM(NF,H,IH,JH,XO,GO)
+ ALF=MXUDOT(NF,XO,GO,IX,KBF)
+ IF (ALF.LE.1.0D 0/ETA9) THEN
+C IF (ALF.LE.1.0D-8*SIG) THEN
+*
+* CG FAILS (THE MATRIX IS NOT POSITIVE DEFINITE)
+*
+ IF (NRED.EQ.1) THEN
+ CALL MXVNEG(NF,G,S)
+ SNORM=GNORM
+ END IF
+ ITERD=0
+ RETURN
+ ELSE
+ ITERD=2
+ END IF
+*
+* CG STEP
+*
+ ALF=RHO/ALF
+ CALL MXUDIR(NF, ALF,XO,S,S,IX,KBF)
+ CALL MXUDIR(NF,-ALF,GO,XS,XS,IX,KBF)
+ NIN=NIN+1
+ RHO2=MXUDOT(NF,XS,XS,IX,KBF)
+ SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
+ IF (RHO2.LE.PAR*RHO1) RETURN
+ IF (NRED.GE.MMX) RETURN
+ IF (NOS2.NE.0) THEN
+ CALL MXVCOP(NF,XS,GO)
+ CALL MXSPTB(NF,H(M+1),IH,JH,GO,0)
+ RHO2=MXUDOT(NF,XS,GO,IX,KBF)
+ ALF=RHO2/RHO
+ CALL MXUDIR(NF,ALF,XO,GO,XO,IX,KBF)
+ ELSE
+ ALF=RHO2/RHO
+ CALL MXUDIR(NF,ALF,XO,XS,XO,IX,KBF)
+ END IF
+ RHO=RHO2
+C SIG=RHO2+ALF*ALF*SIG
+ 10 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PF1HS2 ALL SYSTEMS 99/12/01
+* PURPOSE :
+* NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE MODEL FUNCTION
+* USING ITS GRADIENTS - SPARSE VERSION USING DIRECT COLOURING METHOD.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II ML SIZE OF THE COMPACT FACTOR.
+* II M NUMBER OF NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RA XO(NF) AUXILIARY VECTOR.
+* RO HF(M) HESSIAN MATRIX OF THE MODEL FUNCTION.
+* IU IH(NF+1) POINTER VECTOR OF SPARSE HESSIAN MATRIX.
+* IU JH(M) INDEX VECTOR OF THE HESSIAN MATRIX.
+* RI GF(NF) GRADIENT OF THE MODEL FUNCTION.
+* RA GO(NF) AUXILIARY VECTOR.
+* II COL(NF) VECTOR DISCERNING GROUPS OF THE HESSIAN COLUMN OF THE
+* SAME COLOUR.
+* IA WN11(NF+1) AUXILIARY VECTOR.
+* IA WN12(NF+1) AUXILIARY VECTOR.
+* RA XS(NF) AUXILIARY VECTOR USED FOR STEP SIZES.
+* RI FF VALUE OF THE MODEL FUNCTION.
+* RI ETA1 PRECISION OF THE COMPUTED VALUES.
+* II KBF TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
+* BOUNDS. KBF=2-TWO SIDED BOUNDS.
+* IU ITERM TERMINATION INDICATOR.
+* IU ISYS CONTROL PARAMETER.
+*
+* SUBPROGRAMS USED :
+* S MXSTG1 WIDTHEN THE STRUCTURE.
+* S MXSTL2 SHRINK THE STRUCTURE.
+* S MXVCOP COPYING OF A VECTOR.
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE PF1HS2(NF,ML,M,X,IX,XO,HF,IH,JH,GF,GO,COL,WN11,
+ & WN12,XS,FF,ETA1,KBF,ITERM,ISYS)
+ INTEGER NF,ML,M,IX(*),IH(*),JH(*),COL(*),WN11(*),
+ & WN12(*),KBF,ITERM,ISYS
+ DOUBLE PRECISION X(*),XO(*),HF(*),GF(*),GO(*),XS(*),
+ & FF,ETA1
+ DOUBLE PRECISION XTEMP,FTEMP,ETA
+ INTEGER I,J,J1,K,K1,L,MX,MM,IVAR,JVAR
+ SAVE MX,MM,IVAR,JVAR
+ SAVE XTEMP,FTEMP,ETA
+ IF (ITERM.NE.0) GO TO 12
+ IF (ISYS.EQ.1) GO TO 3
+ MM=IH(NF+1)-1
+ IF (3*MM-NF+ML.GE.M) THEN
+ ITERM=-45
+ ISYS=0
+ RETURN
+ END IF
+ ETA=SQRT(ETA1)
+ FTEMP=FF
+ CALL MXVCOP(NF,X,XO)
+*
+* WIDTHEN THE STRUCTURE
+*
+ K=2*MM-NF
+ DO 50 I=ML+MM,1,-1
+ JH(K+I)=JH(MM+I)
+ 50 CONTINUE
+ CALL MXSTG1(NF,MX,IH,JH,WN12,WN11)
+ CALL MXVSET(K,0.0D 0,HF)
+ IVAR=1
+ 2 CONTINUE
+ IF (IVAR.GT.NF) GO TO 870
+ DO 200 J=IVAR,NF
+ IF (COL(J).GE.1) THEN
+ GO TO 200
+ ELSE
+ JVAR=J
+ GO TO 300
+ END IF
+ 200 CONTINUE
+ 300 CONTINUE
+ DO 400 J=IVAR,JVAR
+ L=ABS(COL(J))
+ IF (KBF.GT.0) THEN
+ IF (IX(L).LE.-7) GO TO 400
+ END IF
+*
+* STEP SELECTION
+*
+ XS(L)=ETA*MAX(ABS(X(L)),1.0D 0)*SIGN(1.0D 0,X(L))
+ XTEMP=X(L)
+ X(L)=XTEMP+XS(L)
+ XS(L)=X(L)-XTEMP
+ 400 CONTINUE
+ ISYS=1
+ RETURN
+ 3 CONTINUE
+*
+* NUMERICAL DIFFERENTIATION
+*
+*
+* SET AUXILIARY VECTOR DISCERNING THE SINGLETONS IN A GROUP TO ZERO
+*
+ DO 450 J1=1,NF
+ WN11(J1)=0
+ 450 CONTINUE
+*
+* DISCERN SINGLETONS OF THE GROUP OF THE SAME COLOR.
+*
+ DO 600 J1=IVAR,JVAR
+ L=ABS(COL(J1))
+ DO 500 K=IH(L),IH(L+1)-1
+ K1=ABS(JH(K))
+ IF (WN11(K1).EQ.0) THEN
+ WN11(K1)=J1
+ ELSE
+ WN11(K1)=-1
+ END IF
+ 500 CONTINUE
+ 600 CONTINUE
+*
+* NUMERICAL VALUES COMPUTATION
+*
+ DO 800 J1=IVAR,JVAR
+ L=ABS(COL(J1))
+ DO 700 K=IH(L),IH(L+1)-1
+ K1=ABS(JH(K))
+ IF (WN11(K1).GT.0) THEN
+ HF(K)=(GF(K1)-GO(K1))/XS(L)
+ END IF
+ 700 CONTINUE
+ 800 CONTINUE
+*
+* SET THE ORIGINAL VALUE OF X FOR THE COMPONENTS OF THE ACTUAL COLOR.
+*
+ DO 850 J=IVAR,JVAR
+ L=ABS(COL(J))
+ X(L)=XO(L)
+ 850 CONTINUE
+ IVAR=JVAR+1
+ GO TO 2
+ 870 CONTINUE
+*
+* MOVE THE ELEMENTS OF THE HESSIAN APPROXIMATION INTO THE UPPER
+* TRIANGULAR PART
+*
+ DO 900 I=1,NF
+ WN11(I)=WN12(I)+1
+ 900 CONTINUE
+ DO 1100 I=1,NF
+ IVAR=IH(I)
+ JVAR=WN12(I)-1
+ DO 1000 J=IVAR,JVAR
+ K=ABS(JH(J))
+ L=WN11(K)
+ IF (HF(L).EQ.0) THEN
+ HF(L)=HF(J)
+ ELSE IF (HF(L).NE.0.AND.HF(J).NE.0) THEN
+ HF(L)=0.5D 0*(HF(J)+HF(L))
+ END IF
+ WN11(K)=WN11(K)+1
+ 1000 CONTINUE
+ 1100 CONTINUE
+ FF=FTEMP
+*
+* SHRINK THE STRUCTURE
+*
+ CALL MXSTL2(NF,MX,HF,IH,JH,WN12)
+ K=2*MM-NF
+ DO 1200 I=1,ML+MM
+ JH(MM+I)=JH(K+I)
+ 1200 CONTINUE
+*
+* RETRIEVE VALUES
+*
+ CALL MXVCOP(NF,XO,X)
+ 12 CONTINUE
+ ISYS=0
+ RETURN
+ END
+* SUBROUTINE PFSEB4 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE PARTITIONED HESSIAN
+* MATRIX.
+*
+* PARAMETERS :
+* II NC NUMBER OF CONSTRAINTS.
+* RU B(M) ELEMENTS OF THE SPARSE MATRIX B.
+* IO IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF B.
+* IO JH(M) INDICES OF THE NONZERO ELEMENTS OF B.
+* II CH(MB) ELEMENTS OF THE PARTITIONED MATRIX H.
+* II ICG(NC+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JCG(MC) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* II ICA(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS.
+* RI CZL(NC) VECTOR CONTAINING LOWER MULTIPLIERS FOR CONSTRAINTS.
+* RI CZU(NC) VECTOR CONTAINING UPPER MULTIPLIERS FOR CONSTRAINTS.
+* II JOB SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
+* JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
+* LAGRANGIAN MULTIPLIERS. JOB-2-ACTIVE TERMS OF THE LAGRANGIAN
+* FUNCTION. JOB-3-ALL TERMS OF THE LAGRANGIAN FUNCTION.
+*
+ SUBROUTINE PFSEB4(NC,B,IH,JH,CH,ICG,JCG,ICA,CZL,CZU,JOB)
+ INTEGER NC,IH(*),JH(*),ICG(*),JCG(*),ICA(*),JOB
+ DOUBLE PRECISION B(*),CH(*),CZL(*),CZU(*)
+ INTEGER I,II,IC,J,JJ,JC,JF,K,KK,L,LL,KC
+ DOUBLE PRECISION TEMP
+ KK=0
+ DO 7 KC=1,NC
+ IF (JOB.LE.1) THEN
+ LL=ABS(ICA(KC))
+ IF (LL.EQ.3.OR.LL.EQ.4) THEN
+ TEMP= CZU(KC)-CZL(KC)
+ ELSE IF (LL.EQ.1) THEN
+ TEMP=-CZL(KC)
+ ELSE IF (LL.EQ.2) THEN
+ TEMP= CZU(KC)
+ ELSE IF (LL.EQ.5) THEN
+ TEMP= CZL(KC)
+ END IF
+ IF (JOB.EQ.1) TEMP=ABS(TEMP)
+ ELSE IF (JOB.EQ.2) THEN
+ IF (ICA(KC).GE.0) GO TO 7
+ TEMP=1.0D 0
+ ELSE
+ TEMP=1.0D 0
+ END IF
+ II=ICG(KC)
+ L=ICG(KC+1)-II
+ DO 6 IC=1,L
+ KK=KK+IC
+ I=JCG(II)
+ IF (I.LE.0) GO TO 5
+ JF=IH(I)
+ JJ=II
+ K=KK
+ DO 4 JC=IC,L
+ J=JCG(JJ)
+ IF (J.LE.0) GO TO 3
+ 2 IF (JH(JF).LT.J) THEN
+ JF=JF+1
+ GO TO 2
+ END IF
+ B(JF)=B(JF)+TEMP*CH(K)
+ 3 K=K+JC
+ JJ=JJ+1
+ 4 CONTINUE
+ 5 II=II+1
+ 6 CONTINUE
+ 7 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PFSEB5 ALL SYSTEMS 06/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE PARTITIONED HESSIAN
+* MATRIX.
+*
+* PARAMETERS :
+* II NC NUMBER OF CONSTRAINTS.
+* RU B(M) ELEMENTS OF THE SPARSE MATRIX B.
+* IO IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF B.
+* IO JH(M) INDICES OF THE NONZERO ELEMENTS OF B.
+* II CH(MB) ELEMENTS OF THE PARTITIONED MATRIX H.
+* II ICG(NC+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JCG(MC) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI CZ(NC) VECTOR CONTAINING LAGRANGE MULTIPLIERS FOR CONSTRAINTS.
+* II JOB SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
+* JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
+* LAGRANGIAN MULTIPLIERS. JOB-2-ACTIVE TERMS OF THE LAGRANGIAN
+* FUNCTION. JOB-3-ALL TERMS OF THE LAGRANGIAN FUNCTION.
+*
+ SUBROUTINE PFSEB5(NC,B,IH,JH,CH,ICG,JCG,CZ,JOB)
+ INTEGER NC,IH(*),JH(*),ICG(*),JCG(*),JOB
+ DOUBLE PRECISION B(*),CH(*),CZ(*)
+ INTEGER I,II,IC,J,JJ,JC,JF,K,KK,L,KC
+ DOUBLE PRECISION TEMP
+ KK=0
+ DO 7 KC=1,NC
+ IF (JOB.EQ.0) THEN
+ TEMP=CZ(KC)
+ ELSE IF (JOB.EQ.1) THEN
+ TEMP=ABS(CZ(KC))
+ ELSE
+ TEMP=1.0D 0
+ END IF
+ II=ICG(KC)
+ L=ICG(KC+1)-II
+ DO 6 IC=1,L
+ KK=KK+IC
+ I=JCG(II)
+ IF (I.LE.0) GO TO 5
+ JF=IH(I)
+ JJ=II
+ K=KK
+ DO 4 JC=IC,L
+ J=JCG(JJ)
+ IF (J.LE.0) GO TO 3
+ 2 IF (JH(JF).LT.J) THEN
+ JF=JF+1
+ GO TO 2
+ END IF
+ B(JF)=B(JF)+TEMP*CH(K)
+ 3 K=K+JC
+ JJ=JJ+1
+ 4 CONTINUE
+ 5 II=II+1
+ 6 CONTINUE
+ 7 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PFSED3 ALL SYSTEMS 07/12/01
+* PURPOSE :
+* COMPRESSED SPARSE STRUCTURE OF THE HESSIAN MATRIX IS COMPUTED FROM
+* THE COORDINATE FORM.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II M NUMBER OF NONZERO ELEMENTS IN THE UPPER PART OF THE SPARSE
+* HESSIAN MATRIX.
+* IU IH(M+NF) ON INPUT ROW INDICES OF NONZERO ELEMENTS IN THE FIELD
+* H. ON OUTPUT POSITIONS OF DIAGONAL ELEMENTS IN THE FIELD H.
+* II JH(M+NF) COLUMN INDICES OF NONZERO ELEMENTS IN THE FIELD H.
+* IO IER ERROR MESAGE. IER=0-THE STANDARD INPUT DATA ARE CORRECT.
+* IER=1-ERROR IN THE ARRAY IH. IER=2-ERROR IN THE ARRAY JH.
+*
+ SUBROUTINE PFSED3(NF,M,IH,JH,IER)
+ INTEGER NF,M,IH(*),JH(*),IER
+ INTEGER I,J,K,L,LL
+ IER=0
+ DO 1 J=1,M
+ IF (IH(J).GT.JH(J)) THEN
+ K=IH(J)
+ IH(J)=JH(J)
+ JH(J)=K
+ END IF
+ 1 CONTINUE
+ DO 2 I=1,NF
+ IH(M+I)=I
+ JH(M+I)=I
+ 2 CONTINUE
+ CALL MXVSR7(M+NF,IH,JH)
+ IF (IH(1).LT.1.OR.IH(M+NF).GT.NF) THEN
+ IER=1
+ RETURN
+ END IF
+ K=1
+ DO 3 J=1,M+NF
+ IF (IH(J).EQ.K) THEN
+ IH(K)=J
+ K=K+1
+ END IF
+ 3 CONTINUE
+ IH(K)=J
+ LL=0
+ DO 5 I=1,NF
+ K=IH(I)
+ L=IH(I+1)-K
+ IF (L.GT.0) THEN
+ CALL MXVSRT(L,JH(K))
+ IF (JH(K).LT.1.OR.JH(K+L-1).GT.NF) THEN
+ IER=2
+ RETURN
+ END IF
+ END IF
+ IH(I)=IH(I)-LL
+ DO 4 J=1,L
+ IF (J.GT.1.AND.JH(K).EQ.JH(K-1)) THEN
+ LL=LL+1
+ ELSE
+ JH(K-LL)=JH(K)
+ END IF
+ K=K+1
+ 4 CONTINUE
+ 5 CONTINUE
+ IH(NF+1)=IH(NF+1)-LL
+ M=IH(NF+1)-1
+ RETURN
+ END
+* SUBROUTINE PFSET2 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE NUMBER OF NONZERO ELEMENTS OF THE SPARSE
+* HESSIAN MATRIX STORED IN THE BLOCKED FORM.
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* II MB NUMBER OF NONZERO ELEMENTS OF THE PARTITIONED HESSIAN MATRIX
+* II MC MAXIMUM NUMBER OF ELEMENTS OF THE PARTIAL HESSIAN MATRIX.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE SPARSE
+* JACOBIAN MATRIX.
+*
+ SUBROUTINE PFSET2(NA,MB,MC,IAG)
+ INTEGER NA,MB,MC,IAG(*)
+ INTEGER K,L,KA
+ MB=0
+ MC=0
+ DO 1 KA=1,NA
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ MB=MB+L*(L+1)/2
+ MC=MAX(MC,L*(L+1)/2)
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PFSET3 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE STRUCTURE OF THE HESSIAN MATRIX FROM THE
+* SPARSE STRUCTURE OF THE JACOBIAN MATRIX.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* IO M NUMBER OF NONZERO ELEMENTS OF THE HESSIAN MATRIX.
+* II MMAX DECLARED LENGHT OF THE ARRAYS H AND JH.
+* IO IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* IO JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* II IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* IU ITERM TERMINATION INDICATOR.
+*
+ SUBROUTINE PFSET3(NF,NA,M,MMAX,IH,JH,IAG,JAG,ITERM)
+ INTEGER NF,NA,M,MMAX,IH(*),JH(*),IAG(*),JAG(*),ITERM
+ INTEGER I,J,JF,JA,K,LF,LA,KA
+ M=IH(NF+1)-1
+ IF (M.GT.MMAX) THEN
+ ITERM=-40
+ RETURN
+ END IF
+ DO 7 KA=1,NA
+ LA=IAG(KA+1)-1
+ DO 6 K=IAG(KA),LA
+ I=JAG(K)
+ JF=IH(I)
+ LF=IH(I+1)-1
+ DO 5 JA=K,LA
+ J=JAG(JA)
+ 2 IF (JH(JF).LT.J.AND.JF.LE.LF) THEN
+ JF=JF+1
+ IF (JF.LE.LF) GO TO 2
+ END IF
+ IF (JH(JF).GT.J .OR.JF.GT.LF) THEN
+ DO 3 J=I+1,NF+1
+ IH(J)=IH(J)+1
+ 3 CONTINUE
+ DO 4 J=M,JF,-1
+ JH(J+1)=JH(J)
+ 4 CONTINUE
+ JH(JF)=JAG(JA)
+ JF=JF+1
+ LF=LF+1
+ M=M+1
+ IF (M.GT.MMAX) THEN
+ ITERM=-40
+ RETURN
+ END IF
+ END IF
+ 5 CONTINUE
+ 6 CONTINUE
+ 7 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PFSET4 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE PARTITIONED HESSIAN
+* MATRIX.
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RU B(M) ELEMENTS OF THE SPARSE MATRIX B.
+* IO IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF B.
+* IO JH(M) INDICES OF THE NONZERO ELEMENTS OF B.
+* II AH(MB) ELEMENTS OF THE PARTITIONED MATRIX H.
+* II IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+*
+ SUBROUTINE PFSET4(NA,B,IH,JH,AH,IAG,JAG)
+ INTEGER NA,IH(*),JH(*),IAG(*),JAG(*)
+ DOUBLE PRECISION B(*),AH(*)
+ INTEGER I,II,IA,J,JJ,JA,JF,K,KK,L,KA
+ KK=0
+ DO 7 KA=1,NA
+ II=IAG(KA)
+ L=IAG(KA+1)-II
+ DO 6 IA=1,L
+ KK=KK+IA
+ I=JAG(II)
+ IF (I.LE.0) GO TO 5
+ JF=IH(I)
+ JJ=II
+ K=KK
+ DO 4 JA=IA,L
+ J=JAG(JJ)
+ IF (J.LE.0) GO TO 3
+ 2 IF (JH(JF).LT.J) THEN
+ JF=JF+1
+ GO TO 2
+ END IF
+ B(JF)=B(JF)+AH(K)
+ 3 K=K+JA
+ JJ=JJ+1
+ 4 CONTINUE
+ 5 II=II+1
+ 6 CONTINUE
+ 7 CONTINUE
+ RETURN
+ END
+* FUNCTION PNFUZ1 ALL SYSTEMS 01/09/22
+* PURPOSE :
+* COMPUTATION OF LOWER AND UPPER LAGRANGE MULTIPLIERS.
+*
+* PARAMETERS :
+* RO Z SLACK VARIABLE IN THE NONLINEAR PROGRAMMING FORMULATION OF
+* A MINIMAX PROBLEM.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI RPF3 BARRIER PARAMETER.
+* RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED
+* FUNCTIONS.
+* RA AZL(NA) VECTOR OF LOWER LAGRANGE MULTIPLIERS.
+* RA AZU(NA) VECTOR OF UPPER LAGRANGE MULTIPLIERS.
+* II IEXT TYPE OF MINIMAX. IEXT<0-MINIMIZATION OF THE MAXIMUM
+* PARTIAL VALUE. IEXT-0-MINIMIZATION OF THE MAXIMUM PARTIAL
+* ABSOLUTE VALUE. IEXT>0-MAXIMIZATION OF THE MINIMUM PARTIAL
+* VALUE.
+*
+ FUNCTION PNFUZ1(Z,NA,RPF3,AF,AZL,AZU,IEXT)
+ INTEGER NA,IEXT
+ DOUBLE PRECISION Z,RPF3,AF(*),AZL(*),AZU(*),PNFUZ1
+ INTEGER KA
+ PNFUZ1=1.0D 0
+ DO 1 KA=1,NA
+ IF (IEXT.LE.0) THEN
+ AZU(KA)=RPF3/(Z-AF(KA))
+ PNFUZ1=PNFUZ1-AZU(KA)
+ END IF
+ IF (IEXT.GE.0) THEN
+ AZL(KA)=RPF3/(Z+AF(KA))
+ PNFUZ1=PNFUZ1-AZL(KA)
+ END IF
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PNINT1 ALL SYSTEMS 91/12/01
+* PURPOSE :
+* EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH WITH DIRECTIONAL
+* DERIVATIVES.
+*
+* PARAMETERS :
+* RI RL LOWER VALUE OF THE STEPSIZE PARAMETER.
+* RI RU UPPER VALUE OF THE STEPSIZE PARAMETER.
+* RI FL VALUE OF THE OBJECTIVE FUNCTION FOR R=RL.
+* RI FU VALUE OF THE OBJECTIVE FUNCTION FOR R=RU.
+* RI PL DIRECTIONAL DERIVATIVE FOR R=RL.
+* RI PU DIRECTIONAL DERIVATIVE FOR R=RU.
+* RO R VALUE OF THE STEPSIZE PARAMETER OBTAINED.
+* II MODE MODE OF LINE SEARCH.
+* II MTYP METHOD SELECTION. MTYP=1-BISECTION. MTYP=2-QUADRATIC
+* INTERPOLATION (WITH ONE DIRECTIONAL DERIVATIVE).
+* MTYP=3-QUADRATIC INTERPOLATION (WITH TWO DIRECTIONAL
+* DERIVATIVES). MTYP=4-CUBIC INTERPOLATION. MTYP=5-CONIC
+* INTERPOLATION.
+* IO MERR ERROR INDICATOR. MERR=0 FOR NORMAL RETURN.
+*
+* METHOD :
+* EXTRAPOLATION OR INTERPOLATION WITH STANDARD MODEL FUNCTIONS.
+*
+ SUBROUTINE PNINT1(RL,RU,FL,FU,PL,PU,R,MODE,MTYP,MERR)
+ DOUBLE PRECISION RL, RU, FL, FU, PL, PU, R
+ INTEGER MODE,MTYP,MERR,NTYP
+ DOUBLE PRECISION A,B,C,D,DIS,DEN
+ DOUBLE PRECISION C1L,C1U,C2L,C2U,C3L
+ PARAMETER (C1L=1.1D 0,C1U=1.0D 3,C2L=1.0D-2,C2U=0.9D 0,
+ & C3L=0.1D 0)
+ MERR=0
+ IF (MODE.LE.0) RETURN
+ IF (PL.GE.0.0D 0) THEN
+ MERR=2
+ RETURN
+ ELSE IF (RU.LE.RL) THEN
+ MERR=3
+ RETURN
+ END IF
+ DO 1 NTYP=MTYP,1,-1
+ IF (NTYP.EQ.1) THEN
+*
+* BISECTION
+*
+ IF (MODE.EQ.1) THEN
+ R=4.0D 0*RU
+ RETURN
+ ELSE
+ R=0.5D 0*(RL+RU)
+ RETURN
+ END IF
+ ELSE IF (NTYP.EQ.MTYP) THEN
+ A = (FU-FL)/(PL*(RU-RL))
+ B = PU/PL
+ END IF
+ IF (NTYP.EQ.2) THEN
+*
+* QUADRATIC EXTRAPOLATION OR INTERPOLATION WITH ONE DIRECTIONAL
+* DERIVATIVE
+*
+ DEN = 2.0D 0*(1.0D 0-A)
+ ELSE IF (NTYP.EQ.3) THEN
+*
+* QUADRATIC EXTRAPOLATION OR INTERPOLATION WITH TWO DIRECTIONAL
+* DERIVATIVES
+*
+ DEN = 1.0D 0 - B
+ ELSE IF (NTYP.EQ.4) THEN
+*
+* CUBIC EXTRAPOLATION OR INTERPOLATION
+*
+ C = B - 2.0D 0*A + 1.0D 0
+ D = B - 3.0D 0*A + 2.0D 0
+ DIS = D*D - 3.0D 0*C
+ IF (DIS.LT.0.0D 0) GO TO 1
+ DEN = D + SQRT(DIS)
+ ELSE IF (NTYP.EQ.5) THEN
+*
+* CONIC EXTRAPOLATION OR INTERPOLATION
+*
+ DIS = A*A - B
+ IF (DIS.LT.0.0D 0) GO TO 1
+ DEN = A + SQRT(DIS)
+ IF (DEN.LE.0.0D 0) GO TO 1
+ DEN = 1.0D 0 - B*(1.0D 0/DEN)**3
+ END IF
+ IF (MODE.EQ.1.AND.DEN.GT.0.0D 0.AND.DEN.LT.1.0D 0) THEN
+*
+* EXTRAPOLATION ACCEPTED
+*
+ R = RL + (RU-RL)/DEN
+ R = MAX(R,C1L*RU)
+ R = MIN(R,C1U*RU)
+ RETURN
+ ELSE IF (MODE.EQ.2.AND.DEN.GT.1.0D 0) THEN
+*
+* INTERPOLATION ACCEPTED
+*
+ R = RL + (RU-RL)/DEN
+ IF (RL.EQ.0.0D 0) THEN
+ R = MAX(R,RL+C2L*(RU-RL))
+ ELSE
+ R = MAX(R,RL+C3L*(RU-RL))
+ END IF
+ R = MIN(R,RL+C2U*(RU-RL))
+ RETURN
+ END IF
+ 1 CONTINUE
+ END
+* SUBROUTINE PNINT3 ALL SYSTEMS 91/12/01
+* PURPOSE :
+* EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH WITHOUT DIRECTIONAL
+* DERIVATIVES.
+*
+* PARAMETERS :
+* RI RO INITIAL VALUE OF THE STEPSIZE PARAMETER.
+* RI RL LOWER VALUE OF THE STEPSIZE PARAMETER.
+* RI RU UPPER VALUE OF THE STEPSIZE PARAMETER.
+* RI RI INNER VALUE OF THE STEPSIZE PARAMETER.
+* RI FO VALUE OF THE OBJECTIVE FUNCTION FOR R=RO.
+* RI FL VALUE OF THE OBJECTIVE FUNCTION FOR R=RL.
+* RI FU VALUE OF THE OBJECTIVE FUNCTION FOR R=RU.
+* RI FI VALUE OF THE OBJECTIVE FUNCTION FOR R=RI.
+* RO PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO R VALUE OF THE STEPSIZE PARAMETER OBTAINED.
+* II MODE MODE OF LINE SEARCH.
+* II MTYP METHOD SELECTION. MTYP=1-BISECTION. MTYP=2-TWO POINT
+* QUADRATIC INTERPOLATION. MTYP=2-THREE POINT QUADRATIC
+* INTERPOLATION.
+* IO MERR ERROR INDICATOR. MERR=0 FOR NORMAL RETURN.
+*
+* METHOD :
+* EXTRAPOLATION OR INTERPOLATION WITH STANDARD MODEL FUNCTIONS.
+*
+ SUBROUTINE PNINT3(RO,RL,RU,RI,FO,FL,FU,FI,PO,R,MODE,MTYP,MERR)
+ DOUBLE PRECISION RO,RL,RU,RI,FO,FL,FU,FI,PO,R
+ INTEGER MODE,MTYP,MERR,NTYP
+ DOUBLE PRECISION AL,AU,AI,DEN,DIS
+ LOGICAL L1,L2
+ DOUBLE PRECISION ZERO,HALF,ONE,TWO,THREE,FOUR,C1L,C1U,C2L,C2U,C3L
+ PARAMETER(ZERO=0.0D 0,HALF=0.5D 0,ONE=1.0D 0,TWO=2.0D 0,
+ & THREE=3.0D 0,FOUR=4.0D 0,C1L=1.1D 0,C1U=1.0D 3,
+ & C2L=1.0D-2,C2U=0.9D 0,C3L=1.0D-1)
+ MERR = 0
+ IF (MODE .LE. 0) RETURN
+ IF (PO .GE. ZERO) THEN
+ MERR = 2
+ RETURN
+ ELSE IF (RU .LE. RL) THEN
+ MERR = 3
+ RETURN
+ END IF
+ L1 = RL .LE. RO
+ L2 = RI .LE. RL
+ DO 1 NTYP = MTYP, 1, -1
+ IF (NTYP .EQ. 1) THEN
+*
+* BISECTION
+*
+ IF (MODE .EQ. 1) THEN
+ R = TWO * RU
+ RETURN
+ ELSE IF (RI-RL.LE.RU-RI) THEN
+ R=HALF*(RI+RU)
+ RETURN
+ ELSE
+ R=HALF*(RL+RI)
+ RETURN
+ END IF
+ ELSE IF (NTYP.EQ.MTYP.AND.L1) THEN
+ IF (.NOT.L2) AI=(FI-FO)/(RI*PO)
+ AU=(FU-FO)/(RU*PO)
+ END IF
+ IF (L1.AND.(NTYP.EQ.2.OR.L2)) THEN
+*
+* TWO POINT QUADRATIC EXTRAPOLATION OR INTERPOLATION
+*
+ IF (AU.GE.ONE) GO TO 1
+ R=HALF*RU/(ONE-AU)
+ ELSE IF (.NOT.L1.OR..NOT.L2.AND.NTYP.EQ.3) THEN
+*
+* THREE POINT QUADRATIC EXTRAPOLATION OR INTERPOLATION
+*
+ AL=(FI-FL)/(RI-RL)
+ AU=(FU-FI)/(RU-RI)
+ DEN=AU-AL
+ IF (DEN.LE.ZERO) GO TO 1
+ R=RI-HALF*(AU*(RI-RL)+AL*(RU-RI))/DEN
+ ELSE IF (L1.AND..NOT.L2.AND.NTYP.EQ.4) THEN
+*
+* THREE POINT CUBIC EXTRAPOLATION OR INTERPOLATION
+*
+ DIS=(AI-ONE)*(RU/RI)
+ DEN=(AU-ONE)*(RI/RU)-DIS
+ DIS=AU+AI-DEN-TWO*(ONE+DIS)
+ DIS=DEN*DEN-THREE*DIS
+ IF (DIS.LT.ZERO) GO TO 1
+ DEN=DEN+SQRT(DIS)
+ IF (DEN.EQ.ZERO) GO TO 1
+ R=(RU-RI)/DEN
+ ELSE
+ GO TO 1
+ END IF
+ IF (MODE .EQ. 1 .AND. R .GT. RU) THEN
+*
+* EXTRAPOLATION ACCEPTED
+*
+ R = MAX( R, C1L*RU)
+ R = MIN( R, C1U*RU)
+ RETURN
+ ELSE IF (MODE .EQ. 2 .AND. R .GT. RL .AND. R .LT. RU) THEN
+*
+* INTERPOLATION ACCEPTED
+*
+ IF (RI.EQ.ZERO.AND.NTYP.NE.4) THEN
+ R = MAX( R, RL + C2L*(RU-RL))
+ ELSE
+ R = MAX( R, RL + C3L*(RU-RL))
+ END IF
+ R = MIN( R, RL + C2U*(RU-RL))
+ IF (R.EQ.RI) GO TO 1
+ RETURN
+ END IF
+ 1 CONTINUE
+ END
+* SUBROUTINE PNNEQ1 ALL SYSTEMS 92/12/01
+* PURPOSE :
+* SOLUTION OF A SINGLE NONLINEAR EQUATION.
+*
+* PARAMETERS :
+* RI AA LEFT ENDPOINT OF THE INTERVAL.
+* RI BB RIGHT ENDPOINT OF THE INTERVAL.
+* RO X COMPUTED SOLUTION POINT.
+* RO F COMPUTED VALUE OF THE NONLINEAR FUNCTION.
+* RF FUN EXTERNAL FUNCTION.
+* RI EPSX REQUIRED PRECISION FOR THE SOLUTION POINT.
+* RI EPSF REQUIRED PRECISION FOR THE NONLINEAR FUNCTION.
+* IO IC NUMBER OF ITERATIONS.
+* IO IE ERROR SPECIFICATION.
+* IU ISYS CONTROL PARAMETER.
+*
+* METHOD :
+* D.LEE: THREE NEW RAPIDLY CONVERGENT ALGORITHMS FOR FINDING A ZERO
+* OF A FUNCTION, SIAM J. SCI. STAT. COMPUT. 6 (1985) 193-208.
+*
+ SUBROUTINE PNNEQ1(AA,BB,X,F,EPSX,EPSF,IC,IE,ISYS)
+ DOUBLE PRECISION AA,BB,X,F,EPSX,EPSF
+ INTEGER IC,IE,ISYS
+ INTEGER ITER,ITMAX,K,L
+ DOUBLE PRECISION FA,FB,X1,X2,X3,F1,F2,F3,R,R1,RA,RB,D,D1,A,B,C,Z,
+ & W,FW,GW,DEL,DDL,F21,F32
+ DOUBLE PRECISION ZERO,ONE,TWO,THREE,FOUR,HALF,CON
+ PARAMETER (ZERO=0.0D 0,ONE=1.0D 0,TWO=2.0D 0,THREE=3.0D 0,
+ & FOUR=4.0D 0,HALF=0.5D 0,CON=0.1D 0)
+ SAVE A,B,C,FA,FB,X1,X2,X3,F1,F2,F3,R,D,FW
+ SAVE L,ITER,ITMAX
+ GO TO (1,2,3,4,6) ISYS+1
+ 1 IE=0
+ ITMAX=IC
+ IF (ITMAX.LE.0) ITMAX=100
+ X=AA
+ ISYS=1
+ IC=1
+ RETURN
+ 2 CONTINUE
+ IF (ABS(F).LE.EPSF) GO TO 7
+ FA=F
+ X=BB
+ ISYS=2
+ IC=2
+ RETURN
+ 3 CONTINUE
+ IF (ABS(F).LE.EPSF) GO TO 7
+ FB=F
+ IF (FA*FB.GT.0.0D 0) THEN
+ X=AA
+ F=FA
+ IE=-2
+ GO TO 7
+ END IF
+ X1=AA
+ F1=FA
+ X=HALF*(AA+BB)
+ ISYS=3
+ IC=3
+ RETURN
+ 4 CONTINUE
+ X2=X
+ F2=F
+ IF (F1*F2.GT.0.0D 0) THEN
+ X3=X1
+ F3=F1
+ X1=BB
+ F1=FB
+ ELSE
+ X3=BB
+ F3=FB
+ END IF
+ L=0
+ D=0.0D 0
+ R=0.0D 0
+ ITER=1
+ 5 CONTINUE
+ D1=D
+ R1=R
+ D=ABS(X1-X2)
+ IF (ABS(F1).LT.ABS(F2)) THEN
+ X=X1
+ F=F1
+ ELSE
+ X=X2
+ F=F2
+ END IF
+ DEL=EPSX*(ABS(X)+ONE)
+ IF (ABS(F).LE.EPSF.OR.D.LE.TWO*DEL) GO TO 7
+ Z=X1+HALF*(X2-X1)
+ DDL=MAX(CON*D,DEL)
+ IF (THREE*D.LE.TWO*D1) THEN
+ K=0
+ ELSE
+ K=1
+ END IF
+ IF (X2.EQ.X1) THEN
+ F21=0.0D 0
+ ELSE
+ F21=(F2-F1)/(X2-X1)
+ ENDIF
+ IF (X3.EQ.X2) THEN
+ F32=0.0D 0
+ ELSE
+ F32=(F3-F2)/(X3-X2)
+ ENDIF
+ A=(F32-F21)/(X3-X1)
+ B=A*(X2+X1)-F21
+ C=F2-(A*X2-B)*X2
+ IF (ABS(A).LE.1.0D-10) THEN
+ R=(F2*X1-F1*X2)/(F2-F1)
+ ELSE
+ R=B*B-FOUR*A*C
+ IF (R.LT.0.0D 0) THEN
+ R=(F2*X1-F1*X2)/(F2-F1)
+ ELSE
+ R=SQRT(R)
+ RA=HALF*(B+R)/A
+ RB=HALF*(B-R)/A
+ IF (ABS(RA-Z).LE.ABS(RB-Z)) THEN
+ R=RA
+ ELSE
+ R=RB
+ END IF
+ IF (R.LE.MIN(X1,X2).OR.R.GE.MAX(X1,X2)) THEN
+ R=(F2*X1-F1*X2)/(F2-F1)
+ END IF
+ END IF
+ END IF
+ IF (L.GE.2) THEN
+ W=R
+ IF (ABS(W-X).LT.DEL) W=X+DEL*SIGN(ONE,Z-X)
+ ELSE IF (K.EQ.1.OR.ABS(R-X).GE.ABS(Z-X)) THEN
+ W=Z
+ ELSE
+ W=R+HALF*ABS(R-R1)*SIGN(ONE,R-X)
+ IF (ABS(W-X).LT.DDL) W=X+DDL*SIGN(ONE,Z-X)
+ IF (ABS(W-X).GE.ABS(Z-X)) W=Z
+ END IF
+ X=W
+ FW=F
+ ISYS=4
+ IC=IC+1
+ RETURN
+ 6 CONTINUE
+ GW=(A*X-B)*X+C
+ IF (ABS(F-GW).LE.1.0D-1*ABS(FW).OR.ABS(FW).LE.1.0D-3*
+ *MAX(ABS(F1),ABS(F2)).AND.L.GE.2) THEN
+ L=L+1
+ ELSE
+ L=0
+ END IF
+ IF (F*SIGN(ONE,F1).GE.0.0D 0) THEN
+ IF (D.LE.ABS(X3-X)) THEN
+ X3=X1
+ F3=F1
+ X1=X2
+ F1=F2
+ X2=X
+ F2=F
+ ELSE
+ X1=X
+ F1=F
+ END IF
+ ELSE
+ X3=X2
+ F3=F2
+ X2=X
+ F2=F
+ END IF
+ ITER=ITER+1
+ IF (ITER.LE.ITMAX) GO TO 5
+ IE=-1
+ 7 ISYS=0
+ RETURN
+ END
+* SUBROUTINE PNSTEP ALL SYSTEMS 89/12/01
+* PURPOSE :
+* DETERMINATION OF A SCALING FACTOR FOR THE BOUNDARY STEP.
+*
+* PARAMETERS :
+* RI DEL MAXIMUM STEPSIZE.
+* RI A INPUT PARAMETER.
+* RI B INPUT PARAMETER.
+* RI C INPUT PARAMETER.
+* RO ALF SCALING FACTOR FOR THE BOUNDARY STEP SUCH THAT
+* A**2+2*B*ALF+C*ALF**2=DEL**2.
+*
+ SUBROUTINE PNSTEP(DEL,A,B,C,ALF)
+ DOUBLE PRECISION DEL, A, B, C, ALF
+ DOUBLE PRECISION DEN, DIS
+ ALF = 0.0D 0
+ DEN = (DEL+A) * (DEL-A)
+ IF (DEN .LE. 0.0D 0) RETURN
+ DIS = B*B + C*DEN
+ IF (B .GE. 0.0D 0) THEN
+ ALF = DEN / (SQRT(DIS) + B)
+ ELSE
+ ALF = (SQRT(DIS) - B) / C
+ END IF
+ RETURN
+ END
+* SUBROUTINE PNSTP4 ALL SYSTEMS 99/12/01
+* PURPOSE :
+* STEPSIZE SELECTION USING POLYHEDRAL APPROXIMATION
+* FOR DESCENT STEP IN NONCONVEX VARIABLE METRIC METHOD.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS
+* II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
+* RU X(N) VECTOR OF VARIABLES.
+* RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES.
+* RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS.
+* RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS.
+* RI S(N) DIRECTION VECTOR.
+* RI F VALUE OF THE OBJECTIVE FUNCTION.
+* RI DF DIRECTIONAL DERIVATIVE.
+* RO T VALUE OF THE STEPSIZE PARAMETER.
+* RO TB BUNDLE PARAMETER FOR MATRIX SCALING.
+* RI ETA5 DISTANCE MEASURE PARAMETER.
+* RI ETA9 MAXIMUM FOR REAL NUMBERS.
+* RI MOS3 LOCALITY MEASURE PARAMETER.
+*
+ SUBROUTINE PNSTP4(N,MA,MAL,X,AF,AG,AY,S,F,DF,T,TB,ETA5,ETA9,MOS3)
+ DOUBLE PRECISION DF,ETA5,ETA9,F,T,TB
+ INTEGER MA,MAL,MOS3,N
+ DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*)
+ DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,DX,Q,R,W
+ INTEGER I,J,JN,K,L,LQ
+ W = DF*T* (1.0D0-T*0.5D0)
+*
+* INITIAL CHOICE OF POSSIBLY ACTIVE LINES
+*
+ K = 0
+ L = -1
+ JN = 0
+ TB = SQRT(ETA9)
+ BETR = -ETA9
+ DO 20 J = 1,MAL - 1
+ R = 0.0D0
+ BET = 0.0D0
+ ALFL = AF(J) - F
+ DO 10 I = 1,N
+ DX = X(I) - AY(JN+I)
+ Q = AG(JN+I)
+ R = R + DX*DX
+ ALFL = ALFL + DX*Q
+ BET = BET + S(I)*Q
+ 10 CONTINUE
+ IF (MOS3.NE.2) R = R** (DBLE(MOS3)*0.5D0)
+ ALF = MAX(ABS(ALFL),ETA5*R)
+ R = 1.0D0 - BET/DF
+ IF (R*R+ (ALF+ALF)/DF.GT.1.0D-6) THEN
+ K = K + 1
+ AF(MA+K) = ALF
+ AF(MA+MA+K) = BET
+ R = T*BET - ALF
+ IF (R.GT.W) THEN
+ W = R
+ L = K
+ END IF
+ END IF
+ IF (BET.GT.0.0D0) TB = MIN(TB,ALF/ (BET-DF))
+ BETR = MAX(BETR,BET-ALF)
+ JN = JN + N
+ 20 CONTINUE
+ LQ = -1
+ IF (BETR.LE.DF*0.5D0) RETURN
+ LQ = 1
+ IF (L.LT.0) RETURN
+ BETR = AF(MA+MA+L)
+ IF (BETR.LE.0.0D0) THEN
+ IF (T.LT.1.0D0 .OR. BETR.EQ.0.0D0) RETURN
+ LQ = 2
+ END IF
+ ALFR = AF(MA+L)
+*
+* ITERATION LOOP
+*
+ 30 IF (LQ.GE.1) THEN
+ Q = 1.0D0 - BETR/DF
+ R = Q + SQRT(Q*Q+ (ALFR+ALFR)/DF)
+ IF (BETR.GE.0.0D0) R = - (ALFR+ALFR)/ (DF*R)
+ R = MIN(1.95D0,MAX(0.0D0,R))
+ ELSE
+ IF (ABS(BETR-BETL)+ABS(ALFR-ALFL).LT.-1.0D-4*DF) RETURN
+ R = (ALFR-ALFL)/ (BETR-BETL)
+ END IF
+ IF (ABS(T-R).LT.1.0D-4) RETURN
+ T = R
+ AF(MA+L) = -1.0D0
+ W = T*BETR - ALFR
+ L = -1
+ DO 40 J = 1,K
+ ALF = AF(MA+J)
+ IF (ALF.LT.0.0D0) GO TO 40
+ BET = AF(MA+MA+J)
+ R = T*BET - ALF
+ IF (R.GT.W) THEN
+ W = R
+ L = J
+ END IF
+ 40 CONTINUE
+ IF (L.LT.0) RETURN
+ BET = AF(MA+MA+L)
+ IF (BET.EQ.0.0D0) RETURN
+*
+* NEW INTERVAL SELECTION
+*
+ ALF = AF(MA+L)
+ IF (BET.LT.0.0D0) THEN
+ IF (LQ.EQ.2) THEN
+ ALFR = ALF
+ BETR = BET
+ ELSE
+ ALFL = ALF
+ BETL = BET
+ LQ = 0
+ END IF
+ ELSE
+ IF (LQ.EQ.2) THEN
+ ALFL = ALFR
+ BETL = BETR
+ LQ = 0
+ END IF
+ ALFR = ALF
+ BETR = BET
+ END IF
+ GO TO 30
+ END
+* SUBROUTINE PNSTP5 ALL SYSTEMS 99/12/01
+* PURPOSE :
+* STEPSIZE SELECTION USING POLYHEDRAL APPROXIMATION
+* FOR NULL STEP IN NONCONVEX VARIABLE METRIC METHOD.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
+* II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
+* RU X(N) VECTOR OF VARIABLES.
+* RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES.
+* RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS.
+* RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS.
+* RI S(N) DIRECTION VECTOR.
+* RI F VALUE OF THE OBJECTIVE FUNCTION.
+* RI DF DIRECTIONAL DERIVATIVE.
+* RO T VALUE OF THE STEPSIZE PARAMETER.
+* RO TB BUNDLE PARAMETER FOR MATRIX SCALING.
+* RI ETA5 DISTANCE MEASURE PARAMETER.
+* RI ETA9 MAXIMUM FOR REAL NUMBERS.
+* RI MOS3 LOCALITY MEASURE PARAMETER.
+*
+ SUBROUTINE PNSTP5(N,MA,MAL,X,AF,AG,AY,S,F,DF,T,TB,ETA5,ETA9,MOS3)
+ DOUBLE PRECISION DF,ETA5,ETA9,F,T,TB
+ INTEGER MA,MAL,MOS3,N
+ DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*)
+ DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,DX,Q,R,W
+ INTEGER I,J,JN,K,L
+ W = DF*T
+*
+* INITIAL CHOICE OF POSSIBLY ACTIVE PARABOLAS
+*
+ K = 0
+ L = -1
+ JN = 0
+ TB = SQRT(ETA9)
+ BETR = -ETA9
+ DO 20 J = 1,MAL - 1
+ BET = 0.0D0
+ R = 0.0D0
+ ALFL = AF(J) - F
+ DO 10 I = 1,N
+ DX = X(I) - AY(JN+I)
+ R = R + DX*DX
+ Q = AG(JN+I)
+ ALFL = ALFL + DX*Q
+ BET = BET + S(I)*Q
+ 10 CONTINUE
+ IF (MOS3.NE.2) R = R** (DBLE(MOS3)*0.5D0)
+ ALF = MAX(ABS(ALFL),ETA5*R)
+ IF (BET+BET.GT.DF) TB = MIN(TB,ALF/ (BET-DF))
+ BETR = MAX(BETR,BET-ALF)
+ IF (ALF.LT.BET-DF) THEN
+ K = K + 1
+ R = T*BET - ALF
+ AF(MA+K) = ALF
+ AF(MA+MA+K) = BET
+ IF (R.GT.W) THEN
+ W = R
+ L = K
+ END IF
+ END IF
+ JN = JN + N
+ 20 CONTINUE
+ IF (L.LT.0) RETURN
+ BETR = AF(MA+MA+L)
+ ALFR = AF(MA+L)
+ ALF = ALFR
+ BET = BETR
+ ALFL = 0.0D0
+ BETL = DF
+*
+* ITERATION LOOP
+*
+ 30 W = BET/DF
+ IF (ABS(BETR-BETL)+ABS(ALFR-ALFL).LT.-1.0D-4*DF) RETURN
+ IF (BETR-BETL.EQ.0.0D0) STOP 11
+ R = (ALFR-ALFL)/ (BETR-BETL)
+ IF (ABS(T-W).LT.ABS(T-R)) R = W
+ Q = T
+ T = R
+ IF (ABS(T-Q).LT.1.0D-3) RETURN
+ AF(MA+L) = -1.0D0
+ W = T*BET - ALF
+ L = -1
+ DO 40 J = 1,K
+ ALF = AF(MA+J)
+ IF (ALF.LT.0.0D0) GO TO 40
+ BET = AF(MA+MA+J)
+ R = T*BET - ALF
+ IF (R.GT.W) THEN
+ W = R
+ L = J
+ END IF
+ 40 CONTINUE
+ IF (L.LT.0) RETURN
+ BET = AF(MA+MA+L)
+ Q = BET - T*DF
+ IF (Q.EQ.0.0D0) RETURN
+*
+* NEW INTERVAL SELECTION
+*
+ ALF = AF(MA+L)
+ IF (Q.LT.0.0D0) THEN
+ ALFL = ALF
+ BETL = BET
+ ELSE
+ ALFR = ALF
+ BETR = BET
+ END IF
+ GO TO 30
+ END
+* SUBROUTINE PP0BA1 ALL SYSTEMS 05/12/01
+* PURPOSE :
+* EVALUATION OF THE BARRIER FUNCTION FOR THE SUM OF ABSOLUTE VALUES.
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI AS(NA) SUM OF ABSOLUTE VALUE SLACK VARIABLES.
+* RI RPF3 BARRIER COEFFICIENT.
+* RO F VALUE OF THE BARRIER FUNCTION.
+*
+ SUBROUTINE PP0BA1(NA,AS,RPF3,F)
+ INTEGER NA
+ DOUBLE PRECISION AS(*),RPF3,F
+ INTEGER KA
+ F=-DBLE(NA)*RPF3*LOG(2.0D 0*RPF3)
+ DO 1 KA=1,NA
+ F=F+AS(KA)-RPF3*LOG(AS(KA))
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PP0BX1 ALL SYSTEMS 05/12/01
+* PURPOSE :
+* EVALUATION OF THE BARRIER FUNCTION FOR THE MINIMAX OPTIMIZATION.
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI Z MINIMAX SLACK VARIABLE.
+* RI AF(NA) VECTOR CONTAINING VALUES OF APPROXIMATED FUNCTIONS.
+* RO F VALUE OF THE BARRIERY FUNCTION.
+* RI FF VALUE OF THE THE OBJECTIVE FUNCTION.
+* RI PAR PARAMETER OF THE BEN-TAL BARRIER FUNCTION.
+* RI RPF3 BARRIER COEFFICIENT.
+* II MEP MERIT FUNCTION USED. MEP=1-LOGARITHMIC BARIER FUNCTION.
+* MEP=2-BEN-TAL BARRIER FUNCTION. MEP=3-COMPOSITE BARRIER
+* FUNCTION.
+* II IEXT KIND OF THE MINIMAX APPROXIMATION. IEXT=0-CHEBYSHEV
+* APPROXIMATION. IEXT=-1-MINIMAX. IEXT=+1-MAXIMIN.
+*
+ SUBROUTINE PP0BX1(NA,Z,AF,F,FF,PAR,RPF3,MEP,IEXT)
+ INTEGER NA,MEP,IEXT
+ DOUBLE PRECISION Z,AF(*),PAR,RPF3,F,FF
+ DOUBLE PRECISION FA
+ INTEGER KA
+ IF (Z.LE.FF) THEN
+ F=1.0D 60
+ ELSE
+ F=Z
+ IF (MEP.EQ.1) THEN
+ DO 11 KA=1,NA
+ FA=AF(KA)
+ IF (IEXT.LE.0) THEN
+ F=F-RPF3*LOG(Z-FA)
+ END IF
+ IF (IEXT.GE.0) THEN
+ F=F-RPF3*LOG(Z+FA)
+ END IF
+ 11 CONTINUE
+ ELSE IF (MEP.EQ.2) THEN
+ DO 21 KA=1,NA
+ FA=AF(KA)
+ IF (IEXT.LE.0) THEN
+ IF (Z-FA.LE.PAR) THEN
+ F=F-RPF3*LOG(Z-FA)
+ ELSE
+ F=F+(2.0D 0-0.5D 0*PAR/(Z-FA))*RPF3*PAR/(Z-FA)
+ END IF
+ END IF
+ IF (IEXT.GE.0) THEN
+ IF (Z+FA.LE.PAR) THEN
+ F=F-RPF3*LOG(Z+FA)
+ ELSE
+ F=F+(2.0D 0-0.5D 0*PAR/(Z+FA))*RPF3*PAR/(Z+FA)
+ END IF
+ END IF
+ 21 CONTINUE
+ ELSE IF (MEP.EQ.3) THEN
+ DO 31 KA=1,NA
+ FA=AF(KA)
+ IF (IEXT.LE.0) THEN
+ F=F+RPF3*LOG(1.0D 0/(Z-FA)+1.0D 0)
+ END IF
+ IF (IEXT.GE.0) THEN
+ F=F+RPF3*LOG(1.0D 0/(Z+FA)+1.0D 0)
+ END IF
+ 31 CONTINUE
+ ELSE IF (MEP.EQ.4) THEN
+ DO 41 KA=1,NA
+ FA=AF(KA)
+ IF (IEXT.LE.0) THEN
+ F=F+RPF3*RPF3/(Z-FA)
+ END IF
+ IF (IEXT.GE.0) THEN
+ F=F+RPF3*RPF3/(Z+FA)
+ END IF
+ 41 CONTINUE
+ END IF
+ END IF
+ RETURN
+ END
+* SUBROUTINE PP1MX3 ALL SYSTEMS 05/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT OF THE LAGRANGIAN FUNCTION
+* FOR THE MINIMAX OPTIMIZATION.
+*
+* PARAMETERS:
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI X(NF) VECTOR OF VARIABLES.
+* RI GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RI AG(IAG(N+1)-1) SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
+* DIRECTION VECTOR DETERMINATION.
+* II IAG(N+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RI AZL(NA) LOWER LAGRANGE MULTIPLIERS.
+* RI AZU(NA) UPPER LAGRANGE MULTIPLIERS.
+* RI FA VALUE OF THE SELECTED FUNCTION.
+* RI AF(NA) VALUES OF THE APPROXIMATED FUNCTIONS.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* IU NFV NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
+* IU NFG NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
+* II ISNA INDICATOR FOR STORING ELEMENTAL FUNCTION VALUES AND
+* GRADIENTS. ISNA=0-STORING SUPPRESSED. ISNA=1-STORING
+* ELEMENTAL FUNCTION VALUES. ISNA=2-STORING ELEMENTAL
+* FUNCTION VALUES AND GRADIENTS.
+* II IEXT TYPE OF MINIMAX. IEXT=0-MINIMIZATION OF THE MAXIMUM VALUE.
+* IEXT=1-MINIMIZATION OF THE MAXIMUM ABSOLUTE VALUE.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE PP1MX3(NF,NA,X,GA,AG,IAG,JAG,G,AZL,AZU,FA,AF,
+ & F,KD,LD,NFV,NFG,ISNA,IEXT)
+ INTEGER NF,NA,IAG(*),JAG(*),KD,LD,NFV,NFG,ISNA,IEXT
+ DOUBLE PRECISION X(*),GA(*),AG(*),G(*),AZL(*),AZU(*),FA,AF(*),F
+ INTEGER J,JP,K,KA,L
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0.AND.LD.LT.0) THEN
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1.AND.LD.LT.1) THEN
+ CALL MXVSET(NF,0.0D 0,G)
+ NFG=NFG+1
+ END IF
+ DO 3 KA=1,NA
+ IF (LD.GE.0) GO TO 1
+ CALL FUN(NF,KA,X,FA)
+ IF (ISNA.GE.1) AF(KA)=FA
+ IF (IEXT.EQ.0) THEN
+ IF (KA.EQ.1) F=ABS(FA)
+ F=MAX(F,ABS(FA))
+ ELSE IF (IEXT.LT.0) THEN
+ IF (KA.EQ.1) F= FA
+ F=MAX(F, FA)
+ ELSE IF (IEXT.GT.0) THEN
+ IF (KA.EQ.1) F=-FA
+ F=MAX(F,-FA)
+ END IF
+ 1 IF (KD.LT.1) GO TO 3
+ IF (LD.GE.1) GO TO 3
+ CALL DFUN(NF,KA,X,GA)
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 2 J=1,L
+ JP=ABS(JAG(K))
+ IF (IEXT.EQ.0) THEN
+ G(JP)=G(JP)+(AZU(KA)-AZL(KA))*GA(JP)
+ ELSE IF (IEXT.LT.0) THEN
+ G(JP)=G(JP)+AZU(KA)*GA(JP)
+ ELSE IF (IEXT.GT.0) THEN
+ G(JP)=G(JP)-AZL(KA)*GA(JP)
+ END IF
+ IF (ISNA.GE.2) AG(K)=GA(JP)
+ K=K+1
+ 2 CONTINUE
+ 3 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PP1SA3 ALL SYSTEMS 05/12/01
+* PURPOSE :
+* COMPUTATION OF THE VALUE AND THE GRADIENT OF THE LAGRANGIAN FUNCTION
+* FOR THE SUM OF ABSOLUTE VALUES.
+*
+* PARAMETERS:
+* II NF NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI X(NF) VECTOR OF VARIABLES.
+* RI GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION.
+* RI AG(IAG(N+1)-1) SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
+* DIRECTION VECTOR DETERMINATION.
+* II IAG(N+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RI AZ(NA) VECTOR OF LAGRANGE MULTIPLIERS.
+* RI FA VALUE OF THE SELECTED FUNCTION.
+* RI AF(NA) VALUES OF THE APPROXIMATED FUNCTIONS.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
+* IU NFV NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
+* IU NFG NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
+* II ISNA INDICATOR FOR STORING ELEMENTAL FUNCTION VALUES AND
+* GRADIENTS. ISNA=0-STORING SUPPRESSED. ISNA=1-STORING
+* ELEMENTAL FUNCTION VALUES. ISNA=2-STORING ELEMENTAL
+* FUNCTION VALUES AND GRADIENTS.
+*
+* SUBPROGRAMS USED :
+* SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
+* SE DFUN COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
+* S MXVSET INITIATION OF A VECTOR.
+*
+ SUBROUTINE PP1SA3(NF,NA,X,GA,AG,IAG,JAG,G,AZ,FA,AF,F,KD,LD,NFV,
+ & NFG,ISNA)
+ INTEGER NF,NA,IAG(*),JAG(*),KD,LD,NFV,NFG,ISNA
+ DOUBLE PRECISION X(*),GA(*),AG(*),G(*),AZ(*),FA,AF(*),F
+ INTEGER J,JP,K,KA,L
+ IF (KD.LE.LD) RETURN
+ IF (KD.GE.0.AND.LD.LT.0) THEN
+ F=0.0D 0
+ NFV=NFV+1
+ END IF
+ IF (KD.GE.1.AND.LD.LT.1) THEN
+ CALL MXVSET(NF,0.0D 0,G)
+ NFG=NFG+1
+ END IF
+ DO 3 KA=1,NA
+ IF (LD.GE.0) GO TO 1
+ CALL FUN(NF,KA,X,FA)
+ IF (ISNA.GE.1) AF(KA)=FA
+ F=F+ABS(FA)
+ 1 IF (KD.LT.1) GO TO 3
+ IF (LD.GE.1) GO TO 3
+ CALL DFUN(NF,KA,X,GA)
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ DO 2 J=1,L
+ JP=ABS(JAG(K))
+ G(JP)=G(JP)+AZ(KA)*GA(JP)
+ IF (ISNA.GE.2) AG(K)=GA(JP)
+ K=K+1
+ 2 CONTINUE
+ 3 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PPLAG1 ALL SYSTEMS 05/12/01
+* PURPOSE :
+* COMPUTATION OF THE LAGRANGE MULTIPLIERS FOR THE SUM OF ABSOLUTE
+* VALUES.
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI AF(NA) VECTOR CONTAINING VALUES OF APPROXIMATED FUNCTIONS.
+* RA AS(NA) AUXILIARY ARRAY.
+* RO AZ(NA) LAGRANGE MULTIPLIERS.
+* RI RPF3 BARRIER COEFFICIENT.
+*
+ SUBROUTINE PPLAG1(NA,AF,AS,AZ,RPF3)
+ INTEGER NA
+ DOUBLE PRECISION AF(*),AS(*),AZ(*),RPF3
+ DOUBLE PRECISION FA
+ INTEGER KA
+ DO 1 KA=1,NA
+ FA=AF(KA)
+ AS(KA)=RPF3+SQRT(RPF3**2+FA**2)
+ AZ(KA)=FA/AS(KA)
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PS0G01 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* SIMPLE SEARCH WITH TRUST REGION UPDATE.
+*
+* PARAMETERS :
+* RO R VALUE OF THE STEPSIZE PARAMETER.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RI FO INITIAL VALUE OF THE OBJECTIVE FUNCTION.
+* RI PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RI PP QUADRATIC PART OF THE PREDICTED FUNCTION VALUE.
+* RU XDEL TRUST REGION BOUND.
+* RO XDELO PREVIOUS TRUST REGION BOUND.
+* RI XMAX MAXIMUM STEPSIZE.
+* RI RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
+* RI SNORM EUCLIDEAN NORM OF THE DIRECTION VECTOR.
+* RI BET1 LOWER BOUND FOR STEPSIZE REDUCTION.
+* RI BET2 UPPER BOUND FOR STEPSIZE REDUCTION.
+* RI GAM1 LOWER BOUND FOR STEPSIZE EXPANSION.
+* RI GAM2 UPPER BOUND FOR STEPSIZE EXPANSION.
+* RI EPS4 FIRST TOLERANCE FOR RATIO DF/DFPRED. STEP BOUND IS
+* DECREASED IF DF/DFPRED<EPS4.
+* RI EPS5 SECOND TOLERANCE FOR RATIO DF/DFPRED. STEP BOUND IS
+* INCREASED IF IT IS ACTIVE AND DF/DFPRED>EPS5.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
+* FUNCTION.
+* IU IDIR INDICATOR FOR DIRECTION DETERMINATION.
+* IDIR=0-BASIC DETERMINATION. IDIR=1-DETERMINATION
+* AFTER STEPSIZE REDUCTION. IDIR=2-DETERMINATION AFTER
+* STEPSIZE EXPANSION.
+* IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-STEP
+* BOUND WAS DECREASED. ITERS=2-STEP BOUND WAS UNCHANGED.
+* ITERS=3-STEP BOUND WAS INCREASED. ITERS=6-FIRST STEPSIZE.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO MAXST MAXIMUM STEPSIZE INDICATOR. MAXST=0 OR MAXST=1 IF MAXIMUM
+* STEPSIZE WAS NOT OR WAS REACHED.
+* IO NRED ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
+* II MRED MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
+* II KTERS TERMINATION SELECTION. KTERS=1-NORMAL TERMINATION.
+* KTERS=6-FIRST STEPSIZE.
+* II MES1 SWITCH FOR EXTRAPOLATION. MES1=1-CONSTANT INCREASING OF
+* THE INTERVAL. MES1=2-EXTRAPOLATION SPECIFIED BY THE PARAMETER
+* MES. MES1=3 SUPPRESSED EXTRAPOLATION.
+* II MES2 SWITCH FOR TERMINATION. MES2=1-NORMAL TERMINATION.
+* MES2=2-TERMINATION AFTER AT LEAST TWO STEPS (ASYMPTOTICALLY
+* PERFECT LINE SEARCH).
+* II MES3 SAFEGUARD AGAINST ROUNDING ERRORS. MES3=0-SAFEGUARD
+* SUPPRESSED. MES3=1-FIRST LEVEL OF SAFEGUARD. MES3=2-SECOND
+* LEVEL OF SAFEGUARD.
+* IU ISYS CONTROL PARAMETER.
+*
+* METHOD :
+* G.A.SCHULTZ, R.B.SCHNABEL, R.H.BYRD: A FAMILY OF TRUST-REGION-BASED
+* ALGORITHMS FOR UNCONSTRAINED MINIMIZATION WITH STRONG GLOBAL
+* CONVERGENCE PROPERTIES, SIAM J. NUMER.ANAL. 22 (1985) PP. 47-67.
+*
+ SUBROUTINE PS0G01(R,F,FO,PO,PP,XDEL,XDELO,XMAX,RMAX,SNORM,BET1,
+ & BET2,GAM1,GAM2,EPS4,EPS5,KD,LD,IDIR,ITERS,ITERD,MAXST,NRED,MRED,
+ & KTERS,MES1,MES2,MES3,ISYS)
+ INTEGER KD,LD,IDIR,ITERS,ITERD,MAXST,NRED,MRED,KTERS,MES1,MES2,
+ & MES3,ISYS
+ DOUBLE PRECISION R,F,FO,PO,PP,XDEL,XDELO,XMAX,RMAX,SNORM,BET1,
+ & BET2,GAM1,GAM2,EPS4,EPS5
+ DOUBLE PRECISION DF,DFPRED
+ INTEGER NRED1,NRED2
+ SAVE NRED1,NRED2
+ IF (ISYS.EQ.1) GO TO 2
+ IF (IDIR.EQ.0) THEN
+ NRED1=0
+ NRED2=0
+ END IF
+ IDIR=0
+ XDELO=XDEL
+*
+* COMPUTATION OF THE NEW FUNCTION VALUE
+*
+ R=MIN(1.0D 0,RMAX)
+ KD= 0
+ LD=-1
+ ISYS=1
+ RETURN
+ 2 CONTINUE
+ IF (KTERS.LT.0.OR.KTERS.GT.5) THEN
+ ITERS=6
+ ELSE
+ DF=FO-F
+ DFPRED=-R*(PO+R*PP)
+ IF (DF.LT.EPS4*DFPRED) THEN
+*
+* STEP IS TOO LARGE, IT HAS TO BE REDUCED
+*
+ IF (MES1.EQ.1) THEN
+ XDEL=BET2*SNORM
+ ELSE IF (MES1.EQ.2) THEN
+ XDEL=BET2*MIN(0.5D 0*XDEL,SNORM)
+ ELSE
+ XDEL=0.5D 0*PO*SNORM/(PO+DF)
+ XDEL=MAX(XDEL,BET1*SNORM)
+ XDEL=MIN(XDEL,BET2*SNORM)
+ END IF
+ ITERS=1
+ IF (MES3.LE.1) THEN
+ NRED2=NRED2+1
+ ELSE
+ IF (ITERD.GT.2) NRED2=NRED2+1
+ END IF
+ ELSE IF (DF.LE.EPS5*DFPRED) THEN
+*
+* STEP IS SUITABLE
+*
+ ITERS=2
+ ELSE
+*
+* STEP IS TOO SMALL, IT HAS TO BE ENLARGED
+*
+ IF (MES2.EQ.2) THEN
+ XDEL=MAX(XDEL,GAM1*SNORM)
+ ELSE IF (ITERD.GT.2) THEN
+ XDEL=GAM1*XDEL
+ END IF
+ ITERS=3
+ END IF
+ XDEL=MIN(XDEL,XMAX,GAM2*SNORM)
+ IF (FO.LE.F) THEN
+ IF (NRED1.GE.MRED) THEN
+ ITERS=-1
+ ELSE
+ IDIR=1
+ ITERS=0
+ NRED1=NRED1+1
+ END IF
+ END IF
+ END IF
+ MAXST=0
+ IF (XDEL.GE.XMAX) MAXST=1
+ IF (MES3.EQ.0) THEN
+ NRED=NRED1
+ ELSE
+ NRED=NRED2
+ END IF
+ ISYS=0
+ RETURN
+ END
+* SUBROUTINE PS0L02 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* EXTENDED LINE SEARCH WITHOUT DIRECTIONAL DERIVATIVES.
+*
+* PARAMETERS :
+* RO R VALUE OF THE STEPSIZE PARAMETER.
+* RO RO INITIAL VALUE OF THE STEPSIZE PARAMETER.
+* RO RP PREVIOUS VALUE OF THE STEPSIZE PARAMETER.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RI FO INITIAL VALUE OF THE OBJECTIVE FUNCTION.
+* RO FP PREVIOUS VALUE OF THE OBJECTIVE FUNCTION.
+* RI PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO PP PREVIOUS VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RI FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
+* RI FMAX UPPER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
+* RI RMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER
+* RI RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER
+* RI TOLS TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
+* CHANGE OF THE FUNCTION VALUE).
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
+* II NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER LAST RESTART.
+* IO NRED ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
+* II MRED MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
+* IO MAXST MAXIMUM STEPSIZE INDICATOR. MAXST=0 OR MAXST=1 IF MAXIMUM
+* STEPSIZE WAS NOT OR WAS REACHED.
+* II IEST LOWER BOUND SPECIFICATION. IEST=0 OR IEST=1 IF LOWER BOUND
+* IS NOT OR IS GIVEN.
+* II INITS CHOICE OF THE INITIAL STEPSIZE. INITS=0-INITIAL STEPSIZE
+* IS SPECIFIED IN THE CALLING PROGRAM. INITS=1-UNIT INITIAL
+* STEPSIZE. INITS=2-COMBINED UNIT AND QUADRATICALLY ESTIMATED
+* INITIAL STEPSIZE. INITS=3-QUADRATICALLY ESTIMATED INITIAL
+* STEPSIZE.
+* IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT
+* LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY
+* STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE.
+* ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE.
+* ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION.
+* ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL
+* DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION.
+* II KTERS TERMINATION SELECTION. KTERS=1-PERFECT LINE SEARCH.
+* KTERS=2-GOLDSTEIN STEPSIZE. KTERS=3-CURRY STEPSIZE.
+* KTERS=4-EXTENDED CURRY STEPSIZE. KTERS=5-ARMIJO STEPSIZE.
+* KTERS=6-FIRST STEPSIZE.
+* II MES METHOD SELECTION. MES=1-BISECTION. MES=2-QUADRATIC
+* INTERPOLATION (WITH ONE DIRECTIONAL DERIVATIVE).
+* MES=3-QUADRATIC INTERPOLATION (WITH TWO DIRECTIONAL
+* DERIVATIVES). MES=4-CUBIC INTERPOLATION. MES=5-CONIC
+* INTERPOLATION.
+* IU ISYS CONTROL PARAMETER.
+*
+* SUBPROGRAM USED :
+* S PNINT3 EXTRAPOLATION OR INTERPOLATION WITHOUT DIRECTIONAL
+* DERIVATIVES.
+*
+* METHOD :
+* SAFEGUARDED EXTRAPOLATION AND INTERPOLATION WITH EXTENDED TERMINATION
+* CRITERIA.
+*
+ SUBROUTINE PS0L02(R,RO,RP,F,FO,FP,PO,PP,FMIN,FMAX,RMIN,RMAX,TOLS,
+ & KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,INITS,ITERS,KTERS,MES,ISYS)
+ INTEGER KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,INITS,ITERS,KTERS,MES,
+ & ISYS
+ DOUBLE PRECISION R,RO,RP,F,FO,FP,PO,PP,FMIN,FMAX,RMIN,RMAX,TOLS
+ DOUBLE PRECISION RL,FL,RU,FU,RI,FI,RTEMP,TOL
+ INTEGER MTYP,MERR,MODE,INIT1,MES1,MES2
+ LOGICAL L1,L2,L3,L4,L6,L7
+ PARAMETER(TOL=1.0D-2)
+ SAVE MTYP,MODE,MES1,MES2
+ SAVE RL,FL,RU,FU,RI,FI
+ IF (ISYS.EQ.1) GO TO 3
+ MES1=2
+ MES2=2
+ ITERS=0
+ IF (PO.GE.0.0D 0) THEN
+ R=0.0D 0
+ ITERS=-2
+ GO TO 4
+ END IF
+ IF (RMAX.LE.0.0D 0) THEN
+ ITERS= 0
+ GO TO 4
+ END IF
+*
+* INITIAL STEPSIZE SELECTION
+*
+ IF (INITS.GT.0) THEN
+ RTEMP=FMIN-F
+ ELSE IF (IEST.EQ.0) THEN
+ RTEMP=F-FP
+ ELSE
+ RTEMP=MAX(F-FP,FMIN-F)
+ END IF
+ INIT1=ABS(INITS)
+ RP=0.0D 0
+ FP=FO
+ PP=PO
+ IF (INIT1.EQ.0) THEN
+ ELSE IF (INIT1.EQ.1.OR.INITS.GE.1.AND.IEST.EQ.0) THEN
+ R=1.0D 0
+ ELSE IF (INIT1.EQ.2) THEN
+ R=MIN(1.0D 0,4.0D 0*RTEMP/PO)
+ ELSE IF (INIT1.EQ.3) THEN
+ R=MIN(1.0D 0, 2.0D 0*RTEMP/PO)
+ ELSE IF (INIT1.EQ.4) THEN
+ R=2.0D 0*RTEMP/PO
+ END IF
+ RTEMP=R
+ R=MAX(R,RMIN)
+ R=MIN(R,RMAX)
+ MODE=0
+ RL=0.0D 0
+ FL=FO
+ RU=0.0D 0
+ FU=FO
+ RI=0.0D 0
+ FI=FO
+*
+* NEW STEPSIZE SELECTION (EXTRAPOLATION OR INTERPOLATION)
+*
+ 2 CALL PNINT3(RO,RL,RU,RI,FO,FL,FU,FI,PO,R,MODE,MTYP,MERR)
+ IF (MERR.GT.0) THEN
+ ITERS=-MERR
+ GO TO 4
+ ELSE IF (MODE.EQ.1) THEN
+ NRED=NRED-1
+ R=MIN(R,RMAX)
+ ELSE IF (MODE.EQ.2) THEN
+ NRED=NRED+1
+ END IF
+*
+* COMPUTATION OF THE NEW FUNCTION VALUE
+*
+ KD= 0
+ LD=-1
+ ISYS=1
+ RETURN
+ 3 CONTINUE
+ IF (ITERS.NE.0) GO TO 4
+ IF (F.LE.FMIN) THEN
+ ITERS=7
+ GO TO 4
+ ELSE
+ L1=R.LE.RMIN.AND.NIT.NE.KIT
+ L2=R.GE.RMAX
+ L3=F-FO.LE.TOLS*R*PO.OR.F-FMIN.LE.(FO-FMIN)/1.0D 1
+ L4=F-FO.GE.(1.0D 0-TOLS)*R*PO.OR.MES2.EQ.2.AND.MODE.EQ.2
+ L6=RU-RL.LE.TOL*RU.AND.MODE.EQ.2
+ L7=MES2.LE.2.OR.MODE.NE.0
+ MAXST=0
+ IF (L2) MAXST=1
+ END IF
+*
+* TEST ON TERMINATION
+*
+ IF (L1.AND..NOT.L3) THEN
+ ITERS=0
+ GO TO 4
+ ELSE IF (L2.AND..NOT.F.GE.FU) THEN
+ ITERS=7
+ GO TO 4
+ ELSE IF (L6) THEN
+ ITERS=1
+ GO TO 4
+ ELSE IF (L3.AND.L7.AND.KTERS.EQ.5) THEN
+ ITERS=5
+ GO TO 4
+ ELSE IF (L3.AND.L4.AND.L7.AND.(KTERS.EQ.2.OR.KTERS.EQ.3.OR.
+ * KTERS.EQ.4)) THEN
+ ITERS=2
+ GO TO 4
+ ELSE IF (KTERS.LT.0.OR.KTERS.EQ.6.AND.L7) THEN
+ ITERS=6
+ GO TO 4
+ ELSE IF (ABS(NRED).GE.MRED) THEN
+ ITERS=-1
+ GO TO 4
+ ELSE
+ RP=R
+ FP=F
+ MODE=MAX(MODE,1)
+ MTYP=ABS(MES)
+ IF (F.GE.FMAX) MTYP=1
+ END IF
+ IF (MODE.EQ.1) THEN
+*
+* INTERVAL CHANGE AFTER EXTRAPOLATION
+*
+ RL=RI
+ FL=FI
+ RI=RU
+ FI=FU
+ RU=R
+ FU=F
+ IF (F.GE.FI) THEN
+ NRED=0
+ MODE=2
+ ELSE IF ( MES1 .EQ. 1) THEN
+ MTYP=1
+ END IF
+*
+* INTERVAL CHANGE AFTER INTERPOLATION
+*
+ ELSE IF (R.LE.RI) THEN
+ IF (F.LE.FI) THEN
+ RU=RI
+ FU=FI
+ RI=R
+ FI=F
+ ELSE
+ RL=R
+ FL=F
+ END IF
+ ELSE
+ IF (F.LE.FI) THEN
+ RL=RI
+ FL=FI
+ RI=R
+ FI=F
+ ELSE
+ RU=R
+ FU=F
+ END IF
+ END IF
+ GO TO 2
+ 4 ISYS=0
+ RETURN
+ END
+* SUBROUTINE PS1L01 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* STANDARD LINE SEARCH WITH DIRECTIONAL DERIVATIVES.
+*
+* PARAMETERS :
+* RO R VALUE OF THE STEPSIZE PARAMETER.
+* RO RP PREVIOUS VALUE OF THE STEPSIZE PARAMETER.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RI FO INITIAL VALUE OF THE OBJECTIVE FUNCTION.
+* RO FP PREVIOUS VALUE OF THE OBJECTIVE FUNCTION.
+* RO P VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RI PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO PP PREVIOUS VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RI FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
+* RI FMAX UPPER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
+* RI RMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER
+* RI RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER
+* RI TOLS TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
+* CHANGE OF THE FUNCTION VALUE).
+* RI TOLP TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
+* CHANGE OF THE DIRECTIONAL DERIVATIVE).
+* RO PAR1 PARAMETER FOR CONTROLLED SCALING OF VARIABLE METRIC
+* UPDATES.
+* RO PAR2 PARAMETER FOR CONTROLLED SCALING OF VARIABLE METRIC
+* UPDATES.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
+* II NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER LAST RESTART.
+* IO NRED ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
+* II MRED MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
+* IO MAXST MAXIMUM STEPSIZE INDICATOR. MAXST=0 OR MAXST=1 IF MAXIMUM
+* STEPSIZE WAS NOT OR WAS REACHED.
+* II IEST LOWER BOUND SPECIFICATION. IEST=0 OR IEST=1 IF LOWER BOUND
+* IS NOT OR IS GIVEN.
+* II INITS CHOICE OF THE INITIAL STEPSIZE. INITS=0-INITIAL STEPSIZE
+* IS SPECIFIED IN THE CALLING PROGRAM. INITS=1-UNIT INITIAL
+* STEPSIZE. INITS=2-COMBINED UNIT AND QUADRATICALLY ESTIMATED
+* INITIAL STEPSIZE. INITS=3-QUADRATICALLY ESTIMATED INITIAL
+* STEPSIZE.
+* IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT
+* LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY
+* STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE.
+* ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE.
+* ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION.
+* ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL
+* DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION.
+* II KTERS TERMINATION SELECTION. KTERS=1-PERFECT LINE SEARCH.
+* KTERS=2-GOLDSTEIN STEPSIZE. KTERS=3-CURRY STEPSIZE.
+* KTERS=4-EXTENDED CURRY STEPSIZE. KTERS=5-ARMIJO STEPSIZE.
+* KTERS=6-FIRST STEPSIZE.
+* II MES METHOD SELECTION. MES=1-BISECTION. MES=2-QUADRATIC
+* INTERPOLATION (WITH ONE DIRECTIONAL DERIVATIVE).
+* MES=3-QUADRATIC INTERPOLATION (WITH TWO DIRECTIONAL
+* DERIVATIVES). MES=4-CUBIC INTERPOLATION. MES=5-CONIC
+* INTERPOLATION.
+* IU ISYS CONTROL PARAMETER.
+*
+* SUBPROGRAM USED :
+* S PNINT1 EXTRAPOLATION OR INTERPOLATION WITH DIRECTIONAL
+* DERIVATIVES.
+*
+* METHOD :
+* SAFEGUARDED EXTRAPOLATION AND INTERPOLATION WITH STANDARD TERMINATION
+* CRITERIA.
+*
+ SUBROUTINE PS1L01(R,RP,F,FO,FP,P,PO,PP,FMIN,FMAX,RMIN,RMAX,
+ & TOLS,TOLP,PAR1,PAR2,KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,INITS,
+ & ITERS,KTERS,MES,ISYS)
+ INTEGER KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,INITS,ITERS,KTERS,
+ & MES,ISYS
+ DOUBLE PRECISION R,RP,F,FO,FP,P,PO,PP,FMIN,FMAX,RMIN,RMAX,
+ & TOLS,TOLP,PAR1,PAR2
+ DOUBLE PRECISION RL,FL,PL,RU,FU,PU,RTEMP
+ INTEGER MTYP,MERR,MODE,INIT1,MES1,MES2,MES3
+ LOGICAL L1,L2,L3,L5,L7,M1,M2,M3
+ DOUBLE PRECISION CON,CON1
+ PARAMETER (CON=1.0D-2,CON1=1.0D-13)
+ SAVE MTYP,MODE,MES1,MES2,MES3
+ SAVE RL,FL,PL,RU,FU,PU
+ IF (ISYS.EQ.1) GO TO 3
+ MES1=2
+ MES2=2
+ MES3=2
+ ITERS=0
+ IF (PO.GE.0.0D 0) THEN
+ R=0.0D 0
+ ITERS=-2
+ GO TO 4
+ END IF
+ IF (RMAX.LE.0.0D 0) THEN
+ ITERS=0
+ GO TO 4
+ END IF
+*
+* INITIAL STEPSIZE SELECTION
+*
+ IF (INITS.GT.0) THEN
+ RTEMP=FMIN-F
+ ELSE IF (IEST.EQ.0) THEN
+ RTEMP=F-FP
+ ELSE
+ RTEMP=MAX(F-FP,FMIN-F)
+ END IF
+ INIT1=ABS(INITS)
+ RP=0.0D 0
+ FP=FO
+ PP=PO
+ IF (INIT1.EQ.0) THEN
+ ELSE IF (INIT1.EQ.1.OR.INITS.GE.1.AND.IEST.EQ.0) THEN
+ R=1.0D 0
+ ELSE IF (INIT1.EQ.2) THEN
+ R=MIN(1.0D 0,4.0D 0*RTEMP/PO)
+ ELSE IF (INIT1.EQ.3) THEN
+ R=MIN(1.0D 0, 2.0D 0*RTEMP/PO)
+ ELSE IF (INIT1.EQ.4) THEN
+ R=2.0D 0*RTEMP/PO
+ END IF
+ R=MAX(R,RMIN)
+ R=MIN(R,RMAX)
+ MODE=0
+ RU=0.0D 0
+ FU=FO
+ PU=PO
+*
+* NEW STEPSIZE SELECTION (EXTRAPOLATION OR INTERPOLATION)
+*
+ 2 CALL PNINT1(RL,RU,FL,FU,PL,PU,R,MODE,MTYP,MERR)
+ IF (MERR.GT.0) THEN
+ ITERS=-MERR
+ GO TO 4
+ ELSE IF (MODE.EQ.1) THEN
+ NRED=NRED-1
+ R=MIN(R,RMAX)
+ ELSE IF (MODE.EQ.2) THEN
+ NRED=NRED+1
+ END IF
+*
+* COMPUTATION OF THE NEW FUNCTION VALUE AND THE NEW DIRECTIONAL
+* DERIVATIVE
+*
+ KD= 1
+ LD=-1
+ ISYS=1
+ RETURN
+ 3 CONTINUE
+ IF (MODE.EQ.0) THEN
+ PAR1=P/PO
+ PAR2=F-FO
+ END IF
+ IF (ITERS.NE.0) GO TO 4
+ IF (F.LE.FMIN) THEN
+ ITERS=7
+ GO TO 4
+ ELSE
+ L1=R.LE.RMIN.AND.NIT.NE.KIT
+ L2=R.GE.RMAX
+ L3=F-FO.LE.TOLS*R*PO
+ L5=P.GE.TOLP*PO.OR.MES2.EQ.2.AND.MODE.EQ.2
+ L7=MES2.LE.2.OR.MODE.NE.0
+ M1=.FALSE.
+ M2=.FALSE.
+ M3=L3
+ IF (MES3.GE.1) THEN
+ M1=ABS(P).LE.CON*ABS(PO).AND.FO-F.GE.(CON1/CON)*ABS(FO)
+ L3=L3.OR.M1
+ END IF
+ IF (MES3.GE.2) THEN
+ M2=ABS(P).LE.0.5D 0*ABS(PO).AND.ABS(FO-F).LE.2.0D 0*CON1*ABS(FO)
+ L3=L3.OR.M2
+ END IF
+ MAXST=0
+ IF (L2) MAXST=1
+ END IF
+*
+* TEST ON TERMINATION
+*
+ IF (L1.AND..NOT.L3) THEN
+ ITERS=0
+ GO TO 4
+ ELSE IF (L2.AND.L3.AND..NOT.L5) THEN
+ ITERS=7
+ GO TO 4
+ ELSE IF (M3.AND.MES1.EQ.3) THEN
+ ITERS=5
+ GO TO 4
+ ELSE IF (L3.AND.L5.AND.L7) THEN
+ ITERS=4
+ GO TO 4
+ ELSE IF (KTERS.LT.0.OR.KTERS.EQ.6.AND.L7) THEN
+ ITERS=6
+ GO TO 4
+ ELSE IF (ABS(NRED).GE.MRED) THEN
+ ITERS=-1
+ GO TO 4
+ ELSE
+ RP=R
+ FP=F
+ PP=P
+ MODE=MAX(MODE,1)
+ MTYP=ABS(MES)
+ IF (F.GE.FMAX) MTYP=1
+ END IF
+ IF (MODE.EQ.1) THEN
+*
+* INTERVAL CHANGE AFTER EXTRAPOLATION
+*
+ RL=RU
+ FL=FU
+ PL=PU
+ RU=R
+ FU=F
+ PU=P
+ IF (.NOT.L3) THEN
+ NRED=0
+ MODE=2
+ ELSE IF ( MES1 .EQ. 1) THEN
+ MTYP=1
+ END IF
+ ELSE
+*
+* INTERVAL CHANGE AFTER INTERPOLATION
+*
+ IF (.NOT.L3) THEN
+ RU=R
+ FU=F
+ PU=P
+ ELSE
+ RL=R
+ FL=F
+ PL=P
+ END IF
+ END IF
+ GO TO 2
+ 4 ISYS=0
+ RETURN
+ END
+* SUBROUTINE PS1L18 ALL SYSTEMS 99/12/01
+* PURPOSE :
+* SPECIAL LINE SEARCH FOR NONSMOOTH NONCONVEX VARIABLE METRIC METHOD.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS
+* II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
+* RU X(N) VECTOR OF VARIABLES.
+* RO G(N) SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RI S(N) DIRECTION VECTOR.
+* RU U(N) PREVIOUS VECTOR OF VARIABLES.
+* RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES.
+* RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS.
+* RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS.
+* RO T VALUE OF THE STEPSIZE PARAMETER.
+* RO TB BUNDLE PARAMETER FOR MATRIX SCALING.
+* RO FO PREVIOUS VALUE OF THE OBJECTIVE FUNCTION.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RU PO PREVIOUS DIRECTIONAL DERIVATIVE.
+* RU P DIRECTIONAL DERIVATIVE.
+* RI TMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER.
+* RI TMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
+* RI SNORM EUCLIDEAN NORM OF THE DIRECTION VECTOR.
+* RI WK STOPPING PARAMETER.
+* RI EPS1 TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
+* CHANGE OF THE FUNCTION VALUE).
+* RI EPS2 TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
+* DIRECTIONAL DERIVATIVE).
+* RI ETA5 DISTANCE MEASURE PARAMETER.
+* RI ETA9 MAXIMUM FOR REAL NUMBERS.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
+* II JE EXTRAPOLATION INDICATOR.
+* RI MOS3 LOCALITY MEASURE PARAMETER.
+* IO ITERS NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT
+* STEP.
+* IU ISYS CONTROL PARAMETER.
+*
+* VARIABLES IN COMMON /STAT/ (STATISTICS) :
+* IO NRES NUMBER OF RESTARTS.
+* IO NDEC NUMBER OF MATRIX DECOMPOSITIONS.
+* IO NIN NUMBER OF INNER ITERATIONS.
+* IO NIT NUMBER OF ITERATIONS.
+* IO NFV NUMBER OF FUNCTION EVALUATIONS.
+* IO NFG NUMBER OF GRADIENT EVALUATIONS.
+* IO NFH NUMBER OF HESSIAN EVALUATIONS.
+*
+* SUBPROGRAMS USED :
+* S PNINT1 EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH
+* S PNSTP4 STEPSIZE DETERMINATION FOR DESCENT STEPS.
+* S PNSTP5 STEPSIZE DETERMINATION FOR NULL STEPS.
+* WITH DIRECTIONAL DERIVATIVES.
+* S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXVDOT DOT PRODUCT OF TWO VECTORS.
+*
+* METHOD :
+* SPECIAL METHOD OF STEP LENGTH DETERMINATION.
+*
+ SUBROUTINE PS1L18(N,MA,MAL,X,G,S,U,AF,AG,AY,T,TB,FO,F,PO,P,TMIN,
+ & TMAX,SNORM,WK,EPS1,EPS2,ETA5,ETA9,KD,LD,JE,MOS3,ITERS,ISYS)
+ DOUBLE PRECISION EPS1,EPS2,ETA5,ETA9,F,FO,P,PO,SNORM,T,TB,TMAX,
+ & TMIN,WK
+ INTEGER ITERS,ISYS,JE,KD,LD,MA,MAL,MOS3,N
+ DOUBLE PRECISION AF(*),AG(*),AY(*),G(*),S(*),U(*),X(*)
+ DOUBLE PRECISION BET,FL,FU,PL,PU,TL,TU
+ INTEGER IER
+ DOUBLE PRECISION MXVDOT
+ SAVE FL,FU,PL,PU,TL,TU
+ IF (ISYS.GT.0) GO TO 25
+ IF (JE.GT.0) T = DBLE(2-JE/99)*T
+ IF (JE.LE.0) T = MIN(1.0D0,TMAX)
+ IF (PO.EQ.0.0D0 .OR. JE.GT.0) GO TO 10
+ IF (ITERS.EQ.1) THEN
+ CALL PNSTP4(N,MA,MAL,X,AF,AG,AY,S,F,PO,T,TB,ETA5,ETA9,MOS3)
+ ELSE
+ CALL PNSTP5(N,MA,MAL,X,AF,AG,AY,S,F,PO,T,TB,ETA5,ETA9,MOS3)
+ END IF
+ 10 T = MIN(MAX(T,TMIN),TMAX)
+ TL = 0.0D0
+ TU = T
+ FL = FO
+ PL = PO
+*
+* FUNCTION AND GRADIENT EVALUATION AT A NEW POINT
+*
+ 20 CALL MXVDIR(N,T,S,U,X)
+ KD= 1
+ LD=-1
+ ISYS=1
+ RETURN
+ 25 CONTINUE
+ P = MXVDOT(N,G,S)
+*
+* NULL/DESCENT STEP TEST (ITERS=0/1)
+*
+ ITERS = 1
+ IF (F.LE.FO-T* (EPS1+EPS1)*WK) THEN
+ TL = T
+ FL = F
+ PL = P
+ ELSE
+ TU = T
+ FU = F
+ PU = P
+ END IF
+ BET = MAX(ABS(FO-F+P*T),ETA5* (SNORM*T)**MOS3)
+ IF (F.LE.FO-T*EPS1*WK .AND. (T.GE.TMIN.OR.
+ & BET.GT.EPS1*WK)) GO TO 40
+ IF (P-BET.GE.-EPS2*WK .OR. TU-TL.LT.TMIN*1.0D-1) GO TO 30
+ IF (TL.EQ.0.0D0 .AND. PL.LT.0.0D0) THEN
+ CALL PNINT1(TL,TU,FL,FU,PL,PU,T,2,2,IER)
+ ELSE
+ T = 5.0D-1* (TU+TL)
+ END IF
+ GO TO 20
+ 30 ITERS = 0
+ 40 CONTINUE
+ ISYS=0
+ RETURN
+ END
+* SUBROUTINE PUBBM1 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* PARTITIONED VARIABLE METRIC UPDATE.
+*
+* PARAMETERS :
+* II NA NUMBER OF BLOCKS OF THE MATRIX H.
+* RU AH(MB) APPROXIMATION OF THE PARTITIONED HESSIAN MATRIX.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RA S(NF) AUXILIARY VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI AGO(MA) GRADIENTS DIFFERENCE.
+* RI ETA0 MACHINE PRECISION.
+* RI ETA9 MAXIMUM MACHINE NUMBER.
+* IU ICOR SWITCH BETWEEN UPDATES. ICOR=0-THE BFGS UPDATE.
+* ICOR=1-THE RANK ONE UPDATE.
+* II NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER LAST RESTART.
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+* II MET METHOD SELECTION. MET=0-NO UPDATE. MET=1-BFGS UPDATE.
+* MET=2-COMBINATION OF BFGS AND RANK-ONE UPDATES.
+* II MET1 SELECTION OF SELF SCALING. MET1=1-SELF SCALING SUPPRESSED.
+* MET1=2 SELF SCALING IN THE FIRST ITERATION AFTER RESTART.
+* MET1=3-SELF SCALING IN EACH ITERATION.
+*
+* SUBPROGRAMS USED :
+* S MXBSBM MULTIPLICATION OF A PARTITIONED MATRIX BY A VECTOR.
+* S MXBSBU UPDATE OF A PARTITIONED MATRIX.
+* S MXDSMS SCALING OF A DENSE SYMMETRIC MATRIX.
+* S MXWDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXWDOT DOT PRODUCT OF TWO SPARSE VECTORS.
+*
+ SUBROUTINE PUBBM1(NA,AH,IAG,JAG,S,XO,AGO,ETA0,ETA9,ICOR,NIT,KIT,
+ & ITERH,MET,MET1)
+ INTEGER NA,IAG(*),JAG(*),ICOR,NIT,KIT,ITERH,MET,
+ & MET1
+ DOUBLE PRECISION AH(*),S(*),XO(*),AGO(*),ETA0,ETA9
+ DOUBLE PRECISION A,B,C,GAM,POM,DEN,MXWDOT
+ INTEGER K,L,KA,NB,INEG
+ LOGICAL L1,L3
+ IF (MET.LE.0) GO TO 22
+ L1=MET1.GE.3.OR.MET1.EQ.2.AND.NIT.EQ.KIT
+ L3=.NOT.L1
+ NB=0
+ INEG=0
+ DO 21 KA=1,NA
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+*
+* DETERMINATION OF THE PARAMETERS B, C
+*
+ B=MXWDOT(L,JAG(K),AGO(K),XO,2)
+ IF (MET.EQ.1) THEN
+ IF (B.LE.1.0D 0/ETA9) GO TO 20
+ ELSE
+ IF (ABS(B).LE.1.0D 0/ETA9) GO TO 20
+ END IF
+ A=0.0D 0
+ CALL MXBSBM(L,AH(NB+1),JAG(K),XO,S,1)
+ C=MXWDOT(L,JAG(K),XO,S,1)
+ IF (ABS(C).LE.1.0D 0/ETA9) GO TO 20
+ IF (L1) THEN
+*
+* DETERMINATION OF THE PARAMETER GAM (SELF SCALING)
+*
+ GAM=C/B
+ IF (L3) THEN
+ GAM=1.0D 0
+ END IF
+ ELSE
+ GAM=1.0D 0
+ END IF
+ IF (MET.EQ.1) THEN
+*
+* BFGS UPDATE
+*
+ POM=0.0D 0
+ CALL MXBSBU(L,AH(NB+1),JAG(K),GAM/B,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),-1.0D 0/C,S,1)
+ ELSE
+ IF (B.LT.0.0D 0) INEG=INEG+1
+ IF (ICOR.GT.0) THEN
+*
+* RANK ONE UPDATE
+*
+ DEN=GAM*B-C
+ IF (ABS(DEN).GT.ETA0*ABS(C)) THEN
+ POM=GAM*B/DEN
+ CALL MXWDIR(L,JAG(K),-GAM,AGO(K),S,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K), 1.0D 0/DEN,AGO(K),2)
+ ELSE
+ GO TO 20
+ END IF
+ ELSE IF (B.LT.0.0D 0) THEN
+ GO TO 20
+ ELSE
+*
+* BFGS UPDATE
+*
+ POM=0.0D 0
+ CALL MXBSBU(L,AH(NB+1),JAG(K),GAM/B,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),-1.0D 0/C,S,1)
+ END IF
+ END IF
+ ITERH=0
+ IF (GAM.NE.1.0D 0) THEN
+ CALL MXDSMS(L,AH(NB+1),1.0D 0/GAM)
+ END IF
+ 20 CONTINUE
+ NB=NB+L*(L+1)/2
+ 21 CONTINUE
+ IF (INEG.GE.NA/2) ICOR=1
+ 22 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PUBBM2 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* PARTITIONED VARIABLE METRIC UPDATE.
+*
+* PARAMETERS :
+* II NA NUMBER OF BLOCKS OF THE MATRIX H.
+* RU AH(MB) APPROXIMATION OF THE PARTITIONED HESSIAN MATRIX.
+* RI IAG(NA+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RA S(NF) AUXILIARY VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI AGO(MA) GRADIENTS DIFFERENCE.
+* RI ETA0 MACHINE PRECISION.
+* RI ETA9 MAXIMUM MACHINE NUMBER.
+* II NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER LAST RESTART.
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+* II MET VARIABLE METRIC UPDATE. MET=1-THE BFGS UPDATE. MET=2-THE
+* DFP UPDATE. MET=3-THE HOSHINO UPDATE. MET=4-THE RANK ONE
+* UPDATE.
+* II MET1 SELECTION OF SELF SCALING. MET1=1-SELF SCALING SUPPRESSED.
+* MET1=2 SELF SCALING IN THE FIRST ITERATION AFTER RESTART.
+* MET1=3-CONTROLLED SELF SCALING.
+* II MET3 CORRECTION OF THE UPDATE. MET3=1-CORRECTION IS SUPPRESSED.
+* MET3=2-THE POWELL UPDATE.
+*
+* SUBPROGRAMS USED :
+* S MXBSBM MULTIPLICATION OF A PARTITIONED MATRIX BY A VECTOR.
+* S MXBSBU UPDATE OF A PARTITIONED MATRIX.
+* S MXDSMS SCALING OF A DENSE SYMMETRIC MATRIX.
+* S MXWDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXWDOT DOT PRODUCT OF TWO SPARSE VECTORS.
+*
+ SUBROUTINE PUBBM2(NA,AH,IAG,JAG,S,XO,AGO,ETA0,ETA9,NIT,KIT,ITERH,
+ & MET,MET1,MET3)
+ INTEGER NA,IAG(*),JAG(*),NIT,KIT,ITERH,MET,MET1,MET3
+ DOUBLE PRECISION AH(*),S(*),XO(*),AGO(*),ETA0,ETA9
+ DOUBLE PRECISION A,B,C,GAM,POM,DEN,DIS,MXWDOT
+ INTEGER K,L,KA,NB
+ LOGICAL L1,L3
+ DOUBLE PRECISION CON,CON1,CON2
+ PARAMETER (CON=0.1D 0,CON1=0.5D 0,CON2=4.0D 0)
+ L1=MET1.GE.3.OR.MET1.EQ.2.AND.NIT.EQ.KIT
+ L3=.NOT.L1
+ NB=0
+ DO 21 KA=1,NA
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+*
+* DETERMINATION OF THE PARAMETERS B, C
+*
+ B=MXWDOT(L,JAG(K),AGO(K),XO,2)
+ IF (MET3.EQ.1) THEN
+ IF (B.LE.1.0D 0/ETA9) GO TO 20
+ ELSE
+ IF (ABS(B).LE.1.0D 0/ETA9) GO TO 20
+ END IF
+ A=0.0D 0
+ CALL MXBSBM(L,AH(NB+1),JAG(K),XO,S,1)
+ C=MXWDOT(L,JAG(K),XO,S,1)
+ IF (MET3.EQ.3) THEN
+ IF (ABS(C).LE.1.0D 0/ETA9) GO TO 20
+ ELSE
+ IF (C.LE.1.0D 0/ETA9) GO TO 20
+ END IF
+ IF (MET3.EQ.2) THEN
+ IF (B.LE.0.0D 0) THEN
+*
+* POWELL'S CORRECTION
+*
+ DIS=(1.0D 0-CON)*C/(C-B)
+ CALL MXWDIR(L,JAG(K),-1.0D 0,AGO(K),S,AGO(K),2)
+ CALL MXWDIR(L,JAG(K),-DIS,AGO(K),S,AGO(K),2)
+ B=C+DIS*(B-C)
+ END IF
+ END IF
+ IF (L1) THEN
+*
+* DETERMINATION OF THE PARAMETER GAM (SELF SCALING)
+*
+ GAM=C/B
+ IF (MET1.EQ.3) THEN
+ IF (NIT.NE.KIT) THEN
+ L3=GAM.LT.CON1.OR.GAM.GT.CON2
+ END IF
+ ELSE IF (MET1.EQ.4) THEN
+ GAM=MAX(1.0D 0,GAM)
+ END IF
+ IF (L3) THEN
+ GAM=1.0D 0
+ END IF
+ ELSE
+ GAM=1.0D 0
+ END IF
+ IF (MET.EQ.1) THEN
+ GO TO 18
+ ELSE IF (MET.EQ.2) THEN
+*
+* DFP UPDATE
+*
+ DEN=GAM*B+C
+ DIS=GAM+C/B
+ POM=1.0D 0
+ CALL MXWDIR(L,JAG(K),-DIS,AGO(K),S,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),1.0D 0/DEN,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),-1.0D 0/DEN,S,1)
+ GO TO 19
+ ELSE IF (MET.EQ.3) THEN
+*
+* HOSHINO UPDATE
+*
+ DEN=GAM*B+C
+ DIS=0.5D 0*B
+ POM=GAM*B/DEN
+ CALL MXBSBU(L,AH(NB+1),JAG(K),GAM/DIS,AGO(K),2)
+ CALL MXWDIR(L,JAG(K),GAM,AGO(K),S,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),-1.0D 0/DEN,AGO(K),2)
+ GO TO 19
+ ELSE IF (MET.EQ.4) THEN
+*
+* RANK ONE UPDATE
+*
+ DEN=GAM*B-C
+ IF (MET3.EQ.3) THEN
+ IF (ABS(DEN).LE.ETA0*ABS(C)) GO TO 18
+ ELSE
+ IF (DEN.LE.ETA0*C) GO TO 18
+ END IF
+ POM=GAM*B/DEN
+ CALL MXWDIR(L,JAG(K),-GAM,AGO(K),S,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K), 1.0D 0/DEN,AGO(K),2)
+ GO TO 19
+ END IF
+ 18 CONTINUE
+*
+* BFGS UPDATE
+*
+ POM=0.0D 0
+ CALL MXBSBU(L,AH(NB+1),JAG(K),GAM/B,AGO(K),2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),-1.0D 0/C,S,1)
+ 19 CONTINUE
+ ITERH=0
+ IF (GAM.NE.1.0D 0) THEN
+ CALL MXDSMS(L,AH(NB+1),1.0D 0/GAM)
+ END IF
+ 20 CONTINUE
+ NB=NB+L*(L+1)/2
+ 21 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PUBVI2 ALL SYSTEMS 04/12/01
+* PURPOSE :
+* NONSMOOTH VARIABLE METRIC UPDATE OF THE INVERSE HESSIAN MATRIX.
+*
+* PARAMETERS :
+* II NF ACTUAL NUMBER OF VARIABLES.
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* II MA NUMBER OF ELEMENTS IN THE FIELD AG.
+* II MB NUMBER OF NONZERO ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
+* RU AH(MB) NUMERICAL VALUES OF ELEMENTS OF THE PARTITIONED HESSIAN
+* MATRIX.
+* II IAG(NA+1) POINTERS OF THE JACOBIAN MATRIX.
+* RI JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* RI AG(NF) NEW GENERALIZED JACOBIAN MATRIX.
+* RI AGO(NF) OLD GENERALIZED JACOBIAN MATRIX.
+* RI XO(N) VECTOR OF VARIABLES DIFFERENCE.
+* RO S(NF) AUXILIARY VECTOR.
+* RO U(NF) AUXILIARY VECTOR.
+* RI ETA9 MAXIMUM MACHINE NUMBER.
+* II NNK CONSECUTIVE NULL STEPS COUNTER.
+* II NIT ACTUAL NUMBER OF ITERATIONS.
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+*
+* SUBPROGRAMS USED :
+* S MXBSBM MULTIPLICATION OF A DENSE SYMMETRIC MATRIX BY A VECTOR.
+* S MXBSBU UPDATE OF A PARTITIONED SYMMETRIC MATRIX.
+* S MXDSMS SCALING OF A DENSE SYMMETRIC MATRIX.
+* S MXVDIF DIFFERENCE OF TWO VECTORS.
+* S MXWDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXWDOT DOT PRODUCT OF VECTORS.
+*
+ SUBROUTINE PUBVI2(NA,AH,IAG,JAG,AG,AGO,XO,S,U,ETA9,NNK,NIT,ITERH)
+ INTEGER NA,IAG(*),JAG(*),NNK,NIT,ITERH
+ DOUBLE PRECISION AH(*),AG(*),AGO(*),XO(*),S(*),U(*),ETA9
+ DOUBLE PRECISION GAM,A,B,C,Q,DEN,POM,MXWDOT
+ INTEGER KA,K,L,NB,INEG
+ LOGICAL LB,LR
+ NB=0
+ INEG=0
+ DO 21 KA=1,NA
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ CALL MXVDIF(L,AG(K),AGO(K),U)
+*
+* DETERMINATION OF THE PARAMETERS B, C
+*
+ B=MXWDOT(L,JAG(K),U,XO,2)
+ IF (ABS(B).LE.1.0D 0/ETA9) GO TO 20
+ A=0.0D 0
+ CALL MXBSBM(L,AH(NB+1),JAG(K),XO,S,1)
+ C=MXWDOT(L,JAG(K),XO,S,1)
+ IF (ABS(C).LE.1.0D 0/ETA9) GO TO 20
+ GAM=1.0D 0
+ IF (NIT.EQ.1) THEN
+ Q=1.0D 0
+ IF (C.NE.0.0D 0) Q=C/B
+ IF ((Q-2.5D-1)*(Q-3.0D 0).GT.0.0D 0) GAM=MIN(3.0D 0,
+ & MAX(2.0D-2,Q))
+ END IF
+ IF (B.LT.0.0D 0) INEG=INEG+1
+ LB=NNK.EQ.0
+ LR=NNK.NE.0.AND.C.LT.GAM*B
+ IF (LB)THEN
+ IF (B.LT.0.0D 0) GO TO 20
+*
+* BFGS UPDATE
+*
+ POM=0.0D 0
+ CALL MXBSBU(L,AH(NB+1),JAG(K),GAM/B,U,2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K),-1.0D 0/C,S,1)
+ ITERH=0
+ IF (GAM.NE.1.0D 0) THEN
+ CALL MXDSMS(L,AH(NB+1),1.0D 0/GAM)
+ END IF
+ ELSE IF (LR) THEN
+ DEN=GAM*B-C
+ POM=GAM*B/DEN
+ CALL MXWDIR(L,JAG(K),-GAM,U,S,U,2)
+ CALL MXBSBU(L,AH(NB+1),JAG(K), 1.0D 0/DEN,U,2)
+ END IF
+ 20 CONTINUE
+ NB=NB+L*(L+1)/2
+ 21 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PULCI3 ALL SYSTEMS 96/12/01
+* PURPOSE :
+* LIMITED STORAGE INVERSE COLUMN UPDATE METHODS.
+*
+* PARAMETERS :
+* II N NUMBER OF VARIABLES.
+* RI A(IAG(N+1)-1) SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
+* DIRECTION VECTOR DETERMINATION.
+* II IA(N+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
+* II JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
+* IU IP(N) PERMUTATION VECTOR.
+* IU ID(N) POSITION OF THE DIAGONAL ELEMENTS IN THE FIELD AG.
+* RU XM(N*MF) SET OF VECTORS FOR INVERSE COLUMN UPDATE.
+* RU GM(MF) SET OF VALUES FOR INVERSE COLUMN UPDATE.
+* IU IM(MF) SET OF INDICES FOR INVERSE COLUMN UPDATE.
+* RA XO(N) AUXILIARY VECTOR.
+* RI AFO(N) GRADIENTS DIFERENCES.
+* RO S(N) DIRECTION VECTOR.
+* II MF NUMBER OF VARIABLE METRIC UPDATES.
+* II NIT NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER LAST RESTART.
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+* IU IREST RESTART INDICATOR.
+*
+* SUBPROGRAMS USED :
+* S MXLIIM MATRIX MULTIPLICATION FOR LIMITED STORAGE INVERSE
+* COLUMN UPDATE METHOD.
+* S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXVMX1 DOT PRODUCT OF VECTORS.
+*
+* METHOD :
+* LIMITED STORAGE VARIABLE METRIC METHODS.
+*
+ SUBROUTINE PULCI3(N,A,IA,JA,IP,ID,XM,GM,IM,XO,AFO,S,MF,NIT,KIT,
+ + ITERH,IREST)
+ INTEGER IREST,ITERH,NIT,KIT,MF,N
+ DOUBLE PRECISION A(*),AFO(*),GM(*),S(*),XM(*),XO(*)
+ INTEGER IA(*),ID(*),IM(*),IP(*),JA(*)
+ DOUBLE PRECISION TEMP
+ INTEGER II,MA,MM
+ DOUBLE PRECISION MXVMX1
+ MA = IA(N+1) - 1
+ MM = MIN(NIT-KIT,MF)
+ IF (MM.GE.MF) THEN
+ ITERH = 1
+ IREST = 1
+ ELSE
+ II = N*MM + 1
+ CALL MXLIIM(N,MM,A(MA+1),IA,JA,IP,ID,XM,GM,IM,AFO,XM(II),S)
+ CALL MXVDIR(N,-1.0D0,XM(II),XO,XM(II))
+ MM = MM + 1
+ TEMP = MXVMX1(N,AFO,II)
+ IF (TEMP.LE.0.0D0) THEN
+ ITERH = 2
+ ELSE
+ IM(MM) = II
+ GM(MM) = AFO(II)
+ ITERH = 0
+ END IF
+ END IF
+ RETURN
+ END
+* SUBROUTINE PULSP3 ALL SYSTEMS 02/12/01
+* PURPOSE :
+* LIMITED STORAGE VARIABLE METRIC UPDATE.
+*
+* PARAMETERS :
+* II N NUMBER OF VARIABLES (NUMBER OF ROWS OF XM).
+* II M NUMBER OF COLUMNS OF XM.
+* II MF MAXIMUM NUMBER OF COLUMNS OF XM.
+* RI XM(N*M) RECTANGULAR MATRIX IN THE PRODUCT FORM SHIFTED BROYDEN
+* METHOD (STORED COLUMNWISE): H-SIGMA*I=XM*TRANS(XM)
+* RO GR(M) MATRIX TRANS(XM)*GO.
+* RU XO(N) VECTORS OF VARIABLES DIFFERENCE XO AND VECTOR XO-TILDE.
+* RU GO(N) GRADIENT DIFFERENCE GO AND VECTOR XM*TRANS(XM)*GO.
+* RI R STEPSIZE PARAMETER.
+* RI PO OLD DIRECTIONAL DERIVATIVE (MULTIPLIED BY R)
+* RU SIG SCALING PARAMETER (ZETA AND SIGMA).
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+* II MET3 CHOICE OF SIGMA (1-CONSTANT, 2-QUADRATIC EQUATION).
+*
+* SUBPROGRAMS USED :
+* S MXDRMM MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR
+* MATRIX BY A VECTOR.
+* S MXDCMU UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX.
+* WITH CONTROLLING OF POSITIVE DEFINITENESS.
+* S MXVDIR VECTOR AUGMENTED BY A SCALED VECTOR.
+* RF MXVDOT DOT PRODUCT OF VECTORS.
+* S MXVSCL SCALING OF A VECTOR.
+*
+* METHOD :
+* SHIFTED BFGS METHOD IN THE PRODUCT FORM.
+*
+ SUBROUTINE PULSP3(N,M,MF,XM,GR,XO,GO,R,PO,SIG,ITERH,MET3)
+ INTEGER N,M,MF,ITERH,MET3
+ DOUBLE PRECISION XM(*),GR(*),XO(*),GO(*),R,PO,SIG
+ DOUBLE PRECISION DEN,POM,A,B,C,AA,AH,BB,PAR,MXVDOT
+ IF (M.GE.MF) RETURN
+ B=MXVDOT(N,XO,GO)
+ IF (B.LE.0.0D 0) THEN
+ ITERH=2
+ GO TO 22
+ END IF
+ CALL MXDRMM(N,M,XM,GO,GR)
+ AH=MXVDOT(N,GO,GO)
+ AA=MXVDOT(M,GR,GR)
+ A=AA+AH*SIG
+ C=-R*PO
+*
+* DETERMINATION OF THE PARAMETER SIG (SHIFT)
+*
+ PAR=1.0D 0
+ POM=B/AH
+ IF (A.GT.0.0D 0) THEN
+ DEN=MXVDOT(N,XO,XO)
+ IF (MET3.LE.4) THEN
+ SIG=SQRT(MAX(0.0D 0,1.0D 0-AA/A))/(1.0D 0+
+ & SQRT(MAX(0.0D 0,1.0D 0-B*B/(DEN*AH))))*POM
+ ELSE
+ SIG=SQRT(MAX(0.0D 0,SIG*AH/A))/(1.0D 0+
+ & SQRT(MAX(0.0D 0,1.0D 0-B*B/(DEN*AH))))*POM
+ END IF
+ SIG=MAX(SIG,2.0D-1*POM)
+ SIG=MIN(SIG,8.0D-1*POM)
+ ELSE
+ SIG=2.5D-1*POM
+ END IF
+*
+* COMPUTATION OF SHIFTED XO AND SHIFTED B
+*
+ BB=B-AH*SIG
+ CALL MXVDIR(N,-SIG,GO,XO,XO)
+*
+* BFGS-BASED SHIFTED BFGS UPDATE
+*
+ POM=1.0D 0
+ CALL MXDCMU(N,M,XM,-1.0D 0/BB,XO,GR)
+ CALL MXVSCL(N,SQRT(PAR/BB),XO,XM(N*M+1))
+ M=M+1
+ 22 CONTINUE
+ ITERH=0
+ RETURN
+ END
+* SUBROUTINE PULVP3 ALL SYSTEMS 03/12/01
+* PURPOSE :
+* RANK-TWO LIMITED-STORAGE VARIABLE-METRIC METHODS IN THE PRODUCT FORM.
+*
+* PARAMETERS :
+* II N NUMBER OF VARIABLES (NUMBER OF ROWS OF XM).
+* II M NUMBER OF COLUMNS OF XM.
+* RI XM(N*M) RECTANGULAR MATRIX IN THE PRODUCT FORM SHIFTED BROYDEN
+* METHOD (STORED COLUMNWISE): H-SIGMA*I=XM*TRANS(XM)
+* RO XR(M) VECTOR TRANS(XM)*H**(-1)*XO.
+* RO GR(M) MATRIX TRANS(XM)*GO.
+* RA S(N) AUXILIARY VECTORS (H**(-1)*XO AND U).
+* RA SO(N) AUXILIARY VECTORS ((H-SIGMA*I)*H**(-1)*XO AND V).
+* RU XO(N) VECTORS OF VARIABLES DIFFERENCE XO AND VECTOR XO-TILDE.
+* RU GO(N) GRADIENT DIFFERENCE GO AND VECTOR XM*TRANS(XM)*GO.
+* RI R STEPSIZE PARAMETER.
+* RI PO OLD DIRECTIONAL DERIVATIVE (MULTIPLIED BY R)
+* RU SIG SCALING PARAMETER (ZETA AND SIGMA).
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+* II MET2 CHOICE OF THE CORRECTION PARAMETER (1-THE UNIT VALUE,
+* 2-THE BALANCING VALUE, 3-THE SQUARE ROOT, 4-THE GEOMETRIC
+* MEAN).
+* II MET3 CHOICE OF THE SHIFT PARAMETER (4-THE FIRST FORMULA,
+* 5-THE SECOND FORMULA).
+* II MET5 CHOICE OF THE METHOD (1-RANK-ONE METHOD, 2-RANK-TWO
+* METHOD).
+*
+* SUBPROGRAMS USED :
+* S MXDRMM MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR
+* MATRIX BY A VECTOR.
+* S MXDCMU UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX.
+* WITH CONTROLLING OF POSITIVE DEFINITENESS. RANK-ONE FORMULA.
+* S MXDCMV UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX.
+* WITH CONTROLLING OF POSITIVE DEFINITENESS. RANK-TWO FORMULA.
+* S MXVDIR VECTOR AUGMENTED BY A SCALED VECTOR.
+* RF MXVDOT DOT PRODUCT OF VECTORS.
+* S MXVLIN LINEAR COMBINATION OF TWO VECTORS.
+* S MXVSCL SCALING OF A VECTOR.
+*
+* METHOD :
+* RANK-ONE LIMITED-STORAGE VARIABLE-METRIC METHOD IN THE PRODUCT FORM.
+*
+ SUBROUTINE PULVP3(N,M,XM,XR,GR,S,SO,XO,GO,R,PO,SIG,ITERH,MET2,
+ & MET3,MET5)
+ INTEGER N,M,ITERH,MET2,MET3,MET5
+ DOUBLE PRECISION XM(*),XR(*),GR(*),S(*),SO(*),XO(*),GO(*),
+ & R,PO,SIG
+ DOUBLE PRECISION MXVDOT
+ DOUBLE PRECISION DEN,POM,A,B,C,AA,BB,CC,AH,PAR,ZET
+ ZET=SIG
+*
+* COMPUTATION OF B
+*
+ B=MXVDOT(N,XO,GO)
+ IF (B.LE.0.0D 0) THEN
+ ITERH=2
+ GO TO 22
+ END IF
+*
+* COMPUTATION OF GR=TRANS(XM)*GO, XR=TRANS(XM)*H**(-1)*XO
+* AND S=H**(-1)*XO, SO=(H-SIGMA*I)*H**(-1)*XO. COMPUTATION
+* OF AA=GR*GR, BB=GR*XR, CC=XR*XR. COMPUTATION OF A AND C.
+*
+ CALL MXDRMM(N,M,XM,GO,GR)
+ CALL MXVSCL(N,R,S,S)
+ CALL MXDRMM(N,M,XM,S,XR)
+ CALL MXVDIR(N,-SIG,S,XO,SO)
+ AH=MXVDOT(N,GO,GO)
+ AA=MXVDOT(M,GR,GR)
+ BB=MXVDOT(M,GR,XR)
+ CC=MXVDOT(M,XR,XR)
+ A=AA+AH*SIG
+ C=-R*PO
+*
+* DETERMINATION OF THE PARAMETER SIG (SHIFT)
+*
+ POM=B/AH
+ IF (A.GT.0.0D 0) THEN
+ DEN=MXVDOT(N,XO,XO)
+ IF (MET3.LE.4) THEN
+ SIG=SQRT(MAX(0.0D 0,1.0D 0-AA/A))/(1.0D 0+
+ & SQRT(MAX(0.0D 0,1.0D 0-B*B/(DEN*AH))))*POM
+ ELSE
+ SIG=SQRT(MAX(0.0D 0,SIG*AH/A))/(1.0D 0+
+ & SQRT(MAX(0.0D 0,1.0D 0-B*B/(DEN*AH))))*POM
+ END IF
+ SIG=MAX(SIG,2.0D-1*POM)
+ SIG=MIN(SIG,8.0D-1*POM)
+ ELSE
+ SIG=2.5D-1*POM
+ END IF
+*
+* COMPUTATION OF SHIFTED XO AND SHIFTED B
+*
+ B=B-AH*SIG
+ CALL MXVDIR(N,-SIG,GO,XO,XO)
+*
+* COMPUTATION OF THE PARAMETER RHO (CORRECTION)
+*
+ IF (MET2.LE.1) THEN
+ PAR=1.0D 0
+ ELSE IF (MET2.EQ.2) THEN
+ PAR=SIG*AH/B
+ ELSE IF (MET2.EQ.3) THEN
+ PAR=SQRT(1.0D 0-AA/A)
+ ELSE IF (MET2.EQ.4) THEN
+ PAR=SQRT(SQRT(1.0D 0-AA/A)*(SIG*AH/B))
+ ELSE
+ PAR=ZET/(ZET+SIG)
+ END IF
+*
+* COMPUTATION OF THE PARAMETER THETA (BFGS)
+*
+ POM=SIGN(SQRT(PAR*B/CC),BB)
+*
+* COMPUTATION OF Q AND P
+*
+ IF (MET5.EQ.1) THEN
+*
+* RANK ONE UPDATE OF XM
+*
+ CALL MXVDIR(M,POM,XR,GR,XR)
+ CALL MXVLIN(N,PAR,XO,POM,SO,S)
+ CALL MXDCMU(N,M,XM,-1.0D 0/(PAR*B+POM*BB),S,XR)
+ ELSE
+*
+* RANK TWO UPDATE OF XM
+*
+ CALL MXVDIR(N,PAR/POM-BB/B,XO,SO,S)
+ CALL MXDCMV(N,M,XM,-1.0D 0/B,XO,GR,-1.0D 0/CC,S,XR)
+ END IF
+ 22 CONTINUE
+ ITERH=0
+ RETURN
+ END
+* SUBROUTINE PUSMM1 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* VARIABLE METRIC UPDATE OF A SPARSE SYMMETRIC POSITIVE DEFINITE MATRIX
+* USING THE MARWIL PROJECTION.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* RU H(M) POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
+* MATRIX.
+* II IH(NF) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RA XS(NF) AUXILIARY VECTOR.
+* RA S(NF) AUXILIARY VECTOR.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI GO(NF) GRADIENTS DIFFERENCE.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RO R VALUE OF THE STEPSIZE PARAMETER.
+* RI PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
+* II NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER LAST RESTART.
+* II MET1 SELECTION OF SELF SCALING. MET1=1-SELF SCALING SUPPRESSED.
+* MET1=2-INITIAL SELF SCALING. MET1=3-SELF SCALING IN EACH
+* ITERATION.
+* II ITERD CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
+* ITERD<0-BAD DECOMPOSITION. ITERD=0-DESCENT DIRECTION.
+* ITERD=1-NEWTON LIKE STEP. ITERD=2-INEXACT NEWTON LIKE STEP.
+* ITERD=3-BOUNDARY STEP. ITERD=4-DIRECTION WITH THE NEGATIVE
+* CURVATURE. ITERD=5-MARQUARDT STEP.
+* IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
+* ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+*
+* SUBPROGRAMS USED :
+* S MXSSMM MATRIX-VECTOR PRODUCT.
+* S MXSSMY MARWILL CORRECTION OF A SPARSE SYMMETRIC MATRIX.
+* S MXUDIF DIFFERENCE OF TWO VECTORS.
+* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR.
+* RF MXUDOT DOT PRODUCT OF VECTORS.
+* S MXVSCL SCALING OF A VECTOR.
+*
+ SUBROUTINE PUSMM1(NF,H,IH,JH,G,XS,S,XO,GO,IX,R,PO,NIT,KIT,
+ & MET1,ITERD,ITERH,KBF)
+ INTEGER NF,IH(*),JH(*),IX(*),NIT,KIT,MET1,ITERD,ITERH,KBF
+ DOUBLE PRECISION H(*),G(*),S(*),XO(*),GO(*),XS(*),R,PO
+ INTEGER MM
+ DOUBLE PRECISION MXUDOT
+ DOUBLE PRECISION A,B,C,GAM
+ LOGICAL L1
+ MM=IH(NF+1)-1
+*
+* DETERMINATION OF THE PARAMETER C AND THE VECTOR S
+*
+ A=0.0D 0
+ L1=MET1.GE.3.OR.MET1.GE.2.AND.NIT.EQ.KIT
+ IF (ITERD.NE.1) THEN
+ CALL MXSSMM(NF,H,IH,JH,XO,S)
+ IF (L1) C=MXUDOT(NF,XO,S,IX,KBF)
+ ELSE
+ CALL MXUDIF(NF,GO,G,S,IX,KBF)
+ CALL MXVSCL(NF,R,S,S)
+ IF (L1) C=-R*PO
+ END IF
+ GAM=1.0D 0
+ IF (L1) THEN
+*
+* SELF SCALING
+*
+ B=MXUDOT(NF,XO,GO,IX,KBF)
+ IF (B.GT.0.0D 0.AND.C.GT.0.0D 0) THEN
+ GAM=C/B
+ CALL MXVSCL(MM,1.0D 0/GAM,H,H)
+ CALL MXVSCL(NF,1.0D 0/GAM,S,S)
+ END IF
+ END IF
+ CALL MXUDIR(NF,-1.0D 0,S,GO,S,IX,KBF)
+*
+* RANK-ONE UPDATE PROJECTED USING MXSSMY
+*
+ CALL MXSSMY(NF,H,IH,JH,XS,S,XO)
+ ITERH=0
+ RETURN
+ END
+* SUBROUTINE PUSSD5 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* INITIATION OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX
+*
+* PARAMETERS :
+* II NA NUMBER OF APPROXIMATED FUNCTIONS.
+* RI AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED
+* FUNCTIONS.
+* RU AH(MB) POSITIVE DEFINITE APPROXIMATION OF THE PARTITIONED
+* HESSIAN MATRIX.
+* II IAG(NA+1) POINTERS OF THE SPARSE JACOBIAN MATRIX.
+* II JAG(MA) COLUMN INDICES OF THE SPARSE JACOBIAN MATRIX.
+* RU H(M) POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
+* MATRIX
+* II IH(NF+1) POINTERS OF THE DIAGONAL ELEMENTS OF THE SPARSE
+* HESSIAN MATRIX.
+* II JH(M) INDICES OF THE NONZERO ELEMENTS OF THE SPARSE HESSIAN
+* MATRIX IN THE PACKED ROW FORM.
+*
+* SUBPROGRAMS USED :
+* S PASSH2 COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE
+* PARTITIONED HESSIAN MATRIX.
+*
+ SUBROUTINE PUSSD5(NA,AF,AH,IAG,JAG,H,IH,JH)
+ INTEGER NA,IAG(*),JAG(*),IH(*),JH(*)
+ DOUBLE PRECISION AF(*),AH(*),H(*)
+ INTEGER K,KA,L,LL,NB
+ NB=0
+ DO 2 KA=1,NA
+ K=IAG(KA)
+ L=IAG(KA+1)-K
+ LL=L*(L+1)/2
+ CALL PASSH2(H,IH,JH,AH(NB+1),IAG,JAG,KA,AF(KA))
+ NB=NB+LL
+ 2 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYABU1 ALL SYSTEMS 04/12/01
+* PURPOSE :
+* SUBGRADIENT AGGREGATION FOR NONSMOOTH VARIABLE METRIC METHOD.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* RI H(M) POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
+* MATRIX.
+* IO JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* II PSL(NF+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
+* II PERM(NF) PERMUTATION VECTOR
+* RI G(NF) NEW SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RI GO(NF) OLD SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RU GV(NF) AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RI S(NF) DIRECTION VECTOR.
+* RA U(NF) AUXILIARY VECTOR.
+* RA V(NF) AUXILIARY VECTOR.
+* RO ALF LINEARIZATION TERM.
+* RU ALFV AGGREGATED LINEARIZATION TERM.
+* RI RHO CORRECTION PARAMETER.
+* II JC CORRECTION INDICATOR.
+*
+* SUBPROGRAMS USED :
+* S MXSPCB BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* RF MXVDOT DOT PRODUCT OF TWO VECTORS.
+* S MXVSBP INVERSE PERMUTATION OF A VECTOR
+* S MXVSFP PERMUTATION OF A VECTOR.
+*
+ SUBROUTINE PYABU1(NF,H,JH,PSL,PERM,G,GO,GV,S,U,V,ALF,ALFV,RHO,
+ & JC)
+ INTEGER NF,JH(*),PSL(*),PERM(*),JC
+ DOUBLE PRECISION H(*),G(*),GO(*),GV(*),S(*),U(*),V(*),ALF,ALFV,
+ & RHO
+ DOUBLE PRECISION A,B,ALFM,LAM1,LAM2,PQ,PR,PRQR,QQP,QR,RR,RRP,RRQ,
+ & W,W1
+ INTEGER I
+ DOUBLE PRECISION ZERO,ONE,MXVDOT
+ PARAMETER (ZERO=0.0D 0,ONE=1.0D 0)
+ ALFM=ZERO
+*
+* General routine - here always input parameter ALFM=0
+*
+ RR=ALFV+ALFV
+ RRP=ALFV-ALFM
+ RRQ=ALFV-ALF
+ DO 1 I=1,NF
+ A=S(I)
+ U(I)=GO(I)-GV(I)
+ S(I)=G(I)-GV(I)
+ RR=RR-A*GV(I)
+ RRP=RRP+A*U(I)
+ RRQ=RRQ+A*S(I)
+ 1 CONTINUE
+ PQ=ZERO
+ PR=ZERO
+ QR=ZERO
+ PRQR=ZERO
+ QQP=ZERO
+ IF (JC.GE.1) THEN
+ DO 2 I=1,NF
+ PQ=PQ+RHO*(S(I)-U(I))**2
+ PR=PR+RHO*U(I)**2
+ QR=QR+RHO*S(I)**2
+ PRQR=PRQR+RHO*U(I)*S(I)
+ QQP=QQP+RHO+G(I)*(S(I)-U(I))
+ 2 CONTINUE
+ END IF
+ QQP=QQP+ALF-ALFM
+ CALL MXVSFP(NF,PERM,U,V)
+ CALL MXSPCB(NF,H,PSL,JH,U,1)
+ CALL MXVSFP(NF,PERM,S,V)
+ CALL MXSPCB(NF,H,PSL,JH,S,1)
+ DO 4 I=1,NF
+ W1=ONE/H(PSL(I)+I-1)
+ PQ=PQ+W1*(S(I)-U(I))**2
+ PR=PR+W1*U(I)**2
+ QR=QR+W1*S(I)**2
+ PRQR=PRQR+W1*U(I)*S(I)
+ S(I)=W1*(S(I)-U(I))
+ 4 CONTINUE
+ CALL MXSPCB(NF,H,PSL,JH,S,-1)
+ CALL MXVSBP(NF,PERM,S,V)
+ QQP=QQP+MXVDOT(NF,G,S)
+ IF (PR.LE.ZERO.OR.QR.LE.ZERO) GO TO 10
+ A=RRQ/QR
+ B=PRQR/QR
+ W=PRQR*B-PR
+ IF (W.EQ.ZERO) GO TO 10
+ LAM1=(A*PRQR-RRP)/W
+ LAM2=A-LAM1*B
+ IF (LAM1*(LAM1-ONE).LT.ZERO.AND.LAM2*(LAM1+LAM2-ONE).LT.ZERO)
+ & GO TO 40
+*
+* MINIMUM ON THE BOUNDARY
+*
+ 10 LAM1=ZERO
+ LAM2=ZERO
+ IF (ALF.LE.ALFV) LAM2=ONE
+ IF (QR.GT.ZERO) LAM2=MIN(ONE,MAX(ZERO,RRQ/QR))
+ W=(LAM2*QR-RRQ-RRQ)*LAM2
+ A=ZERO
+ IF (ALFM.LE.ALFV) A=ONE
+ IF (PR.GT.ZERO) A=MIN(ONE,MAX(ZERO,RRP/PR))
+ B=(A*PR-RRP-RRP)*A
+ IF (B.LT.W)THEN
+ W=B
+ LAM1=A
+ LAM2=ZERO
+ END IF
+ IF (QQP*(QQP-PQ).GE.ZERO) GO TO 40
+ IF (QR-RRQ-RRQ-QQP*QQP/PQ.GE.W) GO TO 40
+ LAM1=QQP/PQ
+ LAM2=ONE-LAM1
+ 40 IF (LAM1.EQ.ZERO.AND.LAM2*(LAM2-ONE).LT.ZERO.AND.RRP-LAM2*PRQR
+ & .GT.ZERO.AND.PR.GT.ZERO) LAM1=MIN(ONE-LAM2,(RRP-LAM2*PRQR)/PR)
+ A=ONE-LAM1-LAM2
+ ALFV=LAM1*ALFM+LAM2*ALF+A*ALFV
+ DO 5 I=1,NF
+ GV(I)=LAM1*GO(I)+LAM2*G(I)+A*GV(I)
+ 5 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYABU2 ALL SYSTEMS 04/12/01
+* PURPOSE :
+* SIMPLIFIED AGGREGATION FOR NONSMOOTH VARIABLE METRIC METHOD.
+*
+* PARAMETERS :
+* II NF NUMBER OF VARIABLES.
+* RI H(M) POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
+* MATRIX.
+* IO JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* II PSL(NF+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
+* II PERM(NF) PERMUTATION VECTOR
+* RI G(NF) ACTUAL SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RU GV(NF) AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RA S(NF) DIRECTION VECTOR.
+* RA V(NF) AUXILIARY VECTOR.
+* RO ALF LINEARIZATION TERM.
+* RU ALFV AGGREGATED LINEARIZATION TERM.
+* RI RHO CORRECTION PARAMETER.
+* II JC CORRECTION INDICATOR.
+*
+* SUBPROGRAMS USED :
+* S MXSPCB BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
+* OBTAINED BY MXSPCF.
+* S MXVSFP PERMUTATION OF A VECTOR.
+*
+ SUBROUTINE PYABU2(NF,H,JH,PSL,PERM,G,GV,S,V,ALF,ALFV,RHO,JC)
+ INTEGER NF,JH(*),PSL(*),PERM(NF),JC
+ DOUBLE PRECISION H(*),G(*),GV(*),S(*),V(*),ALF,ALFV,RHO
+ DOUBLE PRECISION P,Q,W,LAM
+ INTEGER I
+ DOUBLE PRECISION ZERO,ONE
+ PARAMETER (ZERO=0.0D 0,ONE=1.0D 0)
+ P=ALFV-ALF
+ DO 1 I=1,NF
+ W=S(I)
+ P=P+W*S(I)
+ S(I)=G(I)-GV(I)
+ 1 CONTINUE
+ Q=ZERO
+ IF (JC.GE.1) THEN
+ DO 2 I=1,NF
+ Q=Q+RHO*S(I)**2
+ 2 CONTINUE
+ END IF
+ CALL MXVSFP(NF,PERM,S,V)
+ CALL MXSPCB(NF,H,PSL,JH,S,1)
+ DO 4 I=1,NF
+ W=ONE/H(PSL(I)+I-1)
+ Q=Q+W*S(I)**2
+ 4 CONTINUE
+ LAM=0.5D 0+SIGN(0.5D 0,P)
+ IF (Q.GT.ZERO) LAM=MIN(ONE,MAX(ZERO,P/Q))
+ P=ONE-LAM
+ ALFV=LAM*ALF+P*ALFV
+ DO 5 I=1,NF
+ GV(I)=LAM*G(I)+P*GV(I)
+ 5 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYADC0 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* NEW SIMPLE BOUNDS ARE ADDED TO THE ACTIVE SET.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* II N REDUCED NUMBER OF VARIABLES.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES.
+* RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES.
+* IO INEW NUMBER OF ACTIVE CONSTRAINTS.
+*
+ SUBROUTINE PYADC0(NF,N,X,IX,XL,XU,INEW)
+ INTEGER NF,N,IX(NF),INEW
+ DOUBLE PRECISION X(*),XL(*),XU(*)
+ INTEGER I,II,IXI
+ N=NF
+ INEW=0
+ DO 1 I=1,NF
+ II=IX(I)
+ IXI=ABS(II)
+ IF (IXI.GE.5) THEN
+ IX(I)=-IXI
+ ELSE IF ((IXI.EQ.1.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).LE.XL(I))
+ & THEN
+ X(I)=XL(I)
+ IF (IXI.EQ.4) THEN
+ IX(I)=-3
+ ELSE
+ IX(I)=-IXI
+ END IF
+ N=N-1
+ IF (II.GT.0) INEW=INEW+1
+ ELSE IF ((IXI.EQ.2.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).GE.XU(I))
+ & THEN
+ X(I)=XU(I)
+ IF (IXI.EQ.3) THEN
+ IX(I)=-4
+ ELSE
+ IX(I)=-IXI
+ END IF
+ N=N-1
+ IF (II.GT.0) INEW=INEW+1
+ END IF
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYBUN1 ALL SYSTEMS 97/12/01
+* PURPOSE :
+* BUNDLE UPDATING.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* II MB DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
+* II NB CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
+* RU X(N) VECTOR OF VARIABLES.
+* RO G(N) SUBGRADIENT OF THE OBJECTIVE FUNCTION.
+* RO F VALUE OF THE OBJECTIVE FUNCTION.
+* RI AY(N*MB) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS.
+* RI AG(N*MB) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS.
+* RI AF(4*MB) VECTOR OF BUNDLE FUNCTIONS VALUES.
+* IO ITERS NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT
+* STEP.
+*
+* SUBPROGRAMS USED :
+* S MXVCOP COPYING OF A VECTOR.
+*
+ SUBROUTINE PYBUN1(N,MB,NB,X,G,F,AY,AG,AF,ITERS)
+ INTEGER N,MB,NB,ITERS
+ DOUBLE PRECISION X(*),G(*),F,AY(*),AG(*),AF(*)
+ INTEGER I,IND,K,KN,L
+ L=0
+ IF (ITERS.EQ.0) L=1
+*
+* BUNDLE REDUCTION
+*
+ KN=0
+ IF (NB.GE.MB) THEN
+ DO 2 K=1,NB-1
+ KN=K*N-N
+ DO 1 I=1,N
+ IF (G(I).NE.AG(KN+I)) GO TO 2
+ 1 CONTINUE
+ IND=K
+ GO TO 3
+ 2 CONTINUE
+ IND=1
+ 3 DO 4 K=IND,NB-1
+ AF(K)=AF(K+1)
+ AF(K+MB*3)=AF(K+1+MB*3)
+ KN=K*N+1
+ CALL MXVCOP(N,AG(KN),AG(KN-N))
+ CALL MXVCOP(N,AY(KN),AY(KN-N))
+ 4 CONTINUE
+ NB=NB-1
+ END IF
+*
+* BUNDLE COMPLETION
+*
+ IF (L.GT.0.AND.KN.EQ.0) THEN
+ AF(NB+1)=AF(NB)
+ AF(3*MB+NB+1)=AF(3*MB+NB)
+ KN=NB*N+1
+ CALL MXVCOP(N,AG(KN-N),AG(KN))
+ CALL MXVCOP(N,AY(KN-N),AY(KN))
+ END IF
+ NB=NB+1
+ KN=NB-L
+ AF(KN)=F
+ AF(KN+MB*3)=L
+ K=(KN-1)*N+1
+ CALL MXVCOP(N,G,AG(K))
+ CALL MXVCOP(N,X,AY(K))
+ RETURN
+ END
+* SUBROUTINE PYCSER ALL SYSTEMS 98/12/01
+* PURPOSE :
+* GROUP OF THE SAME COLOUR FOR THE POWELL-TOINT ALGORITHM FOR SPARSE
+* HESSIANS APPROXIMATIONS IS CREATED.
+*
+* PARAMETERS :
+* IU IH(MCOLS+1) POINTER VECTOR OF SPARSE HESSIAN MATRIX.
+* IU JH(M) INDEX VECTOR OF THE HESSIAN MATRIX.
+* IA WN02(MCOLS) AUXILIARY VECTOR.
+* RA WN03(MCOLS) AUXILIARY VECTOR.
+* RI DEG(MCOLS) DEGREES OF THE ADJACENCY GRAPH.
+* IA WN01(NF) AUXILIARY VECTOR USED FOR INDICES OF THE COLUMNS
+* THAT HAVE NOT BEEN COLOURED YET.
+* II COL(NF) VECTOR DISCERNING GROUPS OF THE HESSIAN COLUMN OF THE
+* SAME COLOUR.
+* IU NCOL NUMBER OF COLOURS USED SO FAR.
+* IU CNM NUMBER OF COLUMNS THAT HAVE NOT BEEN COLOURED SO FAR.
+*
+ SUBROUTINE PYCSER(JH,IH,WN02,WN03,DEG,WN01,COL,NCOL,CNM)
+ INTEGER JH(*),IH(*),COL(*)
+ INTEGER WN01(*),WN02(*)
+ DOUBLE PRECISION WN03(*),DEG(*)
+ INTEGER NCOL,CNM,I,J,K,L,IP
+*
+* DEFINITION OF THE INCIDENCE ARRAY A
+*
+ L=WN01(1)
+*
+* ELEMENT WAS MARKED THAT IT IS INSERTED
+*
+ DO 100 I=IH(L),IH(L+1)-1
+ K=JH(I)
+*
+* COLUMN OF THIS NUMBER HAS APPEARED IN ONE OF THE PREVIOUS GROUPS
+*
+ IF (COL(K).LT.NCOL) GO TO 100
+ DEG(K)=DEG(K)-1
+ WN02(K)=NCOL
+100 CONTINUE
+*
+* COLUMN IS INSERTED
+*
+ COL(L)=NCOL
+*
+* THE CYCLE OF COMPARING COLUMN WITH THE ARRAY A
+* A2 IS AN HELP ARRAY CONTAINING COLUMNS THAT ARE
+* BEEING EXAMINED BUT THAT WERE NOT YET ACCEPTED
+* P IS ITS POINTER
+*
+ IF (CNM.EQ.1) GO TO 250
+ DO 200 I=2,CNM
+*
+* TRANSFORMATION OF THE EXAMINED COLUMN I IS
+*
+ IP=1
+ L=WN01(I)
+ DO 300 J=IH(L),IH(L+1)-1
+ K=JH(J)
+ IF (COL(K).LT.NCOL) GO TO 300
+ IF (WN02(K).GE.NCOL) GO TO 200
+ WN03(IP)=K
+ IP=IP+1
+300 CONTINUE
+ IF (IP.NE.1) THEN
+*
+* COPY OF THE WN03 ARRAY INTO WN02 FOR THE COLUMN WAS ACCEPTED
+*
+ DO 400 K=1,IP-1
+ WN02(INT(WN03(K)))=NCOL
+ DEG(INT(WN03(K)))=DEG(INT(WN03(K)))-1
+400 CONTINUE
+ END IF
+*
+* INSERT THE COLUMN INTO THE PROCESSED GROUP
+*
+ COL(L)=NCOL
+*
+* END OF THE MAIN CYCLE
+*
+200 CONTINUE
+*
+* JUMP LABEL
+*
+250 CONTINUE
+*
+* INVP SHIFT
+*
+ K=1
+ DO 500 I=1,CNM
+ L=WN01(I)
+ IF (COL(L).EQ.NCOL) THEN
+ ELSE
+ WN01(K)=L
+ K=K+1
+ END IF
+500 CONTINUE
+*
+* CNM UPDATE
+*
+ CNM=K-1
+ RETURN
+ END
+* SUBROUTINE PYFUT1 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* TERMINATION CRITERIA AND TEST ON RESTART.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* RI F NEW VALUE OF THE OBJECTIVE FUNCTION.
+* RI FO OLD VALUE OF THE OBJECTIVE FUNCTION.
+* RI UMAX MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER.
+* RO GMAX NORM OF THE TRANSFORMED GRADIENT.
+* RI DMAX MAXIMUM RELATIVE DIFFERENCE OF VARIABLES.
+* RI TOLX LOWER BOUND FOR STEPLENGTH.
+* RI TOLF LOWER BOUND FOR FUNCTION DECREASE.
+* RI TOLB LOWER BOUND FOR FUNCTION VALUE.
+* RI TOLG LOWER BOUND FOR GRADIENT.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IU NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER RESTART.
+* II MIT MAXIMUM NUMBER OF ITERATIONS.
+* IU NFV ACTUAL NUMBER OF COMPUTED FUNCTION VALUES.
+* II MFV MAXIMUM NUMBER OF COMPUTED FUNCTION VALUES.
+* IU NFG ACTUAL NUMBER OF COMPUTED GRADIENT VALUES.
+* II MFG MAXIMUM NUMBER OF COMPUTED GRADIENT VALUES.
+* IU NTESX ACTUAL NUMBER OF TESTS ON STEPLENGTH.
+* II MTESX MAXIMUM NUMBER OF TESTS ON STEPLENGTH.
+* IU NTESF ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE.
+* II MTESF MAXIMUM NUMBER OF TESTS ON FUNCTION DECREASE.
+* II IRES1 RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
+* IRES1*N+IRES2 ITERATIONS.
+* II IRES2 RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
+* IRES1*N+IRES2 ITERATIONS.
+* IU IREST RESTART INDICATOR. RESTART IS PERFORMED IF IREST>0.
+* II ITERS TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
+* ITERS=0 FOR ZERO STEP.
+* IO ITERM TERMINATION INDICATOR. ITERM=1-TERMINATION AFTER MTESX
+* UNSUFFICIENT STEPLENGTHS. ITERM=2-TERMINATION AFTER MTESF
+* UNSUFFICIENT FUNCTION DECREASES. ITERM=3-TERMINATION ON LOWER
+* BOUND FOR FUNCTION VALUE. ITERM=4-TERMINATION ON LOWER BOUND
+* FOR GRADIENT. ITERM=11-TERMINATION AFTER MAXIMUM NUMBER OF
+* ITERATIONS. ITERM=12-TERMINATION AFTER MAXIMUM NUMBER OF
+* COMPUTED FUNCTION VALUES.
+*
+ SUBROUTINE PYFUT1(N,F,FO,UMAX,GMAX,DMAX,TOLX,TOLF,TOLB,TOLG,KD,
+ & NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,ITES,IRES1,
+ & IRES2,IREST,ITERS,ITERM)
+ INTEGER N,KD,NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,
+ & ITES,IRES1,IRES2,IREST,ITERS,ITERM
+ DOUBLE PRECISION F,FO,UMAX,GMAX,DMAX,TOLX,TOLF,TOLG,TOLB
+ DOUBLE PRECISION TEMP
+ IF (ITERM.LT.0) RETURN
+ IF (ITES .LE.0) GO TO 1
+ IF (ITERS.EQ.0) GO TO 1
+ IF (NIT.LE.0) FO=F+MIN(SQRT(ABS(F)),ABS(F)/1.0D 1)
+ IF (F.LE.TOLB) THEN
+ ITERM = 3
+ RETURN
+ END IF
+ IF (KD.GT.0) THEN
+ IF (GMAX.LE.TOLG.AND.UMAX.LE.TOLG) THEN
+ ITERM = 4
+ RETURN
+ END IF
+ END IF
+ IF (NIT.LE.0) THEN
+ NTESX = 0
+ NTESF = 0
+ END IF
+ IF (DMAX.LE.TOLX) THEN
+ ITERM = 1
+ NTESX = NTESX+1
+ IF (NTESX.GE.MTESX) RETURN
+ ELSE
+ NTESX = 0
+ END IF
+ TEMP=ABS(FO-F)/MAX(ABS(F),1.0D 0)
+ IF (TEMP.LE.TOLF) THEN
+ ITERM = 2
+ NTESF = NTESF+1
+ IF (NTESF.GE.MTESF) RETURN
+ ELSE
+ NTESF = 0
+ END IF
+ 1 IF (NIT.GE.MIT) THEN
+ ITERM = 11
+ RETURN
+ END IF
+ IF (NFV.GE.MFV) THEN
+ ITERM = 12
+ RETURN
+ END IF
+ IF (NFG.GE.MFG) THEN
+ ITERM = 13
+ RETURN
+ END IF
+ ITERM = 0
+ IF (N.GT.0.AND.NIT-KIT.GE.IRES1*N+IRES2) THEN
+ IREST=MAX(IREST,1)
+ END IF
+ NIT = NIT + 1
+ RETURN
+ END
+* SUBROUTINE PYFUT8 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* TERMINATION CRITERIA AND TEST ON RESTART.
+*
+* PARAMETERS :
+* II N ACTUAL NUMBER OF VARIABLES.
+* RI F NEW VALUE OF THE OBJECTIVE FUNCTION.
+* RI FO OLD VALUE OF THE OBJECTIVE FUNCTION.
+* RO GMAX NORM OF THE TRANSFORMED GRADIENT.
+* RI DMAX MAXIMUM RELATIVE DIFFERENCE OF VARIABLES.
+* RI RPF3 VALUE OF THE BARRIER PARAMETER.
+* RI TOLX LOWER BOUND FOR STEPLENGTH.
+* RI TOLF LOWER BOUND FOR FUNCTION DECREASE.
+* RI TOLB LOWER BOUND FOR FUNCTION VALUE.
+* RI TOLG LOWER BOUND FOR GRADIENT.
+* RI TOLP LOWER BOUND FOR BARRIER PARAMETER.
+* II KD DEGREE OF REQUIRED DERIVATIVES.
+* IU NIT ACTUAL NUMBER OF ITERATIONS.
+* II KIT NUMBER OF THE ITERATION AFTER RESTART.
+* II MIT MAXIMUM NUMBER OF ITERATIONS.
+* IU NFV ACTUAL NUMBER OF COMPUTED FUNCTION VALUES.
+* II MFV MAXIMUM NUMBER OF COMPUTED FUNCTION VALUES.
+* IU NFG ACTUAL NUMBER OF COMPUTED GRADIENT VALUES.
+* II MFG MAXIMUM NUMBER OF COMPUTED GRADIENT VALUES.
+* IU NTESX ACTUAL NUMBER OF TESTS ON STEPLENGTH.
+* II MTESX MAXIMUM NUMBER OF TESTS ON STEPLENGTH.
+* IU NTESF ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE.
+* II MTESF MAXIMUM NUMBER OF TESTS ON FUNCTION DECREASE.
+* II IRES1 RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
+* IRES1*N+IRES2 ITERATIONS.
+* II IRES2 RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
+* IRES1*N+IRES2 ITERATIONS.
+* IU IREST RESTART INDICATOR. RESTART IS PERFORMED IF IREST>0.
+* II ITERS TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
+* ITERS=0 FOR ZERO STEP.
+* IO ITERM TERMINATION INDICATOR. ITERM=1-TERMINATION AFTER MTESX
+* UNSUFFICIENT STEPLENGTHS. ITERM=2-TERMINATION AFTER MTESF
+* UNSUFFICIENT FUNCTION DECREASES. ITERM=3-TERMINATION ON LOWER
+* BOUND FOR FUNCTION VALUE. ITERM=4-TERMINATION ON LOWER BOUND
+* FOR GRADIENT. ITERM=11-TERMINATION AFTER MAXIMUM NUMBER OF
+* ITERATIONS. ITERM=12-TERMINATION AFTER MAXIMUM NUMBER OF
+* COMPUTED FUNCTION VALUES.
+*
+ SUBROUTINE PYFUT8(N,F,FO,GMAX,DMAX,RPF3,TOLX,TOLF,TOLB,TOLG,TOLP,
+ & KD,NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,IRES1,
+ & IRES2,IREST,ITERS,ITERM)
+ INTEGER N,KD,NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,
+ & IRES1,IRES2,IREST,ITERS,ITERM
+ DOUBLE PRECISION F,FO,RPF3,GMAX,DMAX,TOLX,TOLF,TOLG,TOLB,TOLP
+ DOUBLE PRECISION TEMP
+ IF (ITERM.LT.0) RETURN
+ IF (ITERS.EQ.0) GO TO 1
+ IF (NIT.LE.0) FO=F+MIN(SQRT(ABS(F)),ABS(F)/1.0D 1)
+ IF (F.LE.TOLB) THEN
+ ITERM = 3
+ RETURN
+ END IF
+ IF (RPF3.GT.TOLP) GO TO 1
+ IF (KD.GT.0) THEN
+ IF (GMAX.LE.TOLG) THEN
+ ITERM = 4
+ RETURN
+ END IF
+ END IF
+ IF (NIT.LE.0) THEN
+ NTESX = 0
+ NTESF = 0
+ END IF
+ IF (DMAX.LE.TOLX) THEN
+ ITERM = 1
+ NTESX = NTESX+1
+ IF (NTESX.GE.MTESX) RETURN
+ ELSE
+ NTESX = 0
+ END IF
+ TEMP=ABS(FO-F)/MAX(ABS(F),1.0D 0)
+ IF (TEMP.LE.TOLF) THEN
+ ITERM = 2
+ NTESF = NTESF+1
+ IF (NTESF.GE.MTESF) RETURN
+ ELSE
+ NTESF = 0
+ END IF
+ 1 IF (NIT.GE.MIT) THEN
+ ITERM = 11
+ RETURN
+ END IF
+ IF (NFV.GE.MFV) THEN
+ ITERM = 12
+ RETURN
+ END IF
+ IF (NFG.GE.MFG) THEN
+ ITERM = 13
+ RETURN
+ END IF
+ ITERM = 0
+ IF (N.GT.0.AND.NIT-KIT.GE.IRES1*N+IRES2) THEN
+ IREST=MAX(IREST,1)
+ END IF
+ NIT = NIT + 1
+ RETURN
+ END
+* SUBROUTINE PYPTSH ALL SYSTEMS 98/12/01
+* PURPOSE :
+* POWELL-TOINT GRAPH COLORING ALGORITHM FOR GROUPING COLUMNS OF THE
+* HESSIAN MATRIX BEFORE NUMERICAL DIFFERENTIATION.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* II MMAX MAXIMUM NUMBER OF NONZERO ELEMENTS.
+* II IH(NF+1) POINTER VECTOR OF SPARSE HESSIAN MATRIX.
+* II JH(MMAX) INDEX VECTOR OF THE HESSIAN MATRIX.
+* IO COL(NF) VECTOR DISCERNING GROUPS OF THE HESSIAN COLUMN OF THE
+* SAME COLOUR.
+* RA DEG(NF) DEGREES OF THE ADJACENCY GRAPH.
+* RA ORD(NF) AUXILIARY ARRAY.
+* RA RADIX(NF+1) AUXILIARY ARRAY.
+* IA WN11(NF) AUXILIARY VECTOR USED FOR INDICES OF THE COLUMNS
+* THAT HAVE NOT BEEN COLOURED YET.
+* IA WN12(NF) AUXILIARY VECTOR.
+* RA XS(NF) AUXILIARY VECTOR.
+* IO ITERM TERMINATION INDICATOR.
+*
+* SUBPROGRAMS USED :
+* S PYCSER GROUPING COLUMNS OF THE SPARSE SYMMETRIC MATRIX.
+* S MXSTG1 WIDTHEN THE STRUCTURE.
+* S MXSTL1 SHRINK THE STRUCTURE.
+* S MXVSR2 SORT.
+*
+ SUBROUTINE PYPTSH(NF,MMAX,IH,JH,COL,DEG,ORD,RADIX,WN11,WN12,XS,
+ & ITERM)
+ INTEGER NF,MMAX,IH(*),JH(*),COL(*)
+ INTEGER WN11(*),WN12(*),ITERM
+ DOUBLE PRECISION RADIX(*),ORD(*)
+ DOUBLE PRECISION XS(*),DEG(*)
+ INTEGER NCOL,CNM,I,ML,MM,J,K1,L
+*
+* SAVE SYMBOLIC STRUCTURE OF FACTOR
+*
+ MM=IH(NF+1)-1
+ IF (2*MM-NF+2.GE.MMAX) THEN
+ ITERM=-45
+ RETURN
+ END IF
+*
+* WIDTHEN THE STRUCTURE
+*
+ CALL MXSTG1(NF,ML,IH,JH,WN12,WN11)
+ DO 100 I=1,NF
+ COL(I)=NF
+ WN12(I)=0
+ WN11(I)=I
+100 CONTINUE
+*
+* NUMBER OF THE FREE COLUMNS
+*
+ CNM=NF
+*
+* NUMBER OF USED COLOURS
+*
+ NCOL=1
+*
+* DEGREE RECOUNT
+*
+ K1=1
+ DO 110 I=1,NF
+ L=IH(I+1)
+ DEG(I)=L-K1
+ K1=L
+110 CONTINUE
+*
+* COLUMN RESORT
+*
+200 CALL MXVSR2(NF,DEG,ORD,RADIX,WN11,CNM)
+*
+* ORD REWRITE INTO THE ARRAY INVP
+*
+ DO 250 I=1,CNM
+ WN11(I)=ORD(I)
+250 CONTINUE
+*
+* COLUMNS OF THE NEW COLOUR NCOL
+*
+ CALL PYCSER(JH,IH,WN12,XS,DEG,WN11,COL,NCOL,CNM)
+*
+* STOP TEST
+*
+ IF (CNM.GE.1) THEN
+ NCOL=NCOL+1
+ GO TO 200
+ END IF
+*
+* SHRINK THE STRUCTURE
+*
+ CALL MXSTL1(NF,ML,IH,JH,WN12)
+*
+* INTO COL GIVE INDICES OF THE INDIVIDUAL GROUPS ONE AFTER ANOTHER,
+* END OF THE GROUP IS MARKED BY THE NEGATIVE INDEX VALUE.
+*
+*
+* READ COL
+*
+ DO 300 I=1,NF
+ WN11(I)=0
+ 300 CONTINUE
+ DO 400 I=1,NF
+ J=COL(I)
+ WN11(J)=WN11(J)+1
+ 400 CONTINUE
+ WN12(1)=1
+ L=1
+ DO 500 I=2,NF
+ L=L+WN11(I-1)
+ WN12(I)=L
+ IF (WN11(I).EQ.0) GO TO 550
+ 500 CONTINUE
+ 550 CONTINUE
+*
+* CHANGE COL
+*
+ DO 600 I=1,NF
+ J=COL(I)
+ WN11(I)=J
+ 600 CONTINUE
+ DO 700 I=1,NF
+ J=WN11(I)
+ COL(WN12(J))=I
+ WN12(J)=WN12(J)+1
+ 700 CONTINUE
+ DO 800 I=1,NCOL
+ L=WN12(I)-1
+ IF (L.GT.NF) GO TO 900
+ COL(L)=-COL(L)
+ 800 CONTINUE
+ 900 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYRMC0 ALL SYSTEMS 98/12/01
+* PURPOSE :
+* OLD SIMPLE BOUND IS REMOVED FROM THE ACTIVE SET. TRANSFORMED
+* GRADIENT OF THE OBJECTIVE FUNCTION IS UPDATED.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* II N REDUCED NUMBER OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RI EPS8 TOLERANCE FOR CONSTRAINT TO BE REMOVED.
+* RI UMAX MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER.
+* RI GMAX NORM OF THE TRANSFORMED GRADIENT.
+* RO RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
+* II IOLD NUMBER OF REMOVED CONSTRAINTS.
+* IU IREST RESTART INDICATOR.
+*
+ SUBROUTINE PYRMC0(NF,N,IX,G,EPS8,UMAX,GMAX,RMAX,IOLD,IREST)
+ INTEGER NF,N,IX(*),IOLD,IREST
+ DOUBLE PRECISION G(*),EPS8,UMAX,GMAX,RMAX
+ INTEGER I,IXI
+ IF (N.EQ.0.OR.RMAX.GT.0.0D 0) THEN
+ IF (UMAX.GT.EPS8*GMAX) THEN
+ IOLD=0
+ DO 1 I=1,NF
+ IXI=IX(I)
+ IF (IXI.GE.0) THEN
+ ELSE IF (IXI.LE.-5) THEN
+ ELSE IF ((IXI.EQ.-1.OR.IXI.EQ.-3).AND.-G(I).LE.0.0D 0) THEN
+ ELSE IF ((IXI.EQ.-2.OR.IXI.EQ.-4).AND. G(I).LE.0.0D 0) THEN
+ ELSE
+ IOLD=IOLD+1
+ IX(I)=MIN(ABS(IX(I)),3)
+ IF (RMAX.EQ.0) GO TO 2
+ END IF
+ 1 CONTINUE
+ 2 IF (IOLD.GT.1) IREST=MAX(IREST,1)
+ END IF
+ END IF
+ RETURN
+ END
+* SUBROUTINE PYTCAB ALL SYSTEMS 06/12/01
+* PURPOSE :
+* VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED
+* AND SCALED. TEST VALUE DMAX IS DETERMINED.
+*
+* PARAMETERS :
+* II NC NUMBER OF APPROXIMATED FUNCTIONS.
+* II MC NUMBER OF NONZERO ELEMENTS IN THE FIELD CG.
+* RI CG(MC) JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
+* RO CGO(MC) SAVED JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
+* RI ICG(NC+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD CG.
+* RI CZ(NC) VECTOR CONTAINING LAGRANGE MULTIPLIERS FOR CONSTRAINTS.
+* II ITERS TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
+* ITERS=0 FOR ZERO STEP.
+* II JOB SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
+* JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
+* LAGRANGIAN MULTIPLIERS. JOB-2-TERMS OF THE LAGRANGIAN
+* FUNCTION.
+*
+* SUBPROGRAMS USED :
+* S MXVDIF DIFFERENCE OF TWO VECTORS.
+* S MXVSAV DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
+* SUBSTRACTED ONE.
+*
+ SUBROUTINE PYTCAB(NC,MC,CG,CGO,ICG,CZ,ITERS,JOB)
+ INTEGER NC,MC,ICG(*),ITERS,JOB
+ DOUBLE PRECISION CG(*),CGO(*),CZ(*)
+ INTEGER J,K,KC,L,M
+ DOUBLE PRECISION TEMP
+ IF (ITERS.GT.0) THEN
+ CALL MXVDIF(MC,CG,CGO,CGO)
+ ELSE
+ CALL MXVSAV(MC,CG,CGO)
+ END IF
+ DO 4 KC=1,NC
+ M=ICG(KC)
+ L=ICG(KC+1)-M
+ IF (JOB.GT.0) THEN
+ TEMP=CZ(KC)
+ IF (JOB.EQ.1) TEMP=SIGN(1.0D 0,TEMP)
+ K=M
+ DO 2 J=1,L
+ CGO(K)=CGO(K)*TEMP
+ K=K+1
+ 2 CONTINUE
+ END IF
+ 4 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYTCUB ALL SYSTEMS 06/12/01
+* PURPOSE :
+* VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED
+* AND SCALED. TEST VALUE DMAX IS DETERMINED.
+*
+* PARAMETERS :
+* II NC NUMBER OF APPROXIMATED FUNCTIONS.
+* II MC NUMBER OF NONZERO ELEMENTS IN THE FIELD CG.
+* RI CG(MC) JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
+* RO CGO(MC) SAVED JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
+* RI ICG(NC+1) POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD CG.
+* II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS.
+* RI CZL(NC) VECTOR CONTAINING LOWER MULTIPLIERS FOR CONSTRAINTS.
+* RI CZU(NC) VECTOR CONTAINING UPPER MULTIPLIERS FOR CONSTRAINTS.
+* II ITERS TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
+* ITERS=0 FOR ZERO STEP.
+* II JOB SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
+* JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
+* LAGRANGIAN MULTIPLIERS. JOB-2-TERMS OF THE LAGRANGIAN
+* FUNCTION.
+*
+* SUBPROGRAMS USED :
+* S MXVDIF DIFFERENCE OF TWO VECTORS.
+* S MXVSAV DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
+* SUBSTRACTED ONE.
+*
+ SUBROUTINE PYTCUB(NC,MC,CG,CGO,ICG,IC,CZL,CZU,ITERS,JOB)
+ INTEGER NC,MC,ICG(NC+1),IC(NC),ITERS,JOB
+ DOUBLE PRECISION CG(*),CGO(*),CZL(*),CZU(*)
+ INTEGER J,K,KC,KK,L,M
+ DOUBLE PRECISION TEMP
+ IF (ITERS.GT.0) THEN
+ CALL MXVDIF(MC,CG,CGO,CGO)
+ ELSE
+ CALL MXVSAV(MC,CG,CGO)
+ END IF
+ DO 4 KC=1,NC
+ M=ICG(KC)
+ L=ICG(KC+1)-M
+ IF (JOB.GT.0) THEN
+ KK=ABS(IC(KC))
+ IF (KK.EQ.3.OR.KK.EQ.4) THEN
+ TEMP= CZU(KC)-CZL(KC)
+ ELSE IF (KK.EQ.1) THEN
+ TEMP=-CZL(KC)
+ ELSE IF (KK.EQ.2) THEN
+ TEMP= CZU(KC)
+ ELSE IF (KK.EQ.5) THEN
+ TEMP= CZL(KC)
+ END IF
+ IF (JOB.EQ.1) TEMP=SIGN(1.0D 0,TEMP)
+ K=M
+ DO 2 J=1,L
+ CGO(K)=CGO(K)*TEMP
+ K=K+1
+ 2 CONTINUE
+ END IF
+ 4 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYTRCD ALL SYSTEMS 98/12/01
+* PURPOSE :
+* VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED
+* AND SCALED AND REDUCED. TEST VALUE DMAX IS DETERMINED.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE.
+* RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RU GO(NF) GRADIENTS DIFFERENCE.
+* RO R VALUE OF THE STEPSIZE PARAMETER.
+* RO F NEW VALUE OF THE OBJECTIVE FUNCTION.
+* RI FO OLD VALUE OF THE OBJECTIVE FUNCTION.
+* RO P NEW VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RI PO OLD VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO DMAX MAXIMUM RELATIVE DIFFERENCE OF VARIABLES.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* IO KD DEGREE OF REQUIRED DERIVATIVES.
+* IO LD DEGREE OF COMPUTED DERIVATIVES.
+* II ITERS TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
+* ITERS=0 FOR ZERO STEP.
+*
+* SUBPROGRAMS USED :
+* S MXVDIF DIFFERENCE OF TWO VECTORS.
+* S MXVSAV DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
+* SUBSTRACTED ONE.
+*
+ SUBROUTINE PYTRCD(NF,X,IX,XO,G,GO,R,F,FO,P,PO,DMAX,KBF,KD,LD,
+ & ITERS)
+ INTEGER NF,IX(*),KBF,KD,LD,ITERS
+ DOUBLE PRECISION X(*),XO(*),G(*),GO(*),R,F,FO,P,PO,DMAX
+ INTEGER I
+ IF (ITERS.GT.0) THEN
+ CALL MXVDIF(NF,X,XO,XO)
+ CALL MXVDIF(NF,G,GO,GO)
+ PO=R*PO
+ P=R*P
+ ELSE
+ F = FO
+ P = PO
+ CALL MXVSAV(NF,X,XO)
+ CALL MXVSAV(NF,G,GO)
+ LD=KD
+ END IF
+ DMAX = 0.0D 0
+ DO 1 I=1,NF
+ IF (KBF.GT.0) THEN
+ IF (IX(I).LT.0) THEN
+ XO(I)=0.0D 0
+ GO(I)=0.0D 0
+ GO TO 1
+ END IF
+ END IF
+ DMAX=MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D 0))
+ 1 CONTINUE
+ RETURN
+ END
+* SUBROUTINE PYTRCG ALL SYSTEMS 99/12/01
+* PURPOSE :
+* GRADIENT OF THE OBJECTIVE FUNCTION IS SCALED AND REDUCED. TEST VALUES
+* GMAX AND UMAX ARE COMPUTED.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* II N ACTUAL NUMBER OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RI UMAX MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER.
+* RI GMAX NORM OF THE TRANSFORMED GRADIENT.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+* II IOLD INDEX OF THE REMOVED CONSTRAINT.
+*
+* SUBPROGRAMS USED :
+* RF MXVMAX L-INFINITY NORM OF A VECTOR.
+*
+ SUBROUTINE PYTRCG(NF,N,IX,G,UMAX,GMAX,KBF,IOLD)
+ INTEGER NF,N,IX(*),KBF,IOLD
+ DOUBLE PRECISION G(*),UMAX,GMAX
+ DOUBLE PRECISION TEMP,MXVMAX
+ INTEGER I
+ IF (KBF.GT.0) THEN
+ GMAX = 0.0D 0
+ UMAX = 0.0D 0
+ IOLD=0
+ DO 1 I=1,NF
+ TEMP=G(I)
+ IF ( IX(I) .GE. 0) THEN
+ GMAX=MAX(GMAX,ABS(TEMP))
+ ELSE IF (IX(I).LE.-5) THEN
+ ELSE IF (( IX(I) .EQ. -1 .OR. IX(I) .EQ. -3)
+ & .AND. UMAX+TEMP .GE. 0.0D 0) THEN
+ ELSE IF (( IX(I) .EQ. -2 .OR. IX(I) .EQ. -4)
+ & .AND. UMAX-TEMP .GE. 0.0D 0) THEN
+ ELSE
+ IOLD=I
+ UMAX=ABS(TEMP)
+ END IF
+ 1 CONTINUE
+ ELSE
+ UMAX=0.0D 0
+ GMAX=MXVMAX(NF,G)
+ END IF
+ N=NF
+ RETURN
+ END
+* SUBROUTINE PYTRCS ALL SYSTEMS 98/12/01
+* PURPOSE :
+* SCALED AND REDUCED DIRECTION VECTOR IS BACK TRANSFORMED. VECTORS
+* X,G AND VALUES F,P ARE SAVED.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* RI X(NF) VECTOR OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RO XO(NF) SAVED VECTOR OF VARIABLES.
+* RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES.
+* RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES.
+* RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION.
+* RO GO(NF) SAVED GRADIENT OF THE OBJECTIVE FUNCTION.
+* RO S(NF) DIRECTION VECTOR.
+* RO RO SAVED VALUE OF THE STEPSIZE PARAMETER.
+* RO FP PREVIOUS VALUE OF THE OBJECTIVE FUNCTION.
+* RU FO SAVED VALUE OF THE OBJECTIVE FUNCTION.
+* RI F VALUE OF THE OBJECTIVE FUNCTION.
+* RO PO SAVED VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RI P VALUE OF THE DIRECTIONAL DERIVATIVE.
+* RO RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
+* RI ETA9 MAXIMUM FOR REAL NUMBERS.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+*
+* SUBPROGRAMS USED :
+* S MXVCOP COPYING OF A VECTOR.
+*
+ SUBROUTINE PYTRCS(NF,X,IX,XO,XL,XU,G,GO,S,RO,FP,FO,F,PO,P,RMAX,
+ & ETA9,KBF)
+ INTEGER NF,IX(*),KBF
+ DOUBLE PRECISION X(*),XO(*),XL(*),XU(*),G(*),GO(*),S(*),RO,FP,FO,
+ & F,PO,P,RMAX,ETA9
+ INTEGER I
+ FP = FO
+ RO = 0.0D 0
+ FO = F
+ PO = P
+ CALL MXVCOP(NF,X,XO)
+ CALL MXVCOP(NF,G,GO)
+ IF (KBF.GT.0) THEN
+ DO 1 I=1,NF
+ IF (IX(I).LT.0) THEN
+ S(I)=0.0D 0
+ ELSE
+ IF (IX(I).EQ.1.OR.IX(I).GE.3) THEN
+ IF (S(I).LT.-1.0D 0/ETA9) RMAX=MIN(RMAX,(XL(I)-X(I))/S(I))
+ END IF
+ IF (IX(I).EQ.2.OR.IX(I).GE.3) THEN
+ IF (S(I).GT. 1.0D 0/ETA9) RMAX=MIN(RMAX,(XU(I)-X(I))/S(I))
+ END IF
+ END IF
+ 1 CONTINUE
+ END IF
+ RETURN
+ END
+* SUBROUTINE PYTSCH ALL SYSTEMS 99/12/01
+* PURPOSE :
+* HESSIAN MATRIX OF THE OBJECTIVE FUNCTION OR ITS APPROXIMATION
+* IS SCALED.
+*
+* PARAMETERS :
+* II NF DECLARED NUMBER OF VARIABLES.
+* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS.
+* RU H(M) HESSIAN MATRIX OR ITS APPROXIMATION.
+* II IH(N+1) POINTERS OF THE DIAGONAL ELEMENTS OF H.
+* II JH(M) INDICES OF THE NONZERO ELEMENTS OF H.
+* II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
+* KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
+*
+ SUBROUTINE PYTSCH(NF,IX,H,IH,JH,KBF)
+ INTEGER NF,IX(*),IH(*),JH(*),KBF
+ DOUBLE PRECISION H(*)
+ INTEGER I,J,K,JSTRT,JSTOP
+ IF (KBF.GT.0) THEN
+ JSTOP=0
+ DO 3 I=1,NF
+ JSTRT=JSTOP+1
+ JSTOP=IH(I+1)-1
+ IF (IX(I).GE.0) THEN
+ DO 1 J=JSTRT,JSTOP
+ K=JH(J)
+ IF (K.LT.0) THEN
+ H(J)=0.0D 0
+ END IF
+ 1 CONTINUE
+ ELSE
+ H(JSTRT)=1.0D 0
+ DO 2 J=JSTRT+1,JSTOP
+ H(J)=0.0D 0
+ 2 CONTINUE
+ END IF
+ 3 CONTINUE
+ END IF
+ RETURN
+ END
~ianmdlvl / nlopt.git / commitdiff