*DTEST PROGRAM DTEST C***BEGIN PROLOGUE TEST C***REFER TO DODR,DODRC C***ROUTINES CALLED DODRX C***DATE WRITTEN 861229 (YYMMDD) C***REVISION DATE 920619 (YYMMDD) C***PURPOSE EXERCISE FEATURES OF ODRPACK SOFTWARE C***END PROLOGUE ODRPACK C...SCALARS IN COMMON INTEGER + NTEST C...LOCAL SCALARS DOUBLE PRECISION + TSTFAC INTEGER + LUNERR,LUNRPT,LUNSUM LOGICAL + PASSED C...EXTERNAL SUBROUTINES EXTERNAL + DODRX C...COMMON BLOCKS COMMON /TSTSET/ NTEST C***VARIABLE DECLARATIONS (ALPHABETICALLY) C LUNERR: THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES. C LUNRPT: THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS. C LUNSUM: THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT LISTING C ONLY THE TEST COMPARISONS AND NOT THE ODRPACK GENERATED C REPORTS. C NTEST: THE NUMBER OF TESTS TO BE RUN. C PASSED: THE VARIABLE DESIGNATING WHETHER THE RESULTS OF ALL OF THE C TESTS AGREE WITH THOSE FROM THE CRAY YMP USING DOUBLE C PRECISION (PASSED=TRUE), OR WHETHER SOME OF THE RESULTS C DISAGREED (PASSED=FALSE). C TSTFAC: THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES C USED TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND C RESULTS OBTAINED USING DOUBLE PRECISION VERSION ON CRAY C YMP. VALUES OF TSTFAC GREATER THAN ONE INCREASE THE C TEST TOLERANCES, MAKING THE TESTS EASIER TO PASS AND C ALLOWING SMALL DISCREPANCIES BETWEEN THE COMPUTED AND C EXPECTED RESULTS TO BE AUTOMATICALLY DISCOUNTED. C***FIRST EXECUTABLE STATEMENT TEST C SET UP NECESSARY FILES C NOTE: ODRPACK GENERATES COMPUTATION AND ERROR REPORTS ON C LOGICAL UNIT 6 BY DEFAULT; C LOGICAL UNIT 'LUNSUM' USED TO SUMMARIZE RESULTS OF COMPARISONS C FROM EXERCISE ROUTINE DODRX. LUNRPT = 18 LUNERR = 18 LUNSUM = 19 OPEN(UNIT=LUNRPT,FILE='REPORT') OPEN(UNIT=LUNERR,FILE='REPORT') OPEN(UNIT=LUNSUM,FILE='SUMMARY') C EXERCISE DOUBLE PRECISION VERSION OF ODRPACK C (TEST REPORTS GENERATED ON FILE 'RESULTS' AND C SUMMARIZED IN FILE 'SUMMARY') NTEST = 12 TSTFAC = 1.0D0 CALL DODRX(TSTFAC,PASSED,LUNSUM) END *DODRX SUBROUTINE DODRX + (TSTFAC,PASSED,LUNSUM) C***BEGIN PROLOGUE DODRX C***REFER TO DODR,DODRC C***ROUTINES CALLED DDOT,DMPREC,DNRM2,DODR,DODRC,DODRXD, C DODRXF,DODRXW,DWGHT,DZERO C***DATE WRITTEN 860529 (YYMMDD) C***REVISION DATE 920619 (YYMMDD) C***PURPOSE EXERCISE FEATURES OF ODRPACK SOFTWARE C***END PROLOGUE DODRX C...PARAMETERS INTEGER + LDWD,LDWE,LD2WD,LD2WE,LIWORK,LWORK,MAXN,MAXM,MAXNP,MAXNQ,NTESTS PARAMETER + (MAXN=50, MAXM=3, MAXNP=10, MAXNQ=2, NTESTS=12, + LDWE=MAXN, LD2WE=MAXNQ, LDWD=MAXN, LD2WD=MAXM, + LWORK = 18 + 11*MAXNP + MAXNP**2 + MAXM + MAXM**2 + + 4*MAXN*MAXNQ + 6*MAXN*MAXM + 2*MAXN*MAXNQ*MAXNP + + 2*MAXN*MAXNQ*MAXM + MAXNQ**2 + + 5*MAXNQ + MAXNQ*(MAXNP+MAXM) + LDWE*LD2WE*MAXNQ, + LIWORK = 20+MAXNP+MAXNQ*(MAXNP+MAXM)) C...SCALAR ARGUMENTS DOUBLE PRECISION + TSTFAC INTEGER + LUNSUM LOGICAL + PASSED C...SCALARS IN COMMON INTEGER + NTEST,SETNO C...LOCAL SCALARS INTEGER + I,INFO,IPRINT,ITEST,JOB,L,LDIFX,LDSCLD,LDSTPD,LDWD1,LDWE1, + LDX,LDY,LD2WD1,LD2WE1,LIWMIN,LUN,LUNERR,LUNRPT,LWMIN, + M,MAXIT,MSG,N,NDIGIT,NP,NQ DOUBLE PRECISION + BNRM,EPSMAC,HUNDRD,ONE,P01,P2,PARTOL,SSTOL, + TAUFAC,THREE,TSTTOL,TWO,WSS,WSSDEL,WSSEPS,ZERO LOGICAL + FAILED,FAILS,ISODR,SHORT CHARACTER TITLE*80 C...LOCAL ARRAYS DOUBLE PRECISION + BETA(MAXNP),DPYMP(2,NTESTS), + SCLB(MAXNP),SCLD(MAXN,MAXM), + STPB(MAXNP),STPD(MAXN,MAXM), + WE(MAXN,MAXNQ,MAXNQ),WD(MAXN,MAXM,MAXM),WORK(LWORK), + WRK(MAXN*MAXM+MAXN*MAXNQ),X(MAXN,MAXM),Y(MAXN,MAXNQ) INTEGER + IDPYMP(NTESTS),IFIXB(MAXNP),IFIXX(MAXN,MAXM),IWORK(LIWORK) C...EXTERNAL FUNCTIONS DOUBLE PRECISION + DDOT,DMPREC,DNRM2 EXTERNAL + DDOT,DMPREC,DNRM2 C...EXTERNAL SUBROUTINES EXTERNAL + DODR,DODRC,DODRXD,DODRXF,DODRXW,DWGHT,DZERO C...INTRINSIC FUNCTIONS INTRINSIC + ABS,MOD C...COMMON BLOCKS COMMON /SETID/SETNO COMMON /TSTSET/ NTEST C...DATA STATEMENTS DATA + ZERO,P01,P2,ONE,TWO,THREE,HUNDRD + /0.0D0,0.01D0,0.2D0,1.0D0,2.0D0,3.0D0,100.0D0/ DATA + (DPYMP(I,1),I=1,2) + /2.762733195780256808978449342964D+04, + 7.532639569022918943695104672512D-04/ DATA + (DPYMP(I,2),I=1,2) + /2.762732630143673024399942947263D+04, + 7.538467722687131506874279314940D-04/ DATA + (DPYMP(I,3),I=1,2) + /1.069944100000000027940905194068D+09, + 1.212808593256056359629660672046D-05/ DATA + (DPYMP(I,4),I=1,2) + /1.069944100000000026623461142867D+09, + 5.452084633790606017572015067556D-07/ DATA + (DPYMP(I,5),I=1,2) + /1.426988156377258617521571734503D+00, + 1.084728687127432219753903919409D+00/ DATA + (DPYMP(I,6),I=1,2) + /4.261321829513978871872508874025D+00, + 1.477967210398420733565424329280D-02/ DATA + (DPYMP(I,7),I=1,2) + /4.261272307142888464011486769858D+00, + 1.477966125465374336804138554559D-02/ DATA + (DPYMP(I,8),I=1,2) + /4.371487317909745009110272283622D+01, + 1.144419474408286067112233592550D-03/ DATA + (DPYMP(I,9),I=1,2) + /3.099048849376848610380977303924D+00, + 8.824708863783850023783338218501D-02/ DATA + (DPYMP(I,10),I=1,2) + /9.469917836739932584221023234527D+00, + 4.205389215588104651198536809880D-01/ DATA + (DPYMP(I,11),I=1,2) + /3.950949253027682207109233363651D+01, + 6.651838750834910819636881506915D+01/ DATA + (DPYMP(I,12),I=1,2) + /3.950949253027682207109233363651D+01, + 6.651838750834910819636881506915D+01/ DATA + (IDPYMP(I),I=1,12) + /1,1,3,1,1,4,1,1,2,1,1023,40100/ C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS C DODRXF: THE USER-SUPPLIED ROUTINE FOR EVALUATING THE MODEL. C...VARIABLE DEFINITIONS (ALPHABETICALLY) C BETA: THE FUNCTION PARAMETERS. C BNRM: THE NORM OF BETA. C DPYMP: THE FLOATING POINT RESULTS FROM A CRAY YMP USING C DOUBLE PRECISION. C EPSMAC: THE VALUE OF MACHINE PRECISION. C FAILED: THE VARIABLE DESIGNATING WHETHER THE RESULTS OF ALL OF THE C DEMONSTRATION RUNS AGREED WITH THOSE FROM THE CRAY YMP C USING DOUBLE PRECISION (FAILED=FALSE) OR WHETHER SOME OF C THE TESTS DISAGREED (FAILED=TRUE). C FAILS: THE VARIABLE DESIGNATING WHETHER THE RESULTS OF AN C INDIVIDUAL DEMONSTRATION RUN AGREED WITH THOSE FROM THE C CRAY YMP USING DOUBLE PRECISION (FAILS=FALSE) OR C DISAGREE (FAILS=TRUE). C HUNDRD: THE VALUE 100.0D0. C I: AN INDEX VARIABLE. C IDPYMP: THE INTEGER RESULTS FROM A CRAY YMP USING C DOUBLE PRECISION. C IFIXB: THE VALUES DESIGNATING WHETHER THE ELEMENTS OF BETA ARE C FIXED AT THEIR INPUT VALUES OR NOT. C IFIXX: THE VALUES DESIGNATING WHETHER THE ELEMENTS OF DELTA ARE C FIXED AT THEIR INPUT VALUES OR NOT. C INFO: THE VARIABLE DESIGNATING WHY THE COMPUTATIONS STOPPED. C IPRINT: THE PRINT CONTROL VARIABLE. C ISODR: THE VARIABLE DESIGNATING WHETHER THE SOLUTION IS BY ODR C (ISODR=TRUE) OR BY OLS (ISODR=FALSE). C ITEST: THE NUMBER OF THE CURRENT TEST BEING RUN. C IWORK: THE INTEGER WORK SPACE. C J: AN INDEX VARIABLE. C JOB: THE VARIABLE CONTROLLING PROBLEM INITIALIZATION AND C COMPUTATIONAL METHOD. C LDIFX: THE LEADING DIMENSION OF ARRAY IFIXX. C LDSCLD: THE LEADING DIMENSION OF ARRAY SCLD. C LDWD: THE LEADING DIMENSION OF ARRAY WD. C LDWD1: THE LEADING DIMENSION OF ARRAY WD AS PASSED TO ODRPACK. C LDWE: THE LEADING DIMENSION OF ARRAY WE. C LDWE1: THE LEADING DIMENSION OF ARRAY WE AS PASSED TO ODRPACK. C LDX: THE LEADING DIMENSION OF ARRAY X. C LDY: THE LEADING DIMENSION OF ARRAY Y. C LD2WD: THE SECOND DIMENSION OF ARRAY WD. C LD2WD1: THE SECOND DIMENSION OF ARRAY WD AS PASSED TO ODRPACK. C LD2WE: THE SECOND DIMENSION OF ARRAY WE. C LD2WE1: THE SECOND DIMENSION OF ARRAY WE AS PASSED TO ODRPACK. C LIWKMN: THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK. C LIWMIN: THE MINIMUM LENGTH OF VECTOR IWORK FOR A GIVEN PROBLEM. C LIWORK: THE LENGTH OF VECTOR IWORK. C LUN: THE LOGICAL UNIT NUMBER CURRENTLY BEING USED. C LUNERR: THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES. C LUNRPT: THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS. C LUNSUM: THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT. C LWKMN: THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK. C LWMIN: THE MINIMUM LENGTH OF VECTOR WORK FOR A GIVEN PROBLEM. C LWORK: THE LENGTH OF VECTOR WORK. C M: THE NUMBER OF COLUMNS OF DATA IN THE EXPLANATORY VARIABLE. C MAXIT: THE MAXIMUM NUMBER OF ITERATIONS ALLOWED. C MSG: THE VARIABLE DESIGNATING WHICH MESSAGE IS TO BE PRINTED AS C A RESULT OF THE COMPARISON WITH THE CRAY YMP RESULTS. C N: THE NUMBER OF OBSERVATIONS. C NDIGIT: THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS C SUPPLIED BY THE USER. C NP: THE NUMBER OF FUNCTION PARAMETERS. C NTEST: THE NUMBER OF TESTS TO BE RUN. C NTESTS: THE NUMBER OF DIFFERENT TESTS AVAILABLE. C ONE: THE VALUE 1.0D0. C PASSED: THE VARIABLE DESIGNATING WHETHER THE RESULTS OF ALL OF THE C DEMONSTRATION RUNS AGREED WITH THOSE FROM THE CRAY YMP C USING DOUBLE PRECISION (PASSED=TRUE), OR WHETHER SOME OF C THE RESULTS DISAGREED (PASSED=FALSE). C P01: THE VALUE 0.01D0. C P2: THE VALUE 0.2D0. C PARTOL: THE PARAMETER CONVERGENCE STOPPING CRITERIA. C SCLB: THE SCALING VALUES FOR BETA. C SCLD: THE SCALING VALUES FOR DELTA. C SETNO: THE NUMBER OF THE DATA SET BEING ANALYZED. C SHORT: THE VARIABLE DESIGNATING WHETHER ODRPACK IS INVOKED BY THE C SHORT-CALL (SHORT=.TRUE.) OR THE LONG-CALL (SHORT=.FALSE.). C SSTOL: THE SUM-OF-SQUARES CONVERGENCE STOPPING TOLERANCE. C TAUFAC: THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION C DIAMETER. C THREE: THE VALUE 3.0D0. C TITLE: THE REFERENCE FOR THE DATA SET BEING ANALYZED. C TSTFAC: THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES C USED TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND C RESULTS OBTAINED USING DOUBLE PRECISION VERSION ON CRAY C YMP. C TSTTOL: THE TEST TOLERANCE USED IN CHECKING COMPUTED VALUES FOR C PURPOSES OF DETERMINING PROPER INSTALLATION. C TWO: THE VALUE 2.0D0. C WD: THE DELTA WEIGHTS. C WE: THE EPSILON WEIGHTS. C WORK: THE DOUBLE PRECISION WORK SPACE. C WRK: THE DOUBLE PRECISION WORK SPACE FOR COMPUTING TEST RESULTS. C WSS: THE SUM OF THE SQUARED WEIGHTED ERRORS. C WSSDEL: THE SUM OF THE SQUARED WEIGHTED ERRORS IN X. C WSSEPS: THE SUM OF THE SQUARED WEIGHTED ERRORS IN Y. C X: THE EXPLANATORY VARIABLE. C Y: THE RESPONSE VARIABLE. C ZERO: THE VALUE 0.0D0. C***FIRST EXECUTABLE STATEMENT DODRX C SET LOGICAL UNITS FOR ERROR AND COMPUTATION REPORTS LUNERR = 18 LUNRPT = 18 C INITIALIZE TEST TOLERANCE IF (TSTFAC.GT.ONE) THEN TSTTOL = TSTFAC ELSE TSTTOL = ONE END IF C INITIALIZE MACHINE PRECISION EPSMAC = DMPREC() C INITIALIZE LEADING DIMENSION OF X LDX = MAXN LDY = MAXN C INITIALIZE MISCELLANEOUS VARIABLES USED IN THE EXERCISE PROCEDURE FAILED = .FALSE. SHORT = .TRUE. ISODR = .TRUE. N = 0 C BEGIN EXERCISING ODRPACK DO 400 ITEST=1,NTEST C SET CONTROL VALUES TO INVOKE DEFAULT VALUES WE(1,1,1) = -ONE LDWE1 = LDWE LD2WE1 = LD2WE WD(1,1,1) = -ONE LDWD1 = LDWD LD2WD1 = LD2WD IFIXB(1) = -1 IFIXX(1,1) = -1 LDIFX = MAXN NDIGIT = -1 TAUFAC = -ONE SSTOL = -ONE PARTOL = -ONE MAXIT = -1 IPRINT = 2112 STPB(1) = -ONE STPD(1,1) = -ONE LDSTPD = 1 SCLB(1) = -ONE SCLD(1,1) = -ONE LDSCLD = 1 IF (ITEST.EQ.1) THEN C TEST SIMPLE ODR PROBLEM C WITH ANALYTIC DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 10 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1010) LUN = LUNSUM 10 CONTINUE SETNO = 5 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00020 SHORT = .TRUE. ISODR = .TRUE. ELSE IF (ITEST.EQ.2) THEN C TEST SIMPLE OLS PROBLEM C WITH FORWARD DIFFERENCE DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 20 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1020) LUN = LUNSUM 20 CONTINUE SETNO = 5 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00002 SHORT = .TRUE. ISODR = .FALSE. ELSE IF (ITEST.EQ.3) THEN C TEST PARAMETER FIXING CAPABILITIES FOR POORLY SCALED OLS PROBLEM C WITH ANALYTIC DERIVATIVES. C (DERIVATIVE CHECKING TURNED OFF.) LUN = LUNRPT WRITE (LUN,1000) DO 30 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1030) LUN = LUNSUM 30 CONTINUE SETNO = 3 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) IFIXB(1) = 1 IFIXB(2) = 1 IFIXB(3) = 1 IFIXB(4) = 0 IFIXB(5) = 1 IFIXB(6) = 0 IFIXB(7) = 0 IFIXB(8) = 0 IFIXB(9) = 0 JOB = 00042 SHORT = .FALSE. ISODR = .FALSE. ELSE IF (ITEST.EQ.4) THEN C TEST WEIGHTING CAPABILITIES FOR ODR PROBLEM WITH C ANALYTIC DERIVATIVES. C ALSO SHOWS SOLUTION OF POORLY SCALED ODR PROBLEM. C (DERIVATIVE CHECKING TURNED OFF.) C N.B., THIS RUN CONTINUES FROM WHERE TEST 3 LEFT OFF. LUN = LUNRPT WRITE (LUN,1000) DO 40 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1040) LUN = LUNSUM 40 CONTINUE SETNO = 3 CALL DZERO(LWORK,1,WORK,LWORK) LDWD1 = LDWD LDWE1 = LDWE LD2WD1 = LD2WD LD2WE1 = LD2WE DO 45 I=1,N WD(I,1,1) = (P01/ABS(X(I,1)))**2 WE(I,1,1) = ONE 45 CONTINUE WE(28,1,1) = ZERO IFIXB(1) = 1 IFIXB(2) = 1 IFIXB(3) = 1 IFIXB(4) = 0 IFIXB(5) = 1 IFIXB(6) = 1 IFIXB(7) = 1 IFIXB(8) = 0 IFIXB(9) = 0 JOB = 00030 IPRINT = 2232 SHORT = .FALSE. ISODR = .TRUE. ELSE IF (ITEST.EQ.5) THEN C TEST DELTA INITIALIZATION CAPABILITIES AND USER-SUPPLIED SCALING C AND USE OF ISTOP TO RESTRICT PARAMETER VALUES C FOR ODR PROBLEM WITH ANALYTIC DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 50 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1050) LUN = LUNSUM 50 CONTINUE SETNO = 1 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 01020 LDSCLD = 1 SCLD(1,1) = TWO SCLB(1) = P2 SCLB(2) = ONE LDWE1 = 1 LD2WE1 = 1 WE(1,1,1) = -ONE LDWD1 = 1 LD2WD1 = 1 WD(1,1,1) = -ONE DO 55 I=20,21 WORK(I) = BETA(1)/Y(I,1) + BETA(2) - X(I,1) 55 CONTINUE SHORT = .FALSE. ISODR = .TRUE. ELSE IF (ITEST.EQ.6) THEN C TEST STIFF STOPPING CONDITIONS FOR UNSCALED ODR PROBLEM C WITH ANALYTIC DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 60 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1060) LUN = LUNSUM 60 CONTINUE SETNO = 4 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00020 SSTOL = HUNDRD*EPSMAC PARTOL = EPSMAC MAXIT = 2 SHORT = .FALSE. ISODR = .TRUE. ELSE IF (ITEST.EQ.7) THEN C TEST RESTART FOR UNSCALED ODR PROBLEM C WITH ANALYTIC DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 70 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1070) LUN = LUNSUM 70 CONTINUE SETNO = 4 JOB = 20220 SSTOL = HUNDRD*EPSMAC PARTOL = EPSMAC MAXIT = 50 SHORT = .FALSE. ISODR = .TRUE. ELSE IF (ITEST.EQ.8) THEN C TEST USE OF TAUFAC TO RESTRICT FIRST STEP C FOR ODR PROBLEM WITH CENTRAL DIFFERENCE DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 80 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1080) LUN = LUNSUM 80 CONTINUE SETNO = 6 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00210 TAUFAC = P01 SHORT = .FALSE. ISODR = .TRUE. ELSE IF (ITEST.EQ.9) THEN C TEST IMPLICIT ODR PROBLEM C WITH FORWARD FINITE DIFFERENCE DERIVATIVES C AND COVARIANCE MATRIX CONSTRUCTED WITH RECOMPUTED DERIVATIVES. LUN = LUNRPT WRITE (LUN,1000) DO 90 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1090) LUN = LUNSUM 90 CONTINUE SETNO = 7 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00001 PARTOL = EPSMAC**(ONE/THREE) SHORT = .TRUE. ISODR = .TRUE. ELSE IF (ITEST.EQ.10) THEN C TEST MULTIRESPONSE ODR PROBLEM C WITH CENTRAL DIFFERENCE DERIVATIVES , C DELTA INITIALIZED TO NONZERO VALUES, C VARIABLE FIXING, AND WEIGHTING. LUN = LUNRPT WRITE (LUN,1000) DO 100 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1100) LUN = LUNSUM 100 CONTINUE SETNO = 8 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) LDWD1 = LDWD LDWE1 = LDWE LD2WD1 = LD2WD LD2WE1 = LD2WE DO 105 I=1,N C INITIALIZE DELTA, AND SPECIFY FIRST DECADE OF FREQUENCIES AS FIXED IF (X(I,1).LT.100.0D0) THEN WORK(I) = 0.0D0 IFIXX(I,1) = 0 ELSE IF (X(I,1).LE.150.0D0) THEN WORK(I) = 0.0D0 IFIXX(I,1) = 1 ELSE IF (X(I,1).LE.1000.0D0) THEN WORK(I) = 25.0D0 IFIXX(I,1) = 1 ELSE IF (X(I,1).LE.10000.0D0) THEN WORK(I) = 560.0D0 IFIXX(I,1) = 1 ELSE IF (X(I,1).LE.100000.0D0) THEN WORK(I) = 9500.0D0 IFIXX(I,1) = 1 ELSE WORK(I) = 144000.0D0 IFIXX(I,1) = 1 END IF C SET WEIGHTS IF (X(I,1).EQ.100.0D0 .OR. X(I,1).EQ.150.0D0) THEN WE(I,1,1) = 0.0D0 WE(I,1,2) = 0.0D0 WE(I,2,1) = 0.0D0 WE(I,2,2) = 0.0D0 ELSE WE(I,1,1) = 559.6D0 WE(I,1,2) = -1634.0D0 WE(I,2,1) = -1634.0D0 WE(I,2,2) = 8397.0D0 END IF WD(I,1,1) = (1.0D-4)/(X(I,1)**2) 105 CONTINUE JOB = 00210 SHORT = .FALSE. ISODR = .TRUE. ELSE IF (ITEST.EQ.11) THEN C TEST DETECTION OF INCORRECT DERIVATIVES LUN = LUNRPT WRITE (LUN,1000) DO 110 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1110) LUN = LUNSUM 110 CONTINUE SETNO = 6 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00022 SHORT = .FALSE. ISODR = .FALSE. ELSE IF (ITEST.EQ.12) THEN C TEST DETECTION OF INCORRECT DERIVATIVES LUN = LUNRPT WRITE (LUN,1000) DO 120 I=1,2 WRITE (LUN,1001) ITEST WRITE (LUN,1120) LUN = LUNSUM 120 CONTINUE SETNO = 6 CALL DODRXD(TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) CALL DZERO(LWORK,1,WORK,LWORK) JOB = 00020 SHORT = .FALSE. ISODR = .TRUE. END IF CALL DODRXW + (N,M,NP,NQ,LDWE1,LD2WE1,ISODR,LIWMIN,LWMIN) C COMPUTE SOLUTION WRITE (LUNRPT,2200) TITLE WRITE (LUNSUM,2200) TITLE IF (SHORT) THEN CALL DODR(DODRXF, + N,M,NP,NQ, + BETA, + Y,LDY,X,LDX, + WE,LDWE1,LD2WE1,WD,LDWD1,LD2WD1, + JOB, + IPRINT,LUNERR,LUNRPT, + WORK,LWMIN,IWORK,LIWMIN, + INFO) ELSE CALL DODRC(DODRXF, + N,M,NP,NQ, + BETA, + Y,LDY,X,LDX, + WE,LDWE1,LD2WE1,WD,LDWD1,LD2WD1, + IFIXB,IFIXX,LDIFX, + JOB,NDIGIT,TAUFAC, + SSTOL,PARTOL,MAXIT, + IPRINT,LUNERR,LUNRPT, + STPB,STPD,LDSTPD, + SCLB,SCLD,LDSCLD, + WORK,LWMIN,IWORK,LIWMIN, + INFO) END IF C COMPARE RESULTS WITH THOSE OBTAINED ON THE CRAY YMP C USING DOUBLE PRECISION VERSION OF ODRPACK BNRM = DNRM2(NP,BETA,1) CALL DWGHT(N,M,WD,LDWD1,LD2WD1,WORK(1),N,WRK(1),N) WSSDEL = DDOT(N*M,WORK(1),1,WRK(1),1) CALL DWGHT(N,NQ,WE,LDWE1,LD2WE1,WORK(N*M+1),N,WRK(N*M+1),N) WSSEPS = DDOT(N*NQ,WORK(N*M+1),1,WRK(N*M+1),1) WSS = WSSEPS + WSSDEL IF (SSTOL.LT.ZERO) THEN SSTOL = SQRT(EPSMAC) ELSE SSTOL = MIN(SSTOL, ONE) END IF IF (PARTOL.LT.ZERO) THEN PARTOL = EPSMAC**(TWO/THREE) ELSE PARTOL = MIN(PARTOL, ONE) END IF IF (INFO.GE.10000) THEN IF (IDPYMP(ITEST).EQ.INFO) THEN FAILS = .FALSE. MSG = 1 ELSE FAILS = .TRUE. MSG = 3 END IF ELSE IF (MOD(INFO,10).EQ.1) THEN FAILS = ABS(WSS-DPYMP(2,ITEST)).GT. + DPYMP(2,ITEST)*SSTOL*TSTTOL MSG = 2 ELSE IF (MOD(INFO,10).EQ.2) THEN FAILS = ABS(BNRM-DPYMP(1,ITEST)).GT. + DPYMP(1,ITEST)*PARTOL*TSTTOL MSG = 2 ELSE IF (MOD(INFO,10).EQ.3) THEN FAILS = (ABS(WSS-DPYMP(2,ITEST)).GT. + DPYMP(2,ITEST)*SSTOL*TSTTOL) + .AND. + (ABS(BNRM-DPYMP(1,ITEST)).GT. + DPYMP(1,ITEST)*PARTOL*TSTTOL) MSG = 2 ELSE IF ((MOD(INFO,10).EQ.4) .AND. (IDPYMP(ITEST).EQ.4)) THEN FAILS = .FALSE. MSG = 1 ELSE IF (INFO.EQ.IDPYMP(ITEST)) THEN FAILS = .TRUE. MSG = 4 ELSE FAILS = .TRUE. MSG = 3 END IF FAILED = FAILED .OR. FAILS LUN = LUNRPT DO 300 L=1,2 WRITE (LUN,3100) WRITE (LUN,3210) ' CRAY YMP RESULT = ', + DPYMP(1,ITEST),DPYMP(2,ITEST),IDPYMP(ITEST) WRITE (LUN,3210) ' NEW TEST RESULT = ', + BNRM,WSS,INFO WRITE (LUN,3220) ' DIFFERENCE = ', + ABS(DPYMP(1,ITEST)-BNRM),ABS(DPYMP(2,ITEST)-WSS) WRITE (LUN,3220) ' RELATIVE ERROR = ', + ABS(DPYMP(1,ITEST)-BNRM)/ABS(DPYMP(1,ITEST)), + ABS(DPYMP(2,ITEST)-WSS)/ABS(DPYMP(2,ITEST)) IF (MSG.EQ.1) THEN WRITE (LUN,3310) ELSE IF (MSG.EQ.2) THEN IF (FAILS) THEN WRITE (LUN,3320) ELSE WRITE (LUN,3330) END IF ELSE IF (MSG.EQ.3) THEN WRITE (LUN,3340) ELSE IF (MSG.EQ.4) THEN WRITE (LUN,3350) END IF LUN = LUNSUM 300 CONTINUE 400 CONTINUE WRITE (LUNRPT,1000) IF (FAILED) THEN WRITE (LUNRPT,4100) WRITE (LUNSUM,4100) PASSED = .FALSE. ELSE WRITE (LUNRPT,4200) WRITE (LUNSUM,4200) PASSED = .TRUE. END IF C FORMAT STATEMENTS 1000 FORMAT('1') 1001 FORMAT(' EXAMPLE ', I2/) 1010 FORMAT(' TEST SIMPLE ODR PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODR.') 1020 FORMAT(' TEST SIMPLE OLS PROBLEM'/ + ' WITH FINITE DIFFERENCE DERIVATIVES', + ' USING DODR.') 1030 FORMAT(' TEST PARAMETER FIXING CAPABILITIES', + ' FOR POORLY SCALED OLS PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODRC.') 1040 FORMAT(' TEST WEIGHTING CAPABILITIES', + ' FOR ODR PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODRC. '/ + ' ALSO SHOWS SOLUTION OF POORLY SCALED', + ' ODR PROBLEM.'/ + ' (DERIVATIVE CHECKING TURNED OFF.)') 1050 FORMAT(' TEST DELTA INITIALIZATION CAPABILITIES'/ + ' AND USE OF ISTOP TO RESTRICT PARAMETER VALUES', + ' FOR ODR PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODRC.') 1060 FORMAT(' TEST STIFF STOPPING CONDITIONS', + ' FOR UNSCALED ODR PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODRC.') 1070 FORMAT(' TEST RESTART', + ' FOR UNSCALED ODR PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODRC.') 1080 FORMAT(' TEST USE OF TAUFAC TO RESTRICT FIRST STEP', + ' FOR ODR PROBLEM'/ + ' WITH FINITE DIFFERENCE DERIVATIVES', + ' USING DODRC.') 1090 FORMAT(' TEST IMPLICIT MODEL', + ' FOR OLS PROBLEM'/ + ' USING DODRC.') 1100 FORMAT(' TEST MULTIRESPONSE MODEL', + ' FOR ODR PROBLEM'/ + ' WITH FINITE DIFFERENCE DERIVATIVES', + ' USING DODRC.') 1110 FORMAT(' TEST DETECTION OF QUESTIONABLE ANALYTIC DERIVATIVES', + ' FOR OLS PROBLEM'/ + ' USING DODRC.') 1120 FORMAT(' TEST DETECTION OF INCORRECT ANALYTIC DERIVATIVES', + ' FOR ODR PROBLEM'/ + ' WITH ANALYTIC DERIVATIVES', + ' USING DODRC.') 2200 FORMAT (' DATA SET REFERENCE: ', A80) 3100 FORMAT + (/' COMPARISON OF NEW RESULTS WITH', + ' DOUBLE PRECISION CRAY YMP RESULT:'// + ' NORM OF BETA', + ' SUM OF SQUARED WTD OBS ERRORS INFO') 3210 FORMAT + (/A25/1P,2D37.30,I6) 3220 FORMAT + (/A25,1P,D12.5,25X,D12.5,I6) 3310 FORMAT + (/' *** STOPPING CONDITIONS', + ' SHOW CONVERGENCE NOT ATTAINED. ***'/ + ' NO FURTHER COMPARISONS MADE BETWEEN RESULTS.'//) 3320 FORMAT + (//' *** WARNING ***', + ' RESULTS DO NOT AGREE TO WITHIN STOPPING TOLERANCE. ***'//) 3330 FORMAT + (//' *** RESULTS AGREE TO WITHIN STOPPING TOLERANCE. ***'//) 3340 FORMAT + (//' *** WARNING ***', + ' STOPPING CONDITIONS DO NOT AGREE. ***'//) 3350 FORMAT + (//' *** WARNING ***', + ' UNEXPECTED STOPPING CONDITION.', + ' PLEASE CONTACT PACKAGE AUTHORS. ***'//) 4100 FORMAT + (/// + ' *** SUMMARY:', + ' ONE OR MORE TESTS DO NOT AGREE WITH EXPECTED RESULTS. ***') 4200 FORMAT + (/// + ' *** SUMMARY:', + ' ALL TESTS AGREE WITH EXPECTED RESULTS. ***') END *DODRXD SUBROUTINE DODRXD + (TITLE,N,M,NP,NQ,LDX,X,LDY,Y,BETA) C***BEGIN PROLOGUE DODRXD C***REFER TO DODR,DODRC C***ROUTINES CALLED (NONE) C***DATE WRITTEN 860529 (YYMMDD) C***REVISION DATE 920619 (YYMMDD) C***PURPOSE SET UP DATA FOR ODRPACK EXERCISER C***END PROLOGUE DODRXD C...PARAMETERS INTEGER + MAXN,MAXM,MAXNP,MAXNQ,MAXSET PARAMETER + (MAXN=50,MAXM=3,MAXNP=10,MAXNQ=3,MAXSET=10) C...SCALAR ARGUMENTS INTEGER + LDX,LDY,M,N,NP,NQ CHARACTER TITLE*80 C...ARRAY ARGUMENTS DOUBLE PRECISION + BETA(*),X(LDX,*),Y(LDY,*) C...SCALARS IN COMMON INTEGER + SETNO C...LOCAL SCALARS INTEGER + I,J,K,L C...LOCAL ARRAYS DOUBLE PRECISION + BDATA(MAXNP,MAXSET),XDATA(MAXN,MAXM,MAXSET), + YDATA(MAXN,MAXNQ,MAXSET) INTEGER + MDATA(MAXSET),NDATA(MAXSET),NPDATA(MAXSET),NQDATA(MAXSET) CHARACTER TDATA(MAXSET)*80 C...COMMON BLOCKS COMMON /SETID/SETNO C...DATA STATEMENTS DATA + TDATA(1) + /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1'/ DATA + NDATA(1), MDATA(1), NPDATA(1), NQDATA(1) + /40, 1, 2, 1/ DATA + (BDATA(K,1),K=1,2) + /1.0D+0, 1.0D+0/ DATA + YDATA( 1,1,1), XDATA( 1,1,1) + /-0.119569795672791172D+1, -0.213701920211315155D-1/ DATA + YDATA( 2,1,1), XDATA( 2,1,1) + /-0.128023349509594288D+1, 0.494813247025012969D-1/ DATA + YDATA( 3,1,1), XDATA( 3,1,1) + /-0.125270693343174591D+1, 0.127889194935560226D+0/ DATA + YDATA( 4,1,1), XDATA( 4,1,1) + /-0.996698267935287383D+0, 0.128615394085645676D+0/ DATA + YDATA( 5,1,1), XDATA( 5,1,1) + /-0.104681033065801934D+1, 0.232544285655021667D+0/ DATA + YDATA( 6,1,1), XDATA( 6,1,1) + /-0.146724952092847308D+1, 0.268151108026504516D+0/ DATA + YDATA( 7,1,1), XDATA( 7,1,1) + /-0.123366891873487528D+1, 0.309041029810905456D+0/ DATA + YDATA( 8,1,1), XDATA( 8,1,1) + /-0.165665097907185554D+1, 0.405991539210081099D+0/ DATA + YDATA( 9,1,1), XDATA( 9,1,1) + /-0.168476460930907119D+1, 0.376611424833536147D+0/ DATA + YDATA(10,1,1), XDATA(10,1,1) + /-0.198571971169224491D+1, 0.475875890851020811D+0/ DATA + YDATA(11,1,1), XDATA(11,1,1) + /-0.195691696638051344D+1, 0.499246935397386550D+0/ DATA + YDATA(12,1,1), XDATA(12,1,1) + /-0.211871342665769836D+1, 0.536615037024021147D+0/ DATA + YDATA(13,1,1), XDATA(13,1,1) + /-0.268642932558671020D+1, 0.581830765902996060D+0/ DATA + YDATA(14,1,1), XDATA(14,1,1) + /-0.281123260058024347D+1, 0.684512710422277446D+0/ DATA + YDATA(15,1,1), XDATA(15,1,1) + /-0.328704486581785920D+1, 0.660219819694757458D+0/ DATA + YDATA(16,1,1), XDATA(16,1,1) + /-0.423062993461887032D+1, 0.766990323960781092D+0/ DATA + YDATA(17,1,1), XDATA(17,1,1) + /-0.512043906552226903D+1, 0.808270426690578456D+0/ DATA + YDATA(18,1,1), XDATA(18,1,1) + /-0.731032616379005535D+1, 0.897410020083189004D+0/ DATA + YDATA(19,1,1), XDATA(19,1,1) + /-0.109002759485608993D+2, 0.959199774116277687D+0/ DATA + YDATA(20,1,1), XDATA(20,1,1) + /-0.251810238510370206D+2, 0.914675474762916558D+0/ DATA + YDATA(21,1,1), XDATA(21,1,1) + /0.100123028650879944D+3, 0.997759691476821892D+0/ DATA + YDATA(22,1,1), XDATA(22,1,1) + /0.168225085871915048D+2, 0.107136870384216308D+1/ DATA + YDATA(23,1,1), XDATA(23,1,1) + /0.894830510866913009D+1, 0.108033321037888526D+1/ DATA + YDATA(24,1,1), XDATA(24,1,1) + /0.645853815227747004D+1, 0.116064198672771453D+1/ DATA + YDATA(25,1,1), XDATA(25,1,1) + /0.498218564760117328D+1, 0.119080889359116553D+1/ DATA + YDATA(26,1,1), XDATA(26,1,1) + /0.382971664718710476D+1, 0.129418875187635420D+1/ DATA + YDATA(27,1,1), XDATA(27,1,1) + /0.344116492497344184D+1, 0.135594148099422453D+1/ DATA + YDATA(28,1,1), XDATA(28,1,1) + /0.276840496973858949D+1, 0.135302808716893195D+1/ DATA + YDATA(29,1,1), XDATA(29,1,1) + /0.259521665196956666D+1, 0.137994666010141371D+1/ DATA + YDATA(30,1,1), XDATA(30,1,1) + /0.205996022794557661D+1, 0.147630019545555113D+1/ DATA + YDATA(31,1,1), XDATA(31,1,1) + /0.197939614345337836D+1, 0.153450708076357840D+1/ DATA + YDATA(32,1,1), XDATA(32,1,1) + /0.156739340562905589D+1, 0.152805351451039313D+1/ DATA + YDATA(33,1,1), XDATA(33,1,1) + /0.159032057073028366D+1, 0.157147316247224806D+1/ DATA + YDATA(34,1,1), XDATA(34,1,1) + /0.173102268158937949D+1, 0.166649596005678175D+1/ DATA + YDATA(35,1,1), XDATA(35,1,1) + /0.155512561664824758D+1, 0.166505665838718412D+1/ DATA + YDATA(36,1,1), XDATA(36,1,1) + /0.149635994944133260D+1, 0.175214128553867338D+1/ DATA + YDATA(37,1,1), XDATA(37,1,1) + /0.147487601463073568D+1, 0.180567992463707922D+1/ DATA + YDATA(38,1,1), XDATA(38,1,1) + /0.117244575233306998D+1, 0.184624404296278952D+1/ DATA + YDATA(39,1,1), XDATA(39,1,1) + /0.910931336069172580D+0, 0.195568727388978002D+1/ DATA + YDATA(40,1,1), XDATA(40,1,1) + /0.126172980914513272D+1, 0.199326394036412237D+1/ DATA + TDATA(2) + /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2'/ DATA + NDATA(2), MDATA(2), NPDATA(2), NQDATA(2) + /50, 2, 3, 1/ DATA + (BDATA(K,2),K=1,3) + /-1.0D+0, 1.0D+0, 1.0D+0/ DATA + YDATA( 1,1,2), XDATA( 1,1,2), XDATA( 1,2,2) + /0.680832777217942900D+0, + 0.625474598833994800D-1, 0.110179064209783100D+0/ DATA + YDATA( 2,1,2), XDATA( 2,1,2), XDATA( 2,2,2) + /0.122183594595302200D+1, + 0.202500343620642400D+0, -0.196140862891327600D-1/ DATA + YDATA( 3,1,2), XDATA( 3,1,2), XDATA( 3,2,2) + /0.118958678734608200D+1, + 0.164943738599876500D+0, 0.166514874750996600D+0/ DATA + YDATA( 4,1,2), XDATA( 4,1,2), XDATA( 4,2,2) + /0.146982623764094600D+1, + 0.304874137610506100D+0, 0.612908688041490500D-2/ DATA + YDATA( 5,1,2), XDATA( 5,1,2), XDATA( 5,2,2) + /0.167775338189355300D+1, + 0.532727445580665100D+0, 0.938248787552444600D-1/ DATA + YDATA( 6,1,2), XDATA( 6,1,2), XDATA( 6,2,2) + /0.202485721906026200D+1, + 0.508823707598910200D+0, 0.499605775020505400D-2/ DATA + YDATA( 7,1,2), XDATA( 7,1,2), XDATA( 7,2,2) + /0.258912851935938800D+1, + 0.704227041878554000D+0, 0.819354849092326200D-1/ DATA + YDATA( 8,1,2), XDATA( 8,1,2), XDATA( 8,2,2) + /0.366894203254154800D+1, + 0.592077736111512000D+0, 0.127113960672389100D-1/ DATA + YDATA( 9,1,2), XDATA( 9,1,2), XDATA( 9,2,2) + /0.574609583351347300D+1, + 0.104940945646421600D+1, 0.258095243658316100D-1/ DATA + YDATA(10,1,2), XDATA(10,1,2), XDATA(10,2,2) + /0.127676424026489300D+2, + 0.979382517558619200D+0, 0.124280755181027900D+0/ DATA + YDATA(11,1,2), XDATA(11,1,2), XDATA(11,2,2) + /0.123473079693623100D+1, + 0.637870453165538700D-1, 0.304856401137196400D+0/ DATA + YDATA(12,1,2), XDATA(12,1,2), XDATA(12,2,2) + /0.142256120864082800D+1, + 0.176123312906025700D+0, 0.262387028078896900D+0/ DATA + YDATA(13,1,2), XDATA(13,1,2), XDATA(13,2,2) + /0.169889534013024700D+1, + 0.310965082300263000D+0, 0.226430765474758800D+0/ DATA + YDATA(14,1,2), XDATA(14,1,2), XDATA(14,2,2) + /0.173485577901204400D+1, + 0.311394269116782100D+0, 0.271375840410281800D+0/ DATA + YDATA(15,1,2), XDATA(15,1,2), XDATA(15,2,2) + /0.277761263972834600D+1, + 0.447076126190612500D+0, 0.255000858902618300D+0/ DATA + YDATA(16,1,2), XDATA(16,1,2), XDATA(16,2,2) + /0.339163324662617300D+1, + 0.384786230998211100D+0, 0.154958003178364000D+0/ DATA + YDATA(17,1,2), XDATA(17,1,2), XDATA(17,2,2) + /0.589615137312147500D+1, + 0.649093176450780500D+0, 0.258301685463773200D+0/ DATA + YDATA(18,1,2), XDATA(18,1,2), XDATA(18,2,2) + /0.124415625214576800D+2, + 0.685612005372525500D+0, 0.107391260603228600D+0/ DATA + YDATA(19,1,2), XDATA(19,1,2), XDATA(19,2,2) + /-0.498491739153861600D+2, + 0.968747139425088400D+0, 0.151932526135740700D+0/ DATA + YDATA(20,1,2), XDATA(20,1,2), XDATA(20,2,2) + /-0.832795509000618600D+1, + 0.869789367989532900D+0, 0.625507500586400000D-1/ DATA + YDATA(21,1,2), XDATA(21,1,2), XDATA(21,2,2) + /0.184934617774239900D+1, + -0.465309930332736600D-2, 0.546795662595375200D+0/ DATA + YDATA(22,1,2), XDATA(22,1,2), XDATA(22,2,2) + /0.175192979176839200D+1, + 0.604753397196646000D-2, 0.230905749473922700D+0/ DATA + YDATA(23,1,2), XDATA(23,1,2), XDATA(23,2,2) + /0.253949381238535800D+1, + 0.239418809621756000D+0, 0.190752069681170700D+0/ DATA + YDATA(24,1,2), XDATA(24,1,2), XDATA(24,2,2) + /0.373500774928501700D+1, + 0.456662468911699800D+0, 0.328870615170984400D+0/ DATA + YDATA(25,1,2), XDATA(25,1,2), XDATA(25,2,2) + /0.548408128950331000D+1, + 0.371115320522079500D+0, 0.439978556640660500D+0/ DATA + YDATA(26,1,2), XDATA(26,1,2), XDATA(26,2,2) + /0.125256880521774300D+2, + 0.586442107042503000D+0, 0.490689043752286700D+0/ DATA + YDATA(27,1,2), XDATA(27,1,2), XDATA(27,2,2) + /-0.493587797164916600D+2, + 0.579796274973298000D+0, 0.521860998203383100D+0/ DATA + YDATA(28,1,2), XDATA(28,1,2), XDATA(28,2,2) + /-0.801158974965412700D+1, + 0.805008094903899900D+0, 0.292283538955391600D+0/ DATA + YDATA(29,1,2), XDATA(29,1,2), XDATA(29,2,2) + /-0.437399487061934100D+1, + 0.637242340835710000D+0, 0.402261740352486000D+0/ DATA + YDATA(30,1,2), XDATA(30,1,2), XDATA(30,2,2) + /-0.297800103425979600D+1, + 0.982132817936118700D+0, 0.392546836419047000D+0/ DATA + YDATA(31,1,2), XDATA(31,1,2), XDATA(31,2,2) + /0.271811057454661300D+1, + -0.223515657121262700D-1, 0.650479019708978800D+0/ DATA + YDATA(32,1,2), XDATA(32,1,2), XDATA(32,2,2) + /0.377035865613392400D+1, + 0.136081427545033600D+0, 0.753020101897661800D+0/ DATA + YDATA(33,1,2), XDATA(33,1,2), XDATA(33,2,2) + /0.560111053917143100D+1, + 0.145367053019870600D+0, 0.611153532003093100D+0/ DATA + YDATA(34,1,2), XDATA(34,1,2), XDATA(34,2,2) + /0.128152376174926800D+2, + 0.308221919576435500D+0, 0.455217283290423900D+0/ DATA + YDATA(35,1,2), XDATA(35,1,2), XDATA(35,2,2) + /-0.498709177732467200D+2, + 0.432658769133528300D+0, 0.678607663414113000D+0/ DATA + YDATA(36,1,2), XDATA(36,1,2), XDATA(36,2,2) + /-0.815797696908314300D+1, + 0.477785501079980300D+0, 0.536178207572157000D+0/ DATA + YDATA(37,1,2), XDATA(37,1,2), XDATA(37,2,2) + /-0.440240491195158600D+1, + 0.727986827616619000D+0, 0.668497920573493900D+0/ DATA + YDATA(38,1,2), XDATA(38,1,2), XDATA(38,2,2) + /-0.276723957061767500D+1, + 0.745950385588265100D+0, 0.786077589007263700D+0/ DATA + YDATA(39,1,2), XDATA(39,1,2), XDATA(39,2,2) + /-0.223203667288734800D+1, + 0.732537503527113500D+0, 0.582625164046828400D+0/ DATA + YDATA(40,1,2), XDATA(40,1,2), XDATA(40,2,2) + /-0.169728270310622000D+1, + 0.967352361433846300D+0, 0.460779396016832800D+0/ DATA + YDATA(41,1,2), XDATA(41,1,2), XDATA(41,2,2) + /0.551015652153227000D+1, + 0.129761784310891100D-1, 0.700009537931860000D+0/ DATA + YDATA(42,1,2), XDATA(42,1,2), XDATA(42,2,2) + /0.128036180496215800D+2, + 0.170163243950629700D+0, 0.853131830764348700D+0/ DATA + YDATA(43,1,2), XDATA(43,1,2), XDATA(43,2,2) + /-0.498257683396339000D+2, + 0.162768461906274000D+0, 0.865315129048175000D+0/ DATA + YDATA(44,1,2), XDATA(44,1,2), XDATA(44,2,2) + /-0.877334550221761900D+1, + 0.222914807946165800D+0, 0.797511758502094500D+0/ DATA + YDATA(45,1,2), XDATA(45,1,2), XDATA(45,2,2) + /-0.453820192156867600D+1, + 0.402910095604624900D+0, 0.761492958727023100D+0/ DATA + YDATA(46,1,2), XDATA(46,1,2), XDATA(46,2,2) + /-0.297499315738677900D+1, + 0.233770812593443200D+0, 0.896000095844223500D+0/ DATA + YDATA(47,1,2), XDATA(47,1,2), XDATA(47,2,2) + /-0.212743255978538900D+1, + 0.646528693486914700D+0, 0.968574333700755700D+0/ DATA + YDATA(48,1,2), XDATA(48,1,2), XDATA(48,2,2) + /-0.209703205365401000D+1, + 0.802811658568969400D+0, 0.904866450476711600D+0/ DATA + YDATA(49,1,2), XDATA(49,1,2), XDATA(49,2,2) + /-0.155287292042086200D+1, + 0.837137859891222900D+0, 0.835684424990021900D+0/ DATA + YDATA(50,1,2), XDATA(50,1,2), XDATA(50,2,2) + /-0.161356673770480700D+1, + 0.103165980756526600D+1, 0.793902191912346100D+0/ DATA + TDATA(3) + /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3'/ DATA + NDATA(3), MDATA(3), NPDATA(3), NQDATA(3) + /44, 1, 9, 1/ DATA + (BDATA(K,3),K=1,9) + /0.281887509408440189D-5, + -0.231290549212363845D-2, 0.583035555572801965D+1, + 0.000000000000000000D+0, 0.406910776203121026D+8, + 0.138001105225000000D-2, 0.596038513209999999D-1, + 0.670582099359999998D+1, 0.106994410000000000D+10/ DATA + YDATA( 1,1,3), XDATA( 1,1,3) + /0.988227696721327788D+0, 0.25D-8/ DATA + YDATA( 2,1,3), XDATA( 2,1,3) + /0.988268083998559958D+0, 0.64D-8/ DATA + YDATA( 3,1,3), XDATA( 3,1,3) + /0.988341022958438831D+0, 1.0D-8/ DATA + YDATA( 4,1,3), XDATA( 4,1,3) + /0.988380557606306446D+0, 0.9D-7/ DATA + YDATA( 5,1,3), XDATA( 5,1,3) + /0.988275062411751338D+0, 1.0D-6/ DATA + YDATA( 6,1,3), XDATA( 6,1,3) + /0.988326680176446987D+0, 0.4D-5/ DATA + YDATA( 7,1,3), XDATA( 7,1,3) + /0.988306058860433439D+0, 0.9D-5/ DATA + YDATA( 8,1,3), XDATA( 8,1,3) + /0.988292880079125555D+0, 0.16D-4/ DATA + YDATA( 9,1,3), XDATA( 9,1,3) + /0.988305279259496905D+0, 0.36D-4/ DATA + YDATA(10,1,3), XDATA(10,1,3) + /0.988278142019574202D+0, 0.64D-4/ DATA + YDATA(11,1,3), XDATA(11,1,3) + /0.988224953369819946D+0, 1.0D-4/ DATA + YDATA(12,1,3), XDATA(12,1,3) + /0.988111989169778223D+0, 0.144D-3/ DATA + YDATA(13,1,3), XDATA(13,1,3) + /0.988045627103840613D+0, 0.225D-3/ DATA + YDATA(14,1,3), XDATA(14,1,3) + /0.987913715667047655D+0, 0.400D-3/ DATA + YDATA(15,1,3), XDATA(15,1,3) + /0.987841994238525678D+0, 0.625D-3/ DATA + YDATA(16,1,3), XDATA(16,1,3) + /0.987638450432434270D+0, 0.900D-3/ DATA + YDATA(17,1,3), XDATA(17,1,3) + /0.987587364331771395D+0, 0.1225D-2/ DATA + YDATA(18,1,3), XDATA(18,1,3) + /0.987576264149633684D+0, 0.1600D-2/ DATA + YDATA(19,1,3), XDATA(19,1,3) + /0.987539209110983643D+0, 0.2025D-2/ DATA + YDATA(20,1,3), XDATA(20,1,3) + /0.987621143807705698D+0, 0.25D-2/ DATA + YDATA(21,1,3), XDATA(21,1,3) + /0.988023229785526217D+0, 0.36D-2/ DATA + YDATA(22,1,3), XDATA(22,1,3) + /0.988558376710994197D+0, 0.49D-2/ DATA + YDATA(23,1,3), XDATA(23,1,3) + /0.989304775352439885D+0, 0.64D-2/ DATA + YDATA(24,1,3), XDATA(24,1,3) + /0.990210452265710472D+0, 0.81D-2/ DATA + YDATA(25,1,3), XDATA(25,1,3) + /0.991095950592263900D+0, 1.00D-2/ DATA + YDATA(26,1,3), XDATA(26,1,3) + /0.991475677297119272D+0, 0.11025D-1/ DATA + YDATA(27,1,3), XDATA(27,1,3) + /0.991901306250746771D+0, 0.12100D-1/ DATA + YDATA(28,1,3), XDATA(28,1,3) + /0.992619222425303263D+0, 0.14400D-1/ DATA + YDATA(29,1,3), XDATA(29,1,3) + /0.993617037631973475D+0, 0.16900D-1/ DATA + YDATA(30,1,3), XDATA(30,1,3) + /0.994727321698030676D+0, 0.19600D-1/ DATA + YDATA(31,1,3), XDATA(31,1,3) + /0.996523114720326189D+0, 0.25600D-1/ DATA + YDATA(32,1,3), XDATA(32,1,3) + /0.998036909563764020D+0, 0.32400D-1/ DATA + YDATA(33,1,3), XDATA(33,1,3) + /0.999151968626971372D+0, 0.40000D-1/ DATA + YDATA(34,1,3), XDATA(34,1,3) + /0.100017083706131769D+1, 0.50625D-1/ DATA + YDATA(35,1,3), XDATA(35,1,3) + /0.100110046382923523D+1, 0.75625D-1/ DATA + YDATA(36,1,3), XDATA(36,1,3) + /0.100059103180404652D+1, 0.12250D+0/ DATA + YDATA(37,1,3), XDATA(37,1,3) + /0.999211829791257561D+0, 0.16000D+0/ DATA + YDATA(38,1,3), XDATA(38,1,3) + /0.994711451526761862D+0, 0.25000D+0/ DATA + YDATA(39,1,3), XDATA(39,1,3) + /0.989844132928847109D+0, 0.33640D+0/ DATA + YDATA(40,1,3), XDATA(40,1,3) + /0.987234104554490439D+0, 0.38440D+0/ DATA + YDATA(41,1,3), XDATA(41,1,3) + /0.980928240178404887D+0, 0.49D+0/ DATA + YDATA(42,1,3), XDATA(42,1,3) + /0.970888680366055576D+0, 0.64D+0/ DATA + YDATA(43,1,3), XDATA(43,1,3) + /0.960043769857327398D+0, 0.81D+0/ DATA + YDATA(44,1,3), XDATA(44,1,3) + /0.947277159259551068D+0, 1.00D+0/ DATA + TDATA(4) + /' HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188'/ DATA + NDATA(4), MDATA(4), NPDATA(4), NQDATA(4) + /13, 2, 3, 1/ DATA + (BDATA(K,4),K=1,3) + /3.0D+0, 3.0D+0, -0.5D+0/ DATA + YDATA( 1,1,4), XDATA( 1,1,4), XDATA( 1,2,4) + /2.93D+0, 0.0D+0, 0.0D+0/ DATA + YDATA( 2,1,4), XDATA( 2,1,4), XDATA( 2,2,4) + /1.95D+0, 0.0D+0, 1.0D+0/ DATA + YDATA( 3,1,4), XDATA( 3,1,4), XDATA( 3,2,4) + /0.81D+0, 0.0D+0, 2.0D+0/ DATA + YDATA( 4,1,4), XDATA( 4,1,4), XDATA( 4,2,4) + /0.58D+0, 0.0D+0, 3.0D+0/ DATA + YDATA( 5,1,4), XDATA( 5,1,4), XDATA( 5,2,4) + /5.90D+0, 1.0D+0, 0.0D+0/ DATA + YDATA( 6,1,4), XDATA( 6,1,4), XDATA( 6,2,4) + /4.74D+0, 1.0D+0, 1.0D+0/ DATA + YDATA( 7,1,4), XDATA( 7,1,4), XDATA( 7,2,4) + /4.18D+0, 1.0D+0, 2.0D+0/ DATA + YDATA( 8,1,4), XDATA( 8,1,4), XDATA( 8,2,4) + /4.05D+0, 1.0D+0, 2.0D+0/ DATA + YDATA( 9,1,4), XDATA( 9,1,4), XDATA( 9,2,4) + /9.03D+0, 2.0D+0, 0.0D+0/ DATA + YDATA(10,1,4), XDATA(10,1,4), XDATA(10,2,4) + /7.85D+0, 2.0D+0, 1.0D+0/ DATA + YDATA(11,1,4), XDATA(11,1,4), XDATA(11,2,4) + /7.22D+0, 2.0D+0, 2.0D+0/ DATA + YDATA(12,1,4), XDATA(12,1,4), XDATA(12,2,4) + /8.50D+0, 2.5D+0, 2.0D+0/ DATA + YDATA(13,1,4), XDATA(13,1,4), XDATA(13,2,4) + /9.81D+0, 2.9D+0, 1.8D+0/ DATA + TDATA(5) + /' DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522'/ DATA + NDATA(5), MDATA(5), NPDATA(5), NQDATA(5) + /8, 2, 2, 1/ DATA + (BDATA(K,5),K=1,2) + /0.01155D+0, 5000.0D+0/ DATA + YDATA(1,1,5), XDATA(1,1,5), XDATA(1,2,5) + /0.912D+0, 109.0D+0, 600.0D+0/ DATA + YDATA(2,1,5), XDATA(2,1,5), XDATA(2,2,5) + /0.382D+0, 65.0D+0, 640.0D+0/ DATA + YDATA(3,1,5), XDATA(3,1,5), XDATA(3,2,5) + /0.397D+0, 1180.0D+0, 600.0D+0/ DATA + YDATA(4,1,5), XDATA(4,1,5), XDATA(4,2,5) + /0.376D+0, 66.0D+0, 640.0D+0/ DATA + YDATA(5,1,5), XDATA(5,1,5), XDATA(5,2,5) + /0.342D+0, 1270.0D+0, 600.0D+0/ DATA + YDATA(6,1,5), XDATA(6,1,5), XDATA(6,2,5) + /0.358D+0, 69.0D+0, 640.0D+0/ DATA + YDATA(7,1,5), XDATA(7,1,5), XDATA(7,2,5) + /0.348D+0, 1230.0D+0, 600.0D+0/ DATA + YDATA(8,1,5), XDATA(8,1,5), XDATA(8,2,5) + /0.376D+0, 68.0D+0, 640.0D+0/ DATA + TDATA(6) + /' POWELL AND MACDONALD, 1972, TABLES 7 AND 8, PAGES 153-154'/ DATA + NDATA(6), MDATA(6), NPDATA(6), NQDATA(6) + /14, 1, 3, 1/ DATA + (BDATA(K,6),K=1,3) + /25.0D+0, 30.0D+0, 6.0D+0/ DATA + YDATA( 1,1,6), XDATA( 1,1,6) + /26.38D+0, 1.0D+0/ DATA + YDATA( 2,1,6), XDATA( 2,1,6) + /25.79D+0, 2.0D+0/ DATA + YDATA( 3,1,6), XDATA( 3,1,6) + /25.29D+0, 3.0D+0/ DATA + YDATA( 4,1,6), XDATA( 4,1,6) + /24.86D+0, 4.0D+0/ DATA + YDATA( 5,1,6), XDATA( 5,1,6) + /24.46D+0, 5.0D+0/ DATA + YDATA( 6,1,6), XDATA( 6,1,6) + /24.10D+0, 6.0D+0/ DATA + YDATA( 7,1,6), XDATA( 7,1,6) + /23.78D+0, 7.0D+0/ DATA + YDATA( 8,1,6), XDATA( 8,1,6) + /23.50D+0, 8.0D+0/ DATA + YDATA( 9,1,6), XDATA( 9,1,6) + /23.24D+0, 9.0D+0/ DATA + YDATA(10,1,6), XDATA(10,1,6) + /23.00D+0, 10.0D+0/ DATA + YDATA(11,1,6), XDATA(11,1,6) + /22.78D+0, 11.0D+0/ DATA + YDATA(12,1,6), XDATA(12,1,6) + /22.58D+0, 12.0D+0/ DATA + YDATA(13,1,6), XDATA(13,1,6) + /22.39D+0, 13.0D+0/ DATA + YDATA(14,1,6), XDATA(14,1,6) + /22.22D+0, 14.0D+0/ DATA + TDATA(7) + /' FULLER, 1987, TABLE 3.2.10, PAGES 244-245'/ DATA + NDATA(7), MDATA(7), NPDATA(7), NQDATA(7) + /20, 2, 5, 1/ DATA + (BDATA(K,7),K=1,5) + /-1.0D+0, -3.0D+0, 0.09D+0, 0.02D+0, 0.08D+0/ DATA + YDATA( 1,1,7), XDATA( 1,1,7), XDATA( 1,2,7) + /0.0D+0, 0.50D+0, -0.12D+0/ DATA + YDATA( 2,1,7), XDATA( 2,1,7), XDATA( 2,2,7) + /0.0D+0, 1.20D+0, -0.60D+0/ DATA + YDATA( 3,1,7), XDATA( 3,1,7), XDATA( 3,2,7) + /0.0D+0, 1.60D+0, -1.00D+0/ DATA + YDATA( 4,1,7), XDATA( 4,1,7), XDATA( 4,2,7) + /0.0D+0, 1.86D+0, -1.40D+0/ DATA + YDATA( 5,1,7), XDATA( 5,1,7), XDATA( 5,2,7) + /0.0D+0, 2.12D+0, -2.54D+0/ DATA + YDATA( 6,1,7), XDATA( 6,1,7), XDATA( 6,2,7) + /0.0D+0, 2.36D+0, -3.36D+0/ DATA + YDATA( 7,1,7), XDATA( 7,1,7), XDATA( 7,2,7) + /0.0D+0, 2.44D+0, -4.00D+0/ DATA + YDATA( 8,1,7), XDATA( 8,1,7), XDATA( 8,2,7) + /0.0D+0, 2.36D+0, -4.75D+0/ DATA + YDATA( 9,1,7), XDATA( 9,1,7), XDATA( 9,2,7) + /0.0D+0, 2.06D+0, -5.25D+0/ DATA + YDATA(10,1,7), XDATA(10,1,7), XDATA(10,2,7) + /0.0D+0, 1.74D+0, -5.64D+0/ DATA + YDATA(11,1,7), XDATA(11,1,7), XDATA(11,2,7) + /0.0D+0, 1.34D+0, -5.97D+0/ DATA + YDATA(12,1,7), XDATA(12,1,7), XDATA(12,2,7) + /0.0D+0, 0.90D+0, -6.32D+0/ DATA + YDATA(13,1,7), XDATA(13,1,7), XDATA(13,2,7) + /0.0D+0, -0.28D+0, -6.44D+0/ DATA + YDATA(14,1,7), XDATA(14,1,7), XDATA(14,2,7) + /0.0D+0, -0.78D+0, -6.44D+0/ DATA + YDATA(15,1,7), XDATA(15,1,7), XDATA(15,2,7) + /0.0D+0, -1.36D+0, -6.41D+0/ DATA + YDATA(16,1,7), XDATA(16,1,7), XDATA(16,2,7) + /0.0D+0, -1.90D+0, -6.25D+0/ DATA + YDATA(17,1,7), XDATA(17,1,7), XDATA(17,2,7) + /0.0D+0, -2.50D+0, -5.88D+0/ DATA + YDATA(18,1,7), XDATA(18,1,7), XDATA(18,2,7) + /0.0D+0, -2.88D+0, -5.50D+0/ DATA + YDATA(19,1,7), XDATA(19,1,7), XDATA(19,2,7) + /0.0D+0, -3.18D+0, -5.24D+0/ DATA + YDATA(20,1,7), XDATA(20,1,7), XDATA(20,2,7) + /0.0D+0, -3.44D+0, -4.86D+0/ DATA + TDATA(8) + /' BATES AND WATTS, 1988, TABLE A1.13, PAGES 280-281'/ DATA + NDATA(8), MDATA(8), NPDATA(8), NQDATA(8) + /23, 1, 5, 2/ DATA + (BDATA(K,8),K=1,5) + /4.0D+0, 2.0D+0, 7.0D+0, 0.40D+0, 0.50D+0/ DATA + YDATA( 1,1,8), YDATA( 1,2,8), XDATA( 1,1,8) + /4.220D+0, 0.136D+0, 30.0D+0/ DATA + YDATA( 2,1,8), YDATA( 2,2,8), XDATA( 2,1,8) + /4.167D+0, 0.167D+0, 50.0D+0/ DATA + YDATA( 3,1,8), YDATA( 3,2,8), XDATA( 3,1,8) + /4.132D+0, 0.188D+0, 70.0D+0/ DATA + YDATA( 4,1,8), YDATA( 4,2,8), XDATA( 4,1,8) + /4.038D+0, 0.212D+0, 100.0D+0/ DATA + YDATA( 5,1,8), YDATA( 5,2,8), XDATA( 5,1,8) + /4.019D+0, 0.236D+0, 150.0D+0/ DATA + YDATA( 6,1,8), YDATA( 6,2,8), XDATA( 6,1,8) + /3.956D+0, 0.257D+0, 200.0D+0/ DATA + YDATA( 7,1,8), YDATA( 7,2,8), XDATA( 7,1,8) + /3.884D+0, 0.276D+0, 300.0D+0/ DATA + YDATA( 8,1,8), YDATA( 8,2,8), XDATA( 8,1,8) + /3.784D+0, 0.297D+0, 500.0D+0/ DATA + YDATA( 9,1,8), YDATA( 9,2,8), XDATA( 9,1,8) + /3.713D+0, 0.309D+0, 700.0D+0/ DATA + YDATA(10,1,8), YDATA(10,2,8), XDATA(10,1,8) + /3.633D+0, 0.311D+0, 1000.0D+0/ DATA + YDATA(11,1,8), YDATA(11,2,8), XDATA(11,1,8) + /3.540D+0, 0.314D+0, 1500.0D+0/ DATA + YDATA(12,1,8), YDATA(12,2,8), XDATA(12,1,8) + /3.433D+0, 0.311D+0, 2000.0D+0/ DATA + YDATA(13,1,8), YDATA(13,2,8), XDATA(13,1,8) + /3.358D+0, 0.305D+0, 3000.0D+0/ DATA + YDATA(14,1,8), YDATA(14,2,8), XDATA(14,1,8) + /3.258D+0, 0.289D+0, 5000.0D+0/ DATA + YDATA(15,1,8), YDATA(15,2,8), XDATA(15,1,8) + /3.193D+0, 0.277D+0, 7000.0D+0/ DATA + YDATA(16,1,8), YDATA(16,2,8), XDATA(16,1,8) + /3.128D+0, 0.255D+0, 10000.0D+0/ DATA + YDATA(17,1,8), YDATA(17,2,8), XDATA(17,1,8) + /3.059D+0, 0.240D+0, 15000.0D+0/ DATA + YDATA(18,1,8), YDATA(18,2,8), XDATA(18,1,8) + /2.984D+0, 0.218D+0, 20000.0D+0/ DATA + YDATA(19,1,8), YDATA(19,2,8), XDATA(19,1,8) + /2.934D+0, 0.202D+0, 30000.0D+0/ DATA + YDATA(20,1,8), YDATA(20,2,8), XDATA(20,1,8) + /2.876D+0, 0.182D+0, 50000.0D+0/ DATA + YDATA(21,1,8), YDATA(21,2,8), XDATA(21,1,8) + /2.838D+0, 0.168D+0, 70000.0D+0/ DATA + YDATA(22,1,8), YDATA(22,2,8), XDATA(22,1,8) + /2.798D+0, 0.153D+0, 100000.0D+0/ DATA + YDATA(23,1,8), YDATA(23,2,8), XDATA(23,1,8) + /2.759D+0, 0.139D+0, 150000.0D+0/ C...VARIABLE DEFINITIONS (ALPHABETICALLY) C BDATA: THE FUNCTION PARAMETER FOR EACH DATA SET. C BETA: THE FUNCTION PARAMETERS. C I: AN INDEXING VARIABLE. C J: AN INDEXING VARIABLE. C L: AN INDEXING VARIABLE. C LDX: THE LEADING DIMENSION OF ARRAY X. C M: THE NUMBER OF COLUMNS OF DATA IN THE EXPLANATORY VARIABLE. C MDATA: THE NUMBER OF COLUMNS OF DATA IN THE EXPLANATORY VARIABLE C IN EACH DATA SET. C N: THE NUMBER OF OBSERVATIONS. C NDATA: THE NUMBER OF OBSERVATIONS PER DATA SET. C NP: THE NUMBER OF FUNCTION PARAMETERS. C NPDATA: THE NUMBER OF FUNCTION PARAMETERS IN EACH DATA SET. C NQDATA: THE NUMBER OF RESPONSES PER OBSERVATION IN EACH DATA SET. C SETNO: THE NUMBER OF THE DATA SET BEING ANALYZED. C TDATA: THE REFERENCE FOR THE EACH OF THE DATA SETS. C TITLE: THE REFERENCE FOR THE DATA SET BEING ANALYZED. C X: THE EXPLANATORY VARIABLES. C XDATA: THE EXPLANATORY VARIABLES FOR EACH DATA SET. C Y: THE RESPONSE VARIABLE. C YDATA: THE RESPONSE VARIABLES FOR EACH DATA SET. C***FIRST EXECUTABLE STATEMENT DODRXD TITLE = TDATA(SETNO) N = NDATA(SETNO) M = MDATA(SETNO) NP = NPDATA(SETNO) NQ = NQDATA(SETNO) DO 20 L=1,NQ DO 10 I=1,N Y(I,L) = YDATA(I,L,SETNO) 10 CONTINUE 20 CONTINUE DO 40 J=1,M DO 30 I=1,N X(I,J) = XDATA(I,J,SETNO) 30 CONTINUE 40 CONTINUE DO 50 K=1,NP BETA(K) = BDATA(K,SETNO) 50 CONTINUE RETURN END *DODRXF SUBROUTINE DODRXF + (N,M,NP,NQ, + LDN,LDM,LDNP, + BETA,XPLUSD, + IFIXB,IFIXX,LDIFX, + IDEVAL,F,FJACB,FJACD, + ISTOP) C***BEGIN PROLOGUE DODRXF C***REFER TO DODR,DODRC C***ROUTINES CALLED (NONE) C***DATE WRITTEN 860529 (YYMMDD) C***REVISION DATE 920619 (YYMMDD) C***PURPOSE COMPUTE JACOBIAN MATRICIES FOR ODRPACK EXERCISER C***END PROLOGUE DODRXF C...SCALAR ARGUMENTS INTEGER + IDEVAL,ISTOP,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ C...ARRAY ARGUMENTS DOUBLE PRECISION + BETA(NP),F(LDN,NQ),FJACB(LDN,LDNP,NQ),FJACD(LDN,LDM,NQ), + XPLUSD(LDN,M) INTEGER + IFIXB(NP),IFIXX(LDIFX,M) C...SCALARS IN COMMON INTEGER + SETNO C...LOCAL SCALARS DOUBLE PRECISION + CTHETA,FAC1,FAC2,FAC3,FAC4,FREQ, + OMEGA,ONE,PHI,PI,R,STHETA,THETA,ZERO INTEGER + I,J,K C...INTRINSIC FUNCTIONS INTRINSIC + ATAN2,COS,EXP,SIN,SQRT C...COMMON BLOCKS COMMON /SETID/SETNO C...DATA STATEMENTS DATA + ZERO,ONE + /0.0D0,1.0D0/ C...VARIABLE DEFINITIONS (ALPHABETICALLY) C BETA: CURRENT VALUES OF PARAMETERS C F: PREDICTED FUNCTION VALUES C FAC1: A FACTORS OR TERMS USED IN COMPUTING THE JACOBIANS. C FAC2: A FACTORS OR TERMS USED IN COMPUTING THE JACOBIANS. C FAC3: A FACTORS OR TERMS USED IN COMPUTING THE JACOBIANS. C FAC4: A FACTORS OR TERMS USED IN COMPUTING THE JACOBIANS. C FJACB: JACOBIAN WITH RESPECT TO BETA C FJACD: JACOBIAN WITH RESPECT TO ERRORS DELTA C IDEVAL: INDICATOR FOR SELECTING COMPUTATION TO BE PERFORMED C IFIXB: INDICATORS FOR "FIXING" PARAMETERS (BETA) C IFIXX: INDICATORS FOR "FIXING" EXPLANATORY VARIABLE (X) C LDIFX: LEADING DIMENSION OF ARRAY IFIXX C ISTOP: STOPPING CONDITION, WHERE C 0 MEANS CURRENT BETA AND X+DELTA WERE C ACCEPTABLE AND VALUES WERE COMPUTED SUCCESSFULLY C 1 MEANS CURRENT BETA AND X+DELTA ARE C NOT ACCEPTABLE; ODRPACK SHOULD SELECT C VALUES CLOSER TO MOST RECENTLY USED VALUES C -1 MEANS CURRENT BETA AND X+DELTA ARE C NOT ACCEPTABLE; ODRPACK SHOULD STOP C LDN: LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING N C LDM: LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING M C LDNP: LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING NP C M: THE NUMBER OF COLUMNS OF DATA IN THE EXPLANATORY VARIABLE. C N: THE NUMBER OF OBSERVATIONS. C NP: THE NUMBER OF FUNCTION PARAMETERS. C NQ: THE NUMBER OF RESPONSES PER OBSERVATION. C ONE: THE VALUE 1.0D0. C SETNO: THE NUMBER OF THE DATA SET BEING ANALYZED. C XPLUSD: CURRENT VALUE OF EXPLANATORY VARIABLE, I.E., X + DELTA C ZERO: THE VALUE 0.0D0. C***FIRST EXECUTABLE STATEMENT DODRXF IF (SETNO.EQ.1) THEN C SETNO. 1: BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1 IF (BETA(1).LE.1.01D0) THEN ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN DO 100 I=1,N F(I,1) = BETA(1)/(XPLUSD(I,1)-BETA(2)) 100 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 110 I=1,N FJACB(I,1,1) = ONE/(XPLUSD(I,1)-BETA(2)) FJACB(I,2,1) = BETA(1)*(XPLUSD(I,1)-BETA(2))**(-2) 110 CONTINUE END IF IF (MOD(IDEVAL/100,10).NE.0) THEN DO 120 I=1,N FJACD(I,1,1) = -BETA(1)*(XPLUSD(I,1)-BETA(2))**(-2) 120 CONTINUE END IF ELSE ISTOP = 1 END IF ELSE IF (SETNO.EQ.2) THEN C SETNO. 2: BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2 ISTOP = 0 DO 200 I=1,N FAC1 = (BETA(2)*XPLUSD(I,1)+BETA(3)*XPLUSD(I,2)-ONE) IF (MOD(IDEVAL,10).NE.0) THEN F(I,1) = BETA(1)/FAC1 END IF IF (MOD(IDEVAL/10,10).NE.0) THEN FJACB(I,1,1) = ONE/FAC1 FJACB(I,2,1) = -BETA(1)*(FAC1**(-2))*XPLUSD(I,1) FJACB(I,3,1) = -BETA(1)*(FAC1**(-2))*XPLUSD(I,2) END IF IF (MOD(IDEVAL/100,10).NE.0) THEN FJACD(I,1,1) = -BETA(1)*(FAC1**(-2))*BETA(2) FJACD(I,2,1) = -BETA(1)*(FAC1**(-2))*BETA(3) END IF 200 CONTINUE ELSE IF (SETNO.EQ.3) THEN C SETNO. 3: BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3 ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN DO 310 I=1,N F(I,1) = ZERO DO 300 J=1,4 F(I,1) = F(I,1) + BETA(J)/(XPLUSD(I,1)+BETA(J+5)) 300 CONTINUE F(I,1) = F(I,1) + BETA(5) 310 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 330 I=1,N FJACB(I,5,1) = ONE DO 320 K=1,4 FJACB(I,K,1) = ONE/(XPLUSD(I,1)+BETA(K+5)) FJACB(I,K+5,1) = -BETA(K)* + (XPLUSD(I,1)+BETA(K+5))**(-2) 320 CONTINUE 330 CONTINUE END IF IF (MOD(IDEVAL/100,10).NE.0) THEN DO 350 I=1,N FJACD(I,1,1) = ZERO DO 340 K=4,1,-1 FJACD(I,1,1) = FJACD(I,1,1) - + BETA(K)*(XPLUSD(I,1)+BETA(K+5))**(-2) 340 CONTINUE 350 CONTINUE END IF ELSE IF (SETNO.EQ.4) THEN C SETNO. 4: HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188 ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN DO 400 I = 1, N F(I,1) = BETA(1)*XPLUSD(I,1) + + BETA(2)*EXP(BETA(3)*XPLUSD(I,2)) 400 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 410 I=1,N FJACB(I,1,1) = XPLUSD(I,1) FJACB(I,2,1) = EXP(BETA(3)*XPLUSD(I,2)) FJACB(I,3,1) = BETA(2)* + EXP(BETA(3)*XPLUSD(I,2))*XPLUSD(I,2) 410 CONTINUE END IF IF (MOD(IDEVAL/100,10).NE.0) THEN DO 420 I=1,N FJACD(I,1,1) = BETA(1) FJACD(I,2,1) = BETA(2)*EXP(BETA(3)*XPLUSD(I,2))*BETA(3) 420 CONTINUE END IF ELSE IF (SETNO.EQ.5) THEN C SETNO. 5: DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522 ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN DO 500 I=1,N F(I,1) = EXP(-BETA(1)*XPLUSD(I,1)* + EXP(-BETA(2)*(ONE/XPLUSD(I,2) - ONE/620.0D0))) 500 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 510 I=1,N FAC1 = ONE/XPLUSD(I,2) - ONE/620.0D0 FAC2 = EXP(-BETA(2)*FAC1) FAC3 = BETA(1)*XPLUSD(I,1) FAC4 = EXP(-FAC3*FAC2) FJACB(I,1,1) = -FAC4*XPLUSD(I,1)*FAC2 FJACB(I,2,1) = FAC4*FAC3*FAC2*FAC1 IF (MOD(IDEVAL/100,10).NE.0) THEN FJACD(I,1,1) = -FAC4*BETA(1)*FAC2 FJACD(I,2,1) = -FAC4*FAC3*FAC2* + BETA(2)/XPLUSD(I,2)**2 END IF 510 CONTINUE END IF ELSE IF (SETNO.EQ.6) THEN C SETNO. 6: POWELL AND MACDONALD, 1972, TABLES 7 AND 8, PAGE 153-154 C N.B. THIS DERIVATIVE IS INTENTIONALLY CODED INCORRECTLY ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN DO 600 I=1,N F(I,1) = BETA(1)* + (ONE+BETA(3)*XPLUSD(I,1)/BETA(2))**(-ONE/BETA(3)) 600 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 610 I=1,N FJACB(I,1,1) = ZERO FJACB(I,2,1) = ZERO FJACB(I,3,1) = ZERO IF (MOD(IDEVAL/100,10).NE.0) THEN FJACD(I,1,1) = XPLUSD(I,1) END IF 610 CONTINUE END IF ELSE IF (SETNO.EQ.7) THEN C SETNO. 7: FULLER, 1987, TABLE 3.2.10, PAGES 244-245 C N.B. THIS DERIVATIVE IS INTENTIONALLY CODED INCORRECTLY ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN DO 700 I=1,N F(I,1) = BETA(3)*(XPLUSD(I,1)-BETA(1))**2 + + 2*BETA(4)*(XPLUSD(I,1)-BETA(1))* + (XPLUSD(I,2)-BETA(2)) + + BETA(5)*(XPLUSD(I,2)-BETA(2))**2 - 1.0D0 700 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 710 I=1,N FJACB(I,1,1) = ZERO FJACB(I,2,1) = ZERO FJACB(I,3,1) = ZERO FJACB(I,4,1) = ZERO FJACB(I,5,1) = ZERO IF (MOD(IDEVAL/100,10).NE.0) THEN FJACD(I,1,1) = ZERO FJACD(I,2,1) = ZERO END IF 710 CONTINUE END IF ELSE IF (SETNO.EQ.8) THEN C SETNO. 8: BATES AND WATTS, 1988, TABLE A1.13, PAGES 280-281 C N.B. THIS DERIVATIVE IS INTENTIONALLY CODED INCORRECTLY DO 800 I=1,N IF (XPLUSD(I,1).LT.0.0D0) THEN ISTOP = 1 RETURN END IF 800 CONTINUE ISTOP = 0 IF (MOD(IDEVAL,10).NE.0) THEN PI = 3.141592653589793238462643383279D0 THETA = PI*BETA(4)*0.5D0 CTHETA = COS(THETA) STHETA = SIN(THETA) DO 810 I=1,N FREQ = XPLUSD(I,1) OMEGA = (2.0D0*PI*FREQ*EXP(-BETA(3)))**BETA(4) PHI = ATAN2((OMEGA*STHETA),(1+OMEGA*CTHETA)) R = (BETA(1)-BETA(2)) * + SQRT((1+OMEGA*CTHETA)**2+(OMEGA*STHETA)**2)** + (-BETA(5)) F(I,1) = BETA(2) + R*COS(BETA(5)*PHI) F(I,2) = R*SIN(BETA(5)*PHI) 810 CONTINUE END IF IF (MOD(IDEVAL/10,10).NE.0) THEN DO 820 I=1,N FJACB(I,1,1) = ZERO FJACB(I,2,1) = ZERO FJACB(I,3,1) = ZERO FJACB(I,4,1) = ZERO FJACB(I,5,1) = ZERO FJACB(I,1,2) = ZERO FJACB(I,2,2) = ZERO FJACB(I,3,2) = ZERO FJACB(I,4,2) = ZERO FJACB(I,5,2) = ZERO IF (MOD(IDEVAL/100,10).NE.0) THEN FJACD(I,1,1) = ZERO FJACD(I,1,2) = ZERO END IF 820 CONTINUE END IF END IF RETURN END *DODRXW SUBROUTINE DODRXW + (MAXN,MAXM,MAXNP,MAXNQ,LDWE,LD2WE,ISODR,LIWMIN,LWMIN) C***BEGIN PROLOGUE DODRXW C***REFER TO DODR,DODRC C***ROUTINES CALLED (NONE) C***DATE WRITTEN 890205 (YYMMDD) C***REVISION DATE 920619 (YYMMDD) C***PURPOSE COMPUTE MINIMUM LENGTHS FOR WORK VECTORS C***ROUTINES CALLED NONE C***END PROLOGUE DODRXW C...SCALAR ARGUMENTS INTEGER + LDWE,LD2WE,LIWMIN,LWMIN,MAXN,MAXM,MAXNP,MAXNQ LOGICAL + ISODR C...VARIABLE DEFINITIONS (ALPHABETICALLY) C ISODR: THE VARIABLE DESIGNATING WHETHER THE SOLUTION IS BY ODR C (ISODR=TRUE) OR BY OLS (ISODR=FALSE). C LDWE: THE LEADING DIMENSION OF ARRAY WE. C LD2WE: THE SECOND DIMENSION OF ARRAY WE. C LIWMIN: THE MINIMUM LENGTH OF VECTOR IWORK FOR A GIVEN PROBLEM. C LWMIN: THE MINIMUM LENGTH OF VECTOR WORK FOR A GIVEN PROBLEM. C MAXM: THE NUMBER OF COLUMNS IN THE EXPLANATORY VARIABLE. C MAXN: THE NUMBER OF OBSERVATIONS. C MAXNP: THE NUMBER OF FUNCTION PARAMETERS. C MAXNQ: THE NUMBER OF RESPONSES PER OBSERVATION. C***FIRST EXECUTABLE STATEMENT DODRXW LIWMIN = 20+MAXNP+MAXNQ*(MAXNP+MAXM) IF (ISODR) THEN LWMIN = 18 + 11*MAXNP + MAXNP**2 + MAXM + MAXM**2 + + 4*MAXN*MAXNQ + 6*MAXN*MAXM + 2*MAXN*MAXNQ*MAXNP + + 2*MAXN*MAXNQ*MAXM + MAXNQ**2 + + 5*MAXNQ + MAXNQ*(MAXNP+MAXM) + LDWE*LD2WE*MAXNQ ELSE LWMIN = 18 + 11*MAXNP + MAXNP**2 + MAXM + MAXM**2 + + 4*MAXN*MAXNQ + 2*MAXN*MAXM + 2*MAXN*MAXNQ*MAXNP + + 5*MAXNQ + MAXNQ*(MAXNP+MAXM) + LDWE*LD2WE*MAXNQ END IF RETURN END