C$TEST NLSJ C TO RUN AS A MAIN PROGRAM REMOVE NEXT LINE SUBROUTINE NLSJ C*********************************************************************** C C EXAMPLE OF USE OF THE PORT PROGRAMS N2F AND N2G C C*********************************************************************** C *** N2F AND N2G, EXAMPLE PROGRAM *** C C *** FIT N = 33 DATA POINTS (T,Y) TO THE CURVE C *** X(1) + X(2)*EXP(T*X(4)) + X(3)*EXP(T*X(5)) C C *** THE FOLLOWING CODE IS FOR CALLING N2G. DIFFERENCES FOR C *** CALLING N2F ARE EXPLAINED IN COMMENTS. C INTEGER I, IV(87), LIV, LTY, LV, UI(1) REAL TY(50,2), V(471), X(5) EXTERNAL DUMMY, OSB1J, OSB1R DATA LIV/87/, LTY/50/, LV/471/ C C *** FOR N2F, OMIT OSB1J FROM THE EXTERNAL STATEMENT. C C C *** TO MAKE THIS EXAMPLE SELF-CONTAINED, WE USE A DATA STATEMENT C *** AND DO LOOP TO SUPPLY (T,Y) PAIRS TO THE ARRAY TY. C C *** Y VALUES... C DATA TY(1,2) /8.44E-1/, TY(2,2) /9.08E-1/, TY(3,2)/9.32E-1/, 1 TY(4,2) /9.36E-1/, TY(5,2) /9.25E-1/, TY(6,2)/9.08E-1/, 2 TY(7,2) /8.81E-1/, TY(8,2) /8.50E-1/, TY(9,2)/8.18E-1/, 3 TY(10,2)/7.84E-1/, TY(11,2)/7.51E-1/, TY(12,2)/7.18E-1/, 4 TY(13,2)/6.85E-1/, TY(14,2)/6.58E-1/, TY(15,2)/6.28E-1/, 5 TY(16,2)/6.03E-1/, TY(17,2)/5.80E-1/, TY(18,2)/5.58E-1/, 6 TY(19,2)/5.38E-1/, TY(20,2)/5.22E-1/, TY(21,2)/5.06E-1/, 7 TY(22,2)/4.90E-1/, TY(23,2)/4.78E-1/, TY(24,2)/4.67E-1/, 8 TY(25,2)/4.57E-1/, TY(26,2)/4.48E-1/, TY(27,2)/4.38E-1/, 9 TY(28,2)/4.31E-1/, TY(29,2)/4.24E-1/, TY(30,2)/4.20E-1/, A TY(31,2)/4.14E-1/, TY(32,2)/4.11E-1/, TY(33,2)/4.06E-1/ C C *** T VALUES... C DO 10 I = 1, 33 TY(I,1) = -10.E+0 * FLOAT(I-1) 10 CONTINUE C C *** SUPPLY LEAD DIMENSION OF TY IN UI(1)... C *** (MOST COMPILERS WOULD LET US SIMPLY PASS LTY FOR UI, C *** BUT SOME, E.G. WATFIV, WILL NOT.) C UI(1) = LTY C C *** SPECIFY ALL DEFAULT IV AND V INPUT COMPONENTS (N2G AND N2F C *** ONLY)... C IV(1) = 0 C C *** SUPPLY INITIAL GUESS... C X(1) = 0.5E+0 X(2) = 1.5E+0 X(3) = -1.E+0 X(4) = 1.E-2 X(5) = 2.E-2 C C *** SOLVE THE PROBLEM -- N2G WILL PRINT THE SOLUTION FOR US... C CALL N2G(33, 5, X, OSB1R, OSB1J, IV, LIV, LV, V, UI, TY, DUMMY) C C *** FOR N2F, THE CORRESPONDING CALLS WOULD BE... C C CALL N2F(33, 5, X, OSB1R, IV, LIV, LV, V, UI, TY, DUMMY) C C C *** NOTE -- ON MOST SYSTEMS, WE COULD SIMPLY PASS OSB1R (OR OSB1J) C *** AS THE UF PARAMETER, SINCE OSB1R AND OSB1J IGNORE THIS C *** PARAMETER. BUT THERE EXIST SYSTEMS (E.G. UNIVAC) THAT WOULD C *** GIVE A RUN-TIME ERROR IF WE DID THIS. HENCE WE PASS THE C *** IMMEDIATELY FOLLOWING DUMMY SUBROUTINE AS UF. C STOP END SUBROUTINE DUMMY RETURN END SUBROUTINE OSB1R(N, P, X, NF, R, LTY, TY, UF) C C *** THIS ROUTINE COMPUTES THE RESIDUAL VECTOR, R = R(X), C *** FOR TEST PROBLEM OSBORNE1. C INTEGER N, P, NF, LTY REAL X(P), R(N), TY(LTY,2) EXTERNAL UF C INTEGER I REAL TI, YI C DO 10 I = 1, N TI = TY(I,1) YI = TY(I,2) R(I) = YI - (X(1) + X(2)* EXP(X(4)*TI) + X(3)* EXP(X(5)*TI)) 10 CONTINUE RETURN END SUBROUTINE OSB1J(N, P, X, NF, J, LTY, TY, UF) C C *** THIS ROUTINE COMPUTES THE JACOBIAN MATRIX, J = J(X), C *** FOR TEST PROBLEM OSBORNE1. J(I,K) IS SET TO THE PARTIAL C *** DERIVATIVE OF COMPONENT I OF R WITH RESPECT TO X(K). C INTEGER N, P, NF, LTY REAL X(P), J(N,P), TY(LTY,2) EXTERNAL UF C INTEGER I REAL NEGONE, TI DATA NEGONE/-1.E+0/ C DO 10 I = 1, N TI = TY(I,1) J(I,1) = NEGONE J(I,2) = - EXP(X(4)*TI) J(I,3) = - EXP(X(5)*TI) J(I,4) = TI*X(2)*J(I,2) J(I,5) = TI*X(3)*J(I,3) 10 CONTINUE RETURN END .