1*  =====================================================================
2*     SUBROUTINE LADD
3*  =====================================================================
4*
5      SUBROUTINE LADD( J, K, I )
6*
7*  -- ScaLAPACK routine (version 1.7) --
8*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
9*     and University of California, Berkeley.
10*     May 1, 1997
11*
12*     .. Array Arguments ..
13      INTEGER            I(2), J(2), K(2)
14*     ..
15*
16*  =====================================================================
17*
18*     .. Parameters ..
19      INTEGER            IPOW16, IPOW15
20      PARAMETER        ( IPOW16=2**16, IPOW15=2**15 )
21*     ..
22*     .. Intrinsic Functions ..
23      INTRINSIC          MOD
24*     ..
25*     .. Executable Statements ..
26*
27      I(1) = MOD( K(1)+J(1), IPOW16 )
28      I(2) = MOD( (K(1)+J(1)) / IPOW16+K(2)+J(2), IPOW15 )
29*
30      RETURN
31*
32*     End of LADD
33*
34      END
35*
36*  =====================================================================
37*     SUBROUTINE LMUL
38*  =====================================================================
39*
40      SUBROUTINE LMUL( K, J, I )
41*
42*  -- ScaLAPACK routine (version 1.7) --
43*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
44*     and University of California, Berkeley.
45*     May 1, 1997
46*
47*     .. Array Arguments ..
48      INTEGER            I(2), J(2), K(2)
49*     ..
50*
51*  =====================================================================
52*
53*     .. Parameters ..
54      INTEGER            IPOW15, IPOW16, IPOW30
55      PARAMETER        ( IPOW15=2**15, IPOW16=2**16, IPOW30=2**30 )
56*     ..
57*     .. Local Scalars ..
58      INTEGER            KT, LT
59*     ..
60*     .. Intrinsic Functions ..
61      INTRINSIC          MOD
62*     ..
63*     .. Executable Statements ..
64*
65      KT   = K(1)*J(1)
66      IF( KT.LT.0 ) KT = (KT+IPOW30) + IPOW30
67      I(1) = MOD(KT,IPOW16)
68      LT   = K(1)*J(2) + K(2)*J(1)
69      IF( LT.LT.0 ) LT = (LT+IPOW30) + IPOW30
70      KT   = KT/IPOW16 + LT
71      IF( KT.LT.0 ) KT = (KT+IPOW30) + IPOW30
72      I(2) = MOD( KT, IPOW15 )
73*
74      RETURN
75*
76*     End of LMUL
77*
78      END
79*
80*  =====================================================================
81*     SUBROUTINE XJUMPM
82*  =====================================================================
83*
84      SUBROUTINE XJUMPM( JUMPM, MULT, IADD, IRANN, IRANM, IAM, ICM )
85*
86*  -- ScaLAPACK routine (version 1.7) --
87*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
88*     and University of California, Berkeley.
89*     May 1, 1997
90*
91*     .. Scalar Arguments ..
92      INTEGER            JUMPM
93*     ..
94*     .. Array Arguments ..
95      INTEGER            IADD(2), IAM(2), ICM(2), IRANM(2), IRANN(2)
96      INTEGER            MULT(2)
97*     ..
98*
99*  =====================================================================
100*
101*     .. Local Scalars ..
102      INTEGER            I
103*     ..
104*     .. Local Arrays ..
105      INTEGER            J(2)
106*     ..
107*     .. External Subroutines ..
108      EXTERNAL           LADD, LMUL
109*     ..
110*     .. Executable Statements ..
111*
112      IF( JUMPM.GT.0 ) THEN
113         DO 10 I = 1, 2
114            IAM(I) = MULT(I)
115            ICM(I) = IADD(I)
116   10    CONTINUE
117         DO 20 I = 1, JUMPM-1
118            CALL LMUL( IAM, MULT, J )
119            IAM(1) = J(1)
120            IAM(2) = J(2)
121            CALL LMUL( ICM, MULT, J )
122            CALL LADD( IADD, J, ICM )
123   20    CONTINUE
124         CALL LMUL( IRANN, IAM, J )
125         CALL LADD( J, ICM, IRANM )
126      ELSE
127         IRANM(1) = IRANN(1)
128         IRANM(2) = IRANN(2)
129      END IF
130*
131      RETURN
132*
133*     End of XJUMPM
134*
135      END
136*
137*  =====================================================================
138*     SUBROUTINE SETRAN
139*  =====================================================================
140*
141      SUBROUTINE SETRAN( IRAN, IA, IC )
142*
143*  -- ScaLAPACK routine (version 1.7) --
144*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
145*     and University of California, Berkeley.
146*     May 1, 1997
147*
148*     .. Array Arguments ..
149      INTEGER            IA(2),  IC(2), IRAN(2)
150*     ..
151*
152*  =====================================================================
153*
154*     .. Local Scalars ..
155      INTEGER            I
156*     ..
157*     .. Local Arrays ..
158      INTEGER            IAS(2),  ICS(2), IRAND(2)
159*     ..
160*     .. Common Blocks ..
161      COMMON /RANCOM/    IRAND, IAS, ICS
162      SAVE   /RANCOM/
163*     ..
164*     .. Executable Statements ..
165*
166      DO 10 I = 1, 2
167         IRAND(I) = IRAN(I)
168         IAS(I)   = IA(I)
169         ICS(I)   = IC(I)
170   10 CONTINUE
171*
172      RETURN
173*
174*     End of SETRAN
175*
176      END
177*
178*  =====================================================================
179*     SUBROUTINE JUMPIT
180*  =====================================================================
181*
182      SUBROUTINE JUMPIT( MULT, IADD, IRANN, IRANM )
183*
184*  -- ScaLAPACK routine (version 1.7) --
185*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
186*     and University of California, Berkeley.
187*     May 1, 1997
188*
189*     .. Array Arguments ..
190      INTEGER            IADD(2), IRANM(2), IRANN(2), MULT(2)
191*     ..
192*
193*  =====================================================================
194*
195*     .. Local Arrays ..
196      INTEGER            IAS(2), ICS(2), IRAND(2), J(2)
197*     ..
198*     .. External Subroutines ..
199      EXTERNAL           LADD, LMUL
200*     ..
201*     .. Common Blocks ..
202      COMMON /RANCOM/    IRAND, IAS, ICS
203      SAVE   /RANCOM/
204*     ..
205*     .. Executable Statements ..
206*
207      CALL LMUL( IRANN, MULT, J )
208      CALL LADD( J, IADD, IRANM )
209*
210      IRAND(1) = IRANM(1)
211      IRAND(2) = IRANM(2)
212*
213      RETURN
214*
215*     End of JUMPIT
216*
217      END
218*
219*  =====================================================================
220*     REAL FUNCTION PSRAND
221*  =====================================================================
222*
223      REAL FUNCTION PSRAND( IDUMM )
224*
225*  -- ScaLAPACK routine (version 1.7) --
226*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
227*     and University of California, Berkeley.
228*     May 1, 1997
229*
230*     .. Scalar Arguments ..
231      INTEGER            IDUMM
232*     ..
233*
234*  =====================================================================
235*
236*     .. Parameters ..
237      REAL               DIVFAC, POW16
238      PARAMETER          ( DIVFAC=2.147483648E+9, POW16=6.5536E+4 )
239*     ..
240*     .. Local Arrays ..
241      INTEGER            J( 2 )
242*     ..
243*     .. External Subroutines ..
244      EXTERNAL           LADD, LMUL
245*     ..
246*     .. Intrinsic Functions ..
247      INTRINSIC          REAL
248*     ..
249*     .. Common Blocks ..
250      INTEGER            IAS(2), ICS(2), IRAND(2)
251      COMMON /RANCOM/    IRAND, IAS, ICS
252      SAVE   /RANCOM/
253*     ..
254*     .. Executable Statements ..
255*
256      PSRAND = ( REAL(IRAND(1)) + POW16 * REAL(IRAND(2)) ) / DIVFAC
257*
258      CALL LMUL( IRAND, IAS, J )
259      CALL LADD( J, ICS, IRAND )
260*
261      RETURN
262*
263*     End of PSRAND
264*
265      END
266*
267*  =====================================================================
268*     DOUBLE PRECISION FUNCTION PDRAND
269*  =====================================================================
270*
271      DOUBLE PRECISION FUNCTION PDRAND( IDUMM )
272*
273*  -- ScaLAPACK routine (version 1.7) --
274*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
275*     and University of California, Berkeley.
276*     May 1, 1997
277*
278*     .. Scalar Arguments ..
279      INTEGER            IDUMM
280*     ..
281*
282*  =====================================================================
283*
284*     .. Parameters ..
285      DOUBLE PRECISION   DIVFAC, POW16
286      PARAMETER          ( DIVFAC=2.147483648D+9, POW16=6.5536D+4 )
287*     ..
288*     .. Local Arrays ..
289      INTEGER            J(2)
290*     ..
291*     .. External Subroutines ..
292      EXTERNAL           LADD, LMUL
293*     ..
294*     .. Intrinsic Functions ..
295      INTRINSIC          DBLE
296*     ..
297*     .. Common Blocks ..
298      INTEGER            IAS(2), ICS(2), IRAND(2)
299      COMMON /RANCOM/    IRAND, IAS, ICS
300      SAVE   /RANCOM/
301*     ..
302*     .. Executable Statements ..
303*
304      PDRAND = ( DBLE(IRAND(1)) + POW16 * DBLE(IRAND(2)) ) / DIVFAC
305*
306      CALL LMUL( IRAND, IAS, J )
307      CALL LADD( J, ICS, IRAND )
308*
309      RETURN
310*
311*     End of PDRAND
312*
313      END
314