* G13FAF Example Program Text * Mark 20 Release. NAG Copyright 2001. * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) INTEGER NPARMX, NUM DOUBLE PRECISION ZERO PARAMETER (NPARMX=10,NUM=1500,ZERO=0.0D0) INTEGER NUM1, NREGMX PARAMETER (NUM1=3000,NREGMX=10) * .. Local Scalars .. DOUBLE PRECISION DF, FAC1, GAMMA, HP, LGF, MEAN, TOL, XTERM INTEGER I, IFLAG, IGEN, IP, IQ, ISYM, K, LDX, LWK, MAXIT, + MN, NPAR, NPAR2, NREG, NT LOGICAL FCALL CHARACTER DIST * .. Local Arrays .. DOUBLE PRECISION BX(10), COVAR(NPARMX,NPARMX), CVAR(100), + ETM(NUM1), HT(NUM1+10), HTM(NUM1), PARAM(NPARMX), + RVEC(40), RWSAV(9), SC(NPARMX), SE(NPARMX), + THETA(NPARMX), WK(NUM1*3+NPARMX+NREGMX*NUM1+20* + 20+1), X(NUM1,10), YT(NUM1+10) INTEGER ISEED(4) LOGICAL COPTS(2) * .. External Subroutines .. EXTERNAL G05CBF, G05HKF, G05KBF, G13FAF, G13FBF * .. Intrinsic Functions .. INTRINSIC DBLE, SIN * .. Executable Statements .. WRITE (NOUT,*) 'G13FAF Example Program Results' ISEED(1) = 111 IGEN = 0 NREG = 0 LDX = NUM1 BX(1) = 1.5D0 BX(2) = 2.5D0 BX(3) = 3.0D0 MEAN = 3.0D0 DO 20 I = 1, NUM FAC1 = DBLE(I)*0.01D0 X(I,1) = 0.01D0 + 0.7D0*SIN(FAC1) X(I,2) = 0.5D0 + FAC1*0.1D0 X(I,3) = 1.0D0 20 CONTINUE ISYM = 1 MN = 1 GAMMA = -0.4D0 IP = 0 IQ = 3 PARAM(1) = 0.8D0 PARAM(2) = 0.6D0 PARAM(3) = 0.2D0 PARAM(4) = 0.1D0 NPAR = 1 + IQ + IP LWK = NREG*NUM + 3*NUM + NPAR + ISYM + MN + NREG + 403 FCALL = .TRUE. IFLAG = 0 DIST = 'N' CALL G05KBF(IGEN,ISEED) CALL G05HKF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) FCALL = .FALSE. CALL G05HKF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) IFLAG = -1 DO 60 I = 1, NUM XTERM = ZERO DO 40 K = 1, NREG XTERM = XTERM + X(I,K)*BX(K) 40 CONTINUE IF (MN.EQ.1) THEN YT(I) = MEAN + XTERM + YT(I) ELSE YT(I) = XTERM + YT(I) END IF 60 CONTINUE COPTS(1) = .TRUE. COPTS(2) = .TRUE. MAXIT = 200 TOL = 1.0D-5 DO 80 I = 1, NPAR THETA(I) = PARAM(I)*0.5D0 80 CONTINUE IF (ISYM.EQ.1) THEN THETA(NPAR+ISYM) = GAMMA*0.5D0 END IF IFLAG = 0 NPAR2 = 1 + IQ + IP + ISYM + MN + NREG CALL G13FAF(DIST,YT,X,LDX,NUM,IP,IQ,NREG,MN,ISYM,NPAR2,THETA,SE, + SC,COVAR,NPARMX,HP,ETM,HTM,LGF,COPTS,MAXIT,TOL,WK,LWK, + IFLAG) WRITE (NOUT,*) WRITE (NOUT,*) 'Normal distribution' WRITE (NOUT,*) WRITE (NOUT,*) + ' Parameter Standard Correct' WRITE (NOUT,*) + ' estimates errors values' DO 100 I = 1, NPAR WRITE (NOUT,99999) THETA(I), SE(I), PARAM(I) 100 CONTINUE IF (ISYM.EQ.1) THEN WRITE (NOUT,99999) THETA(NPAR+1), SE(NPAR+1), GAMMA END IF IF (MN.EQ.1) THEN WRITE (NOUT,99999) THETA(NPAR+ISYM+1), SE(NPAR+ISYM+1), + MEAN END IF DO 120 I = 1, NREG WRITE (NOUT,99999) THETA(NPAR+ISYM+MN+I), + SE(NPAR+ISYM+MN+I), BX(I) 120 CONTINUE NT = 4 CALL G13FBF(NUM,NT,IP,IQ,THETA,GAMMA,CVAR,HTM,ETM,IFLAG) WRITE (NOUT,*) WRITE (NOUT,99998) 'Volatility forecast = ', CVAR(NT) WRITE (NOUT,*) DIST = 'T' NREG = 2 MN = 1 DF = 4.1D0 IP = 1 IQ = 2 ISYM = 1 GAMMA = -0.2D0 NPAR = IQ + IP + 1 LWK = NREG*NUM + 3*NUM + NPAR + ISYM + MN + NREG + 404 PARAM(1) = 0.1D0 PARAM(2) = 0.2D0 PARAM(3) = 0.3D0 PARAM(4) = 0.4D0 PARAM(5) = 0.1D0 FCALL = .TRUE. CALL G05CBF(111) IGEN = 0 ISEED(1) = 111 CALL G05KBF(IGEN,ISEED) CALL G05HKF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) FCALL = .FALSE. CALL G05HKF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) CALL G05HKF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) IFLAG = -1 DO 160 I = 1, NUM XTERM = ZERO DO 140 K = 1, NREG XTERM = XTERM + X(I,K)*BX(K) 140 CONTINUE IF (MN.EQ.1) THEN YT(I) = MEAN + XTERM + YT(I) ELSE YT(I) = XTERM + YT(I) END IF 160 CONTINUE COPTS(1) = .TRUE. COPTS(2) = .TRUE. MAXIT = 200 TOL = 1.0D-5 DO 180 I = 1, NPAR THETA(I) = PARAM(I)*0.5D0 180 CONTINUE THETA(NPAR+ISYM) = GAMMA*0.5D0 THETA(NPAR+ISYM+1) = DF*0.65D0 NPAR2 = 2 + IP + IQ + ISYM + MN + NREG CALL G13FAF(DIST,YT,X,LDX,NUM,IP,IQ,NREG,MN,ISYM,NPAR2,THETA,SE, + SC,COVAR,NPARMX,HP,ETM,HTM,LGF,COPTS,MAXIT,TOL,WK,LWK, + IFLAG) WRITE (NOUT,*) WRITE (NOUT,*) 'Student t-distribution' WRITE (NOUT,*) WRITE (NOUT,*) + ' Parameter Standard Correct' WRITE (NOUT,*) + ' estimates errors values' DO 200 I = 1, NPAR WRITE (NOUT,99999) THETA(I), SE(I), PARAM(I) 200 CONTINUE IF (ISYM.EQ.1) THEN WRITE (NOUT,99999) THETA(NPAR+ISYM), SE(NPAR+ISYM), GAMMA END IF WRITE (NOUT,99999) THETA(NPAR+ISYM+1), SE(NPAR+ISYM+1), DF IF (MN.EQ.1) THEN WRITE (NOUT,99999) THETA(NPAR+ISYM+1+MN), + SE(NPAR+ISYM+1+MN), MEAN END IF DO 220 I = 1, NREG WRITE (NOUT,99999) THETA(NPAR+ISYM+1+MN+I), + SE(NPAR+ISYM+1+MN+I), BX(I) 220 CONTINUE NT = 4 CALL G13FBF(NUM,NT,IP,IQ,THETA,GAMMA,CVAR,HTM,ETM,IFLAG) WRITE (NOUT,*) WRITE (NOUT,99998) 'Volatility forecast = ', CVAR(NT) STOP * 99999 FORMAT (1X,3F16.4) 99998 FORMAT (1X,A,F12.4) END