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