PROGRAM g05nefe ! G05NEF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g05kff, g05nef, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: lseed = 1, nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: genid, i, ifail, lipop, lstate, m, & n, subid CHARACTER (1) :: order, pop ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: wt(:) INTEGER, ALLOCATABLE :: ipop(:), isampl(:), state(:) INTEGER :: seed(lseed) ! .. Executable Statements .. WRITE (nout,*) 'G05NEF 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 initialiser to get size of 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 population size, sample size and order READ (nin,*) n, m, pop READ (nin,*) order SELECT CASE (pop) CASE ('S','s') lipop = n CASE DEFAULT lipop = 0 END SELECT ALLOCATE (ipop(lipop),wt(n),isampl(m)) 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 ! Generate the sample without replacement, unequal weights CALL g05nef(order,wt,pop,ipop,n,isampl,m,state,ifail) ! Display the results WRITE (nout,99999) (isampl(i),i=1,m) 99999 FORMAT (10(1X,I4)) END PROGRAM g05nefe