/*< SUBROUTINE CG(X,E,IT,STEP,T,LIMIT,N,M,VALUE,GRAD,BOTH,PRE,H) >*/ /* Subroutine */ int cg_(doublereal *x, doublereal *e, integer *it, doublereal *step, doublereal *t, integer *limit, integer *n, integer * m, double (*value)(double*,void*), void (*grad)(double*,double*,void*), void (*both)(double*,double*,double*,void*), void (*pre)(double*,double*,void*), doublereal *h__, void* userdata, integer* error_code) { /* Initialized data */ static doublereal a1 = .1; /* constant */ static doublereal a2 = .9; /* constant */ static doublereal a3 = 5.; /* constant */ static doublereal a4 = .2; /* constant */ static doublereal a5 = 10.; /* constant */ static doublereal a6 = .9; /* constant */ static doublereal a7 = .3; /* constant */ /* System generated locals */ integer h_dim1, h_offset, i__1; doublereal d__1, d__2; /* Builtin functions */ double log(doublereal), exp(doublereal), d_sign(doublereal *, doublereal * ), sqrt(doublereal); integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(); /* Subroutine */ int s_stop(char *, ftnlen); /* Local variables */ doublereal a, b, c__, d__, f, g; integer i__, j, k, l=0; doublereal p, q, r__, s, v=0, w=0, y[50], z__[50], a8, c0, c1=0, d0, f0, f1, l3, da, db, fa, fb, fc; extern doublereal fd_(doublereal *, doublereal *, doublereal *, integer *, void (*grad)(double*,double*,void*), void*); integer na=0, nb, nc, nd, iq=0; extern doublereal fv_(doublereal *, doublereal *, doublereal *, integer *, double (*value)(double*,void*), void*); extern /* Subroutine */ int cub_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), fvd_( doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, void (*)(double*,double*,double*,void*), void*), ins_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *) ; /*< INTEGER I,IT,J,K,L,LIMIT,M,N,NA,NB,NC,ND >*/ /*< REAL*8 H(N,1),X(1),Y(50),Z(50),A1,A2,A3,A4,A5,A6,A7,A8,A,B,C,C0,C1 >*/ /*< REAL*8 D,D0,DA,DB,E,F,F0,F1,FA,FB,FC,G,L3,P,Q,R,S,STEP,T,V,W >*/ /*< REAL*8 FV,FD,VALUE >*/ /*< EXTERNAL BOTH,GRAD,PRE,VALUE >*/ /*< DATA A1/.1D0/,A2/.9D0/,A3/5.D0/,A4/.2D0/,A5/10.D0/,A6/.9D0/ >*/ /* Parameter adjustments */ --x; h_dim1 = *n; h_offset = 1 + h_dim1; h__ -= h_offset; /* Initialize to no error. */ if(error_code) { *error_code = 0; } /* Function Body */ /*< DATA A7/.3D0/ >*/ /*< A8 = A3 + .01D0 >*/ a8 = a3 + .01; /*< IT = 0 >*/ *it = 0; /*< CALL BOTH(F,H(1,3),X) >*/ (*both)(&f, &h__[h_dim1 * 3 + 1], &x[1], userdata); /*< E = 0. >*/ *e = (float)0.; /*< DO 10 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 10 IF ( DABS(H(I,3)) .GT. E ) E = DABS(H(I,3)) >*/ /* L10: */ if ((d__1 = h__[i__ + h_dim1 * 3], abs(d__1)) > *e) { *e = (d__2 = h__[i__ + h_dim1 * 3], abs(d__2)); } } /*< IF ( E .LE. T ) RETURN >*/ if (*e <= *t) { return 0; } /*< L3 = 1./DLOG(A3) >*/ l3 = (float)1. / log(a3); /*< CALL PRE(H(1,2),H(1,3)) >*/ (*pre)(&h__[(h_dim1 << 1) + 1], &h__[h_dim1 * 3 + 1], userdata); /*< A = STEP >*/ a = *step; /*< IF ( A .GT. 0. ) GOTO 30 >*/ if (a > (float)0.) { goto L30; } /*< DO 20 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 20 IF ( DABS(X(I)) .GT. A ) A = DABS(X(I)) >*/ /* L20: */ if ((d__1 = x[i__], abs(d__1)) > a) { a = (d__2 = x[i__], abs(d__2)); } } /*< A = .01*A/E >*/ a = a * (float).01 / *e; /*< IF ( A .EQ. 0. ) A = 1. >*/ if (a == (float)0.) { a = (float)1.; } /*< 30 G = 0. >*/ L30: g = (float)0.; /*< DO 40 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 40 G = G + H(I,2)*H(I,3) >*/ /* L40: */ g += h__[i__ + (h_dim1 << 1)] * h__[i__ + h_dim1 * 3]; } /*< IF ( G .LT. 0. ) GOTO 620 >*/ if (g < (float)0.) { goto L620; } /*< 50 L = 0 >*/ L50: l = 0; /*< DO 60 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 60 H(I,1) = -H(I,2) >*/ /* L60: */ h__[i__ + h_dim1] = -h__[i__ + (h_dim1 << 1)]; } /*< D = -G >*/ d__ = -g; /*< 70 FA = FV(A,X,H,N,VALUE) >*/ L70: fa = fv_(&a, &x[1], &h__[h_offset], n, value, userdata); /*< C0 = A >*/ c0 = a; /*< F0 = FA >*/ f0 = fa; /*< J = 2 >*/ j = 2; /*< Y(1) = 0. >*/ y[0] = (float)0.; /*< Z(1) = F >*/ z__[0] = f; /*< Y(2) = A >*/ y[1] = a; /*< Z(2) = FA >*/ z__[1] = fa; /*< V = A1*D >*/ v = a1 * d__; /*< W = A2*D >*/ w = a2 * d__; /*< IQ = 0 >*/ iq = 0; /*< IF ( FA .LE. F ) GOTO 80 >*/ if (fa <= f) { goto L80; } /*< C = A >*/ c__ = a; /*< B = 0. >*/ b = (float)0.; /*< A = 0. >*/ a = (float)0.; /*< FC = FA >*/ fc = fa; /*< FB = F >*/ fb = f; /*< FA = F >*/ fa = f; /*< GOTO 90 >*/ goto L90; /*< 80 C = 0. >*/ L80: c__ = (float)0.; /*< B = 0. >*/ b = (float)0.; /*< FC = F >*/ fc = f; /*< FB = F >*/ fb = f; /*< IQ = 1 >*/ iq = 1; /*< 90 NA = 0 >*/ L90: na = 0; /*< NB = 0 >*/ nb = 0; /*< NC = 0 >*/ nc = 0; /*< ND = 0 >*/ nd = 0; /*< Q = (D+(F-F0)/C0)/C0 >*/ q = (d__ + (f - f0) / c0) / c0; /*< IF ( Q .LT. 0. ) GOTO 110 >*/ if (q < (float)0.) { goto L110; } /*< Q = A >*/ q = a; /*< 100 ND = ND + 1 >*/ L100: ++nd; /*< IF ( ND .GT. 25 ) GOTO 610 >*/ if (nd > 25) { goto L610; } /*< Q = A3*Q >*/ q = a3 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .LT. W*Q ) GOTO 100 >*/ if (p - f < w * q) { goto L100; } /*< GOTO 260 >*/ goto L260; /*< 110 Q = .5*D/Q >*/ L110: q = d__ * (float).5 / q; /*< IF ( Q .LT. .01*C0 ) Q = .01*C0 >*/ if (q < c0 * (float).01) { q = c0 * (float).01; } /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< IF ( P .LE. F0 ) GOTO 120 >*/ if (p <= f0) { goto L120; } /*< F1 = F0 >*/ f1 = f0; /*< C1 = C0 >*/ c1 = c0; /*< F0 = P >*/ f0 = p; /*< C0 = Q >*/ c0 = q; /*< GOTO 130 >*/ goto L130; /*< 120 F1 = P >*/ L120: f1 = p; /*< C1 = Q >*/ c1 = q; /*< 130 CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ L130: ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< 135 IF ( A .EQ. 0. ) GOTO 140 >*/ L135: if (a == (float)0.) { goto L140; } /*< IF ( FA-F .GE. V*A ) GOTO 160 >*/ if (fa - f >= v * a) { goto L160; } /*< IF ( FA-F .LT. W*A ) GOTO 210 >*/ if (fa - f < w * a) { goto L210; } /*< GOTO 280 >*/ goto L280; /*< 140 Q = C0 >*/ L140: q = c0; /*< IF ( C1 .LT. Q ) Q = C1 >*/ if (c1 < q) { q = c1; } /*< 150 NA = NA + 1 >*/ L150: ++na; /*< IF ( NA .GT. 25 ) GOTO 630 >*/ if (na > 25) { goto L630; } /*< Q = A4*Q >*/ q = a4 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .GE. V*Q ) GOTO 150 >*/ if (p - f >= v * q) { goto L150; } /*< GOTO 250 >*/ goto L250; /*< 160 IF ( C0 .GT. C1 ) GOTO 200 >*/ L160: if (c0 > c1) { goto L200; } /*< IF ( F0-F .GT. V*C0 ) GOTO 180 >*/ if (f0 - f > v * c0) { goto L180; } /*< IF ( F0-F .GE. W*C0 ) GOTO 320 >*/ if (f0 - f >= w * c0) { goto L320; } /*< IF ( C1 .LE. A5*C0 ) GOTO 320 >*/ if (c1 <= a5 * c0) { goto L320; } /*< R = DLOG(C1/C0) >*/ r__ = log(c1 / c0); /*< S = -IDINT(R*L3+.999) >*/ s = (doublereal) (-((integer) (r__ * l3 + (float).999))); /*< R = .999*DEXP(R/S) >*/ r__ = exp(r__ / s) * (float).999; /*< Q = C1 >*/ q = c1; /*< 170 Q = Q*R >*/ L170: q *= r__; /*< IF ( Q .LT. C0 ) GOTO 320 >*/ if (q < c0) { goto L320; } /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< NA = NA + 1 >*/ ++na; /*< IF ( P-F .GT. V*Q ) GOTO 170 >*/ if (p - f > v * q) { goto L170; } /*< GOTO 320 >*/ goto L320; /*< 180 Q = C0 >*/ L180: q = c0; /*< 190 NA = NA + 1 >*/ L190: ++na; /*< IF ( NA .GT. 25 ) GOTO 630 >*/ if (na > 25) { goto L630; } /*< Q = A4*Q >*/ q = a4 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .GE. V*Q ) GOTO 190 >*/ if (p - f >= v * q) { goto L190; } /*< GOTO 250 >*/ goto L250; /*< 200 Q = A >*/ L200: q = a; /*< GOTO 190 >*/ goto L190; /*< 210 IF ( C0 .LT. C1 ) GOTO 290 >*/ L210: if (c0 < c1) { goto L290; } /*< IF ( F0-F .GE. V*C0 ) GOTO 230 >*/ if (f0 - f >= v * c0) { goto L230; } /*< IF ( F0-F .GE. W*C0 ) GOTO 250 >*/ if (f0 - f >= w * c0) { goto L250; } /*< Q = C0 >*/ q = c0; /*< 220 ND = ND + 1 >*/ L220: ++nd; /*< IF ( ND .GT. 25 ) GOTO 610 >*/ if (nd > 25) { goto L610; } /*< Q = A3*Q >*/ q = a3 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .LT. W*Q ) GOTO 220 >*/ if (p - f < w * q) { goto L220; } /*< GOTO 250 >*/ goto L250; /*< 230 IF ( C0 .LE. A5*C1 ) GOTO 250 >*/ L230: if (c0 <= a5 * c1) { goto L250; } /*< R = DLOG(C0/C1) >*/ r__ = log(c0 / c1); /*< S = IDINT(R*L3+.999) >*/ s = (doublereal) ((integer) (r__ * l3 + (float).999)); /*< R = 1.001*DEXP(R/S) >*/ r__ = exp(r__ / s) * (float)1.001; /*< Q = A >*/ q = a; /*< 240 Q = Q*R >*/ L240: q *= r__; /*< IF ( Q .GT. C0 ) GOTO 250 >*/ if (q > c0) { goto L250; } /*< ND = ND + 1 >*/ ++nd; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .LT. W*Q ) GOTO 240 >*/ if (p - f < w * q) { goto L240; } /*< 250 IF ( IQ .EQ. 1 ) GOTO 320 >*/ L250: if (iq == 1) { goto L320; } /*< 260 IF ( B .EQ. 0. ) GOTO 280 >*/ L260: if (b == (float)0.) { goto L280; } /*< IF ( C .EQ. 0. ) GOTO 270 >*/ if (c__ == (float)0.) { goto L270; } /*< V = C - A >*/ v = c__ - a; /*< W = A - B >*/ w = a - b; /*< R = 1./V >*/ r__ = (float)1. / v; /*< S = 1./W >*/ s = (float)1. / w; /*< P = FC - FA >*/ p = fc - fa; /*< Q = FB - FA >*/ q = fb - fa; /*< E = P*R + Q*S >*/ *e = p * r__ + q * s; /*< IF ( DSIGN(E,C-B) .NE. E ) GOTO 320 >*/ d__1 = c__ - b; if (d_sign(e, &d__1) != *e) { goto L320; } /*< IF ( E .EQ. 0. ) GOTO 320 >*/ if (*e == (float)0.) { goto L320; } /*< Q = (P*R)*W - (Q*S)*V >*/ q = p * r__ * w - q * s * v; /*< Q = A - .5*Q/E >*/ q = a - q * (float).5 / *e; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< GOTO 320 >*/ goto L320; /*< 270 R = 1./A >*/ L270: r__ = (float)1. / a; /*< S = 1./B >*/ s = (float)1. / b; /*< P = R*(FA-F) - D >*/ p = r__ * (fa - f) - d__; /*< Q = S*(FB-F) - D >*/ q = s * (fb - f) - d__; /*< E = A - B >*/ *e = a - b; /*< V = (R*P-S*Q)/E >*/ v = (r__ * p - s * q) / *e; /*< W = (A*Q*S-B*P*R)/E >*/ w = (a * q * s - b * p * r__) / *e; /*< V = W*W-3.*V*D >*/ v = w * w - v * (float)3. * d__; /*< IF ( V .LT. 0. ) V = 0. >*/ if (v < (float)0.) { v = (float)0.; } /*< V = DSQRT(V) >*/ v = sqrt(v); /*< IF ( W+V .EQ. 0. ) GOTO 320 >*/ if (w + v == (float)0.) { goto L320; } /*< Q = -D/(W+V) >*/ q = -d__ / (w + v); /*< IF ( Q .LE. 0. ) GOTO 320 >*/ if (q <= (float)0.) { goto L320; } /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< GOTO 320 >*/ goto L320; /*< 280 IF ( IQ .EQ. 1 ) GOTO 320 >*/ L280: if (iq == 1) { goto L320; } /*< Q = (D+(F-FA)/A)/A >*/ q = (d__ + (f - fa) / a) / a; /*< IF ( Q .GE. 0. ) GOTO 320 >*/ if (q >= (float)0.) { goto L320; } /*< Q = .5*D/Q >*/ q = d__ * (float).5 / q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< GOTO 320 >*/ goto L320; /*< 290 IF ( F0-F .GT. V*C0 ) GOTO 300 >*/ L290: if (f0 - f > v * c0) { goto L300; } /*< IF ( F0-F .GT. W*C0 ) GOTO 320 >*/ if (f0 - f > w * c0) { goto L320; } /*< 300 Q = A >*/ L300: q = a; /*< 310 ND = ND + 1 >*/ L310: ++nd; /*< IF ( ND .GT. 25 ) GOTO 610 >*/ if (nd > 25) { goto L610; } /*< Q = A3*Q >*/ q = a3 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .LT. W*Q ) GOTO 310 >*/ if (p - f < w * q) { goto L310; } /*< GOTO 250 >*/ goto L250; /*< 320 DA = FD(A,X,H,N,GRAD) >*/ L320: da = fd_(&a, &x[1], &h__[h_offset], n, grad, userdata); /*< IF ( DA .GT. A6*G ) GOTO 410 >*/ if (da > a6 * g) { goto L410; } /*< IF ( DA .GE. 0. ) GOTO 560 >*/ if (da >= (float)0.) { goto L560; } /*< R = A >*/ r__ = a; /*< Q = 0. >*/ q = (float)0.; /*< DO 330 I = 1,J >*/ i__1 = j; for (i__ = 1; i__ <= i__1; ++i__) { /*< IF ( Y(I) .GT. A ) GOTO 370 >*/ if (y[i__ - 1] > a) { goto L370; } /*< IF ( Y(I) .LE. Q ) GOTO 330 >*/ if (y[i__ - 1] <= q) { goto L330; } /*< IF ( Y(I) .EQ. A ) GOTO 330 >*/ if (y[i__ - 1] == a) { goto L330; } /*< Q = Y(I) >*/ q = y[i__ - 1]; /*< 330 CONTINUE >*/ L330: ; } /*< IF ( A .LE. A8*Q ) GOTO 560 >*/ if (a <= a8 * q) { goto L560; } /*< Q = A >*/ q = a; /*< 340 ND = ND + 1 >*/ L340: ++nd; /*< IF ( ND .GT. 25 ) GOTO 610 >*/ if (nd > 25) { goto L610; } /*< Q = A3*Q >*/ q = a3 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< F1 = FA >*/ f1 = fa; /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P .LT. F1 ) GOTO 340 >*/ if (p < f1) { goto L340; } /*< IF ( A .GT. R ) GOTO 360 >*/ if (a > r__) { goto L360; } /*< DO 350 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 350 H(I,2) = X(I) + A*H(I,1) >*/ /* L350: */ h__[i__ + (h_dim1 << 1)] = x[i__] + a * h__[i__ + h_dim1]; } /*< GOTO 560 >*/ goto L560; /*< 360 DA = FD(A,X,H,N,GRAD) >*/ L360: da = fd_(&a, &x[1], &h__[h_offset], n, grad, userdata); /*< IF ( DA .GT. A6*G ) GOTO 410 >*/ if (da > a6 * g) { goto L410; } /*< GOTO 560 >*/ goto L560; /*< 370 Q = Y(I) >*/ L370: q = y[i__ - 1]; /*< DO 380 K = I,J >*/ i__1 = j; for (k = i__; k <= i__1; ++k) { /*< IF ( Y(K) .LE. A ) GOTO 380 >*/ if (y[k - 1] <= a) { goto L380; } /*< IF ( Y(K) .LT. Q ) Q = Y(K) >*/ if (y[k - 1] < q) { q = y[k - 1]; } /*< 380 CONTINUE >*/ L380: ; } /*< IF ( Q .LE. A5*A ) GOTO 560 >*/ if (q <= a5 * a) { goto L560; } /*< F0 = DLOG(Q/A) >*/ f0 = log(q / a); /*< S = IDINT(F0*L3+.999) >*/ s = (doublereal) ((integer) (f0 * l3 + (float).999)); /*< F0 = 1.001*DEXP(F0/S) >*/ f0 = exp(f0 / s) * (float)1.001; /*< S = A >*/ s = a; /*< 390 S = S*F0 >*/ L390: s *= f0; /*< IF ( S .GE. Q ) GOTO 320 >*/ if (s >= q) { goto L320; } /*< P = FV(S,X,H,N,VALUE) >*/ p = fv_(&s, &x[1], &h__[h_offset], n, value, userdata); /*< F1 = FA >*/ f1 = fa; /*< CALL INS(S,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&s, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P .LT. F1 ) GOTO 390 >*/ if (p < f1) { goto L390; } /*< IF ( A .GT. R ) GOTO 320 >*/ if (a > r__) { goto L320; } /*< DO 400 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 400 H(I,2) = X(I) + A*H(I,1) >*/ /* L400: */ h__[i__ + (h_dim1 << 1)] = x[i__] + a * h__[i__ + h_dim1]; } /*< GOTO 560 >*/ goto L560; /*< 410 B = 0. >*/ L410: b = (float)0.; /*< K = 1 >*/ k = 1; /*< I = K >*/ i__ = k; /*< 420 I = I + 1 >*/ L420: ++i__; /*< IF ( I .GT. J ) GOTO 430 >*/ if (i__ > j) { goto L430; } /*< IF ( Y(I) .GE. A ) GOTO 420 >*/ if (y[i__ - 1] >= a) { goto L420; } /*< IF ( Y(I) .LT. B ) GOTO 420 >*/ if (y[i__ - 1] < b) { goto L420; } /*< B = Y(I) >*/ b = y[i__ - 1]; /*< K = I >*/ k = i__; /*< GOTO 420 >*/ goto L420; /*< 430 FB = Z(K) >*/ L430: fb = z__[k - 1]; /*< DB = D >*/ db = d__; /*< IF ( B .NE. 0. ) DB = FD(B,X,H,N,GRAD) >*/ if (b != (float)0.) { db = fd_(&b, &x[1], &h__[h_offset], n, grad, userdata); } /*< 440 W = 2.*DABS(B-A) >*/ /* L440: */ w = (d__1 = b - a, abs(d__1)) * (float)2.; /*< CALL CUB(C,A,B,FA,FB,DA,DB) >*/ cub_(&c__, &a, &b, &fa, &fb, &da, &db); /*< NC = 1 >*/ nc = 1; /*< GOTO 480 >*/ goto L480; /*< 450 W = .5*W >*/ L450: w *= (float).5; /*< IF ( W .LT. DABS(C0-C) ) GOTO 550 >*/ if (w < (d__1 = c0 - c__, abs(d__1))) { goto L550; } /*< IF ( C0 .LT. C ) GOTO 460 >*/ if (c0 < c__) { goto L460; } /*< IF ( D0 .GE. D ) GOTO 470 >*/ if (d0 >= d__) { goto L470; } /*< GOTO 550 >*/ goto L550; /*< 460 IF ( D0 .GT. D ) GOTO 550 >*/ L460: if (d0 > d__) { goto L550; } /*< 470 CALL CUB(C,C,C0,F,F0,D,D0) >*/ L470: cub_(&c__, &c__, &c0, &f, &f0, &d__, &d0); /*< NC = NC + 1 >*/ ++nc; /*< IF ( NC .GT. 30 ) GOTO 600 >*/ if (nc > 30) { goto L600; } /*< 480 R = DMAX1(A,B) >*/ L480: r__ = max(a,b); /*< S = DMIN1(A,B) >*/ s = min(a,b); /*< IF ( C .GT. R ) GOTO 490 >*/ if (c__ > r__) { goto L490; } /*< IF ( C .GT. S ) GOTO 500 >*/ if (c__ > s) { goto L500; } /*< C = S + (S-C) >*/ c__ = s + (s - c__); /*< S = .5*(A+B) >*/ s = (a + b) * (float).5; /*< IF ( C .GT. S ) C = S >*/ if (c__ > s) { c__ = s; } /*< GOTO 500 >*/ goto L500; /*< 490 C = R - (C-R) >*/ L490: c__ = r__ - (c__ - r__); /*< S = .5*(A+B) >*/ s = (a + b) * (float).5; /*< IF ( C .LT. S ) C = S >*/ if (c__ < s) { c__ = s; } /*< 500 C0 = A >*/ L500: c0 = a; /*< F0 = FA >*/ f0 = fa; /*< D0 = DA >*/ d0 = da; /*< CALL FVD(F,D,C,X,H,N,BOTH) >*/ fvd_(&f, &d__, &c__, &x[1], &h__[h_offset], n, both, userdata); /*< IF ( F .LT. FA ) GOTO 510 >*/ if (f < fa) { goto L510; } /*< B = C >*/ b = c__; /*< FB = F >*/ fb = f; /*< DB = D >*/ db = d__; /*< GOTO 450 >*/ goto L450; /*< 510 IF ( C .LT. A ) GOTO 540 >*/ L510: if (c__ < a) { goto L540; } /*< IF ( D .LT. 0. ) GOTO 530 >*/ if (d__ < (float)0.) { goto L530; } /*< 520 B = A >*/ L520: b = a; /*< FB = FA >*/ fb = fa; /*< DB = DA >*/ db = da; /*< 530 A = C >*/ L530: a = c__; /*< FA = F >*/ fa = f; /*< DA = D >*/ da = d__; /*< IF ( D .GT. A6*G ) GOTO 450 >*/ if (d__ > a6 * g) { goto L450; } /*< GOTO 560 >*/ goto L560; /*< 540 IF ( D .LT. 0. ) GOTO 520 >*/ L540: if (d__ < (float)0.) { goto L520; } /*< GOTO 530 >*/ goto L530; /*< 550 C = .5*(A+B) >*/ L550: c__ = (a + b) * (float).5; /*< NB = NB + 1 >*/ ++nb; /*< W = DABS(B-A) >*/ w = (d__1 = b - a, abs(d__1)); /*< GOTO 500 >*/ goto L500; /*< 560 E = 0. >*/ L560: *e = (float)0.; /*< DO 570 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< IF ( DABS(H(I,3)) .GT. E ) E = DABS(H(I,3)) >*/ if ((d__1 = h__[i__ + h_dim1 * 3], abs(d__1)) > *e) { *e = (d__2 = h__[i__ + h_dim1 * 3], abs(d__2)); } /*< 570 X(I) = H(I,2) >*/ /* L570: */ x[i__] = h__[i__ + (h_dim1 << 1)]; } /*< IT = IT + 1 >*/ ++(*it); /*< IF ( E .LE. T ) GOTO 660 >*/ if (*e <= *t) { goto L660; } /*< IF ( IT .GE. LIMIT ) GOTO 660 >*/ if (*it >= *limit) { goto L660; } /*< F = FA >*/ f = fa; /*< D = DA >*/ d__ = da; /*< A = A7*A >*/ a = a7 * a; /*< CALL PRE(H(1,2),H(1,3)) >*/ (*pre)(&h__[(h_dim1 << 1) + 1], &h__[h_dim1 * 3 + 1], userdata); /*< R = 0. >*/ r__ = (float)0.; /*< DO 580 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< 580 R = R + H(I,2)*H(I,3) >*/ /* L580: */ r__ += h__[i__ + (h_dim1 << 1)] * h__[i__ + h_dim1 * 3]; } /*< IF ( R .LT. 0. ) GOTO 620 >*/ if (r__ < (float)0.) { goto L620; } /*< S = R/G >*/ s = r__ / g; /*< G = R >*/ g = r__; /*< L = L + 1 >*/ ++l; /*< IF ( L .GE. M ) GOTO 50 >*/ if (l >= *m) { goto L50; } /*< D = 0. >*/ d__ = (float)0.; /*< DO 590 I = 1,N >*/ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /*< H(I,1) = -H(I,2) + S*H(I,1) >*/ h__[i__ + h_dim1] = -h__[i__ + (h_dim1 << 1)] + s * h__[i__ + h_dim1]; /*< 590 D = D + H(I,1)*H(I,3) >*/ /* L590: */ d__ += h__[i__ + h_dim1] * h__[i__ + h_dim1 * 3]; } /*< GOTO 70 >*/ goto L70; /*< 600 IF ( D .LT. G ) GOTO 560 >*/ L600: if (d__ < g) { goto L560; } /*< WRITE(6,*) 'UNABLE TO OBTAIN DESCENT DIRECTION' >*/ if(error_code) { *error_code = 1; return 0; } else { printf("UNABLE TO OBTAIN DESCENT DIRECTION\n"); } /*< STOP >*/ /*assert(0);*/ return 0; /*< 610 WRITE(6,*) 'THE FUNCTION DECREASES WITH NO MINIMUM' >*/ L610: if(error_code) { *error_code = 2; } else { printf("THE FUNCTION DECREASES WITH NO MINIMUM\n"); } /*< STOP >*/ /*assert(0);*/ return 0; /*< 620 WRITE(6,*) 'PRECONDITIONER NOT POSITIVE DEFINITE' >*/ L620: if(error_code) { *error_code = 3; return 0; } else { printf("PRECONDITIONER NOT POSITIVE DEFINITE\n"); } /*< STOP >*/ /*assert(0);*/ return 0; /*< 630 Q = Q*A3**25 >*/ L630: /* Computing 25th power */ d__1 = a3, d__2 = d__1, d__1 *= d__1, d__1 *= d__1, d__1 *= d__1, d__2 *= d__1; q *= d__2 * (d__1 * d__1); /*< ND = 0 >*/ nd = 0; /*< 640 ND = ND + 1 >*/ L640: ++nd; /*< IF ( ND .GT. 25 ) GOTO 650 >*/ if (nd > 25) { goto L650; } /*< Q = A3*Q >*/ q = a3 * q; /*< P = FV(Q,X,H,N,VALUE) >*/ p = fv_(&q, &x[1], &h__[h_offset], n, value, userdata); /*< CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z) >*/ ins_(&q, &p, &a, &b, &c__, &fa, &fb, &fc, &j, y, z__); /*< IF ( P-F .GT. V*Q ) GOTO 640 >*/ if (p - f > v * q) { goto L640; } /*< GOTO 135 >*/ goto L135; /*< 650 WRITE(6,*) 'UNABLE TO SATISFY ARMIJO CONDITION' >*/ L650: printf("UNABLE TO SATISFY ARMIJO CONDITION\n"); /*< RETURN >*/ return 0; /*< 660 STEP = A >*/ L660: *step = a; /*< RETURN >*/ return 0; /*< END >*/ } /* cg_ */
void apply(long row, long col, ScalarType value) { typename mtl::Collection<MatrixType>::value_type val(value); ins_(row, col) << val; }