SECTION 1.6 USER-SUPPLIED DERIVATIVES

1. When the Hessian matrix is not calculated by the Berndt, Hall, Hall, Hausman (BHHH) procedure (for this procedure see Section 2.2). The methods DFP and GRADX require the use of first derivatives of the function (the latter uses 2nd derivatives as well). These routines allow the user to explicitly supply the analytic 1st (and 2nd) derivatives by writing subroutines FP and SP:

      SUBROUTINE FP(X,NP,F,FPD,FUNC)
      IMPLICIT REAL*8 (A-H,O-Z)
      EXTERNAL FUNC
      DIMENSION X(NP),FPD(NP)
        ...
      FPD(I)=
        ...
      RETURN
      END 

where

X = Input, variable value at which derivatives are to be evaluated
NP = Input, number of variables
F = Input, function value at X (supplied by the caller) which may be used by the derivative routine and must not be reevaluated
FPD = Output, 1st partial derivatives at X
FUNC = Input, name of the function1 to be optimized

The user may also supply GRADX with second partial derivatives:

      SUBROUTINE SP (X,NP,F,FPD,SPD,FUNC)
      IMPLICIT REAL*8 (A-H,O-Z)
      EXTERNAL FUNC
      DIMENSION X(NP),FPD(NP),SPD(NP,NP)
        ...
      SPD(I,J) =
        ...
      RETURN
      END 

X, NP, and F are defined as in FP. FPD contains the first partial derivatives at the point and may be used, BUT MUST NOT BE CHANGED!! SPD must be assigned the appropriate second partial derivatives. The user can prevent the variables from entering a certain region in which the derivatives are undefined by using the error return in FUNC To signal an error in FP or SP, include:

      COMMON/BOPT2/ ACC,R,PM1,IVAL,ITERL,ITERC,MX,IER 

Then include the statement

      IER = -2

before returning. If the user does not wish to write analytic derivatives, these routines will attempt to evaluate derivatives numerically (this occurs automatically when no FP or SP subroutine is supplied). Numerical derivatives may be evaluated in several ways (see definitions of IFP (Section 3.1,DFP) and ISP (Section 2.1,GRADX).

2. When the Hessian is calculated according to the BHHH procedure (see Section 2.2) This case is relevant only the the event of maximization of the loglikelihood function. According to the BHHH procedure, only first partial derivatives need to be supplied. To provide GRADX with analytic derivatives, the user should include the SUBROUTINE FPPP which should compute the first partial derivatives of the logdensity for the KBHHH-th observation, i.e., the derivatives of the KBHHH-th term of the loglikelihood.

      SUBROUTINE FPPP(A0,NP,AFU0,FPD,FUNC)
C OBTAIN 1ST DERIVATIVES AT A0
      IMPLICIT REAL*8(A-H,O-Z)
      EXTERNAL FUNC
      DIMENSION A0(NP),FPD(NP)
      COMMON/BOPT2/ACC,R ,PM1,IVAL,ITERL,ITERC,MX,IER
      COMMON/BGRDX1/NTRM,NBHHH,LBHHH,KBHHH
C BE SURE TO PASS ANY DATA BY INCLUDING THE APPROPRIATE USER'S COMMON BLOCK
        ...
      FPD(I)=
        ...
      RETURN
      END 

where the section in the middle computes the analytic first derivatives. As in part 1 of this subsection, error conditions should be flagged by setting IER=-2.

Return to
|Sect. 2.1|Sect. 2.2|Sect. 3.1|Beginning|