PROGRAM SAMPLE C ODRPACK ARGUMENT DEFINITIONS C ==> FCN NAME OF THE USER SUPPLIED FUNCTION SUBROUTINE C ==> N NUMBER OF OBSERVATIONS C ==> M COLUMNS OF DATA IN THE EXPLANATORY VARIABLE C ==> NP NUMBER OF PARAMETERS C ==> NQ NUMBER OF RESPONSES PER OBSERVATION C <==> BETA FUNCTION PARAMETERS C ==> Y RESPONSE VARIABLE (UNUSED WHEN MODEL IS IMPLICIT) C ==> LDY LEADING DIMENSION OF ARRAY Y C ==> X EXPLANATORY VARIABLE C ==> LDX LEADING DIMENSION OF ARRAY X C ==> WE INITIAL PENALTY PARAMETER FOR IMPLICIT MODEL C ==> LDWE LEADING DIMENSION OF ARRAY WE C ==> LD2WE SECOND DIMENSION OF ARRAY WE C ==> WD "DELTA" WEIGHTS C ==> LDWD LEADING DIMENSION OF ARRAY WD C ==> LD2WD SECOND DIMENSION OF ARRAY WD C ==> JOB TASK TO BE PERFORMED C ==> IPRINT PRINT CONTROL C ==> LUNERR LOGICAL UNIT FOR ERROR REPORTS C ==> LUNRPT LOGICAL UNIT FOR COMPUTATION REPORTS C <==> WORK DOUBLE PRECISION WORK VECTOR C ==> LWORK DIMENSION OF VECTOR WORK C <== IWORK INTEGER WORK VECTOR C ==> LIWORK DIMENSION OF VECTOR IWORK C <== INFO STOPPING CONDITION C PARAMETERS SPECIFYING MAXIMUM PROBLEM SIZES HANDLED BY THIS DRIVER C MAXN MAXIMUM NUMBER OF OBSERVATIONS C MAXM MAXIMUM NUMBER OF COLUMNS IN EXPLANATORY VARIABLE C MAXNP MAXIMUM NUMBER OF FUNCTION PARAMETERS C MAXNQ MAXIMUM NUMBER OF RESPONSES PER OBSERVATION C PARAMETER DECLARATIONS AND SPECIFICATIONS INTEGER LDWD,LDWE,LDX,LDY,LD2WD,LD2WE, + LIWORK,LWORK,MAXM,MAXN,MAXNP,MAXNQ PARAMETER (MAXM=5,MAXN=25,MAXNP=5,MAXNQ=2, + LDY=MAXN,LDX=MAXN, + LDWE=1,LD2WE=1,LDWD=1,LD2WD=1, + 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 VARIABLE DECLARATIONS INTEGER I,INFO,IPRINT,J,JOB,LUNERR,LUNRPT,M,N,NP,NQ INTEGER IWORK(LIWORK) DOUBLE PRECISION BETA(MAXNP), + WD(LDWD,LD2WD,MAXM),WE(LDWE,LD2WE,MAXNQ), + WORK(LWORK),X(LDX,MAXM),Y(LDY,MAXNQ) EXTERNAL FCN C SPECIFY DEFAULT VALUES FOR DODR ARGUMENTS WE(1,1,1) = -1.0D0 WD(1,1,1) = -1.0D0 JOB = -1 IPRINT = -1 LUNERR = -1 LUNRPT = -1 C SET UP ODRPACK REPORT FILES LUNERR = 9 LUNRPT = 9 OPEN (UNIT=9,FILE='REPORT2') C READ PROBLEM DATA OPEN (UNIT=5,FILE='DATA2') READ (5,FMT=*) N,M,NP,NQ READ (5,FMT=*) (BETA(I),I=1,NP) DO 10 I=1,N READ (5,FMT=*) (X(I,J),J=1,M) 10 CONTINUE C SPECIFY TASK: IMPLICIT ORTHOGONAL DISTANCE REGRESSION C WITH FORWARD FINITE DIFFERENCE DERIVATIVES C COVARIANCE MATRIX CONSTRUCTED WITH RECOMPUTED DERIVATIVES C DELTA INITIALIZED TO ZERO C NOT A RESTART JOB = 00001 C COMPUTE SOLUTION CALL DODR(FCN, + N,M,NP,NQ, + BETA, + Y,LDY,X,LDX, + WE,LDWE,LD2WE,WD,LDWD,LD2WD, + JOB, + IPRINT,LUNERR,LUNRPT, + WORK,LWORK,IWORK,LIWORK, + INFO) END SUBROUTINE FCN(N,M,NP,NQ, + LDN,LDM,LDNP, + BETA,XPLUSD, + IFIXB,IFIXX,LDIFX, + IDEVAL,F,FJACB,FJACD, + ISTOP) C SUBROUTINE ARGUMENTS C ==> N NUMBER OF OBSERVATIONS C ==> M NUMBER OF COLUMNS IN EXPLANATORY VARIABLE C ==> NP NUMBER OF PARAMETERS C ==> NQ NUMBER OF RESPONSES PER OBSERVATION 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 ==> BETA CURRENT VALUES OF PARAMETERS C ==> XPLUSD CURRENT VALUE OF EXPLANATORY VARIABLE, I.E., X + DELTA C ==> IFIXB INDICATORS FOR "FIXING" PARAMETERS (BETA) C ==> IFIXX INDICATORS FOR "FIXING" EXPLANATORY VARIABLE (X) C ==> LDIFX LEADING DIMENSION OF ARRAY IFIXX C ==> IDEVAL INDICATOR FOR SELECTING COMPUTATION TO BE PERFORMED C <== F PREDICTED FUNCTION VALUES C <== FJACB JACOBIAN WITH RESPECT TO BETA C <== FJACD JACOBIAN WITH RESPECT TO ERRORS DELTA 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 VALUES C CLOSER TO MOST RECENTLY USED VALUES IF POSSIBLE C -1 MEANS CURRENT BETA AND X+DELTA ARE C NOT ACCEPTABLE; ODRPACK SHOULD STOP C INPUT ARGUMENTS, NOT TO BE CHANGED BY THIS ROUTINE: INTEGER I,IDEVAL,ISTOP,L,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ DOUBLE PRECISION BETA(NP),XPLUSD(LDN,M) INTEGER IFIXB(NP),IFIXX(LDIFX,M) C OUTPUT ARGUMENTS: DOUBLE PRECISION F(LDN,NQ),FJACB(LDN,LDNP,NQ),FJACD(LDN,LDM,NQ) C CHECK FOR UNACCEPTABLE VALUES FOR THIS PROBLEM IF (BETA(1) .GT. 0.0D0) THEN ISTOP = 1 RETURN ELSE ISTOP = 0 END IF C COMPUTE PREDICTED VALUES IF (MOD(IDEVAL,10).GE.1) THEN DO 110 L = 1,NQ DO 100 I = 1,N F(I,L) = 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 100 CONTINUE 110 CONTINUE END IF RETURN END