* G05HMF Example Program Text * Mark 22 Release. NAG Copyright 2008. * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) INTEGER NPARMX, LDCOVR, NUM DOUBLE PRECISION ZERO PARAMETER (NPARMX=10,LDCOVR=NPARMX,NUM=2000,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, K, LDX, LWORK, MAXIT, MN, + NPAR, NPAR2, NREG, NT LOGICAL FCALL CHARACTER DIST * .. Local Arrays .. DOUBLE PRECISION BX(10), COVR(LDCOVR,NPARMX), CVAR(100), + ETM(NUM1), HT(NUM1+10), HTM(NUM1), PARAM(NPARMX), + RVEC(40), RWSAV(9), SC(NPARMX), SE(NPARMX), + THETA(NPARMX), WORK(NUM1*3+NPARMX+NREGMX*NUM1+20* + 20+1), X(NUM1,10), YT(NUM1+10) INTEGER ISEED(4) LOGICAL COPTS(2) * .. External Subroutines .. EXTERNAL G05HMF, G05KBF, G13FEF, G13FFF * .. Intrinsic Functions .. INTRINSIC DBLE, SIN * .. Executable Statements .. WRITE (NOUT,*) 'G05HMF Example Program Results' WRITE (NOUT,*) * ISEED(1) = 111 IGEN = 0 * LWORK = NUM1*3 + NPARMX + NREGMX*NUM1 + 1 NREG = 0 LDX = NUM1 DF = 5.1D0 GAMMA = 0.1D0 BX(1) = 1.5D0 BX(2) = 2.5D0 BX(3) = 3.0D0 MEAN = 4.0D0 * DO 20 I = 1, NUM FAC1 = DBLE(I)*0.01D0 X(I,2) = 0.01D0 + 0.7D0*SIN(FAC1) X(I,1) = 0.5D0 + FAC1*0.1D0 X(I,3) = 1.0D0 20 CONTINUE * MN = 1 NREG = 2 GAMMA = 0.1D0 IP = 1 IQ = 1 NPAR = IQ + IP + 1 PARAM(1) = 0.4D0 PARAM(2) = 0.1D0 PARAM(3) = 0.7D0 FCALL = .TRUE. * DIST = 'N' CALL G05KBF(IGEN,ISEED) IFLAG = 1 CALL G05HMF(DIST,200,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) * IF (IFLAG.EQ.0) THEN FCALL = .FALSE. IFLAG = 1 CALL G05HMF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC, + IGEN,ISEED,RWSAV,IFLAG) END IF IF (IFLAG.NE.0) THEN WRITE (NOUT,99997) IFLAG GO TO 300 END IF * 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 * IFLAG = -1 * COPTS(1) = .TRUE. COPTS(2) = .TRUE. * MAXIT = 100 TOL = 1.0D-5 * DO 80 I = 1, NPAR THETA(I) = PARAM(I)*0.5D0 80 CONTINUE THETA(NPAR+1) = GAMMA*0.5D0 IF (MN.EQ.1) THEN THETA(NPAR+MN+1) = MEAN*0.5D0 END IF DO 100 I = 1, NREG THETA(NPAR+MN+1+I) = BX(I)*0.5D0 100 CONTINUE * NPAR2 = 2 + IP + IQ + MN + NREG CALL G13FEF(DIST,YT,X,LDX,NUM,IP,IQ,NREG,MN,NPAR2,THETA,SE,SC, + COVR,LDCOVR,HP,ETM,HTM,LGF,COPTS,MAXIT,TOL,WORK,LWORK, + IFLAG) * IF (IFLAG.LT.0) GO TO 300 WRITE (NOUT,*) WRITE (NOUT,*) 'Normal distribution' WRITE (NOUT,*) WRITE (NOUT,*) ' Parameter Standard Correct' WRITE (NOUT,*) ' estimates errors values' * DO 120 I = 1, NPAR WRITE (NOUT,99999) THETA(I), SE(I), PARAM(I) 120 CONTINUE * WRITE (NOUT,99999) THETA(NPAR+1), SE(NPAR+1), GAMMA * IF (MN.EQ.1) THEN WRITE (NOUT,99999) THETA(NPAR+2), SE(NPAR+2), MEAN END IF * DO 140 I = 1, NREG WRITE (NOUT,99999) THETA(NPAR+MN+I+1), SE(NPAR+MN+I+1), BX(I) 140 CONTINUE * NT = 4 IFLAG = 0 CALL G13FFF(NUM,NT,IP,IQ,THETA,GAMMA,CVAR,HTM,ETM,IFLAG) * WRITE (NOUT,*) WRITE (NOUT,99998) 'Volatility forecast = ', CVAR(NT) WRITE (NOUT,*) * DIST = 'T' MEAN = 3.0D0 * DO 160 I = 1, NUM FAC1 = DBLE(I)*0.01D0 X(I,2) = 0.01D0 + 0.7D0*SIN(FAC1) X(I,1) = 0.5D0 + FAC1*0.1D0 X(I,3) = 1.0D0 160 CONTINUE * MN = 1 NREG = 2 GAMMA = 0.09D0 IP = 1 IQ = 1 * NPAR = IQ + IP + 1 PARAM(1) = 0.05D0 PARAM(2) = 0.1D0 PARAM(3) = 0.8D0 * FCALL = .TRUE. ISEED(1) = 111 CALL G05KBF(IGEN,ISEED) * IFLAG = 0 CALL G05HMF(DIST,200,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) FCALL = .FALSE. IFLAG = 0 CALL G05HMF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) IFLAG = 0 CALL G05HMF(DIST,NUM,IP,IQ,PARAM,GAMMA,DF,HT,YT,FCALL,RVEC,IGEN, + ISEED,RWSAV,IFLAG) * DO 200 I = 1, NUM XTERM = ZERO DO 180 K = 1, NREG XTERM = XTERM + X(I,K)*BX(K) 180 CONTINUE IF (MN.EQ.1) THEN YT(I) = MEAN + XTERM + YT(I) ELSE YT(I) = XTERM + YT(I) END IF 200 CONTINUE * IFLAG = -1 * MAXIT = 100 TOL = 1.0D-5 * DO 220 I = 1, NPAR THETA(I) = PARAM(I)*0.5D0 220 CONTINUE * THETA(NPAR+1) = GAMMA*0.5D0 * THETA(NPAR+2) = DF*0.65D0 * IF (MN.EQ.1) THEN THETA(NPAR+2+MN) = MEAN*0.5D0 END IF DO 240 I = 1, NREG THETA(NPAR+2+MN+I) = BX(I)*0.5D0 240 CONTINUE * COPTS(1) = .TRUE. COPTS(2) = .TRUE. HP = 0.5D0 * NPAR2 = 3 + IP + IQ + MN + NREG * CALL G13FEF(DIST,YT,X,LDX,NUM,IP,IQ,NREG,MN,NPAR2,THETA,SE,SC, + COVR,LDCOVR,HP,ETM,HTM,LGF,COPTS,MAXIT,TOL,WORK,LWORK, + IFLAG) * WRITE (NOUT,*) WRITE (NOUT,*) 'Students t distribution' WRITE (NOUT,*) WRITE (NOUT,*) ' Parameter Standard Correct' WRITE (NOUT,*) ' estimates errors values' * DO 260 I = 1, NPAR WRITE (NOUT,99999) THETA(I), SE(I), PARAM(I) 260 CONTINUE * WRITE (NOUT,99999) THETA(NPAR+1), SE(NPAR+1), GAMMA * WRITE (NOUT,99999) THETA(NPAR+2), SE(NPAR+2), DF * IF (MN.EQ.1) THEN WRITE (NOUT,99999) THETA(NPAR+2+MN), SE(NPAR+2+MN), MEAN END IF * DO 280 I = 1, NREG WRITE (NOUT,99999) THETA(NPAR+2+MN+I), SE(NPAR+2+MN+I), BX(I) 280 CONTINUE * NT = 4 IFLAG = 0 CALL G13FFF(NUM,NT,IP,IQ,THETA,GAMMA,CVAR,HTM,ETM,IFLAG) * WRITE (NOUT,*) WRITE (NOUT,99998) 'Volatility forecast = ', CVAR(NT) WRITE (NOUT,*) 300 CONTINUE * 99999 FORMAT (1X,3F16.3) 99998 FORMAT (1X,A,F12.3) 99997 FORMAT (1X,' ** G05HMF returned with IFAIL = ',I5) END