Mercurial > octave-nkf
changeset 4040:5b781670e9ee
[project @ 2002-08-15 01:36:24 by jwe]
| author | jwe |
|---|---|
| date | Thu, 15 Aug 2002 01:36:25 +0000 |
| parents | e82257ed348c |
| children | 3995501ce1d9 |
| files | libcruft/ChangeLog libcruft/dasrt/dasrt_xerrwv.f libcruft/dasrt/ddasrt.f libcruft/odepack/intdy.f libcruft/odepack/lsode.f libcruft/odepack/xerrwv.f libcruft/quadpack/dqagi.f libcruft/quadpack/dqagp.f libcruft/quadpack/xerror.f libcruft/slatec-err/xerrwd.f |
| diffstat | 10 files changed, 134 insertions(+), 303 deletions(-) [+] |
line wrap: on
line diff
--- a/libcruft/ChangeLog Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/ChangeLog Thu Aug 15 01:36:25 2002 +0000 @@ -1,3 +1,18 @@ +2002-08-14 John W. Eaton <jwe@bevo.che.wisc.edu> + + * dasrt/xerrwv.f, odepack/xerrwv.f: Delete. + * slatec-err/xerrwd.f (XERRWD): Call XSTOPX instead of using STOP. + + * quadpack/dqagi.f (DQAGI): Replace Hollerith constants with + character string constants. + * quadpack/dqagp.f (DQAGP): Likewise. + * odepack/lsode.f (LSODE): Likewise. + + * odepack/lsode.f (LSODE): Use XERRWD instead of XERRWV. + * odepack/intdy.f (INTDY): Likewise. + * dasrt/ddasrt.f (DDASRT): Likewise. + * quadpack/xerror.f (XERROR): Likewise. + 2002-07-25 John W. Eaton <jwe@bevo.che.wisc.edu> * slatec-fn/xgmainc.f: New file.
--- a/libcruft/dasrt/dasrt_xerrwv.f Wed Aug 14 19:33:31 2002 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ - SUBROUTINE DASRT_XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, - $ NR, R1, R2) - INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR - DOUBLE PRECISION R1, R2 - CHARACTER*1 MSG(NMES) -C----------------------------------------------------------------------- -C Subroutine XERRWV, as given here, constitutes a simplified version of -C the SLATEC error handling package. -C Written by A. C. Hindmarsh and P. N. Brown at LLNL. -C Modified 1/8/90 by Clement Ulrich at LLNL. -C Version of 8 January, 1990. -C This version is in double precision. -C -C All arguments are input arguments. -C -C MSG = The message (character array). -C NMES = The length of MSG (number of characters). -C NERR = The error number (not used). -C LEVEL = The error level.. -C 0 or 1 means recoverable (control returns to caller). -C 2 means fatal (run is aborted--see note below). -C NI = Number of integers (0, 1, or 2) to be printed with message. -C I1,I2 = Integers to be printed, depending on NI. -C NR = Number of reals (0, 1, or 2) to be printed with message. -C R1,R2 = Reals to be printed, depending on NR. -C -C Note.. this routine is compatible with ANSI-77; however the -C following assumptions may not be valid for some machines: -C -C 1. The argument MSG is assumed to be of type CHARACTER, and -C the message is printed with a format of (1X,80A1). -C 2. The message is assumed to take only one line. -C Multi-line messages are generated by repeated calls. -C 3. If LEVEL = 2, control passes to the statement STOP -C to abort the run. For a different run-abort command, -C change the statement following statement 100 at the end. -C 4. R1 and R2 are assumed to be in double precision and are printed -C in E21.13 format. -C 5. The logical unit number 6 is standard output. -C For a different default logical unit number, change the assignment -C statement for LUNIT below. -C -C----------------------------------------------------------------------- -C Subroutines called by XERRWV.. None -C Function routines called by XERRWV.. None -C----------------------------------------------------------------------- -C - INTEGER I, LUNIT, MESFLG -C -C Define message print flag and logical unit number. ------------------- - MESFLG = 1 - LUNIT = 6 - IF (MESFLG .EQ. 0) GO TO 100 -C Write the message. --------------------------------------------------- - WRITE (LUNIT,10) (MSG(I),I=1,NMES) - 10 FORMAT(1X,80A1) - IF (NI .EQ. 1) WRITE (LUNIT, 20) I1 - 20 FORMAT(6X,'In above message, I1 =',I10) - IF (NI .EQ. 2) WRITE (LUNIT, 30) I1,I2 - 30 FORMAT(6X,'In above message, I1 =',I10,3X,'I2 =',I10) - IF (NR .EQ. 1) WRITE (LUNIT, 40) R1 - 40 FORMAT(6X,'In above message, R1 =',E21.13) - IF (NR .EQ. 2) WRITE (LUNIT, 50) R1,R2 - 50 FORMAT(6X,'In above, R1 =',E21.13,3X,'R2 =',E21.13) -C Abort the run if LEVEL = 2. ------------------------------------------ - 100 IF (LEVEL .NE. 2) RETURN - STOP -C----------------------- End of Subroutine XERRWV ---------------------- - END
--- a/libcruft/dasrt/ddasrt.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/dasrt/ddasrt.f Thu Aug 15 01:36:25 2002 +0000 @@ -859,7 +859,7 @@ C Equations, Elsevier, New York, 1989. C C***ROUTINES CALLED DDASTP,DDAINI,DDANRM,DDAWTS,DDATRP,DRCHEK,DROOTS, -C XERRWV,D1MACH +C XERRWD,D1MACH C***END PROLOGUE DDASRT C C**End @@ -983,11 +983,11 @@ C APPROPRIATE ACTION WAS NOT TAKEN. THIS C IS A FATAL ERROR. MSG = 'DASRT-- THE LAST STEP TERMINATED WITH A NEGATIVE' - CALL DASRT_XERRWV(MSG,49,201,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,49,201,0,0,0,0,0,0.0D0,0.0D0) MSG = 'DASRT-- VALUE (=I1) OF IDID AND NO APPROPRIATE' - CALL DASRT_XERRWV(MSG,47,202,0,1,IDID,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,47,202,0,1,IDID,0,0,0.0D0,0.0D0) MSG = 'DASRT-- ACTION WAS TAKEN. RUN TERMINATED' - CALL DASRT_XERRWV(MSG,41,203,1,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,41,203,1,0,0,0,0,0.0D0,0.0D0) RETURN 110 CONTINUE IWORK(LNSTL)=IWORK(LNST) @@ -1393,80 +1393,80 @@ C THE MAXIMUM NUMBER OF STEPS WAS TAKEN BEFORE C REACHING TOUT 610 MSG = 'DASRT-- AT CURRENT T (=R1) 500 STEPS' - CALL DASRT_XERRWV(MSG,38,610,0,0,0,0,1,TN,0.0D0) + CALL XERRWD(MSG,38,610,0,0,0,0,1,TN,0.0D0) MSG = 'DASRT-- TAKEN ON THIS CALL BEFORE REACHING TOUT' - CALL DASRT_XERRWV(MSG,48,611,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,48,611,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C TOO MUCH ACCURACY FOR MACHINE PRECISION 620 MSG = 'DASRT-- AT T (=R1) TOO MUCH ACCURACY REQUESTED' - CALL DASRT_XERRWV(MSG,47,620,0,0,0,0,1,TN,0.0D0) + CALL XERRWD(MSG,47,620,0,0,0,0,1,TN,0.0D0) MSG = 'DASRT-- FOR PRECISION OF MACHINE. RTOL AND ATOL' - CALL DASRT_XERRWV(MSG,48,621,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,48,621,0,0,0,0,0,0.0D0,0.0D0) MSG = 'DASRT-- WERE INCREASED TO APPROPRIATE VALUES' - CALL DASRT_XERRWV(MSG,45,622,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,45,622,0,0,0,0,0,0.0D0,0.0D0) C GO TO 690 C WT(I) .LE. 0.0D0 FOR SOME I (NOT AT START OF PROBLEM) 630 MSG = 'DASRT-- AT T (=R1) SOME ELEMENT OF WT' - CALL DASRT_XERRWV(MSG,38,630,0,0,0,0,1,TN,0.0D0) + CALL XERRWD(MSG,38,630,0,0,0,0,1,TN,0.0D0) MSG = 'DASRT-- HAS BECOME .LE. 0.0' - CALL DASRT_XERRWV(MSG,28,631,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,28,631,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C ERROR TEST FAILED REPEATEDLY OR WITH H=HMIN 640 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2) THE' - CALL DASRT_XERRWV(MSG,44,640,0,0,0,0,2,TN,H) + CALL XERRWD(MSG,44,640,0,0,0,0,2,TN,H) MSG='DASRT-- ERROR TEST FAILED REPEATEDLY OR WITH ABS(H)=HMIN' - CALL DASRT_XERRWV(MSG,57,641,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,57,641,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C CORRECTOR CONVERGENCE FAILED REPEATEDLY OR WITH H=HMIN 650 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2) THE' - CALL DASRT_XERRWV(MSG,44,650,0,0,0,0,2,TN,H) + CALL XERRWD(MSG,44,650,0,0,0,0,2,TN,H) MSG = 'DASRT-- CORRECTOR FAILED TO CONVERGE REPEATEDLY' - CALL DASRT_XERRWV(MSG,48,651,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,48,651,0,0,0,0,0,0.0D0,0.0D0) MSG = 'DASRT-- OR WITH ABS(H)=HMIN' - CALL DASRT_XERRWV(MSG,28,652,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,28,652,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C THE ITERATION MATRIX IS SINGULAR 660 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2) THE' - CALL DASRT_XERRWV(MSG,44,660,0,0,0,0,2,TN,H) + CALL XERRWD(MSG,44,660,0,0,0,0,2,TN,H) MSG = 'DASRT-- ITERATION MATRIX IS SINGULAR' - CALL DASRT_XERRWV(MSG,37,661,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,37,661,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C CORRECTOR FAILURE PRECEEDED BY ERROR TEST FAILURES. 670 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2) THE' - CALL DASRT_XERRWV(MSG,44,670,0,0,0,0,2,TN,H) + CALL XERRWD(MSG,44,670,0,0,0,0,2,TN,H) MSG = 'DASRT-- CORRECTOR COULD NOT CONVERGE. ALSO, THE' - CALL DASRT_XERRWV(MSG,49,671,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,49,671,0,0,0,0,0,0.0D0,0.0D0) MSG = 'DASRT-- ERROR TEST FAILED REPEATEDLY.' - CALL DASRT_XERRWV(MSG,38,672,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,38,672,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C CORRECTOR FAILURE BECAUSE IRES = -1 675 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2) THE' - CALL DASRT_XERRWV(MSG,44,675,0,0,0,0,2,TN,H) + CALL XERRWD(MSG,44,675,0,0,0,0,2,TN,H) MSG = 'DASRT-- CORRECTOR COULD NOT CONVERGE BECAUSE' - CALL DASRT_XERRWV(MSG,45,676,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,45,676,0,0,0,0,0,0.0D0,0.0D0) MSG = 'DASRT-- IRES WAS EQUAL TO MINUS ONE' - CALL DASRT_XERRWV(MSG,36,677,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,36,677,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C FAILURE BECAUSE IRES = -2 680 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2)' - CALL DASRT_XERRWV(MSG,40,680,0,0,0,0,2,TN,H) + CALL XERRWD(MSG,40,680,0,0,0,0,2,TN,H) MSG = 'DASRT-- IRES WAS EQUAL TO MINUS TWO' - CALL DASRT_XERRWV(MSG,36,681,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,36,681,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 C C FAILED TO COMPUTE INITIAL YPRIME 685 MSG = 'DASRT-- AT T (=R1) AND STEPSIZE H (=R2) THE' - CALL DASRT_XERRWV(MSG,44,685,0,0,0,0,2,TN,HO) + CALL XERRWD(MSG,44,685,0,0,0,0,2,TN,HO) MSG = 'DASRT-- INITIAL YPRIME COULD NOT BE COMPUTED' - CALL DASRT_XERRWV(MSG,45,686,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,45,686,0,0,0,0,0,0.0D0,0.0D0) GO TO 690 690 CONTINUE INFO(1)=-1 @@ -1483,77 +1483,77 @@ C C----------------------------------------------------------------------- 701 MSG = 'DASRT-- SOME ELEMENT OF INFO VECTOR IS NOT ZERO OR ONE' - CALL DASRT_XERRWV(MSG,55,1,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,55,1,0,0,0,0,0,0.0D0,0.0D0) GO TO 750 702 MSG = 'DASRT-- NEQ (=I1) .LE. 0' - CALL DASRT_XERRWV(MSG,25,2,0,1,NEQ,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,25,2,0,1,NEQ,0,0,0.0D0,0.0D0) GO TO 750 703 MSG = 'DASRT-- MAXORD (=I1) NOT IN RANGE' - CALL DASRT_XERRWV(MSG,34,3,0,1,MXORD,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,34,3,0,1,MXORD,0,0,0.0D0,0.0D0) GO TO 750 704 MSG='DASRT-- RWORK LENGTH NEEDED, LENRW (=I1), EXCEEDS LRW (=I2)' - CALL DASRT_XERRWV(MSG,60,4,0,2,LENRW,LRW,0,0.0D0,0.0D0) + CALL XERRWD(MSG,60,4,0,2,LENRW,LRW,0,0.0D0,0.0D0) GO TO 750 705 MSG='DASRT-- IWORK LENGTH NEEDED, LENIW (=I1), EXCEEDS LIW (=I2)' - CALL DASRT_XERRWV(MSG,60,5,0,2,LENIW,LIW,0,0.0D0,0.0D0) + CALL XERRWD(MSG,60,5,0,2,LENIW,LIW,0,0.0D0,0.0D0) GO TO 750 706 MSG = 'DASRT-- SOME ELEMENT OF RTOL IS .LT. 0' - CALL DASRT_XERRWV(MSG,39,6,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,39,6,0,0,0,0,0,0.0D0,0.0D0) GO TO 750 707 MSG = 'DASRT-- SOME ELEMENT OF ATOL IS .LT. 0' - CALL DASRT_XERRWV(MSG,39,7,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,39,7,0,0,0,0,0,0.0D0,0.0D0) GO TO 750 708 MSG = 'DASRT-- ALL ELEMENTS OF RTOL AND ATOL ARE ZERO' - CALL DASRT_XERRWV(MSG,47,8,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,47,8,0,0,0,0,0,0.0D0,0.0D0) GO TO 750 709 MSG='DASRT-- INFO(4) = 1 AND TSTOP (=R1) BEHIND TOUT (=R2)' - CALL DASRT_XERRWV(MSG,54,9,0,0,0,0,2,TSTOP,TOUT) + CALL XERRWD(MSG,54,9,0,0,0,0,2,TSTOP,TOUT) GO TO 750 710 MSG = 'DASRT-- HMAX (=R1) .LT. 0.0' - CALL DASRT_XERRWV(MSG,28,10,0,0,0,0,1,HMAX,0.0D0) + CALL XERRWD(MSG,28,10,0,0,0,0,1,HMAX,0.0D0) GO TO 750 711 MSG = 'DASRT-- TOUT (=R1) BEHIND T (=R2)' - CALL DASRT_XERRWV(MSG,34,11,0,0,0,0,2,TOUT,T) + CALL XERRWD(MSG,34,11,0,0,0,0,2,TOUT,T) GO TO 750 712 MSG = 'DASRT-- INFO(8)=1 AND H0=0.0' - CALL DASRT_XERRWV(MSG,29,12,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,29,12,0,0,0,0,0,0.0D0,0.0D0) GO TO 750 713 MSG = 'DASRT-- SOME ELEMENT OF WT IS .LE. 0.0' - CALL DASRT_XERRWV(MSG,39,13,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,39,13,0,0,0,0,0,0.0D0,0.0D0) GO TO 750 714 MSG='DASRT-- TOUT (=R1) TOO CLOSE TO T (=R2) TO START INTEGRATION' - CALL DASRT_XERRWV(MSG,60,14,0,0,0,0,2,TOUT,T) + CALL XERRWD(MSG,60,14,0,0,0,0,2,TOUT,T) GO TO 750 715 MSG = 'DASRT-- INFO(4)=1 AND TSTOP (=R1) BEHIND T (=R2)' - CALL DASRT_XERRWV(MSG,49,15,0,0,0,0,2,TSTOP,T) + CALL XERRWD(MSG,49,15,0,0,0,0,2,TSTOP,T) GO TO 750 716 MSG = 'DASRT-- INFO(12)=1 AND MXSTP (=I1) .LT. 0' - CALL DASRT_XERRWV(MSG,42,16,0,1,IWORK(LMXSTP),0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,42,16,0,1,IWORK(LMXSTP),0,0,0.0D0,0.0D0) GO TO 750 717 MSG = 'DASRT-- ML (=I1) ILLEGAL. EITHER .LT. 0 OR .GT. NEQ' - CALL DASRT_XERRWV(MSG,52,17,0,1,IWORK(LML),0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,52,17,0,1,IWORK(LML),0,0,0.0D0,0.0D0) GO TO 750 718 MSG = 'DASRT-- MU (=I1) ILLEGAL. EITHER .LT. 0 OR .GT. NEQ' - CALL DASRT_XERRWV(MSG,52,18,0,1,IWORK(LMU),0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,52,18,0,1,IWORK(LMU),0,0,0.0D0,0.0D0) GO TO 750 719 MSG = 'DASRT-- TOUT (=R1) IS EQUAL TO T (=R2)' - CALL DASRT_XERRWV(MSG,39,19,0,0,0,0,2,TOUT,T) + CALL XERRWD(MSG,39,19,0,0,0,0,2,TOUT,T) GO TO 750 730 MSG = 'DASRT-- NG (=I1) .LT. 0' - CALL DASRT_XERRWV(MSG,24,30,1,1,NG,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,24,30,1,1,NG,0,0,0.0D0,0.0D0) GO TO 750 732 MSG = 'DASRT-- ONE OR MORE COMPONENTS OF G HAS A ROOT' - CALL DASRT_XERRWV(MSG,47,32,1,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,47,32,1,0,0,0,0,0.0D0,0.0D0) MSG = ' TOO NEAR TO THE INITIAL POINT' - CALL DASRT_XERRWV(MSG,38,32,1,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,38,32,1,0,0,0,0,0.0D0,0.0D0) 750 IF(INFO(1).EQ.-1) GO TO 760 INFO(1)=-1 IDID=-33 RETURN 760 MSG = 'DASRT-- REPEATED OCCURRENCES OF ILLEGAL INPUT' - CALL DASRT_XERRWV(MSG,46,801,0,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,46,801,0,0,0,0,0,0.0D0,0.0D0) 770 MSG = 'DASRT-- RUN TERMINATED. APPARENT INFINITE LOOP' - CALL DASRT_XERRWV(MSG,47,802,1,0,0,0,0,0.0D0,0.0D0) + CALL XERRWD(MSG,47,802,1,0,0,0,0,0.0D0,0.0D0) RETURN C-----------END OF SUBROUTINE DDASRT------------------------------------ END
--- a/libcruft/odepack/intdy.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/odepack/intdy.f Thu Aug 15 01:36:25 2002 +0000 @@ -69,14 +69,14 @@ 60 DKY(I) = R*DKY(I) RETURN C - 80 CALL XERRWV(30HINTDY-- K (=I1) ILLEGAL , + 80 CALL XERRWD('INTDY-- K (=I1) ILLEGAL ', 1 30, 51, 0, 1, K, 0, 0, 0.0D0, 0.0D0) IFLAG = -1 RETURN - 90 CALL XERRWV(30HINTDY-- T (=R1) ILLEGAL , + 90 CALL XERRWD('INTDY-- T (=R1) ILLEGAL ', 1 30, 52, 0, 0, 0, 0, 1, T, 0.0D0) - CALL XERRWV( - 1 60H T NOT IN INTERVAL TCUR - HU (= R1) TO TCUR (=R2) , + CALL XERRWD( + 1 ' T NOT IN INTERVAL TCUR - HU (= R1) TO TCUR (=R2) ', 1 60, 52, 0, 0, 0, 0, 2, TP, TN) IFLAG = -2 RETURN
--- a/libcruft/odepack/lsode.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/odepack/lsode.f Thu Aug 15 01:36:25 2002 +0000 @@ -821,10 +821,9 @@ C IF LSODE IS TO BE USED IN AN OVERLAY SITUATION, THE USER C MUST DECLARE, IN THE PRIMARY OVERLAY, THE VARIABLES IN.. C (1) THE CALL SEQUENCE TO LSODE, -C (2) THE TWO INTERNAL COMMON BLOCKS +C (2) THE INTERNAL COMMON BLOCK C /LS0001/ OF LENGTH 257 (218 DOUBLE PRECISION WORDS C FOLLOWED BY 39 INTEGER WORDS), -C /EH0001/ OF LENGTH 2 (INTEGER WORDS). C C IF LSODE IS USED ON A SYSTEM IN WHICH THE CONTENTS OF INTERNAL C COMMON BLOCKS ARE NOT PRESERVED BETWEEN CALLS, THE USER SHOULD @@ -929,8 +928,8 @@ C DAXPY, DSCAL, IDAMAX, AND DDOT ARE BASIC LINEAR ALGEBRA MODULES C (BLAS) USED BY THE ABOVE LINPACK ROUTINES. C D1MACH COMPUTES THE UNIT ROUNDOFF IN A MACHINE-INDEPENDENT MANNER. -C XERRWV, XSETUN, AND XSETF HANDLE THE PRINTING OF ALL ERROR -C MESSAGES AND WARNINGS. XERRWV IS MACHINE-DEPENDENT. +C XERRWD, XSETUN, AND XSETF HANDLE THE PRINTING OF ALL ERROR +C MESSAGES AND WARNINGS. XERRWD IS MACHINE-DEPENDENT. C NOTE.. VNORM, IDAMAX, DDOT, AND D1MACH ARE FUNCTION ROUTINES. C ALL THE OTHERS ARE SUBROUTINES. C @@ -1249,17 +1248,17 @@ 280 IF ((TN + H) .NE. TN) GO TO 290 NHNIL = NHNIL + 1 IF (NHNIL .GT. MXHNIL) GO TO 290 - CALL XERRWV(50HLSODE-- WARNING..INTERNAL T (=R1) AND H (=R2) ARE, + CALL XERRWD('LSODE-- WARNING..INTERNAL T (=R1) AND H (=R2) ARE', 1 50, 101, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV( - 1 60H SUCH THAT IN THE MACHINE, T + H = T ON THE NEXT STEP , + CALL XERRWD( + 1 ' SUCH THAT IN THE MACHINE, T + H = T ON THE NEXT STEP ', 1 60, 101, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(50H (H = STEP SIZE). SOLVER WILL CONTINUE ANYWAY, + CALL XERRWD(' (H = STEP SIZE). SOLVER WILL CONTINUE ANYWAY', 1 50, 101, 0, 0, 0, 0, 2, TN, H) IF (NHNIL .LT. MXHNIL) GO TO 290 - CALL XERRWV(50HLSODE-- ABOVE WARNING HAS BEEN ISSUED I1 TIMES. , + CALL XERRWD('LSODE-- ABOVE WARNING HAS BEEN ISSUED I1 TIMES. ', 1 50, 102, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(50H IT WILL NOT BE ISSUED AGAIN FOR THIS PROBLEM, + CALL XERRWD(' IT WILL NOT BE ISSUED AGAIN FOR THIS PROBLEM', 1 50, 102, 0, 1, MXHNIL, 0, 0, 0.0D0, 0.0D0) 290 CONTINUE C----------------------------------------------------------------------- @@ -1334,8 +1333,8 @@ C 430 NTREP = NTREP + 1 IF (NTREP .LT. 5) RETURN - CALL XERRWV( - 1 60HLSODE-- REPEATED CALLS WITH ISTATE = 1 AND TOUT = T (=R1) , + CALL XERRWD( + 1 'LSODE-- REPEATED CALLS WITH ISTATE = 1 AND TOUT = T (=R1) ', 1 60, 301, 0, 0, 0, 0, 1, T, 0.0D0) GO TO 800 C----------------------------------------------------------------------- @@ -1348,39 +1347,39 @@ C THE WORK ARRAYS BEFORE RETURNING. C----------------------------------------------------------------------- C THE MAXIMUM NUMBER OF STEPS WAS TAKEN BEFORE REACHING TOUT. ---------- - 500 CALL XERRWV(50HLSODE-- AT CURRENT T (=R1), MXSTEP (=I1) STEPS , + 500 CALL XERRWD('LSODE-- AT CURRENT T (=R1), MXSTEP (=I1) STEPS ', 1 50, 201, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(50H TAKEN ON THIS CALL BEFORE REACHING TOUT , + CALL XERRWD(' TAKEN ON THIS CALL BEFORE REACHING TOUT ', 1 50, 201, 0, 1, MXSTEP, 0, 1, TN, 0.0D0) ISTATE = -1 GO TO 580 C EWT(I) .LE. 0.0 FOR SOME I (NOT AT START OF PROBLEM). ---------------- 510 EWTI = RWORK(LEWT+I-1) - CALL XERRWV(50HLSODE-- AT T (=R1), EWT(I1) HAS BECOME R2 .LE. 0., + CALL XERRWD('LSODE-- AT T (=R1), EWT(I1) HAS BECOME R2 .LE. 0.', 1 50, 202, 0, 1, I, 0, 2, TN, EWTI) ISTATE = -6 GO TO 580 C TOO MUCH ACCURACY REQUESTED FOR MACHINE PRECISION. ------------------- - 520 CALL XERRWV(50HLSODE-- AT T (=R1), TOO MUCH ACCURACY REQUESTED , + 520 CALL XERRWD('LSODE-- AT T (=R1), TOO MUCH ACCURACY REQUESTED ', 1 50, 203, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(50H FOR PRECISION OF MACHINE.. SEE TOLSF (=R2) , + CALL XERRWD(' FOR PRECISION OF MACHINE.. SEE TOLSF (=R2) ', 1 50, 203, 0, 0, 0, 0, 2, TN, TOLSF) RWORK(14) = TOLSF ISTATE = -2 GO TO 580 C KFLAG = -1. ERROR TEST FAILED REPEATEDLY OR WITH ABS(H) = HMIN. ----- - 530 CALL XERRWV(50HLSODE-- AT T(=R1) AND STEP SIZE H(=R2), THE ERROR, + 530 CALL XERRWD('LSODE-- AT T(=R1) AND STEP SIZE H(=R2), THE ERROR', 1 50, 204, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(50H TEST FAILED REPEATEDLY OR WITH ABS(H) = HMIN, + CALL XERRWD(' TEST FAILED REPEATEDLY OR WITH ABS(H) = HMIN', 1 50, 204, 0, 0, 0, 0, 2, TN, H) ISTATE = -4 GO TO 560 C KFLAG = -2. CONVERGENCE FAILED REPEATEDLY OR WITH ABS(H) = HMIN. ---- - 540 CALL XERRWV(50HLSODE-- AT T (=R1) AND STEP SIZE H (=R2), THE , + 540 CALL XERRWD('LSODE-- AT T (=R1) AND STEP SIZE H (=R2), THE ', 1 50, 205, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(50H CORRECTOR CONVERGENCE FAILED REPEATEDLY , + CALL XERRWD(' CORRECTOR CONVERGENCE FAILED REPEATEDLY ', 1 50, 205, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV(30H OR WITH ABS(H) = HMIN , + CALL XERRWD(' OR WITH ABS(H) = HMIN ', 1 30, 205, 0, 0, 0, 0, 2, TN, H) ISTATE = -5 C COMPUTE IMXER IF RELEVANT. ------------------------------------------- @@ -1415,108 +1414,108 @@ C 5 CONSECUTIVE SUCH RETURNS JUST BEFORE THIS CALL TO THE SOLVER, C THE RUN IS HALTED. C----------------------------------------------------------------------- - 601 CALL XERRWV(30HLSODE-- ISTATE (=I1) ILLEGAL , + 601 CALL XERRWD('LSODE-- ISTATE (=I1) ILLEGAL ', 1 30, 1, 0, 1, ISTATE, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 602 CALL XERRWV(30HLSODE-- ITASK (=I1) ILLEGAL , + 602 CALL XERRWD('LSODE-- ITASK (=I1) ILLEGAL ', 1 30, 2, 0, 1, ITASK, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 603 CALL XERRWV(50HLSODE-- ISTATE .GT. 1 BUT LSODE NOT INITIALIZED , + 603 CALL XERRWD('LSODE-- ISTATE .GT. 1 BUT LSODE NOT INITIALIZED ', 1 50, 3, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 604 CALL XERRWV(30HLSODE-- NEQ (=I1) .LT. 1 , + 604 CALL XERRWD('LSODE-- NEQ (=I1) .LT. 1 ', 1 30, 4, 0, 1, NEQ(1), 0, 0, 0.0D0, 0.0D0) GO TO 700 - 605 CALL XERRWV(50HLSODE-- ISTATE = 3 AND NEQ INCREASED (I1 TO I2) , + 605 CALL XERRWD('LSODE-- ISTATE = 3 AND NEQ INCREASED (I1 TO I2) ', 1 50, 5, 0, 2, N, NEQ(1), 0, 0.0D0, 0.0D0) GO TO 700 - 606 CALL XERRWV(30HLSODE-- ITOL (=I1) ILLEGAL , + 606 CALL XERRWD('LSODE-- ITOL (=I1) ILLEGAL ', 1 30, 6, 0, 1, ITOL, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 607 CALL XERRWV(30HLSODE-- IOPT (=I1) ILLEGAL , + 607 CALL XERRWD('LSODE-- IOPT (=I1) ILLEGAL ', 1 30, 7, 0, 1, IOPT, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 608 CALL XERRWV(30HLSODE-- MF (=I1) ILLEGAL , + 608 CALL XERRWD('LSODE-- MF (=I1) ILLEGAL ', 1 30, 8, 0, 1, MF, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 609 CALL XERRWV(50HLSODE-- ML (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2), + 609 CALL XERRWD('LSODE-- ML (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2)', 1 50, 9, 0, 2, ML, NEQ(1), 0, 0.0D0, 0.0D0) GO TO 700 - 610 CALL XERRWV(50HLSODE-- MU (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2), + 610 CALL XERRWD('LSODE-- MU (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2)', 1 50, 10, 0, 2, MU, NEQ(1), 0, 0.0D0, 0.0D0) GO TO 700 - 611 CALL XERRWV(30HLSODE-- MAXORD (=I1) .LT. 0 , + 611 CALL XERRWD('LSODE-- MAXORD (=I1) .LT. 0 ', 1 30, 11, 0, 1, MAXORD, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 612 CALL XERRWV(30HLSODE-- MXSTEP (=I1) .LT. 0 , + 612 CALL XERRWD('LSODE-- MXSTEP (=I1) .LT. 0 ', 1 30, 12, 0, 1, MXSTEP, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 613 CALL XERRWV(30HLSODE-- MXHNIL (=I1) .LT. 0 , + 613 CALL XERRWD('LSODE-- MXHNIL (=I1) .LT. 0 ', 1 30, 13, 0, 1, MXHNIL, 0, 0, 0.0D0, 0.0D0) GO TO 700 - 614 CALL XERRWV(40HLSODE-- TOUT (=R1) BEHIND T (=R2) , + 614 CALL XERRWD('LSODE-- TOUT (=R1) BEHIND T (=R2) ', 1 40, 14, 0, 0, 0, 0, 2, TOUT, T) - CALL XERRWV(50H INTEGRATION DIRECTION IS GIVEN BY H0 (=R1) , + CALL XERRWD(' INTEGRATION DIRECTION IS GIVEN BY H0 (=R1) ', 1 50, 14, 0, 0, 0, 0, 1, H0, 0.0D0) GO TO 700 - 615 CALL XERRWV(30HLSODE-- HMAX (=R1) .LT. 0.0 , + 615 CALL XERRWD('LSODE-- HMAX (=R1) .LT. 0.0 ', 1 30, 15, 0, 0, 0, 0, 1, HMAX, 0.0D0) GO TO 700 - 616 CALL XERRWV(30HLSODE-- HMIN (=R1) .LT. 0.0 , + 616 CALL XERRWD('LSODE-- HMIN (=R1) .LT. 0.0 ', 1 30, 16, 0, 0, 0, 0, 1, HMIN, 0.0D0) GO TO 700 - 617 CALL XERRWV( - 1 60HLSODE-- RWORK LENGTH NEEDED, LENRW (=I1), EXCEEDS LRW (=I2), + 617 CALL XERRWD( + 1 'LSODE-- RWORK LENGTH NEEDED, LENRW (=I1), EXCEEDS LRW (=I2)', 1 60, 17, 0, 2, LENRW, LRW, 0, 0.0D0, 0.0D0) GO TO 700 - 618 CALL XERRWV( - 1 60HLSODE-- IWORK LENGTH NEEDED, LENIW (=I1), EXCEEDS LIW (=I2), + 618 CALL XERRWD( + 1 'LSODE-- IWORK LENGTH NEEDED, LENIW (=I1), EXCEEDS LIW (=I2)', 1 60, 18, 0, 2, LENIW, LIW, 0, 0.0D0, 0.0D0) GO TO 700 - 619 CALL XERRWV(40HLSODE-- RTOL(I1) IS R1 .LT. 0.0 , + 619 CALL XERRWD('LSODE-- RTOL(I1) IS R1 .LT. 0.0 ', 1 40, 19, 0, 1, I, 0, 1, RTOLI, 0.0D0) GO TO 700 - 620 CALL XERRWV(40HLSODE-- ATOL(I1) IS R1 .LT. 0.0 , + 620 CALL XERRWD('LSODE-- ATOL(I1) IS R1 .LT. 0.0 ', 1 40, 20, 0, 1, I, 0, 1, ATOLI, 0.0D0) GO TO 700 621 EWTI = RWORK(LEWT+I-1) - CALL XERRWV(40HLSODE-- EWT(I1) IS R1 .LE. 0.0 , + CALL XERRWD('LSODE-- EWT(I1) IS R1 .LE. 0.0 ', 1 40, 21, 0, 1, I, 0, 1, EWTI, 0.0D0) GO TO 700 - 622 CALL XERRWV( - 1 60HLSODE-- TOUT (=R1) TOO CLOSE TO T(=R2) TO START INTEGRATION, + 622 CALL XERRWD( + 1 'LSODE-- TOUT (=R1) TOO CLOSE TO T(=R2) TO START INTEGRATION', 1 60, 22, 0, 0, 0, 0, 2, TOUT, T) GO TO 700 - 623 CALL XERRWV( - 1 60HLSODE-- ITASK = I1 AND TOUT (=R1) BEHIND TCUR - HU (= R2) , + 623 CALL XERRWD( + 1 'LSODE-- ITASK = I1 AND TOUT (=R1) BEHIND TCUR - HU (= R2) ', 1 60, 23, 0, 1, ITASK, 0, 2, TOUT, TP) GO TO 700 - 624 CALL XERRWV( - 1 60HLSODE-- ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TCUR (=R2) , + 624 CALL XERRWD( + 1 'LSODE-- ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TCUR (=R2) ', 1 60, 24, 0, 0, 0, 0, 2, TCRIT, TN) GO TO 700 - 625 CALL XERRWV( - 1 60HLSODE-- ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TOUT (=R2) , + 625 CALL XERRWD( + 1 'LSODE-- ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TOUT (=R2) ', 1 60, 25, 0, 0, 0, 0, 2, TCRIT, TOUT) GO TO 700 - 626 CALL XERRWV(50HLSODE-- AT START OF PROBLEM, TOO MUCH ACCURACY , + 626 CALL XERRWD('LSODE-- AT START OF PROBLEM, TOO MUCH ACCURACY ', 1 50, 26, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) - CALL XERRWV( - 1 60H REQUESTED FOR PRECISION OF MACHINE.. SEE TOLSF (=R1) , + CALL XERRWD( + 1 ' REQUESTED FOR PRECISION OF MACHINE.. SEE TOLSF (=R1) ', 1 60, 26, 0, 0, 0, 0, 1, TOLSF, 0.0D0) RWORK(14) = TOLSF GO TO 700 - 627 CALL XERRWV(50HLSODE-- TROUBLE FROM INTDY. ITASK = I1, TOUT = R1, + 627 CALL XERRWD('LSODE-- TROUBLE FROM INTDY. ITASK = I1, TOUT = R1', 1 50, 27, 0, 1, ITASK, 0, 1, TOUT, 0.0D0) C 700 IF (ILLIN .EQ. 5) GO TO 710 ILLIN = ILLIN + 1 ISTATE = -3 RETURN - 710 CALL XERRWV(50HLSODE-- REPEATED OCCURRENCES OF ILLEGAL INPUT , + 710 CALL XERRWD('LSODE-- REPEATED OCCURRENCES OF ILLEGAL INPUT ', 1 50, 302, 0, 0, 0, 0, 0, 0.0D0, 0.0D0) C - 800 CALL XERRWV(50HLSODE-- RUN ABORTED.. APPARENT INFINITE LOOP , + 800 CALL XERRWD('LSODE-- RUN ABORTED.. APPARENT INFINITE LOOP ', 1 50, 303, 2, 0, 0, 0, 0, 0.0D0, 0.0D0) RETURN C----------------------- END OF SUBROUTINE LSODE -----------------------
--- a/libcruft/odepack/xerrwv.f Wed Aug 14 19:33:31 2002 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ - SUBROUTINE XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2) - INTEGER MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, - 1 I, LUN, LUNIT, MESFLG, NCPW, NCH, NWDS - DOUBLE PRECISION R1, R2 - DIMENSION MSG(NMES) -C----------------------------------------------------------------------- -C SUBROUTINES XERRWV, XSETF, AND XSETUN, AS GIVEN HERE, CONSTITUTE -C A SIMPLIFIED VERSION OF THE SLATEC ERROR HANDLING PACKAGE. -C WRITTEN BY A. C. HINDMARSH AT LLNL. VERSION OF MARCH 30, 1987. -C THIS VERSION IS IN DOUBLE PRECISION. -C -C ALL ARGUMENTS ARE INPUT ARGUMENTS. -C -C MSG = THE MESSAGE (HOLLERITH LITERAL OR INTEGER ARRAY). -C NMES = THE LENGTH OF MSG (NUMBER OF CHARACTERS). -C NERR = THE ERROR NUMBER (NOT USED). -C LEVEL = THE ERROR LEVEL.. -C 0 OR 1 MEANS RECOVERABLE (CONTROL RETURNS TO CALLER). -C 2 MEANS FATAL (RUN IS ABORTED--SEE NOTE BELOW). -C NI = NUMBER OF INTEGERS (0, 1, OR 2) TO BE PRINTED WITH MESSAGE. -C I1,I2 = INTEGERS TO BE PRINTED, DEPENDING ON NI. -C NR = NUMBER OF REALS (0, 1, OR 2) TO BE PRINTED WITH MESSAGE. -C R1,R2 = REALS TO BE PRINTED, DEPENDING ON NR. -C -C NOTE.. THIS ROUTINE IS MACHINE-DEPENDENT AND SPECIALIZED FOR USE -C IN LIMITED CONTEXT, IN THE FOLLOWING WAYS.. -C 1. THE NUMBER OF HOLLERITH CHARACTERS STORED PER WORD, DENOTED -C BY NCPW BELOW, IS A DATA-LOADED CONSTANT. -C 2. THE VALUE OF NMES IS ASSUMED TO BE AT MOST 60. -C (MULTI-LINE MESSAGES ARE GENERATED BY REPEATED CALLS.) -C 3. IF LEVEL = 2, CONTROL PASSES TO THE STATEMENT STOP -C TO ABORT THE RUN. THIS STATEMENT MAY BE MACHINE-DEPENDENT. -C 4. R1 AND R2 ARE ASSUMED TO BE IN DOUBLE PRECISION AND ARE PRINTED -C IN D21.13 FORMAT. -C 5. THE COMMON BLOCK /EH0001/ BELOW IS DATA-LOADED (A MACHINE- -C DEPENDENT FEATURE) WITH DEFAULT VALUES. -C THIS BLOCK IS NEEDED FOR PROPER RETENTION OF PARAMETERS USED BY -C THIS ROUTINE WHICH THE USER CAN RESET BY CALLING XSETF OR XSETUN. -C THE VARIABLES IN THIS BLOCK ARE AS FOLLOWS.. -C MESFLG = PRINT CONTROL FLAG.. -C 1 MEANS PRINT ALL MESSAGES (THE DEFAULT). -C 0 MEANS NO PRINTING. -C LUNIT = LOGICAL UNIT NUMBER FOR MESSAGES. -C THE DEFAULT IS 6 (MACHINE-DEPENDENT). -C----------------------------------------------------------------------- -C THE FOLLOWING ARE INSTRUCTIONS FOR INSTALLING THIS ROUTINE -C IN DIFFERENT MACHINE ENVIRONMENTS. -C -C TO CHANGE THE DEFAULT OUTPUT UNIT, CHANGE THE DATA STATEMENT -C IN THE BLOCK DATA SUBPROGRAM BELOW. -C -C FOR A DIFFERENT NUMBER OF CHARACTERS PER WORD, CHANGE THE -C DATA STATEMENT SETTING NCPW BELOW, AND FORMAT 10. ALTERNATIVES FOR -C VARIOUS COMPUTERS ARE SHOWN IN COMMENT CARDS. -C -C FOR A DIFFERENT RUN-ABORT COMMAND, CHANGE THE STATEMENT FOLLOWING -C STATEMENT 100 AT THE END. -C----------------------------------------------------------------------- - COMMON /EH0001/ MESFLG, LUNIT -C----------------------------------------------------------------------- -C THE FOLLOWING DATA-LOADED VALUE OF NCPW IS VALID FOR THE CDC-6600 -C AND CDC-7600 COMPUTERS. -C DATA NCPW/10/ -C THE FOLLOWING IS VALID FOR THE CRAY-1 COMPUTER. -C DATA NCPW/8/ -C THE FOLLOWING IS VALID FOR THE BURROUGHS 6700 AND 7800 COMPUTERS. -C DATA NCPW/6/ -C THE FOLLOWING IS VALID FOR THE PDP-10 COMPUTER. -C DATA NCPW/5/ -C THE FOLLOWING IS VALID FOR THE VAX COMPUTER WITH 4 BYTES PER INTEGER, -C AND FOR THE IBM-360, IBM-370, IBM-303X, AND IBM-43XX COMPUTERS. - DATA NCPW/4/ -C THE FOLLOWING IS VALID FOR THE PDP-11, OR VAX WITH 2-BYTE INTEGERS. -C DATA NCPW/2/ -C----------------------------------------------------------------------- - IF (MESFLG .EQ. 0) GO TO 100 -C GET LOGICAL UNIT NUMBER. --------------------------------------------- - LUN = LUNIT -C GET NUMBER OF WORDS IN MESSAGE. -------------------------------------- - NCH = MIN0(NMES,60) - NWDS = NCH/NCPW - IF (NCH .NE. NWDS*NCPW) NWDS = NWDS + 1 -C WRITE THE MESSAGE. --------------------------------------------------- - WRITE (LUN, 10) (MSG(I),I=1,NWDS) -C----------------------------------------------------------------------- -C THE FOLLOWING FORMAT STATEMENT IS TO HAVE THE FORM -C 10 FORMAT(1X,MMANN) -C WHERE NN = NCPW AND MM IS THE SMALLEST INTEGER .GE. 60/NCPW. -C THE FOLLOWING IS VALID FOR NCPW = 10. -C 10 FORMAT(1X,6A10) -C THE FOLLOWING IS VALID FOR NCPW = 8. -C 10 FORMAT(1X,8A8) -C THE FOLLOWING IS VALID FOR NCPW = 6. -C 10 FORMAT(1X,10A6) -C THE FOLLOWING IS VALID FOR NCPW = 5. -C 10 FORMAT(1X,12A5) -C THE FOLLOWING IS VALID FOR NCPW = 4. - 10 FORMAT(1X,15A4) -C THE FOLLOWING IS VALID FOR NCPW = 2. -C 10 FORMAT(1X,30A2) -C----------------------------------------------------------------------- - IF (NI .EQ. 1) WRITE (LUN, 20) I1 - 20 FORMAT(6X,23HIN ABOVE MESSAGE, I1 =,I10) - IF (NI .EQ. 2) WRITE (LUN, 30) I1,I2 - 30 FORMAT(6X,23HIN ABOVE MESSAGE, I1 =,I10,3X,4HI2 =,I10) - IF (NR .EQ. 1) WRITE (LUN, 40) R1 - 40 FORMAT(6X,23HIN ABOVE MESSAGE, R1 =,D21.13) - IF (NR .EQ. 2) WRITE (LUN, 50) R1,R2 - 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
--- a/libcruft/quadpack/dqagi.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/quadpack/dqagi.f Thu Aug 15 01:36:25 2002 +0000 @@ -185,6 +185,6 @@ C LVL = 0 10 IF(IER.EQ.6) LVL = 1 - IF(IER.GT.0) CALL XERROR(26HABNORMAL RETURN FROM DQAGI,26,IER,LVL) + IF(IER.GT.0) CALL XERROR('ABNORMAL RETURN FROM DQAGI',26,IER,LVL) RETURN END
--- a/libcruft/quadpack/dqagp.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/quadpack/dqagp.f Thu Aug 15 01:36:25 2002 +0000 @@ -219,6 +219,6 @@ C LVL = 0 10 IF(IER.EQ.6) LVL = 1 - IF(IER.GT.0) CALL XERROR(26HABNORMAL RETURN FROM DQAGP,26,IER,LVL) + IF(IER.GT.0) CALL XERROR('ABNORMAL RETURN FROM DQAGP',26,IER,LVL) RETURN END
--- a/libcruft/quadpack/xerror.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/quadpack/xerror.f Thu Aug 15 01:36:25 2002 +0000 @@ -34,6 +34,6 @@ C LATEST REVISION --- 7 FEB 1979 C DIMENSION MESSG(NMESSG) - CALL XERRWV(MESSG,NMESSG,NERR,LEVEL,0,0,0,0,0.,0.) + CALL XERRWD(MESSG,NMESSG,NERR,LEVEL,0,0,0,0,0.,0.) RETURN END
--- a/libcruft/slatec-err/xerrwd.f Wed Aug 14 19:33:31 2002 +0000 +++ b/libcruft/slatec-err/xerrwd.f Thu Aug 15 01:36:25 2002 +0000 @@ -92,6 +92,6 @@ C Abort the run if LEVEL = 2. C 100 IF (LEVEL .NE. 2) RETURN - STOP + CALL XSTOPX (' ') C----------------------- End of Subroutine XERRWD ---------------------- END