00001 SUBROUTINE setall(iseed1,iseed2) 00002 C********************************************************************** 00003 C 00004 C SUBROUTINE SETALL(ISEED1,ISEED2) 00005 C SET ALL random number generators 00006 C 00007 C Sets the initial seed of generator 1 to ISEED1 and ISEED2. The 00008 C initial seeds of the other generators are set accordingly, and 00009 C all generators states are set to these seeds. 00010 C 00011 C This is a transcription from Pascal to Fortran of routine 00012 C Set_Initial_Seed from the paper 00013 C 00014 C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package 00015 C with Splitting Facilities." ACM Transactions on Mathematical 00016 C Software, 17:98-111 (1991) 00017 C 00018 C 00019 C Arguments 00020 C 00021 C 00022 C ISEED1 -> First of two integer seeds 00023 C INTEGER ISEED1 00024 C 00025 C ISEED2 -> Second of two integer seeds 00026 C INTEGER ISEED1 00027 C 00028 C********************************************************************** 00029 C .. Parameters .. 00030 INTEGER numg 00031 PARAMETER (numg=32) 00032 C .. 00033 C .. Scalar Arguments .. 00034 INTEGER iseed1,iseed2 00035 LOGICAL qssd 00036 C .. 00037 C .. Scalars in Common .. 00038 INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2 00039 C .. 00040 C .. Arrays in Common .. 00041 INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg), 00042 + lg2(numg) 00043 LOGICAL qanti(numg) 00044 C .. 00045 C .. Local Scalars .. 00046 INTEGER g,ocgn 00047 LOGICAL qqssd 00048 C .. 00049 C .. External Functions .. 00050 INTEGER mltmod 00051 LOGICAL qrgnin 00052 EXTERNAL mltmod,qrgnin 00053 C .. 00054 C .. External Subroutines .. 00055 EXTERNAL getcgn,initgn,inrgcm,setcgn 00056 C .. 00057 C .. Common blocks .. 00058 COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1, 00059 + cg2,qanti 00060 C .. 00061 C .. Save statement .. 00062 SAVE /globe/,qqssd 00063 C .. 00064 C .. Data statements .. 00065 DATA qqssd/.FALSE./ 00066 C .. 00067 C .. Executable Statements .. 00068 C 00069 C TELL IGNLGI, THE ACTUAL NUMBER GENERATOR, THAT THIS ROUTINE 00070 C HAS BEEN CALLED. 00071 C 00072 qqssd = .TRUE. 00073 CALL getcgn(ocgn) 00074 C 00075 C Initialize Common Block if Necessary 00076 C 00077 IF (.NOT. (qrgnin())) CALL inrgcm() 00078 ig1(1) = iseed1 00079 ig2(1) = iseed2 00080 CALL initgn(-1) 00081 DO 10,g = 2,numg 00082 ig1(g) = mltmod(a1vw,ig1(g-1),m1) 00083 ig2(g) = mltmod(a2vw,ig2(g-1),m2) 00084 CALL setcgn(g) 00085 CALL initgn(-1) 00086 10 CONTINUE 00087 CALL setcgn(ocgn) 00088 RETURN 00089 00090 ENTRY rgnqsd(qssd) 00091 C********************************************************************** 00092 C 00093 C SUBROUTINE RGNQSD 00094 C Random Number Generator Query SeeD set? 00095 C 00096 C Returns (LOGICAL) QSSD as .TRUE. if SETALL has been invoked, 00097 C otherwise returns .FALSE. 00098 C 00099 C********************************************************************** 00100 qssd = qqssd 00101 RETURN 00102 00103 END
1.7.1
