Mercurial > hg > octave-nkf
diff libcruft/dasrt/ddasrt.f @ 4040:5b781670e9ee
[project @ 2002-08-15 01:36:24 by jwe]
| author | jwe |
|---|---|
| date | Thu, 15 Aug 2002 01:36:25 +0000 |
| parents | 243f50d6f3d5 |
| children | 402d7b86a0a2 |
line wrap: on
line diff
--- a/libcruft/dasrt/ddasrt.f +++ b/libcruft/dasrt/ddasrt.f @@ -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