Mercurial > hg > octave-lyh
diff libcruft/STOP.patch @ 6:73cca179ce1f
[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 |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/libcruft/STOP.patch @@ -0,0 +1,480 @@ +This patch replaces all STOP statements with calls to XSTOPX so that +Fortran routines won't be able to kill Octave. + +If you decide not to use the versions of the Fortran subroutines that +are distributed with Octave, you might want to apply this patch (or +something like it) to your sources. + +John W. Eaton +jwe@che.utexas.edu +Department of Chemical Engineering +The University of Texas at Austin + + +diff -rc libcruft.orig/blas/xerbla.f libcruft/blas/xerbla.f +*** libcruft.orig/blas/xerbla.f Wed Feb 19 21:46:03 1992 +--- libcruft/blas/xerbla.f Mon Jun 7 14:33:52 1993 +*************** +*** 35,41 **** + * + WRITE (*,99999) SRNAME, INFO + * +! STOP + * + 99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2, + $ ' had an illegal value' ) +--- 35,41 ---- + * + WRITE (*,99999) SRNAME, INFO + * +! CALL XSTOPX (' ') + * + 99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2, + $ ' had an illegal value' ) +diff -rc libcruft.orig/dassl/xerhlt.f libcruft/dassl/xerhlt.f +*** libcruft.orig/dassl/xerhlt.f Wed Feb 19 23:46:22 1992 +--- libcruft/dassl/xerhlt.f Mon Jun 7 14:34:44 1993 +*************** +*** 33,37 **** + C***END PROLOGUE XERHLT + CHARACTER*(*) MESSG + C***FIRST EXECUTABLE STATEMENT XERHLT +! STOP + END +--- 33,37 ---- + C***END PROLOGUE XERHLT + CHARACTER*(*) MESSG + C***FIRST EXECUTABLE STATEMENT XERHLT +! CALL XSTOPX (MESSG) + END +diff -rc libcruft.orig/misc/i1mach.f libcruft/misc/i1mach.f +*** libcruft.orig/misc/i1mach.f Tue Jul 21 22:31:59 1992 +--- libcruft/misc/i1mach.f Mon Jun 7 14:36:50 1993 +*************** +*** 523,527 **** + RETURN + 10 WRITE(OUTPUT,1999) I + 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10) +! STOP + END +--- 523,527 ---- + RETURN + 10 WRITE(OUTPUT,1999) I + 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10) +! CALL XSTOPX (' ') + END +diff -rc libcruft.orig/npsol/mcenv2.f libcruft/npsol/mcenv2.f +*** libcruft.orig/npsol/mcenv2.f Sun Oct 25 23:36:33 1992 +--- libcruft/npsol/mcenv2.f Mon Jun 7 14:36:21 1993 +*************** +*** 134,140 **** + END IF + ELSE + WRITE( NOUT, 9999 ) +! STOP + END IF + ELSE + IF( NGPMIN.EQ.GPMIN )THEN +--- 134,140 ---- + END IF + ELSE + WRITE( NOUT, 9999 ) +! CALL XSTOPX (' ') + END IF + ELSE + IF( NGPMIN.EQ.GPMIN )THEN +*************** +*** 148,154 **** + END IF + ELSE + WRITE( NOUT, 9999 ) +! STOP + END IF + IF( NGNMIN.EQ.GNMIN )THEN + LEMIN2 = NGNMIN +--- 148,154 ---- + END IF + ELSE + WRITE( NOUT, 9999 ) +! CALL XSTOPX (' ') + END IF + IF( NGNMIN.EQ.GNMIN )THEN + LEMIN2 = NGNMIN +*************** +*** 161,167 **** + END IF + ELSE + WRITE( NOUT, 9999 ) +! STOP + END IF + LEMIN = MAX( LEMIN1, LEMIN2 ) + END IF +--- 161,167 ---- + END IF + ELSE + WRITE( NOUT, 9999 ) +! CALL XSTOPX (' ') + END IF + LEMIN = MAX( LEMIN1, LEMIN2 ) + END IF +diff -rc libcruft.orig/odepack/xerrwv.f libcruft/odepack/xerrwv.f +*** libcruft.orig/odepack/xerrwv.f Wed Feb 19 23:50:24 1992 +--- libcruft/odepack/xerrwv.f Mon Jun 7 14:38:00 1993 +*************** +*** 109,114 **** + 50 FORMAT(6X,15HIN ABOVE, R1 =,D21.13,3X,4HR2 =,D21.13) + C ABORT THE RUN IF LEVEL = 2. ------------------------------------------ + 100 IF (LEVEL .NE. 2) RETURN +! STOP + C----------------------- END OF SUBROUTINE XERRWV ---------------------- + END +--- 109,114 ---- + 50 FORMAT(6X,15HIN ABOVE, R1 =,D21.13,3X,4HR2 =,D21.13) + C ABORT THE RUN IF LEVEL = 2. ------------------------------------------ + 100 IF (LEVEL .NE. 2) RETURN +! CALL XSTOPX (' ') + C----------------------- END OF SUBROUTINE XERRWV ---------------------- + END +diff -rc libcruft.orig/ranlib/advnst.f libcruft/ranlib/advnst.f +*** libcruft.orig/ranlib/advnst.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/advnst.f Mon Jun 7 15:35:37 1993 +*************** +*** 60,66 **** + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' ADVNST called before random number generator ', + + ' initialized -- abort!' +! STOP ' ADVNST called before random number generator initialized' + + 10 CALL getcgn(g) + C +--- 60,67 ---- + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' ADVNST called before random number generator ', + + ' initialized -- abort!' +! CALL XSTOPX +! + (' ADVNST called before random number generator initialized') + + 10 CALL getcgn(g) + C +diff -rc libcruft.orig/ranlib/genbet.f libcruft/ranlib/genbet.f +*** libcruft.orig/ranlib/genbet.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/genbet.f Mon Jun 7 15:35:23 1993 +*************** +*** 67,73 **** + IF (.NOT. (aa.LE.0.0.OR.bb.LE.0.0)) GO TO 10 + WRITE (*,*) ' AA or BB <= 0 in GENBET - Abort!' + WRITE (*,*) ' AA: ',aa,' BB ',bb +! STOP ' AA or BB <= 0 in GENBET - Abort!' + + 10 olda = aa + oldb = bb +--- 67,73 ---- + IF (.NOT. (aa.LE.0.0.OR.bb.LE.0.0)) GO TO 10 + WRITE (*,*) ' AA or BB <= 0 in GENBET - Abort!' + WRITE (*,*) ' AA: ',aa,' BB ',bb +! CALL XSTOPX (' AA or BB <= 0 in GENBET - Abort!') + + 10 olda = aa + oldb = bb +diff -rc libcruft.orig/ranlib/genchi.f libcruft/ranlib/genchi.f +*** libcruft.orig/ranlib/genchi.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/genchi.f Mon Jun 7 15:35:17 1993 +*************** +*** 37,43 **** + IF (.NOT. (df.LE.0.0)) GO TO 10 + WRITE (*,*) 'DF <= 0 in GENCHI - ABORT' + WRITE (*,*) 'Value of DF: ',df +! STOP 'DF <= 0 in GENCHI - ABORT' + + 10 genchi = 2.0*gengam(1.0,df/2.0) + RETURN +--- 37,43 ---- + IF (.NOT. (df.LE.0.0)) GO TO 10 + WRITE (*,*) 'DF <= 0 in GENCHI - ABORT' + WRITE (*,*) 'Value of DF: ',df +! CALL XSTOPX ('DF <= 0 in GENCHI - ABORT') + + 10 genchi = 2.0*gengam(1.0,df/2.0) + RETURN +diff -rc libcruft.orig/ranlib/genf.f libcruft/ranlib/genf.f +*** libcruft.orig/ranlib/genf.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/genf.f Mon Jun 7 15:35:07 1993 +*************** +*** 44,50 **** + IF (.NOT. (dfn.LE.0.0.OR.dfd.LE.0.0)) GO TO 10 + WRITE (*,*) 'Degrees of freedom nonpositive in GENF - abort!' + WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd +! STOP 'Degrees of freedom nonpositive in GENF - abort!' + + 10 xnum = genchi(dfn)/dfn + C GENF = ( GENCHI( DFN ) / DFN ) / ( GENCHI( DFD ) / DFD ) +--- 44,50 ---- + IF (.NOT. (dfn.LE.0.0.OR.dfd.LE.0.0)) GO TO 10 + WRITE (*,*) 'Degrees of freedom nonpositive in GENF - abort!' + WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd +! CALL XSTOPX ('Degrees of freedom nonpositive in GENF - abort!') + + 10 xnum = genchi(dfn)/dfn + C GENF = ( GENCHI( DFN ) / DFN ) / ( GENCHI( DFD ) / DFD ) +diff -rc libcruft.orig/ranlib/gennch.f libcruft/ranlib/gennch.f +*** libcruft.orig/ranlib/gennch.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/gennch.f Mon Jun 7 15:34:58 1993 +*************** +*** 48,54 **** + IF (.NOT. (df.LE.1.0.OR.xnonc.LT.0.0)) GO TO 10 + WRITE (*,*) 'DF <= 1 or XNONC < 0 in GENNCH - ABORT' + WRITE (*,*) 'Value of DF: ',df,' Value of XNONC',xnonc +! STOP 'DF <= 1 or XNONC < 0 in GENNCH - ABORT' + + 10 gennch = genchi(df-1.0) + gennor(sqrt(xnonc),1.0)**2 + RETURN +--- 48,54 ---- + IF (.NOT. (df.LE.1.0.OR.xnonc.LT.0.0)) GO TO 10 + WRITE (*,*) 'DF <= 1 or XNONC < 0 in GENNCH - ABORT' + WRITE (*,*) 'Value of DF: ',df,' Value of XNONC',xnonc +! CALL XSTOPX ('DF <= 1 or XNONC < 0 in GENNCH - ABORT') + + 10 gennch = genchi(df-1.0) + gennor(sqrt(xnonc),1.0)**2 + RETURN +diff -rc libcruft.orig/ranlib/gennf.f libcruft/ranlib/gennf.f +*** libcruft.orig/ranlib/gennf.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/gennf.f Mon Jun 7 15:56:26 1993 +*************** +*** 56,62 **** + WRITE (*,*) '(3) Noncentrality parameter < 0.0' + WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd,'XNONC value: ', + + xnonc +! STOP 'Degrees of freedom or noncent param our of range in GENNF' + + 10 xnum = gennch(dfn,xnonc)/dfn + C GENNF = ( GENNCH( DFN, XNONC ) / DFN ) / ( GENCHI( DFD ) / DFD ) +--- 56,63 ---- + WRITE (*,*) '(3) Noncentrality parameter < 0.0' + WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd,'XNONC value: ', + + xnonc +! CALL XSTOPX +! + ('Degrees of freedom or noncent param our of range in GENNF') + + 10 xnum = gennch(dfn,xnonc)/dfn + C GENNF = ( GENNCH( DFN, XNONC ) / DFN ) / ( GENCHI( DFD ) / DFD ) +diff -rc libcruft.orig/ranlib/genunf.f libcruft/ranlib/genunf.f +*** libcruft.orig/ranlib/genunf.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/genunf.f Mon Jun 7 15:34:37 1993 +*************** +*** 33,39 **** + IF (.NOT. (low.GT.high)) GO TO 10 + WRITE (*,*) 'LOW > HIGH in GENUNF: LOW ',low,' HIGH: ',high + WRITE (*,*) 'Abort' +! STOP 'LOW > High in GENUNF - Abort' + + 10 genunf = low + (high-low)*ranf() + +--- 33,39 ---- + IF (.NOT. (low.GT.high)) GO TO 10 + WRITE (*,*) 'LOW > HIGH in GENUNF: LOW ',low,' HIGH: ',high + WRITE (*,*) 'Abort' +! CALL XSTOPX ('LOW > High in GENUNF - Abort') + + 10 genunf = low + (high-low)*ranf() + +diff -rc libcruft.orig/ranlib/getcgn.f libcruft/ranlib/getcgn.f +*** libcruft.orig/ranlib/getcgn.f Wed Apr 22 08:49:00 1992 +--- libcruft/ranlib/getcgn.f Mon Jun 7 15:34:31 1993 +*************** +*** 47,53 **** + IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10 + WRITE (*,*) ' Generator number out of range in SETCGN:', + + ' Legal range is 1 to ',numg,' -- ABORT!' +! STOP ' Generator number out of range in SETCGN' + + 10 curntg = g + RETURN +--- 47,53 ---- + IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10 + WRITE (*,*) ' Generator number out of range in SETCGN:', + + ' Legal range is 1 to ',numg,' -- ABORT!' +! CALL XSTOPX (' Generator number out of range in SETCGN') + + 10 curntg = g + RETURN +diff -rc libcruft.orig/ranlib/getsd.f libcruft/ranlib/getsd.f +*** libcruft.orig/ranlib/getsd.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/getsd.f Mon Jun 7 15:34:23 1993 +*************** +*** 62,68 **** + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' GETSD called before random number generator ', + + ' initialized -- abort!' +! STOP ' GETSD called before random number generator initialized' + + 10 CALL getcgn(g) + iseed1 = cg1(g) +--- 62,69 ---- + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' GETSD called before random number generator ', + + ' initialized -- abort!' +! CALL XSTOPX +! + (' GETSD called before random number generator initialized') + + 10 CALL getcgn(g) + iseed1 = cg1(g) +diff -rc libcruft.orig/ranlib/ignuin.f libcruft/ranlib/ignuin.f +*** libcruft.orig/ranlib/ignuin.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/ignuin.f Mon Jun 7 15:34:09 1993 +*************** +*** 94,100 **** + 100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high + WRITE (*,*) ' Abort on Fatal ERROR' + IF (.NOT. (err.EQ.1)) GO TO 110 +! STOP 'LOW > HIGH in IGNUIN' + + GO TO 120 + +--- 94,100 ---- + 100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high + WRITE (*,*) ' Abort on Fatal ERROR' + IF (.NOT. (err.EQ.1)) GO TO 110 +! CALL XSTOPX ('LOW > HIGH in IGNUIN') + + GO TO 120 + +diff -rc libcruft.orig/ranlib/initgn.f libcruft/ranlib/initgn.f +*** libcruft.orig/ranlib/initgn.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/initgn.f Mon Jun 7 15:34:03 1993 +*************** +*** 66,72 **** + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' INITGN called before random number generator ', + + ' initialized -- abort!' +! STOP ' INITGN called before random number generator initialized' + + 10 CALL getcgn(g) + IF ((-1).NE. (isdtyp)) GO TO 20 +--- 66,73 ---- + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' INITGN called before random number generator ', + + ' initialized -- abort!' +! CALL XSTOPX +! + (' INITGN called before random number generator initialized') + + 10 CALL getcgn(g) + IF ((-1).NE. (isdtyp)) GO TO 20 +diff -rc libcruft.orig/ranlib/mltmod.f libcruft/ranlib/mltmod.f +*** libcruft.orig/ranlib/mltmod.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/mltmod.f Mon Jun 7 15:33:49 1993 +*************** +*** 39,45 **** + WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!' + WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m + WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M' +! STOP ' A, M, S out of order in MLTMOD - ABORT!' + + 10 IF (.NOT. (a.LT.h)) GO TO 20 + a0 = a +--- 39,45 ---- + WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!' + WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m + WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M' +! CALL XSTOPX (' A, M, S out of order in MLTMOD - ABORT!') + + 10 IF (.NOT. (a.LT.h)) GO TO 20 + a0 = a +diff -rc libcruft.orig/ranlib/setant.f libcruft/ranlib/setant.f +*** libcruft.orig/ranlib/setant.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/setant.f Mon Jun 7 15:33:36 1993 +*************** +*** 65,71 **** + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' SETANT called before random number generator ', + + ' initialized -- abort!' +! STOP ' SETANT called before random number generator initialized' + + 10 CALL getcgn(g) + qanti(g) = qvalue +--- 65,72 ---- + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' SETANT called before random number generator ', + + ' initialized -- abort!' +! CALL XSTOPX +! + (' SETANT called before random number generator initialized') + + 10 CALL getcgn(g) + qanti(g) = qvalue +diff -rc libcruft.orig/ranlib/setgmn.f libcruft/ranlib/setgmn.f +*** libcruft.orig/ranlib/setgmn.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/setgmn.f Mon Jun 7 15:33:21 1993 +*************** +*** 55,61 **** + IF (.NOT. (p.LE.0)) GO TO 10 + WRITE (*,*) 'P nonpositive in SETGMN' + WRITE (*,*) 'Value of P: ',p +! STOP 'P nonpositive in SETGMN' + + 10 parm(1) = p + C +--- 55,61 ---- + IF (.NOT. (p.LE.0)) GO TO 10 + WRITE (*,*) 'P nonpositive in SETGMN' + WRITE (*,*) 'Value of P: ',p +! CALL XSTOPX ('P nonpositive in SETGMN') + + 10 parm(1) = p + C +*************** +*** 70,76 **** + CALL spofa(covm,p,p,info) + IF (.NOT. (info.NE.0)) GO TO 30 + WRITE (*,*) ' COVM not positive definite in SETGMN' +! STOP ' COVM not positive definite in SETGMN' + + 30 icount = p + 1 + C +--- 70,76 ---- + CALL spofa(covm,p,p,info) + IF (.NOT. (info.NE.0)) GO TO 30 + WRITE (*,*) ' COVM not positive definite in SETGMN' +! CALL XSTOPX (' COVM not positive definite in SETGMN') + + 30 icount = p + 1 + C +diff -rc libcruft.orig/ranlib/setsd.f libcruft/ranlib/setsd.f +*** libcruft.orig/ranlib/setsd.f Wed Apr 22 08:49:01 1992 +--- libcruft/ranlib/setsd.f Mon Jun 7 15:32:58 1993 +*************** +*** 62,68 **** + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' SETSD called before random number generator ', + + ' initialized -- abort!' +! STOP ' SETSD called before random number generator initialized' + + 10 CALL getcgn(g) + ig1(g) = iseed1 +--- 62,69 ---- + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' SETSD called before random number generator ', + + ' initialized -- abort!' +! CALL XSTOPX +! + (' SETSD called before random number generator initialized') + + 10 CALL getcgn(g) + ig1(g) = iseed1 +diff -rc libcruft.orig/villad/vilerr.f libcruft/villad/vilerr.f +*** libcruft.orig/villad/vilerr.f Wed Dec 2 21:54:57 1992 +--- libcruft/villad/vilerr.f Mon Jun 7 15:55:08 1993 +*************** +*** 80,86 **** + C + C -- PROGRAM EXECUTION TERMINATES HERE + C +! STOP + C + ELSE + END IF +--- 80,86 ---- + C + C -- PROGRAM EXECUTION TERMINATES HERE + C +! CALL XSTOPX (' ') + C + ELSE + END IF