Program g13bhfe ! G13BHF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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 Procedures .. 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