Program g13ccfe ! G13CCF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g13ccf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: pxy Integer :: i, ic, ifail, ii, ish, iw, kc, l, & lxg, lyg, mtxy, mw, nc, ng, nxy, nxyg ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: cxy(:), cyx(:), xg(:), yg(:) ! .. Intrinsic Procedures .. Intrinsic :: max, min ! .. Executable Statements .. Write (nout,*) 'G13CCF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) nxy, nc, ic ! Read in control parameters Read (nin,*) mtxy, pxy Read (nin,*) iw, mw Read (nin,*) ish, kc, l If (ic==0) Then nxyg = max(kc,l) Else nxyg = l End If lxg = max(nxyg,nxy) lyg = max(nxyg,nxy) Allocate (xg(lxg),yg(lyg),cxy(nc),cyx(nc)) If (ic==0) Then Read (nin,*)(xg(i),i=1,nxy) Read (nin,*)(yg(i),i=1,nxy) Else Read (nin,*)(cxy(i),i=1,nc) Read (nin,*)(cyx(i),i=1,nc) End If ifail = 0 Call g13ccf(nxy,mtxy,pxy,iw,mw,ish,ic,nc,cxy,cyx,kc,l,nxyg,xg,yg,ng, & ifail) ! Display results Write (nout,*) ' Returned cross covariances' Write (nout,*) Write (nout,*) & 'Lag XY YX Lag XY YX Lag XY YX' Do i = 1, nc, 3 Write (nout,99999)(ii-1,cxy(ii),cyx(ii),ii=i,min(i+2,nc)) End Do Write (nout,*) Write (nout,*) ' Returned sample spectrum' Write (nout,*) Write (nout,*) & ' Real Imaginary Real Imaginary Real Imaginary' Write (nout,*) & 'Lag part part Lag part part Lag part part' Do i = 1, ng, 3 Write (nout,99999)(ii-1,xg(ii),yg(ii),ii=i,min(i+2,ng)) End Do 99999 Format (1X,I3,2F9.4,I4,2F9.4,I4,2F9.4) End Program g13ccfe