Program g01anfe ! G01ANF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g01anf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: eps Integer :: i, ifail, ind, licomm, lrcomm, n, & nb, np, nq, nrv, onb ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: q(:), qv(:), rcomm(:), rv(:) Integer, Allocatable :: icomm(:) ! .. Executable Statements .. Write (nout,*) 'G01ANF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in stream size and approximation factor Read (nin,*) n, eps ! Read in number of elements in the output vector qv Read (nin,*) nq Allocate (qv(nq),q(nq)) ! Read in vector q Read (nin,*) q(1:nq) ! Dummy allocation for the communication arrays lrcomm = 1 licomm = 2 nb = 1 Allocate (rv(nb),rcomm(lrcomm),icomm(licomm)) ! Call NAG routine for the first time to obtain lrcomm and licomm ind = 0 ifail = 0 Call g01anf(ind,n,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm,ifail) ! Reallocate the communication arrays to the required size lrcomm = icomm(1) licomm = icomm(2) Deallocate (rcomm,icomm) Allocate (rcomm(lrcomm),icomm(licomm)) ! Read in number of vectors with dataset blocks Read (nin,*) nrv onb = 0 d_lp: Do i = 1, nrv ! Read in number of elements in the first/next vector rv Read (nin,*) nb If (onb/=nb) Then ! Reallocate RV if required Deallocate (rv) Allocate (rv(nb)) End If onb = nb ! Read in vector rv Read (nin,*) rv(1:nb) ! Repeat calls to NAG routine for every dataset block rv ! until n observations have been passed ifail = 1 Call g01anf(ind,n,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm, & ifail) If (ifail/=0) Then ! This routine is most likely to be used to process large datasets, ! certain parameter checks will only be done once all the data has ! been processed. Calling the routine with a hard failure (IFAIL=0) ! would cause any processing to be lost as the program terminates. ! It is likely that a soft failure would be more appropriate. This ! would allow any issues with the input parameters to be resolved ! without losing any processing already carried out. ! In this small example we are just calling the routine again with ! a hard failure so that the error messages are displayed. ifail = 0 Call g01anf(ind,n,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm, & ifail) End If If (ind==4) Exit d_lp End Do d_lp ! Call NAG routine again to calculate quantiles specified in vector q ind = 3 ifail = 0 Call g01anf(ind,n,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm,ifail) ! Print the results Write (nout,*) 'Input data:' Write (nout,99999) n, ' observations' Write (nout,99998) 'eps = ', eps Write (nout,*) Write (nout,*) 'Quantile Result' Write (nout,99997)(q(i),qv(i),i=1,nq) 99999 Format (1X,I2,A) 99998 Format (1X,A,F5.2) 99997 Format (1X,F7.2,4X,F7.2) End Program g01anfe