GEANT321/gparal/gpwriterng.F

   1 *CMZ :          26/02/96  11.38.47  by  S.Ravndal
   2 *-- Author :
   3 C------------------------------------------------------------------------
   4 C     gpwriterng( lunwrite, filename, ierr )
   5 C
   6 C     Function: write out the state of the pseudo random number
   7 C               generator on all the nodes into a file.
   8 C
   9 c     A convention: if lunwrite is >= 0, use that unit.
  10 c       If not, create a new 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 #if defined(CERNLIB_PARA)
  20       subroutine gpwriterng( lunwrite, filename, ierr )
  21       implicit none
  22       integer lunwrite, ierr
  23       character filename*(*)
  24
  25 #include "geant321/mpifinc.inc"
  26 #include "geant321/multseeds.inc"
  27       integer    numprocs, nrank, nleader
  28       integer    MAXNODES, SEEDS_PER_SEQ
  29       parameter (MAXNODES=4096)
  30       character*12 chNameRng
  31
  32 c     In order to accomodate RANMAR, which has the largest table of seeds.
  33       parameter (SEEDS_PER_SEQ=103)
  34
  35 c     For  RANECU it would be enough: (SEEDS_PER_SEQ=2).
  36 c     For ranlux            parameter (SEEDS_PER_SEQ= 25)
  37
  38       integer   myseeds(SEEDS_PER_SEQ)
  39       integer   iseedrng( SEEDS_PER_SEQ, MAXNODES )
  40 c     version of the seed file format
  41       real   version
  42       integer nsubseq, numperseq, nperline
  43       integer lunwr, lunerr
  44       integer isubseq, inumb, imax, ino
  45       data  version / 1.0 /
  46
  47       if (lunwrite .lt. 0) then
  48 c     Default number
  49           lunwr= 74
  50           open (unit=lunwr, file=filename )
  51       else
  52           lunwr= lunwrite
  53       endif
  54
  55 c     Make sure to go to the start of the file
  56 c
  57       rewind( lunwr )
  58 #if defined(CERNLIB_PARA_RANECU)
  59 c     -----------------------------------------------------------------
  60 c     The RANECU pseudo random number generator, used by GEANT's GRNDM.
  61 c     -----------------------------------------------------------------
  62 #if !defined(CERNLIB_PARA_TASKRNG)
  63 c     Currently the number of sequences is the number of processors!
  64       call gprocs( numprocs, nrank, nleader )
  65       nsubseq=   numprocs
  66
  67       if( numprocs .gt. MAXNODES ) then
  68          write(*, *) 'GPwriteRng: ERROR Too many nodes ', numprocs
  69          ierr= -101
  70          goto 9999
  71       endif
  72
  73 #endif
  74       chnamerng= 'RANECU'
  75       numperseq= 2              !  2 "seed" integers per RANECU sequence
  76       nperline=  2              !  2 numbers per line
  77 #endif
  78 #if defined(CERNLIB_PARA_RANMAR)
  79       chnamerng= 'RANMAR'
  80       numperseq= 103            !  103 "seed" integers per RANMAR sequence
  81       nperline=  5              !    5 numbers per line
  82 #endif
  83 #if defined(CERNLIB_PARA_RANLUX)
  84       chnamerng= 'RANLUX'
  85       numperseq= 25             !   25 "seed" integers per RANMAR sequence
  86       nperline=  5              !    5 numbers per line
  87 #endif
  88
  89 c     "Gather" all seeds to node 0
  90 c
  91 #if defined(CERNLIB_PARA_RANECU)
  92 #if !defined(CERNLIB_PARA_TASKRNG)
  93 c     In this version there is one sequence per node
  94       call grndmq( myseeds(1), myseeds(2), iseqnc, 'G' )
  95
  96       if (numperseq .gt. SEEDS_PER_SEQ ) then
  97           ierr= -102
  98           goto 9999
  99       endif
 100
 101 c     The following has all nodes send their seed, and node 0 collect them.
 102 c      It should work if  numperseq <= SEEDS_PER_SEQ
 103 c
 104       call MPI_Gather( myseeds, numperseq, MPI_INTEGER, iseedrng,
 105      $     SEEDS_PER_SEQ, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
 106 c
 107       if ( ierr .gt. 0 ) then
 108          write( lunerr, '(a,i,a)' ) 'GpWr(iteRng)Seeds: Error ', ierr,
 109      $        ' in Mpi_gather '
 110          goto 9999
 111       endif
 112 #endif
 113 #endif
 114 c     Write out the header and then all the seeds, on node 0 only !!
 115 c
 116       if ( nrank .eq. 0   ) then
 117           write(lunwr, 900 ) 'Version ', version,
 118      $         ' of pRNG seed file for parallel Geant '
 119
 120           write(lunwr, 905)  'RNG    ',   chNameRng,
 121      $         ' Identity of pseudorandom Number generator '
 122           write(lunwr, 910)  'SUBSEQ   ',   nsubseq,
 123      $         ' Number  of  subsequences '
 124           write(lunwr, 910)  'NOPERSEQ ', numperseq,
 125      $         ' Numbers per subsequence '
 126           write(lunwr, 910)  'NPERLINE ', nperline,
 127      $         ' Numbers per line '
 128           write(lunwr, 920)  'ENDPROLOG'
 129
 130
 131           DO isubseq= 1, nsubseq
 132               write(lunwr, 930 )  ' Subsequence ' , isubseq
 133               DO inumb= 1, numperseq, nperline
 134                  imax=max(inumb+nperline-1,numperseq)
 135                  write( lunwr, 940 ) ( iseedrng( ino, isubseq ),
 136      $               ino=inumb, imax)
 137               ENDDO
 138           ENDDO
 139
 140           if (lunwrite .lt. 0) then
 141               close (unit=lunwr)
 142           endif
 143
 144       endif
 145
 146  900  format( a8, f5.2, a )
 147  905  format( a7, a12, a )
 148  910  format( a9, i6, a )
 149  920  format( a )
 150  930  format( a14, i6 )
 151  940  format( 8i15 )
 152
 153
 154 9999  continue
 155
 156       return
 157       end
 158 #endif