GEANT321/gparal/gpdefrng.F

   1 *CMZ :          26/02/96  11.38.47  by  S.Ravndal
   2 *-- Author :
   3 C------------------------------------------------------------------------
   4 c     gpdefrng( ibase )
   5 c
   6 c     Modified: November 6, 1995  J.A. to provide more flexibility by
   7 c                                       including argument
   8 c
   9 c     Function: Provide seeds for the pseudo-random number
  10 c                 generator different on each node
  11 c               If ibase <= 0 default sequences are used.
  12 c
  13 c     Should be called to provide a default seeding.
  14 c     Only currently available for RANECU/GRNDM.
  15 c
  16 c     ibase=  the RNG sequence for first node.
  17 c             If ibase=0 a system default is used.
  18 c
  19 C     called by:  <USER>, uginit, (if CERNLIB_PARA switch is used)
  20 C------------------------------------------------------------------------
  21 #if defined(CERNLIB_PARA)
  22       subroutine gpdefrng( ibase )
  23       implicit none
  24       integer ibase
  25
  26 C--------------------------------------------------------------
  27 C     Must be called in uginit only after other routines that do the
  28 C   default RNG seeding for sequential machines
  29 C   have been called (ie after ginit) ... see example uginit
  30 C--------------------------------------------------------------
  31 #include "geant321/mpifinc.inc"
  32 #include "geant321/multiprox.inc"
  33 #include "geant321/multseeds.inc"
  34 #include "geant321/gcflag.inc"
  35 #include "geant321/gcunit.inc"
  36       integer ibasedef, lunerr
  37       data    ibasedef / 1 /
  38       integer msgerror, rngerror
  39       data    msgerror, rngerror / 0, 0 /
  40 c----------------------------------------------------------------------------
  41 c     Random number generator seeding:
  42 c
  43 c     Set the seeds on each node for the start of a different sequence.
  44 c----------------------------------------------------------------------------
  45 c     Done for RANECU
  46 c----------------------------------------------------------------------------
  47
  48       if ( ibase .lt. 0 ) then
  49           ibase = 0
  50           write( chmail, '(a,a,i4,a)' )
  51      $         ' Warning: gpdefrng: ibase < 0 is invalid. Value =',
  52      $         ibase , ' Reset to zero '
  53           call gmail(1,1)
  54       endif
  55       if ( ibase .eq. 0 ) then
  56           ibase = ibasedef
  57       endif
  58
  59 C     We check to see if the resulting sequence is valid for RANECU
  60
  61       iseqnc = ibase + nprank
  62       if( (iseqnc .gt.0 ) .and. (iseqnc .le. 215 )) then
  63           call GRNDMQ( iseeda, iseedb, iseqnc, 'Q' )
  64           write (*,*)  ' Node ', nprank, ' init-ed seq ', iseqnc,
  65      &              ' and got seeds ', iseeda, iseedb
  66           call GRNDMQ( iseeda, iseedb, iseqnc, 'S' )
  67       else
  68           write (lunerr, *) ' Node ', nprank, ': in GRNDMQ exceeds ',
  69      &        ' number of rng sequences with precalculated seeds.'
  70           rngerror = 1
  71
  72 c         --- Other Possibility: ---
  73 c         write (lunerr, *) ' Node ', nprank, ':    wrapping around ... '
  74 c         iseqnc = mod( iseqnc, 215 ) + 1
  75 c         call GRNDMQ( iseeda, iseedb, iseqnc, 'Q' )
  76       endif
  77 #if defined(CERNLIB_PARA_RANMAR)
  78 c----------------------------------------------------------------------------
  79 c     In the case that RANMAR is used
  80 c
  81 c----------------------------------------------------------------------------
  82       ibase  = nrndm(1)
  83       iseeda = ibase * 100 + nprank
  84       iseqnc = 1
  85 c
  86 c     As changed by Stic/Delphi only the first parameter is used.
  87 c
  88       call GRNDMQ( iseeda, iseedb, iseqnc, 'S' )
  89 c
  90 #endif
  91       return
  92       end
  93 #endif
  94