annotate libcruft/STOP.patch @ 4720:e759d01692db ss-2-1-53

[project @ 2004-01-23 04:13:37 by jwe]
author jwe
date Fri, 23 Jan 2004 04:13:37 +0000
parents 8ec2d00e20e5
children 66fdc831c580
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
1 This patch replaces all STOP statements with calls to XSTOPX so that
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
2 Fortran routines won't be able to kill Octave.
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
3
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
4 If you decide not to use the versions of the Fortran subroutines that
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
5 are distributed with Octave, you might want to apply this patch (or
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
6 something like it) to your sources.
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
7
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
8 John W. Eaton
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
9 jwe@che.utexas.edu
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
10 Department of Chemical Engineering
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
11 The University of Texas at Austin
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
12
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
13
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
14 diff -rc libcruft.orig/blas/xerbla.f libcruft/blas/xerbla.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
15 *** libcruft.orig/blas/xerbla.f Wed Feb 19 21:46:03 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
16 --- libcruft/blas/xerbla.f Mon Jun 7 14:33:52 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
17 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
18 *** 35,41 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
19 *
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
20 WRITE (*,99999) SRNAME, INFO
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
21 *
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
22 ! STOP
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
23 *
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
24 99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
25 $ ' had an illegal value' )
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
26 --- 35,41 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
27 *
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
28 WRITE (*,99999) SRNAME, INFO
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
29 *
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
30 ! CALL XSTOPX (' ')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
31 *
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
32 99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
33 $ ' had an illegal value' )
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
34 diff -rc libcruft.orig/dassl/xerhlt.f libcruft/dassl/xerhlt.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
35 *** libcruft.orig/dassl/xerhlt.f Wed Feb 19 23:46:22 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
36 --- libcruft/dassl/xerhlt.f Mon Jun 7 14:34:44 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
37 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
38 *** 33,37 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
39 C***END PROLOGUE XERHLT
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
40 CHARACTER*(*) MESSG
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
41 C***FIRST EXECUTABLE STATEMENT XERHLT
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
42 ! STOP
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
43 END
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
44 --- 33,37 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
45 C***END PROLOGUE XERHLT
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
46 CHARACTER*(*) MESSG
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
47 C***FIRST EXECUTABLE STATEMENT XERHLT
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
48 ! CALL XSTOPX (MESSG)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
49 END
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
50 diff -rc libcruft.orig/misc/i1mach.f libcruft/misc/i1mach.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
51 *** libcruft.orig/misc/i1mach.f Tue Jul 21 22:31:59 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
52 --- libcruft/misc/i1mach.f Mon Jun 7 14:36:50 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
53 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
54 *** 523,527 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
55 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
56 10 WRITE(OUTPUT,1999) I
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
57 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
58 ! STOP
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
59 END
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
60 --- 523,527 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
61 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
62 10 WRITE(OUTPUT,1999) I
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
63 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
64 ! CALL XSTOPX (' ')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
65 END
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
66 diff -rc libcruft.orig/odepack/xerrwv.f libcruft/odepack/xerrwv.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
67 *** libcruft.orig/odepack/xerrwv.f Wed Feb 19 23:50:24 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
68 --- libcruft/odepack/xerrwv.f Mon Jun 7 14:38:00 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
69 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
70 *** 109,114 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
71 50 FORMAT(6X,15HIN ABOVE, R1 =,D21.13,3X,4HR2 =,D21.13)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
72 C ABORT THE RUN IF LEVEL = 2. ------------------------------------------
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
73 100 IF (LEVEL .NE. 2) RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
74 ! STOP
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
75 C----------------------- END OF SUBROUTINE XERRWV ----------------------
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
76 END
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
77 --- 109,114 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
78 50 FORMAT(6X,15HIN ABOVE, R1 =,D21.13,3X,4HR2 =,D21.13)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
79 C ABORT THE RUN IF LEVEL = 2. ------------------------------------------
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
80 100 IF (LEVEL .NE. 2) RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
81 ! CALL XSTOPX (' ')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
82 C----------------------- END OF SUBROUTINE XERRWV ----------------------
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
83 END
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
84 diff -rc libcruft.orig/ranlib/advnst.f libcruft/ranlib/advnst.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
85 *** libcruft.orig/ranlib/advnst.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
86 --- libcruft/ranlib/advnst.f Mon Jun 7 15:35:37 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
87 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
88 *** 60,66 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
89 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
90 WRITE (*,*) ' ADVNST called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
91 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
92 ! STOP ' ADVNST called before random number generator initialized'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
93
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
94 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
95 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
96 --- 60,67 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
97 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
98 WRITE (*,*) ' ADVNST called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
99 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
100 ! CALL XSTOPX
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
101 ! + (' ADVNST called before random number generator initialized')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
102
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
103 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
104 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
105 diff -rc libcruft.orig/ranlib/genbet.f libcruft/ranlib/genbet.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
106 *** libcruft.orig/ranlib/genbet.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
107 --- libcruft/ranlib/genbet.f Mon Jun 7 15:35:23 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
108 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
109 *** 67,73 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
110 IF (.NOT. (aa.LE.0.0.OR.bb.LE.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
111 WRITE (*,*) ' AA or BB <= 0 in GENBET - Abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
112 WRITE (*,*) ' AA: ',aa,' BB ',bb
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
113 ! STOP ' AA or BB <= 0 in GENBET - Abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
114
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
115 10 olda = aa
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
116 oldb = bb
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
117 --- 67,73 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
118 IF (.NOT. (aa.LE.0.0.OR.bb.LE.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
119 WRITE (*,*) ' AA or BB <= 0 in GENBET - Abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
120 WRITE (*,*) ' AA: ',aa,' BB ',bb
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
121 ! CALL XSTOPX (' AA or BB <= 0 in GENBET - Abort!')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
122
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
123 10 olda = aa
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
124 oldb = bb
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
125 diff -rc libcruft.orig/ranlib/genchi.f libcruft/ranlib/genchi.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
126 *** libcruft.orig/ranlib/genchi.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
127 --- libcruft/ranlib/genchi.f Mon Jun 7 15:35:17 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
128 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
129 *** 37,43 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
130 IF (.NOT. (df.LE.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
131 WRITE (*,*) 'DF <= 0 in GENCHI - ABORT'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
132 WRITE (*,*) 'Value of DF: ',df
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
133 ! STOP 'DF <= 0 in GENCHI - ABORT'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
134
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
135 10 genchi = 2.0*gengam(1.0,df/2.0)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
136 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
137 --- 37,43 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
138 IF (.NOT. (df.LE.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
139 WRITE (*,*) 'DF <= 0 in GENCHI - ABORT'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
140 WRITE (*,*) 'Value of DF: ',df
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
141 ! CALL XSTOPX ('DF <= 0 in GENCHI - ABORT')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
142
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
143 10 genchi = 2.0*gengam(1.0,df/2.0)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
144 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
145 diff -rc libcruft.orig/ranlib/genf.f libcruft/ranlib/genf.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
146 *** libcruft.orig/ranlib/genf.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
147 --- libcruft/ranlib/genf.f Mon Jun 7 15:35:07 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
148 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
149 *** 44,50 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
150 IF (.NOT. (dfn.LE.0.0.OR.dfd.LE.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
151 WRITE (*,*) 'Degrees of freedom nonpositive in GENF - abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
152 WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
153 ! STOP 'Degrees of freedom nonpositive in GENF - abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
154
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
155 10 xnum = genchi(dfn)/dfn
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
156 C GENF = ( GENCHI( DFN ) / DFN ) / ( GENCHI( DFD ) / DFD )
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
157 --- 44,50 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
158 IF (.NOT. (dfn.LE.0.0.OR.dfd.LE.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
159 WRITE (*,*) 'Degrees of freedom nonpositive in GENF - abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
160 WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
161 ! CALL XSTOPX ('Degrees of freedom nonpositive in GENF - abort!')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
162
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
163 10 xnum = genchi(dfn)/dfn
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
164 C GENF = ( GENCHI( DFN ) / DFN ) / ( GENCHI( DFD ) / DFD )
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
165 diff -rc libcruft.orig/ranlib/gennch.f libcruft/ranlib/gennch.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
166 *** libcruft.orig/ranlib/gennch.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
167 --- libcruft/ranlib/gennch.f Mon Jun 7 15:34:58 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
168 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
169 *** 48,54 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
170 IF (.NOT. (df.LE.1.0.OR.xnonc.LT.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
171 WRITE (*,*) 'DF <= 1 or XNONC < 0 in GENNCH - ABORT'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
172 WRITE (*,*) 'Value of DF: ',df,' Value of XNONC',xnonc
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
173 ! STOP 'DF <= 1 or XNONC < 0 in GENNCH - ABORT'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
174
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
175 10 gennch = genchi(df-1.0) + gennor(sqrt(xnonc),1.0)**2
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
176 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
177 --- 48,54 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
178 IF (.NOT. (df.LE.1.0.OR.xnonc.LT.0.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
179 WRITE (*,*) 'DF <= 1 or XNONC < 0 in GENNCH - ABORT'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
180 WRITE (*,*) 'Value of DF: ',df,' Value of XNONC',xnonc
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
181 ! CALL XSTOPX ('DF <= 1 or XNONC < 0 in GENNCH - ABORT')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
182
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
183 10 gennch = genchi(df-1.0) + gennor(sqrt(xnonc),1.0)**2
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
184 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
185 diff -rc libcruft.orig/ranlib/gennf.f libcruft/ranlib/gennf.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
186 *** libcruft.orig/ranlib/gennf.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
187 --- libcruft/ranlib/gennf.f Mon Jun 7 15:56:26 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
188 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
189 *** 56,62 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
190 WRITE (*,*) '(3) Noncentrality parameter < 0.0'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
191 WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd,'XNONC value: ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
192 + xnonc
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
193 ! STOP 'Degrees of freedom or noncent param our of range in GENNF'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
194
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
195 10 xnum = gennch(dfn,xnonc)/dfn
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
196 C GENNF = ( GENNCH( DFN, XNONC ) / DFN ) / ( GENCHI( DFD ) / DFD )
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
197 --- 56,63 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
198 WRITE (*,*) '(3) Noncentrality parameter < 0.0'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
199 WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd,'XNONC value: ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
200 + xnonc
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
201 ! CALL XSTOPX
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
202 ! + ('Degrees of freedom or noncent param our of range in GENNF')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
203
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
204 10 xnum = gennch(dfn,xnonc)/dfn
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
205 C GENNF = ( GENNCH( DFN, XNONC ) / DFN ) / ( GENCHI( DFD ) / DFD )
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
206 diff -rc libcruft.orig/ranlib/genunf.f libcruft/ranlib/genunf.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
207 *** libcruft.orig/ranlib/genunf.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
208 --- libcruft/ranlib/genunf.f Mon Jun 7 15:34:37 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
209 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
210 *** 33,39 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
211 IF (.NOT. (low.GT.high)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
212 WRITE (*,*) 'LOW > HIGH in GENUNF: LOW ',low,' HIGH: ',high
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
213 WRITE (*,*) 'Abort'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
214 ! STOP 'LOW > High in GENUNF - Abort'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
215
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
216 10 genunf = low + (high-low)*ranf()
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
217
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
218 --- 33,39 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
219 IF (.NOT. (low.GT.high)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
220 WRITE (*,*) 'LOW > HIGH in GENUNF: LOW ',low,' HIGH: ',high
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
221 WRITE (*,*) 'Abort'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
222 ! CALL XSTOPX ('LOW > High in GENUNF - Abort')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
223
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
224 10 genunf = low + (high-low)*ranf()
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
225
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
226 diff -rc libcruft.orig/ranlib/getcgn.f libcruft/ranlib/getcgn.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
227 *** libcruft.orig/ranlib/getcgn.f Wed Apr 22 08:49:00 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
228 --- libcruft/ranlib/getcgn.f Mon Jun 7 15:34:31 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
229 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
230 *** 47,53 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
231 IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
232 WRITE (*,*) ' Generator number out of range in SETCGN:',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
233 + ' Legal range is 1 to ',numg,' -- ABORT!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
234 ! STOP ' Generator number out of range in SETCGN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
235
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
236 10 curntg = g
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
237 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
238 --- 47,53 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
239 IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
240 WRITE (*,*) ' Generator number out of range in SETCGN:',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
241 + ' Legal range is 1 to ',numg,' -- ABORT!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
242 ! CALL XSTOPX (' Generator number out of range in SETCGN')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
243
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
244 10 curntg = g
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
245 RETURN
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
246 diff -rc libcruft.orig/ranlib/getsd.f libcruft/ranlib/getsd.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
247 *** libcruft.orig/ranlib/getsd.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
248 --- libcruft/ranlib/getsd.f Mon Jun 7 15:34:23 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
249 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
250 *** 62,68 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
251 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
252 WRITE (*,*) ' GETSD called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
253 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
254 ! STOP ' GETSD called before random number generator initialized'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
255
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
256 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
257 iseed1 = cg1(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
258 --- 62,69 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
259 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
260 WRITE (*,*) ' GETSD called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
261 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
262 ! CALL XSTOPX
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
263 ! + (' GETSD called before random number generator initialized')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
264
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
265 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
266 iseed1 = cg1(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
267 diff -rc libcruft.orig/ranlib/ignuin.f libcruft/ranlib/ignuin.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
268 *** libcruft.orig/ranlib/ignuin.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
269 --- libcruft/ranlib/ignuin.f Mon Jun 7 15:34:09 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
270 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
271 *** 94,100 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
272 100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
273 WRITE (*,*) ' Abort on Fatal ERROR'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
274 IF (.NOT. (err.EQ.1)) GO TO 110
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
275 ! STOP 'LOW > HIGH in IGNUIN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
276
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
277 GO TO 120
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
278
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
279 --- 94,100 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
280 100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
281 WRITE (*,*) ' Abort on Fatal ERROR'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
282 IF (.NOT. (err.EQ.1)) GO TO 110
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
283 ! CALL XSTOPX ('LOW > HIGH in IGNUIN')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
284
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
285 GO TO 120
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
286
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
287 diff -rc libcruft.orig/ranlib/initgn.f libcruft/ranlib/initgn.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
288 *** libcruft.orig/ranlib/initgn.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
289 --- libcruft/ranlib/initgn.f Mon Jun 7 15:34:03 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
290 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
291 *** 66,72 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
292 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
293 WRITE (*,*) ' INITGN called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
294 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
295 ! STOP ' INITGN called before random number generator initialized'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
296
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
297 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
298 IF ((-1).NE. (isdtyp)) GO TO 20
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
299 --- 66,73 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
300 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
301 WRITE (*,*) ' INITGN called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
302 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
303 ! CALL XSTOPX
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
304 ! + (' INITGN called before random number generator initialized')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
305
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
306 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
307 IF ((-1).NE. (isdtyp)) GO TO 20
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
308 diff -rc libcruft.orig/ranlib/mltmod.f libcruft/ranlib/mltmod.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
309 *** libcruft.orig/ranlib/mltmod.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
310 --- libcruft/ranlib/mltmod.f Mon Jun 7 15:33:49 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
311 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
312 *** 39,45 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
313 WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
314 WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
315 WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
316 ! STOP ' A, M, S out of order in MLTMOD - ABORT!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
317
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
318 10 IF (.NOT. (a.LT.h)) GO TO 20
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
319 a0 = a
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
320 --- 39,45 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
321 WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
322 WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
323 WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
324 ! CALL XSTOPX (' A, M, S out of order in MLTMOD - ABORT!')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
325
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
326 10 IF (.NOT. (a.LT.h)) GO TO 20
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
327 a0 = a
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
328 diff -rc libcruft.orig/ranlib/setant.f libcruft/ranlib/setant.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
329 *** libcruft.orig/ranlib/setant.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
330 --- libcruft/ranlib/setant.f Mon Jun 7 15:33:36 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
331 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
332 *** 65,71 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
333 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
334 WRITE (*,*) ' SETANT called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
335 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
336 ! STOP ' SETANT called before random number generator initialized'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
337
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
338 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
339 qanti(g) = qvalue
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
340 --- 65,72 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
341 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
342 WRITE (*,*) ' SETANT called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
343 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
344 ! CALL XSTOPX
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
345 ! + (' SETANT called before random number generator initialized')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
346
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
347 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
348 qanti(g) = qvalue
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
349 diff -rc libcruft.orig/ranlib/setgmn.f libcruft/ranlib/setgmn.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
350 *** libcruft.orig/ranlib/setgmn.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
351 --- libcruft/ranlib/setgmn.f Mon Jun 7 15:33:21 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
352 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
353 *** 55,61 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
354 IF (.NOT. (p.LE.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
355 WRITE (*,*) 'P nonpositive in SETGMN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
356 WRITE (*,*) 'Value of P: ',p
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
357 ! STOP 'P nonpositive in SETGMN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
358
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
359 10 parm(1) = p
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
360 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
361 --- 55,61 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
362 IF (.NOT. (p.LE.0)) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
363 WRITE (*,*) 'P nonpositive in SETGMN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
364 WRITE (*,*) 'Value of P: ',p
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
365 ! CALL XSTOPX ('P nonpositive in SETGMN')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
366
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
367 10 parm(1) = p
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
368 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
369 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
370 *** 70,76 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
371 CALL spofa(covm,p,p,info)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
372 IF (.NOT. (info.NE.0)) GO TO 30
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
373 WRITE (*,*) ' COVM not positive definite in SETGMN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
374 ! STOP ' COVM not positive definite in SETGMN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
375
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
376 30 icount = p + 1
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
377 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
378 --- 70,76 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
379 CALL spofa(covm,p,p,info)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
380 IF (.NOT. (info.NE.0)) GO TO 30
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
381 WRITE (*,*) ' COVM not positive definite in SETGMN'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
382 ! CALL XSTOPX (' COVM not positive definite in SETGMN')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
383
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
384 30 icount = p + 1
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
385 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
386 diff -rc libcruft.orig/ranlib/setsd.f libcruft/ranlib/setsd.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
387 *** libcruft.orig/ranlib/setsd.f Wed Apr 22 08:49:01 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
388 --- libcruft/ranlib/setsd.f Mon Jun 7 15:32:58 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
389 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
390 *** 62,68 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
391 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
392 WRITE (*,*) ' SETSD called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
393 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
394 ! STOP ' SETSD called before random number generator initialized'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
395
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
396 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
397 ig1(g) = iseed1
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
398 --- 62,69 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
399 IF (qrgnin()) GO TO 10
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
400 WRITE (*,*) ' SETSD called before random number generator ',
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
401 + ' initialized -- abort!'
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
402 ! CALL XSTOPX
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
403 ! + (' SETSD called before random number generator initialized')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
404
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
405 10 CALL getcgn(g)
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
406 ig1(g) = iseed1
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
407 diff -rc libcruft.orig/villad/vilerr.f libcruft/villad/vilerr.f
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
408 *** libcruft.orig/villad/vilerr.f Wed Dec 2 21:54:57 1992
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
409 --- libcruft/villad/vilerr.f Mon Jun 7 15:55:08 1993
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
410 ***************
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
411 *** 80,86 ****
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
412 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
413 C -- PROGRAM EXECUTION TERMINATES HERE
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
414 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
415 ! STOP
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
416 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
417 ELSE
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
418 END IF
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
419 --- 80,86 ----
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
420 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
421 C -- PROGRAM EXECUTION TERMINATES HERE
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
422 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
423 ! CALL XSTOPX (' ')
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
424 C
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
425 ELSE
73cca179ce1f [project @ 1993-08-08 02:09:35 by jwe]
jwe
parents:
diff changeset
426 END IF