Mercurial > hg > octave-nkf
changeset 4041:3995501ce1d9
[project @ 2002-08-15 01:56:41 by jwe]
author | jwe |
---|---|
date | Thu, 15 Aug 2002 01:56:42 +0000 |
parents | 5b781670e9ee |
children | 8bc97120fbd5 |
files | libcruft/ChangeLog libcruft/odessa/odessa.f libcruft/odessa/odessa_intdy.f libcruft/odessa/odessa_rscom.f libcruft/odessa/odessa_svcom.f libcruft/odessa/odessa_xsetf.f libcruft/odessa/xerr.f libcruft/odessa/xsetun.f |
diffstat | 8 files changed, 67 insertions(+), 170 deletions(-) [+] |
line wrap: on
line diff
--- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,5 +1,10 @@ 2002-08-14 John W. Eaton <jwe@bevo.che.wisc.edu> + * odessa/odessa.f (ODESSA): Use XERRWD instead of XERR. + * odessa/intdy.f (ODESSA_INTDY): Likewise. + * odessa_rscom.f (ODESSA_RSCOM): Delete unused common block EH0001. + * odessa_svcom.f (ODESSA_SVCOM): Likewise. + * dasrt/xerrwv.f, odepack/xerrwv.f: Delete. * slatec-err/xerrwd.f (XERRWD): Call XSTOPX instead of using STOP.
--- a/libcruft/odessa/odessa.f +++ b/libcruft/odessa/odessa.f @@ -1008,23 +1008,6 @@ C C THE FOLLOWING ARE OPTIONAL CALLS WHICH THE USER MAY MAKE TO C GAIN ADDITIONAL CAPABILITIES IN CONJUNCTION WITH ODESSA. -C (THE ROUTINES XSETUN AND ODESSA_XSETF ARE DESIGNED TO CONFORM TO THE -C SLATEC ERROR HANDLING PACKAGE.) -C -C FORM OF CALL FUNCTION -C CALL XSETUN(LUN) SET THE LOGICAL UNIT NUMBER, LUN, FOR -C OUTPUT OF MESSAGES FROM ODESSA, IF -C THE DEFAULT IS NOT DESIRED. -C THE DEFAULT VALUE OF LUN IS 6. -C -C CALL ODESSA_XSETF(MFLAG) SET A FLAG TO CONTROL THE PRINTING OF -C MESSAGES BY ODESSA.. -C MFLAG = 0 MEANS DO NOT PRINT. (DANGER.. -C THIS RISKS LOSING VALUABLE INFORMATION.) -C MFLAG = 1 MEANS PRINT (THE DEFAULT). -C -C EITHER OF THE ABOVE CALLS MAY BE MADE AT -C ANY TIME AND WILL TAKE EFFECT IMMEDIATELY. C C CALL ODESSA_SVCOM (RSAV, ISAV) STORE IN RSAV AND ISAV THE CONTENTS C OF THE INTERNAL COMMON BLOCKS USED BY @@ -1088,7 +1071,6 @@ C FOLLOWED BY 39 INTEGER WORDS), C /ODE002/ OF LENGTH 14 (3 DOUBLE PRECISION WORDS FOLLOWED C BY 11 INTEGER WORDS), -C /EH0001/ OF LENGTH 2 (INTEGER WORDS). C C IF ODESSA IS USED ON A SYSTEM IN WHICH THE CONTENTS OF INTERNAL C COMMON BLOCKS ARE NOT PRESERVED BETWEEN CALLS, THE USER SHOULD @@ -1197,7 +1179,7 @@ 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 XERR, XSETUN, AND ODESSA_XSETF HANDLE THE PRINTING OF ALL ERROR +C XERRWD, XSETUN, AND ODESSA_XSETF HANDLE THE PRINTING OF ALL ERROR C MESSAGES AND WARNINGS. C NOTE.. ODESSA_VNORM, IDAMAX, DDOT, AND D1MACH ARE FUNCTION ROUTINES. C ALL THE OTHERS ARE SUBROUTINES. @@ -1635,16 +1617,16 @@ 280 IF (ODESSA_ADDX(TN,H) .NE. TN) GO TO 290 NHNIL = NHNIL + 1 IF (NHNIL .GT. MXHNIL) GO TO 290 - CALL XERR ('ODESSA - WARNING..INTERNAL T (=R1) AND H (=R2) ARE', + CALL XERRWD ('ODESSA - WARNING..INTERNAL T (=R1) AND H (=R2) ARE', 1 101, 1, 0, 0, 0, 0, ZERO, ZERO) - CALL XERR ('SUCH THAT IN THE MACHINE, T + H = T ON THE NEXT STEP', + CALL XERRWD ('SUCH THAT IN THE MACHINE, T + H = T ON THE NEXT STEP', 1 101, 1, 0, 0, 0, 0, ZERO, ZERO) - CALL XERR ('(H = STEP SIZE). SOLVER WILL CONTINUE ANYWAY', + CALL XERRWD ('(H = STEP SIZE). SOLVER WILL CONTINUE ANYWAY', 1 101, 1, 0, 0, 0, 2, TN, H) IF (NHNIL .LT. MXHNIL) GO TO 290 - CALL XERR ('ODESSA - ABOVE WARNING HAS BEEN ISSUED I1 TIMES.', + CALL XERRWD ('ODESSA - ABOVE WARNING HAS BEEN ISSUED I1 TIMES.', 1 102, 1, 0, 0, 0, 0, ZERO, ZERO) - CALL XERR ('IT WILL NOT BE ISSUED AGAIN FOR THIS PROBLEM', + CALL XERRWD ('IT WILL NOT BE ISSUED AGAIN FOR THIS PROBLEM', 1 102, 1, 1, MXHNIL, 0, 0, ZERO,ZERO) 290 CONTINUE C----------------------------------------------------------------------- @@ -1718,7 +1700,7 @@ RETURN 430 NTREP = NTREP + 1 IF (NTREP .LT. 5) RETURN - CALL XERR ('ODESSA -- REPEATED CALLS WITH ISTATE = 1 AND + CALL XERRWD ('ODESSA -- REPEATED CALLS WITH ISTATE = 1 AND 1TOUT = T (=R1)', 301, 1, 0, 0, 0, 1, T, ZERO) GO TO 800 C----------------------------------------------------------------------- @@ -1731,39 +1713,39 @@ C THE WORK ARRAYS BEFORE RETURNING. C----------------------------------------------------------------------- C THE MAXIMUM NUMBER OF STEPS WAS TAKEN BEFORE REACHING TOUT. ---------- - 500 CALL XERR ('ODESSA - AT CURRENT T (=R1), MXSTEP (=I1) STEPS', + 500 CALL XERRWD ('ODESSA - AT CURRENT T (=R1), MXSTEP (=I1) STEPS', 1 201, 1, 0, 0, 0, 0, ZERO,ZERO) - CALL XERR ('TAKEN ON THIS CALL BEFORE REACHING TOUT', + CALL XERRWD ('TAKEN ON THIS CALL BEFORE REACHING TOUT', 1 201, 1, 1, MXSTEP, 0, 1, TN, ZERO) 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 XERR ('ODESSA - AT T (=R1), EWT(I1) HAS BECOME R2 .LE. 0.', + CALL XERRWD ('ODESSA - AT T (=R1), EWT(I1) HAS BECOME R2 .LE. 0.', 1 202, 1, 1, I, 0, 2, TN, EWTI) ISTATE = -6 GO TO 580 C TOO MUCH ACCURACY REQUESTED FOR MACHINE PRECISION. ------------------- - 520 CALL XERR ('ODESSA - AT T (=R1), TOO MUCH ACCURACY REQUESTED', + 520 CALL XERRWD ('ODESSA - AT T (=R1), TOO MUCH ACCURACY REQUESTED', 1 203, 1, 0, 0, 0, 0, ZERO,ZERO) - CALL XERR ('FOR PRECISION OF MACHINE.. SEE TOLSF (=R2)', + CALL XERRWD ('FOR PRECISION OF MACHINE.. SEE TOLSF (=R2)', 1 203, 1, 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 XERR ('ODESSA - AT T(=R1) AND STEP SIZE H(=R2), THE ERROR', + 530 CALL XERRWD ('ODESSA - AT T(=R1) AND STEP SIZE H(=R2), THE ERROR', 1 204, 1, 0, 0, 0, 0, ZERO, ZERO) - CALL XERR ('TEST FAILED REPEATEDLY OR WITH ABS(H) = HMIN', + CALL XERRWD ('TEST FAILED REPEATEDLY OR WITH ABS(H) = HMIN', 1 204, 1, 0, 0, 0, 2, TN, H) ISTATE = -4 GO TO 560 C KFLAG = -2. CONVERGENCE FAILED REPEATEDLY OR WITH ABS(H) = HMIN. ---- - 540 CALL XERR ('ODESSA - AT T (=R1) AND STEP SIZE H (=R2), THE', + 540 CALL XERRWD ('ODESSA - AT T (=R1) AND STEP SIZE H (=R2), THE', 1 205, 1, 0, 0, 0, 0, ZERO,ZERO) - CALL XERR ('CORRECTOR CONVERGENCE FAILED REPEATEDLY', + CALL XERRWD ('CORRECTOR CONVERGENCE FAILED REPEATEDLY', 1 205, 1, 0, 0, 0, 0, ZERO,ZERO) - CALL XERR ('OR WITH ABS(H) = HMIN', + CALL XERRWD ('OR WITH ABS(H) = HMIN', 1 205, 1, 0, 0, 0, 2, TN, H) ISTATE = -5 C COMPUTE IMXER IF RELEVANT. ------------------------------------------- @@ -1801,111 +1783,112 @@ C 5 CONSECUTIVE SUCH RETURNS JUST BEFORE THIS CALL TO THE SOLVER, C THE RUN IS HALTED. C----------------------------------------------------------------------- - 601 CALL XERR ('ODESSA - ISTATE (=I1) ILLEGAL', + 601 CALL XERRWD ('ODESSA - ISTATE (=I1) ILLEGAL', 1 1, 1, 1, ISTATE, 0, 0, ZERO,ZERO) GO TO 700 - 602 CALL XERR ('ODESSA - ITASK (=I1) ILLEGAL', + 602 CALL XERRWD ('ODESSA - ITASK (=I1) ILLEGAL', 1 2, 1, 1, ITASK, 0, 0, ZERO,ZERO) GO TO 700 - 603 CALL XERR ('ODESSA - ISTATE .GT. 1 BUT ODESSA NOT INITIALIZED', + 603 CALL XERRWD ('ODESSA - ISTATE .GT. 1 BUT ODESSA NOT INITIALIZED', 1 3, 1, 0, 0, 0, 0, ZERO,ZERO) GO TO 700 - 604 CALL XERR ('ODESSA - NEQ (=I1) .LT. 1', + 604 CALL XERRWD ('ODESSA - NEQ (=I1) .LT. 1', 1 4, 1, 1, NEQ(1), 0, 0, ZERO,ZERO) GO TO 700 - 605 CALL XERR ('ODESSA - ISTATE = 3 AND NEQ CHANGED. (I1 TO I2)', + 605 CALL XERRWD ('ODESSA - ISTATE = 3 AND NEQ CHANGED. (I1 TO I2)', 1 5, 1, 2, N, NEQ(1), 0, ZERO,ZERO) GO TO 700 - 606 CALL XERR ('ODESSA - ITOL (=I1) ILLEGAL', + 606 CALL XERRWD ('ODESSA - ITOL (=I1) ILLEGAL', 1 6, 1, 1, ITOL, 0, 0, ZERO,ZERO) GO TO 700 - 607 CALL XERR ('ODESSA - IOPT (=I1) ILLEGAL', + 607 CALL XERRWD ('ODESSA - IOPT (=I1) ILLEGAL', 1 7, 1, 1, IOPT, 0, 0, ZERO,ZERO) GO TO 700 - 608 CALL XERR('ODESSA - MF (=I1) ILLEGAL', + 608 CALL XERRWD('ODESSA - MF (=I1) ILLEGAL', 1 8, 1, 1, MF, 0, 0, ZERO,ZERO) GO TO 700 - 609 CALL XERR('ODESSA - ML (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2)', + 609 CALL XERRWD('ODESSA - ML (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2)', 1 9, 1, 2, ML, NEQ(1), 0, ZERO,ZERO) GO TO 700 - 610 CALL XERR('ODESSA - MU (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2)', + 610 CALL XERRWD('ODESSA - MU (=I1) ILLEGAL.. .LT.0 OR .GE.NEQ (=I2)', 1 10, 1, 2, MU, NEQ(1), 0, ZERO,ZERO) GO TO 700 - 611 CALL XERR('ODESSA - MAXORD (=I1) .LT. 0', + 611 CALL XERRWD('ODESSA - MAXORD (=I1) .LT. 0', 1 11, 1, 1, MAXORD, 0, 0, ZERO,ZERO) GO TO 700 - 612 CALL XERR('ODESSA - MXSTEP (=I1) .LT. 0', + 612 CALL XERRWD('ODESSA - MXSTEP (=I1) .LT. 0', 1 12, 1, 1, MXSTEP, 0, 0, ZERO,ZERO) GO TO 700 - 613 CALL XERR('ODESSA - MXHNIL (=I1) .LT. 0', + 613 CALL XERRWD('ODESSA - MXHNIL (=I1) .LT. 0', 1 13, 1, 1, MXHNIL, 0, 0, ZERO,ZERO) GO TO 700 - 614 CALL XERR('ODESSA - TOUT (=R1) BEHIND T (=R2)', + 614 CALL XERRWD('ODESSA - TOUT (=R1) BEHIND T (=R2)', 1 14, 1, 0, 0, 0, 2, TOUT, T) - CALL XERR('INTEGRATION DIRECTION IS GIVEN BY H0 (=R1)', + CALL XERRWD('INTEGRATION DIRECTION IS GIVEN BY H0 (=R1)', 1 14, 1, 0, 0, 0, 1, H0, ZERO) GO TO 700 - 615 CALL XERR('ODESSA - HMAX (=R1) .LT. 0.0', + 615 CALL XERRWD('ODESSA - HMAX (=R1) .LT. 0.0', 1 15, 1, 0, 0, 0, 1, HMAX, ZERO) GO TO 700 - 616 CALL XERR('ODESSA - HMIN (=R1) .LT. 0.0', + 616 CALL XERRWD('ODESSA - HMIN (=R1) .LT. 0.0', 1 16, 1, 0, 0, 0, 1, HMIN, ZERO) GO TO 700 - 617 CALL XERR('ODESSA - RWORK LENGTH NEEDED, LENRW (=I1), EXCEEDS + 617 CALL XERRWD('ODESSA - RWORK LENGTH NEEDED, LENRW (=I1), EXCEEDS 1 LRW (=I2)', 17, 1, 2, LENRW, LRW, 0, ZERO,ZERO) GO TO 700 - 618 CALL XERR('ODESSA - IWORK LENGTH NEEDED, LENIW (=I1), EXCEEDS + 618 CALL XERRWD('ODESSA - IWORK LENGTH NEEDED, LENIW (=I1), EXCEEDS 1 LIW (=I2)', 18, 1, 2, LENIW, LIW, 0, ZERO,ZERO) GO TO 700 - 619 CALL XERR('ODESSA - RTOL(I1) IS R1 .LT. 0.0', + 619 CALL XERRWD('ODESSA - RTOL(I1) IS R1 .LT. 0.0', 1 19, 1, 1, I, 0, 1, RTOLI, ZREO) GO TO 700 - 620 CALL XERR('ODESSA - ATOL(I1) IS R1 .LT. 0.0', + 620 CALL XERRWD('ODESSA - ATOL(I1) IS R1 .LT. 0.0', 1 20, 1, 1, I, 0, 1, ATOLI, ZERO) GO TO 700 * 621 EWTI = RWORK(LEWT+I-1) - CALL XERR('ODESSA - EWT(I1) IS R1 .LE. 0.0', + CALL XERRWD('ODESSA - EWT(I1) IS R1 .LE. 0.0', 1 21, 1, 1, I, 0, 1, EWTI, ZERO) GO TO 700 - 622 CALL XERR('ODESSA - TOUT (=R1) TOO CLOSE TO T(=R2) TO START + 622 CALL XERRWD('ODESSA - TOUT (=R1) TOO CLOSE TO T(=R2) TO START 1 INTEGRATION', 22, 1, 0, 0, 0, 2, TOUT, T) GO TO 700 - 623 CALL XERR('ODESSA - ITASK = I1 AND TOUT (=R1) BEHIND TCUR - HU + 623 CALL XERRWD('ODESSA - ITASK = I1 AND TOUT (=R1) BEHIND TCUR - HU 1 (= R2)', 23, 1, 1, ITASK, 0, 2, TOUT, TP) GO TO 700 - 624 CALL XERR('ODESSA - ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TCUR + 624 CALL XERRWD('ODESSA - ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TCUR 1 (=R2)', 24, 1, 0, 0, 0, 2, TCRIT, TN) GO TO 700 - 625 CALL XERR('ODESSA - ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TOUT + 625 CALL XERRWD('ODESSA - ITASK = 4 OR 5 AND TCRIT (=R1) BEHIND TOUT 1 (=R2)', 25, 1, 0, 0, 0, 2, TCRIT, TOUT) GO TO 700 - 626 CALL XERR('ODESSA - AT START OF PROBLEM, TOO MUCH ACCURACY', + 626 CALL XERRWD('ODESSA - AT START OF PROBLEM, TOO MUCH ACCURACY', 1 26, 1, 0, 0, 0, 0, ZERO,ZERO) - CALL XERR('REQUESTED FOR PRECISION OF MACHINE. SEE TOLSF (=R1)', + CALL XERRWD('REQUESTED FOR PRECISION OF MACHINE. SEE TOLSF (=R1)', 1 26, 1, 0, 0, 0, 1, TOLSF, ZERO) RWORK(14) = TOLSF GO TO 700 - 627 CALL XERR('ODESSA - TROUBLE FROM ODESSA_INTDY. ITASK = I1, TOUT = - 1 R1', 27, 1, 1, ITASK, 0, 1, TOUT, ZERO) + 627 CALL XERRWD + 1 ('ODESSA - TROUBLE FROM ODESSA_INTDY. ITASK = I1, TOUT = R1', + 1 27, 1, 1, ITASK, 0, 1, TOUT, ZERO) GO TO 700 C ERROR STATEMENTS ASSOCIATED WITH SENSITIVITY ANALYSIS. - 628 CALL XERR('ODESSA - NPAR (=I1) .LT. 1', + 628 CALL XERRWD('ODESSA - NPAR (=I1) .LT. 1', 1 28, 1, 1, NPAR, 0, 0, ZERO,ZERO) GO TO 700 - 629 CALL XERR('ODESSA - ISTATE = 3 AND NPAR CHANGED (I1 TO I2)', + 629 CALL XERRWD('ODESSA - ISTATE = 3 AND NPAR CHANGED (I1 TO I2)', 1 29, 1, 2, NP, NPAR, 0, ZERO,ZERO) GO TO 700 - 630 CALL XERR('ODESSA - MITER (=I1) ILLEGAL', + 630 CALL XERRWD('ODESSA - MITER (=I1) ILLEGAL', 1 30, 1, 1, MITER, 0, 0, ZERO,ZERO) GO TO 700 - 631 CALL XERR('ODESSA - TROUBLE IN ODESSA_SPRIME (IERPJ)', + 631 CALL XERRWD('ODESSA - TROUBLE IN ODESSA_SPRIME (IERPJ)', 1 31, 1, 0, 0, 0, 0, ZERO,ZERO) GO TO 700 - 632 CALL XERR('ODESSA - TROUBLE IN ODESSA_SPRIME (MITER)', + 632 CALL XERRWD('ODESSA - TROUBLE IN ODESSA_SPRIME (MITER)', 1 32, 1, 0, 0, 0, 0, ZERO,ZERO) GO TO 700 - 633 CALL XERR('ODESSA - FATAL ERROR IN ODESSA_STODE (KFLAG = -3)', + 633 CALL XERRWD('ODESSA - FATAL ERROR IN ODESSA_STODE (KFLAG = -3)', 1 33, 2, 0, 0, 0, 0, ZERO,ZERO) GO TO 801 C @@ -1913,13 +1896,13 @@ ILLIN = ILLIN + 1 ISTATE = -3 RETURN - 710 CALL XERR('ODESSA - REPEATED OCCURRENCES OF ILLEGAL INPUT', + 710 CALL XERRWD('ODESSA - REPEATED OCCURRENCES OF ILLEGAL INPUT', 1 302, 1, 0, 0, 0, 0, ZERO,ZERO) C - 800 CALL XERR('ODESSA - RUN ABORTED.. APPARENT INFINITE LOOP', + 800 CALL XERRWD('ODESSA - RUN ABORTED.. APPARENT INFINITE LOOP', 1 303, 2, 0, 0, 0, 0, ZERO,ZERO) RETURN - 801 CALL XERR('ODESSA - RUN ABORTED', + 801 CALL XERRWD('ODESSA - RUN ABORTED', 1 304, 2, 0, 0, 0, 0, ZERO,ZERO) RETURN C-------------------- END OF SUBROUTINE ODESSA -------------------------
--- a/libcruft/odessa/odessa_intdy.f +++ b/libcruft/odessa/odessa_intdy.f @@ -60,13 +60,13 @@ 60 DKY(I) = R*DKY(I) RETURN C - 80 CALL XERR('ODESSA_INTDY-- K (=I1) ILLEGAL', + 80 CALL XERRWD('ODESSA_INTDY-- K (=I1) ILLEGAL', 1 51, 1, 1, K, 0, 0, ZERO,ZERO) IFLAG = -1 RETURN - 90 CALL XERR ('ODESSA_INTDY-- T (=R1) ILLEGAL', + 90 CALL XERRWD ('ODESSA_INTDY-- T (=R1) ILLEGAL', 1 52, 1, 0, 0, 0, 1, T, ZERO) - CALL XERR('T NOT IN INTERVAL TCUR - HU (= R1) TO TCUR (=R2)', + CALL XERRWD('T NOT IN INTERVAL TCUR - HU (= R1) TO TCUR (=R2)', 1 52, 1, 0, 0, 0, 2, TP, TN) IFLAG = -2 RETURN
--- a/libcruft/odessa/odessa_rscom.f +++ b/libcruft/odessa/odessa_rscom.f @@ -1,7 +1,7 @@ SUBROUTINE ODESSA_RSCOM (RSAV, ISAV) C----------------------------------------------------------------------- C THIS ROUTINE RESTORES FROM RSAV AND ISAV THE CONTENTS OF COMMON BLOCKS -C ODE001, ODE002 AND EH0001, WHICH ARE USED INTERNALLY IN THE ODESSSA +C ODE001 AND ODE002, WHICH ARE USED INTERNALLY IN THE ODESSSA C PACKAGE. THIS PRESUMES THAT RSAV AND ISAV WERE LOADED BY MEANS C OF SUBROUTINE ODESSA_SVCOM OR THE EQUIVALENT. C----------------------------------------------------------------------- @@ -9,7 +9,6 @@ DIMENSION RSAV(*), ISAV(*) COMMON /ODE001/ RODE1(219), IODE1(39) COMMON /ODE002/ RODE2(3), IODE2(11) - COMMON /EH0001/ IEH(2) DATA LRODE1/219/, LIODE1/39/, LRODE2/3/, LIODE2/11/ C DO 10 I = 1,LRODE1 @@ -22,8 +21,6 @@ DO 40 I = 1,LODE2 J = LIODE1 + I 40 IODE2(I) = ISAV(J) - IEH(1) = ISAV(LIODE1+LIODE2+1) - IEH(2) = ISAV(LIODE1+LIODE2+2) RETURN C----------------------- END OF SUBROUTINE ODESSA_RSCOM ----------------------- END
--- a/libcruft/odessa/odessa_svcom.f +++ b/libcruft/odessa/odessa_svcom.f @@ -1,7 +1,7 @@ SUBROUTINE ODESSA_SVCOM (RSAV, ISAV) C----------------------------------------------------------------------- C THIS ROUTINE STORES IN RSAV AND ISAV THE CONTENTS OF COMMON BLOCKS -C ODE001, ODE002 AND EH0001, WHICH ARE USED INTERNALLY IN THE ODESSA +C ODE001 AND ODE002, WHICH ARE USED INTERNALLY IN THE ODESSA C PACKAGE. C RSAV = REAL ARRAY OF LENGTH 222 OR MORE. C ISAV = INTEGER ARRAY OF LENGTH 52 OR MORE. @@ -10,7 +10,6 @@ DIMENSION RSAV(*), ISAV(*) COMMON /ODE001/ RODE1(219), IODE1(39) COMMON /ODE002/ RODE2(3), IODE2(11) - COMMON /EH0001/ IEH(2) DATA LRODE1/219/, LIODE1/39/, LRODE2/3/, LIODE2/11/ C DO 10 I = 1,LRODE1 @@ -23,8 +22,6 @@ DO 40 I = 1,LIODE2 J = LIODE1 + I 40 ISAV(J) = IODE2(I) - ISAV(LIODE1+LIODE2+1) = IEH(1) - ISAV(LIODE1+LIODE2+2) = IEH(2) RETURN C----------------------- END OF SUBROUTINE ODESSA_SVCOM ----------------------- END
deleted file mode 100644 --- a/libcruft/odessa/odessa_xsetf.f +++ /dev/null @@ -1,11 +0,0 @@ - SUBROUTINE ODESSA_XSETF (MFLAG) -C -C THIS ROUTINE RESETS THE PRINT CONTROL FLAG MFLAG. -C - INTEGER MFLAG, MESFLG, LUNIT - COMMON /EH0001/ MESFLG, LUNIT -C - IF (MFLAG .EQ. 0 .OR. MFLAG .EQ. 1) MESFLG = MFLAG - RETURN -C----------------------- END OF SUBROUTINE ODESSA_XSETF ----------------------- - END
deleted file mode 100644 --- a/libcruft/odessa/xerr.f +++ /dev/null @@ -1,63 +0,0 @@ - SUBROUTINE XERR (MSG, NERR, IERT, NI, I1, I2, NR, R1, R2) - INTEGER NERR, IERT, NI, I1, I2, NR, - 1 LUN, LUNIT, MESFLG - DOUBLE PRECISION R1, R2 - CHARACTER*(*) MSG -C------------------------------------------------------------------- -C -C ALL ARGUMENTS ARE INPUT ARGUMENTS. -C -C MSG = THE MESSAGE (CHARACTER VARIABLE) -C NERR = THE ERROR NUMBER (NOT USED). -C IERT = THE ERROR TYPE.. -C 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 NOTES: -C 1. THE DIMENSION OF MSG IS ASSUMED TO BE AT MOST 60. -C (MULTI-LINE MESSAGES ARE GENERATED BY REPEATED CALLS.) -C 2. IF IERT = 2, CONTROL PASSES TO THE STATEMENT STOP -C TO ABORT THE RUN. THIS STATEMENT MAY BE MACHINE-DEPENDENT. -C 3. R1 AND R2 ARE ASSUMED TO BE IN DOUBLE PRECISION AND ARE PRINTED -C IN D21.13 FORMAT. -C 4. 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 ODESSA_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 5. TO CHANGE THE DEFAULT OUTPUT UNIT, CHANGE THE DATA STATEMENT -C IN THE BLOCK DATA SUBPROGRAM BELOW. -C -C FOR A DIFFERENT RUN-ABORT COMMAND, CHANGE THE STATEMENT FOLLOWING -C STATEMENT 100 AT THE END. -C----------------------------------------------------------------------- - COMMON /EH0001/ MESFLG, LUNIT - IF (MESFLG .EQ. 0) GO TO 100 -C GET LOGICAL UNIT NUMBER. --------------------------------------------- - LUN = LUNIT -C WRITE THE MESSAGE. --------------------------------------------------- - WRITE (LUN, 10) MSG - 10 FORMAT(1X,A) -C----------------------------------------------------------------------- - IF (NI .EQ. 1) WRITE (LUN, 20) I1 - 20 FORMAT(6X,'IN ABOVE MESSAGE, I1 = ',I10) - IF (NI .EQ. 2) WRITE (LUN, 30) I1,I2 - 30 FORMAT(6X,'IN ABOVE MESSAGE, I1 = ',I10,3X,'I2 = ',I10) - IF (NR .EQ. 1) WRITE (LUN, 40) R1 - 40 FORMAT(6X,'IN ABOVE MESSAGE, R1 = ',D21.13) - IF (NR .EQ. 2) WRITE (LUN, 50) R1,R2 - 50 FORMAT(6X,'IN ABOVE, R1 = ',D21.13,3X,'R2 = ',D21.13) -C ABORT THE RUN IF IERT = 2. ------------------------------------------- - 100 IF (IERT .NE. 2) RETURN - STOP -C----------------------- END OF SUBROUTINE XERR ---------------------- - END
deleted file mode 100644 --- a/libcruft/odessa/xsetun.f +++ /dev/null @@ -1,11 +0,0 @@ - SUBROUTINE XSETUN (LUN) -C -C THIS ROUTINE RESETS THE LOGICAL UNIT NUMBER FOR MESSAGES. -C - INTEGER LUN, MESFLG, LUNIT - COMMON /EH0001/ MESFLG, LUNIT -C - IF (LUN .GT. 0) LUNIT = LUN - RETURN -C----------------------- END OF SUBROUTINE XSETUN ---------------------- - END