GEANT321/gparal/gpreadrng.F

   1 *CMZ :          26/02/96  11.38.47  by  S.Ravndal
   2 *-- Author :
   3 C------------------------------------------------------------------------
   4 C     SUBROUTINE gpreadrng( lunread, filename, ierr )
   5 C
   6 C     Function: read a file containing a state of the pseudo random number
   7 C               generator on all the nodes and set the RNG seeds using it.
   8 c
   9 c     A convention: if lunread is >= 0, use that unit.
  10 c     If not, read from the file called <filename>
  11 c
  12 C     Possible error codes:
  13 c         ierr= -102         The number of seeds required for a subsequence of
  14 c                            the RNG (numperseq) is more than allocated
  15 c                            in the array iseedrng (SEEDS_PER_SEQ)
  16 c
  17 c     called by:  <USER> (if PARALLEL switch is used)
  18 c
  19 c     Author:     John Apostolakis,  January 1996.
  20 c
  21 c     Last Modified: February 22, 1996   J.A.
  22 c------------------------------------------------------------------------
  23 #if defined(CERNLIB_PARA)
  24       subroutine gpreadrng( lunread, filename, ierr )
  25       implicit none
  26 #if defined(CERNLIB_PARA_COMM)
  27 #include "geant321/mpifinc.inc"
  28 #endif
  29       integer lunread, ierr
  30       character filename*(*)
  31 c     Containes iseeda, iseedb, iseqnc
  32 #include "geant321/multseeds.inc"
  33       integer    numprocs, nrank, nleader
  34       integer    MAXNODES, SEEDS_PER_SEQ
  35       parameter (MAXNODES=4096)
  36 c     RANMAR
  37       parameter (SEEDS_PER_SEQ=103)
  38
  39       integer   myseeds(SEEDS_PER_SEQ)
  40       integer   iseedrng( SEEDS_PER_SEQ, MAXNODES )
  41
  42 #include "geant321/gcunit.inc"
  43 c     version of the seed file format
  44       real   version, versionrd
  45       integer nsubseq, numperseq, nperline, nsubseqexp, nsubseqrd
  46       integer lunrd, lunerr
  47       integer isubseq, inumb, imax, ino, ichkerr(4), iia, iseqrd
  48       character*12 chSUBSEQ, chNOPERSEQ, chNPERLINE, chENDPROLOG,
  49      $     chsubsequence , chVersion
  50       character*12 chNameRng, chNameRead, chIdRng
  51       data  version / 1.0 /
  52
  53       lunerr= lout
  54
  55       if (lunread .lt. 0) then
  56           lunrd= 74   !! Some number ...
  57           open (unit=lunrd, file=filename, status='old')
  58       else
  59           lunrd= lunread
  60       endif
  61
  62 c #if defined(CERNLIB_PARA_RANECU)
  63 c     if( ParaRng .eq. 'RANECU' )
  64 c     --------------------------------------------------------------------
  65 c     The RANECU pseudo random number generator, used by GEANT's GRNDM(Q).
  66 c     --------------------------------------------------------------------
  67 #if  !defined(CERNLIB_PARA_TASKRNG)
  68 c     Currently the number of sequences must be the number of processors!
  69       call gprocs( numprocs, nrank, nleader )
  70       nsubseqexp=  numprocs
  71
  72       if( numprocs .gt. MAXNODES )then
  73 c        write(lunerr, *) 'GPreadRng: ERROR Too many nodes ', numprocs
  74          write(*, *) 'GPreadRng: ERROR Too many nodes ', numprocs
  75       endif
  76 #endif
  77       chnamerng= 'RANECU'
  78       numperseq= 2              !  2 "seed" integers per RANECU sequence
  79       nperline=  2              !  2 numbers per line
  80 c #endif
  81
  82 #if defined(CERNLIB_PARA_RANMAR)
  83 #endif
  84
  85       read ( lunrd, 905 )  chVersion, versionrd
  86  905  format( a8, f5.2, a )
  87       write ( *, * ) ' Reading seedfile version ', version
  88
  89       read(lunrd, 910) chIdRng,    chNameRead
  90  910  format( a7, a12 )
  91       read(lunrd, 920) chSUBSEQ,   nsubseqrd
  92  920  format( a9, i6 )
  93       read(lunrd, 920) chNOPERSEQ, numperseq
  94       read(lunrd, 920) chNPERLINE, nperline
  95       read(lunrd, 930) chENDPROLOG
  96  930  format( a9 )
  97
  98 c     Check that the strings before the values were correctly read in.
  99 c
 100       call checkstr( chSUBSEQ,    'SUBSEQ ',   7,
 101      $     'Number  of  subsequences ', ichkerr(1) )
 102       call checkstr( chNOPERSEQ,  'NOPERSEQ ', 9,
 103      $     ' Numbers per subsequence ',  ichkerr(2) )
 104       call checkstr( chNPERLINE,  'NPERLINE ', 9,
 105      $     ' Numbers per line ',         ichkerr(3) )
 106       call checkstr( chENDPROLOG, 'ENDPROLOG', 9,
 107      $     ' No variable to be read ',   ichkerr(4) )
 108       DO iia=1,4
 109           IF( ichkerr(iia) .ne. 0 ) then
 110              write(*,*) ' GpReadRng : STOPping because of error ',
 111      $            '  in reading overall header, part ', iia
 112              stop
 113           ENDIF
 114       ENDDO
 115
 116 C     CHECK the VALUES read in
 117 C
 118       IF ( nsubseqexp .ne. nsubseqrd ) THEN
 119          write(*,*)
 120      $        ' GpReadRng: Error: Mismatch in number of subsequences, ',
 121      $        ' expected = ' , nsubseqexp, ' file = ', nsubseqrd
 122          IF ( nsubseqexp .lt. nsubseqrd ) THEN
 123             write(*,*) ' Enough seeds to work with, continuing '
 124             nsubseq= nsubseqexp
 125          ELSE
 126             write(*,*) ' Not enough subsequences, aborting '
 127             call gpabort()
 128          ENDIF
 129       ELSE
 130          nsubseq= nsubseqexp
 131       ENDIF
 132
 133 c     Now read in the values from each subsequence
 134 c
 135       DO isubseq= 1, nsubseq
 136           read(lunrd, 970 )  chSubsequence, iseqrd
 137           call checkstr( chSubsequence, ' Subsequence', 11,
 138      $         ' Which of the Subsequences ', ichkerr(1) )
 139           IF( (ichkerr(1).ne.0) .or. (iseqrd .ne. isubseq) ) then
 140              write(*,*) ' GpReadRng : STOPping because of error ',
 141      $                    ' in reading subsequence header '
 142              write(*,*) ' chSubsequence=/', chSubsequence, '/, iseqrd=',
 143      $                    iseqrd, ' iseq-expected= ', isubseq
 144              stop
 145           ENDIF
 146           DO inumb= 1, numperseq, nperline
 147              imax=max(inumb+nperline-1,numperseq)
 148              read( lunrd, 980 ) ( iseedrng( ino, isubseq ),
 149      $            ino=inumb, imax)
 150           ENDDO
 151       ENDDO
 152  970  format( a14, i6 )
 153  980  format( 8i15 )
 154 #if defined(CERNLIB_PARA_RANECU)
 155 #if !defined(CERNLIB_PARA_TASKRNG)
 156
 157 #if defined(CERNLIB_PARA_COMM)
 158 c     Now "scatter" all seeds from node 0 to all the nodes
 159 c
 160 c     if numperseq < SEEDS_PER_SEQ the following should still work.
 161 c
 162       call MPI_Scatter( iseedrng, SEEDS_PER_SEQ, MPI_INTEGER,
 163      $                  myseeds,  numperseq,     MPI_INTEGER,
 164      $                  0, MPI_COMM_WORLD, ierr)
 165 c
 166       if ( ierr .gt. 0 ) then
 167          write( lunerr, '(a,i,a)' ) 'GpDefRng: Error ', ierr,
 168      $        ' in Mpi_gather '
 169       endif
 170 #else
 171 c     Else each node selects its seeds ...
 172 c
 173       DO inumb= 1, numperseq
 174           myseeds( inumb )= iseedrng( inumb, nrank+1 )
 175       ENDDO
 176 #endif
 177
 178 c     Set the pRNG seeds (In this version there is one sequence per node)
 179       call grndmq( myseeds(1), myseeds(2), iseqnc, 'S' )
 180 #endif
 181 #endif
 182       if (lunread .lt. 0) then
 183           close (unit=lunrd)
 184       endif
 185
 186       return
 187       end
 188 #else
 189       SUBROUTINE GPREADRNG_DUMMY
 190       END
 191 #endif