This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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