1 SUBROUTINE setsd(iseed1,iseed2) 2C********************************************************************** 3C 4C SUBROUTINE SETSD(ISEED1,ISEED2) 5C SET S-ee-D of current generator 6C 7C Resets the initial seed of the current generator to ISEED1 and 8C ISEED2. The seeds of the other generators remain unchanged. 9C 10C This is a transcription from Pascal to Fortran of routine 11C Set_Seed from the paper 12C 13C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package 14C with Splitting Facilities." ACM Transactions on Mathematical 15C Software, 17:98-111 (1991) 16C 17C 18C Arguments 19C 20C 21C ISEED1 -> First integer seed 22C INTEGER ISEED1 23C 24C ISEED2 -> Second integer seed 25C INTEGER ISEED1 26C 27C********************************************************************** 28C .. Parameters .. 29 INTEGER*4 numg 30 PARAMETER (numg=32) 31C .. 32C .. Scalar Arguments .. 33 INTEGER*4 iseed1,iseed2 34C .. 35C .. Scalars in Common .. 36 INTEGER*4 a1,a1vw,a1w,a2,a2vw,a2w,m1,m2 37C .. 38C .. Arrays in Common .. 39 INTEGER*4 cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg), 40 + lg2(numg) 41 LOGICAL qanti(numg) 42C .. 43C .. Local Scalars .. 44 INTEGER*4 g 45C .. 46C .. External Functions .. 47 LOGICAL qrgnin 48 EXTERNAL qrgnin 49C .. 50C .. External Subroutines .. 51 EXTERNAL getcgn,initgn 52C .. 53C .. Common blocks .. 54 COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1, 55 + cg2,qanti 56C .. 57C .. Save statement .. 58 SAVE /globe/ 59C .. 60C .. Executable Statements .. 61C Abort unless random number generator initialized 62 IF (qrgnin()) GO TO 10 63 WRITE (*,*) ' SETSD called before random number generator ', 64 + ' initialized -- abort!' 65 CALL XSTOPX 66 + (' SETSD called before random number generator initialized') 67 68 10 CALL getcgn(g) 69 ig1(g) = iseed1 70 ig2(g) = iseed2 71 CALL initgn(-1) 72 RETURN 73 74 END 75