PROGRAM g13bhfe ! G13BHF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g13bhf, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: i, ifail, iwa, kzef, ldparx, ldxxyn, & ncf, ncg, nch, nci, ncj, nck, ncl, & ncm, nfv, nis, npara, nparax, nser, & nsttf ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: fsd(:), fva(:), para(:), parx(:,:), & rmsxy(:), sttf(:), wa(:), xxyn(:,:) INTEGER :: mr(7) INTEGER, ALLOCATABLE :: mrx(:,:), mt(:,:) ! .. Intrinsic Functions .. INTRINSIC max ! .. Executable Statements .. WRITE (nout,*) 'G13BHF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in problem size READ (nin,*) nsttf, nser, nfv, kzef ! Number of input series nis = nser - 1 ! Read in the orders READ (nin,*) (mr(i),i=1,7) ALLOCATE (mt(4,nser)) ! Read in transfer function DO i = 1, nis READ (nin,*) mt(1:4,i) END DO ! Calculate NPARA npara = 0 DO i = 1, nis npara = npara + mt(2,i) + mt(3,i) END DO npara = npara + mr(1) + mr(3) + mr(4) + mr(6) + nser ldxxyn = nfv ldparx = npara ALLOCATE (para(npara),sttf(nsttf),xxyn(ldxxyn,nser),mrx(7,nser), & parx(ldparx,nser),rmsxy(nser),fva(nfv),fsd(nfv)) ! Read in rest of data READ (nin,*) sttf(1:nsttf) READ (nin,*) para(1:npara) READ (nin,*) (xxyn(i,1:nis),i=1,nfv) ncf = mr(1) + mr(3) + mr(4) + mr(6) DO i = 1, nis READ (nin,*) mrx(1:7,i) nparax = mrx(1,i) + mrx(3,i) + mrx(4,i) + mrx(6,i) ncf = max(ncf,nparax) READ (nin,*) parx(1:nparax,i) END DO READ (nin,*) rmsxy(1:nser) ! Calculate size of workspace array ncg = 0 nch = 0 nci = 0 DO i = 1, nis IF (mt(4,i)>1) THEN ncg = max(ncg,mrx(1,i)) nch = max(nch,mt(1,i)+mrx(3,i)) nci = max(nci,mt(1,i)+mrx(3,i)+mrx(1,i)) END IF ncf = max(ncf,mrx(1,i)+mrx(3,i)+mrx(4,i)+mrx(6,i)) END DO ncj = nci + 1 nck = nfv + max(ncg,nch) ncl = max(nsttf,ncf,ncj,nck) ncm = max(nsttf+4*ncf,ncl) iwa = ncm + 3*ncl + nfv ALLOCATE (wa(iwa)) ! Produce forecasts ifail = 0 CALL g13bhf(sttf,nsttf,mr,nser,mt,para,npara,nfv,xxyn,ldxxyn,mrx,parx, & ldparx,rmsxy,kzef,fva,fsd,wa,iwa,ifail) ! Display results WRITE (nout,*) 'The forecast values and their standard errors' WRITE (nout,*) WRITE (nout,*) ' I FVA FSD' WRITE (nout,*) WRITE (nout,99999) (i,fva(i),fsd(i),i=1,nfv) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',nfv,nser,xxyn,ldxxyn, & 'The values of z(t) and n(t)',ifail) WRITE (nout,99998) 'The first ', nis, & ' columns hold the z(t) and the last column the n(t)' 99999 FORMAT (1X,I4,2F10.4) 99998 FORMAT (1X,A,I0,A) END PROGRAM g13bhfe