# HG changeset patch # User Rik # Date 1263450284 28800 # Node ID 20b74e630faf3a6a8745ad18ef8d123c1c0073b7 # Parent 0e71ead7359da5272cffba1d7c3b7c4ba6706f73 Remove unmaintained patch STOP.patch for Fortran code diff -r 0e71ead7359d -r 20b74e630faf libcruft/ChangeLog --- a/libcruft/ChangeLog Wed Jan 13 22:22:46 2010 -0800 +++ b/libcruft/ChangeLog Wed Jan 13 22:24:44 2010 -0800 @@ -1,3 +1,7 @@ +2009-01-13 Rik + + * STOP.patch: Remove unmaintained patch for Fortran code + 2009-01-13 Rik * ranlib/advnst.f ranlib/genbet.f ranlib/genchi.f ranlib/genexp.f diff -r 0e71ead7359d -r 20b74e630faf libcruft/STOP.patch --- a/libcruft/STOP.patch Wed Jan 13 22:22:46 2010 -0800 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,423 +0,0 @@ -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@octave.org - -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/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