Program g05nffe
! G05NFF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: g05kff, g05nff, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: lseed = 1, nin = 5, nout = 6
! .. Local Scalars ..
Integer :: genid, i, ifail, j, ldisampl, lipop, &
lstate, m, n, nrs, otype, rtype, &
subid
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: wt(:)
Integer, Allocatable :: ipop(:), isampl(:,:), state(:)
Integer :: seed(lseed)
! .. Intrinsic Procedures ..
Intrinsic :: max, repeat
! .. Executable Statements ..
Write (nout,*) 'G05NFF Example Program Results'
Write (nout,*)
! Skip heading in data file
Read (nin,*)
! Read in the base generator information and seed
Read (nin,*) genid, subid, seed(1)
! Initial call to the initializer to get the size of the STATE array
lstate = 0
Allocate (state(lstate))
ifail = 0
Call g05kff(genid,subid,seed,lseed,state,lstate,ifail)
! Reallocate STATE
Deallocate (state)
Allocate (state(lstate))
! Initialize the generator to a repeatable sequence
ifail = 0
Call g05kff(genid,subid,seed,lseed,state,lstate,ifail)
! Read in the required resampling method and output type
Read (nin,*) rtype, otype
! Read in original sample size, resample size, number of samples
! and population length
Read (nin,*) n, m, nrs, lipop
If (otype==1) Then
ldisampl = m
Else
ldisampl = n
End If
Allocate (ipop(lipop),wt(n),isampl(ldisampl,nrs))
If (lipop==n) Then
! Read in the population and weights
Do i = 1, n
Read (nin,*) ipop(i), wt(i)
End Do
Else
! Read in just the weights
Do i = 1, n
Read (nin,*) wt(i)
End Do
End If
! Resample from the population using the supplied weights
ifail = -1
Call g05nff(rtype,n,wt,ipop,lipop,m,nrs,otype,isampl,ldisampl,state, &
ifail)
If (ifail==0 .Or. ifail==91) Then
! IFAIL = 91 is a warning, so we want to continue even if it occurs
! Display the results
If (otype==2) Then
Write (nout,99996) repeat(' ',3*nrs+9), 'Count for Sample'
Write (nout,99997) 'Value', (j,j=1,nrs)
Write (nout,99996) repeat('-',max(30,6*nrs+18))
Do i = 1, n
If (lipop==0) Then
Write (nout,99999) i, (isampl(i,j),j=1,nrs)
Else
Write (nout,99999) ipop(i), (isampl(i,j),j=1,nrs)
End If
End Do
Else
Write (nout,99996) repeat(' ',3*nrs), 'Sample'
Write (nout,99998)(j,j=1,nrs)
Write (nout,99996) repeat('-',6*nrs+3)
Do i = 1, m
Write (nout,99998)(isampl(i,j),j=1,nrs)
End Do
End If
End If
99999 Format (1X,I5,9X,10(1X,I5))
99998 Format (10(1X,I5))
99997 Format (2X,A,8X,10(1X,I5))
99996 Format (3A)
End Program g05nffe