Mercurial > hg > octave-thorsten

comparison libcruft/STOP.patch @ 6:73cca179ce1f

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