C$TEST NLSP C TO RUN AS A MAIN PROGRAM REMOVE NEXT LINE SUBROUTINE NLSP C*********************************************************************** C C EXAMPLE OF USE OF THE PORT PROGRAM N2PB C C*********************************************************************** C *** N2PB 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 INTEGER I, IV(102), LIV, LTY, LV, UI(1) REAL B(2,5), BIG, TY(50,2), V(302), X(5) EXTERNAL DUMMY, OSB1J, OSB1R, R1MACH REAL R1MACH DATA LIV/102/, LTY/50/, LV/302/ 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... C IV(1) = 0 C C ... TO LIMIT THE NUMBER OF ITERATIONS TO 100, WE WOULD REPLACE THE C ... ABOVE ASSIGNMENT OF 0 TO IV(1) WITH THE FOLLOWING TWO LINES... C C CALL IVSET(1, IV, LIV, LV, V) C IV(18) = 100 C 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 *** SET BIG TO LARGEST POSITIVE (MODEL) NUMBER... C BIG = R1MACH(2) C C *** SUPPLY BOUNDS -- INCLUDING LOWER BOUNDS OF -BIG AND UPPER C *** BOUNDS OF BIG WHERE WE DO NOT WISH TO IMPOSE BOUNDS... C DO 20 I = 1, 5 B(1,I) = -BIG B(2,I) = BIG 20 CONTINUE C B(2,4) = .0125 B(1,5) = .03 C C *** SOLVE THE PROBLEM -- N2PB WILL PRINT THE SOLUTION FOR US. C *** WE COMPUTE 7 RESIDUAL COMPONENTS OR JACOBIAN ROWS PER CALL... C CALL N2PB(33, 7, 5, X, B, OSB1R, OSB1J, IV, LIV, LV, V, UI, TY, 1 DUMMY) C C C *** NOTE -- ON MOST SYSTEMS, WE COULD SIMPLY PASS OSB1R OR OSB1J C *** AS THE LAST PARAMETER TO N2PB, SINCE OSB1R AND OSB1J IGNORE C *** THEIR UF PARAMETER. BUT THERE EXIST SYSTEMS (E.G. UNIVAC) C *** THAT WOULD GIVE A RUN-TIME ERROR IF WE DID THIS. HENCE WE C *** PASS THE IMMEDIATELY FOLLOWING DUMMY SUBROUTINE AS UF. C STOP END SUBROUTINE DUMMY RETURN END SUBROUTINE OSB1R(N, ND1, N1, N2, P, X, NF, R, LTY, TY, UF) C C *** THIS ROUTINE COMPUTES CHUNKS OF THE RESIDUAL VECTOR, R = R(X), C *** FOR TEST PROBLEM OSBORNE1. C INTEGER N, ND1, N1, N2, P, NF, LTY REAL X(P), R(ND1), TY(LTY,2) EXTERNAL UF C INTEGER I, I1 REAL TI, YI C I1 = 1 DO 10 I = N1, N2 TI = TY(I,1) YI = TY(I,2) R(I1) = YI - (X(1) + X(2)* EXP(X(4)*TI) + X(3)* EXP(X(5)*TI)) I1 = I1 + 1 10 CONTINUE RETURN END SUBROUTINE OSB1J(N, ND1, N1, N2, P, X, NF, J, LTY, TY, UF) C C *** THIS ROUTINE COMPUTES CHUNKS OF THE JACOBIAN MATRIX, J = J(X), C *** FOR TEST PROBLEM OSBORNE1. C INTEGER N, ND1, N1, N2, P, NF, LTY REAL X(P), J(ND1,P), TY(LTY,2) EXTERNAL UF C INTEGER I, I1 REAL NEGONE, TI DATA NEGONE/-1.E+0/ C I1 = 1 DO 10 I = N1, N2 TI = TY(I,1) J(I1,1) = NEGONE J(I1,2) = - EXP(X(4)*TI) J(I1,3) = - EXP(X(5)*TI) J(I1,4) = TI*X(2)*J(I1,2) J(I1,5) = TI*X(3)*J(I1,3) I1 = I1 + 1 10 CONTINUE RETURN END .