5 SUBROUTINE ddaspk (RES, NEQ, T, Y, YPRIME, TOUT, INFO, RTOL, ATOL,
6 * IDID, RWORK, LRW, IWORK, LIW, RPAR, IPAR, JAC, PSOL)
1341 IMPLICIT DOUBLE PRECISION(a-h,o-z)
1342 LOGICAL DONE, LAVL, LCFN, LCFL, LWARN
1343 dimension y(*),yprime(*)
1345 dimension rwork(lrw),iwork(liw)
1346 dimension rtol(*),atol(*)
1347 dimension rpar(*),ipar(*)
1353 parameter(lml=1, lmu=2, lmtype=4,
1354 * liwm=1, lmxord=3, ljcalc=5, lphase=6, lk=7, lkold=8,
1355 * lns=9, lnstl=10, lnst=11, lnre=12, lnje=13, letf=14, lncfn=15,
1356 * lncfl=16, lniw=17, lnrw=18, lnni=19, lnli=20, lnps=21,
1357 * lnpd=22, lmiter=23, lmaxl=24, lkmp=25, lnrmax=26, llnwp=27,
1358 * llniwp=28, llocwp=29, llciwp=30, lkprin=31,
1359 * lmxnit=32, lmxnj=33, lmxnh=34, llsoff=35, licns=41)
1363 parameter(ltstop=1, lhmax=2, lh=3, ltn=4, lcj=5, lcjold=6,
1364 * lhold=7, ls=8, lround=9, lepli=10, lsqrn=11, lrsqrn=12,
1365 * lepcon=13, lstol=14, lepin=15,
1366 * lalpha=21, lbeta=27,
lgamma=33, lpsi=39, lsigma=45, ldelta=51)
1368 SAVE lid, lenid, nonneg
1374 IF(info(1).NE.0)
GO TO 100
1388 IF (info(i) .NE. 0 .AND. info(i) .NE. 1)
GO TO 701
1391 IF(info(10).LT.0 .OR. info(10).GT.3)
GO TO 701
1393 IF(info(11).LT.0 .OR. info(11).GT.2)
GO TO 701
1396 IF (info(i) .NE. 0 .AND. info(i) .NE. 1)
GO TO 701
1399 IF(info(18).LT.0 .OR. info(18).GT.2)
GO TO 701
1404 IF (neq .LE. 0)
GO TO 702
1409 IF (info(9) .NE. 0)
THEN
1411 IF (mxord .LT. 1 .OR. mxord .GT. 5)
GO TO 703
1421 IF (info(10) .EQ. 0)
GO TO 20
1422 IF (info(10) .EQ. 1)
THEN
1426 ELSEIF (info(10) .EQ. 2)
THEN
1441 IF (info(12) .EQ. 0)
GO TO 25
1443 iwork(lmiter) = info(12)
1444 IF (info(13) .EQ. 0)
THEN
1445 iwork(lmaxl) =
min(5,neq)
1446 iwork(lkmp) = iwork(lmaxl)
1448 rwork(lepli) = 0.05d0
1450 IF(iwork(lmaxl) .LT. 1 .OR. iwork(lmaxl) .GT. neq)
GO TO 720
1451 IF(iwork(lkmp) .LT. 1 .OR. iwork(lkmp) .GT. iwork(lmaxl))
1453 IF(iwork(lnrmax) .LT. 0)
GO TO 722
1454 IF(rwork(lepli).LE.0.0d0 .OR. rwork(lepli).GE.1.0d0)
GO TO 723
1463 IF (info(11) .EQ. 0)
GO TO 30
1464 IF (info(17) .EQ. 0)
THEN
1466 IF (info(12) .GT. 0) iwork(lmxnit) = 15
1468 IF (info(12) .GT. 0) iwork(lmxnj) = 2
1471 rwork(lepin) = 0.01d0
1473 IF (iwork(lmxnit) .LE. 0)
GO TO 725
1474 IF (iwork(lmxnj) .LE. 0)
GO TO 725
1475 IF (iwork(lmxnh) .LE. 0)
GO TO 725
1476 lsoff = iwork(llsoff)
1477 IF (lsoff .LT. 0 .OR. lsoff .GT. 1)
GO TO 725
1478 IF (rwork(lepin) .LE. 0.0d0)
GO TO 725
1488 IF (info(10) .EQ. 1 .OR. info(10) .EQ. 3) lenic = neq
1490 IF (info(11) .EQ. 1 .OR. info(16) .EQ. 1) lenid = neq
1491 IF (info(12) .EQ. 0)
THEN
1495 ncphi =
max(mxord + 1, 4)
1496 IF(info(6).EQ.0)
THEN
1498 lenrw = 50 + (ncphi+3)*neq + lenpd
1499 IF(info(5).EQ.0)
THEN
1505 IF(iwork(lml).LT.0.OR.iwork(lml).GE.neq)
GO TO 717
1506 IF(iwork(lmu).LT.0.OR.iwork(lmu).GE.neq)
GO TO 718
1507 lenpd=(2*iwork(lml)+iwork(lmu)+1)*neq
1508 IF(info(5).EQ.0)
THEN
1510 mband=iwork(lml)+iwork(lmu)+1
1512 lenrw = 50 + (ncphi+3)*neq + lenpd + 2*msave
1515 lenrw = 50 + (ncphi+3)*neq + lenpd
1521 leniw = 40 + lenic + lenid + neq
1525 ELSE IF (info(12) .EQ. 1)
THEN
1527 lenwp = iwork(llnwp)
1528 leniwp = iwork(llniwp)
1529 lenpd = (maxl+3+min0(1,maxl-iwork(lkmp)))*neq
1530 1 + (maxl+3)*maxl + 1 + lenwp
1531 lenrw = 50 + (iwork(lmxord)+5)*neq + lenpd
1532 leniw = 40 + lenic + lenid + leniwp
1535 IF(info(16) .NE. 0) lenrw = lenrw + neq
1542 iwork(llocwp) = lenpd-lenwp+1
1543 IF(lrw.LT.lenrw)
GO TO 704
1544 IF(liw.LT.leniw)
GO TO 705
1548 IF (lenic .GT. 0)
THEN
1550 ici = iwork(licns-1+i)
1551 IF (ici .LT. -2 .OR. ici .GT. 2)
GO TO 726
1557 IF (lenic .GT. 0)
THEN
1558 CALL dcnst0(neq,y,iwork(licns),iret)
1559 IF (iret .NE. 0)
GO TO 727
1564 IF (lenid .GT. 0)
THEN
1566 idi = iwork(lid-1+i)
1567 IF (idi .NE. 1 .AND. idi .NE. -1)
GO TO 724
1573 IF(tout .EQ. t)
GO TO 719
1577 IF(info(7) .NE. 0)
THEN
1579 IF (hmax .LE. 0.0d0)
GO TO 710
1593 iwork(lkprin)=info(18)
1604 IF(info(1).EQ.1)
GO TO 110
1606 IF(info(1).NE.-1)
GO TO 701
1612 msg =
'DASPK-- THE LAST STEP TERMINATED WITH A NEGATIVE'
1613 CALL xerrwd(msg,49,201,0,0,0,0,0,0.0d0,0.0d0)
1614 msg =
'DASPK-- VALUE (=I1) OF IDID AND NO APPROPRIATE'
1615 CALL xerrwd(msg,47,202,0,1,idid,0,0,0.0d0,0.0d0)
1616 msg =
'DASPK-- ACTION WAS TAKEN. RUN TERMINATED'
1617 CALL xerrwd(msg,41,203,1,0,0,0,0,0.0d0,0.0d0)
1633 iwork(lnstl)=iwork(lnst)
1636 ncfn0 = iwork(lncfn)
1637 ncfl0 = iwork(lncfl)
1646 IF (info(2) .EQ. 1) rtoli = rtol(i)
1647 IF (info(2) .EQ. 1) atoli = atol(i)
1648 IF (rtoli .GT. 0.0d0 .OR. atoli .GT. 0.0d0) nzflg = 1
1649 IF (rtoli .LT. 0.0d0)
GO TO 706
1650 IF (atoli .LT. 0.0d0)
GO TO 707
1652 IF (nzflg .EQ. 0)
GO TO 708
1657 iwork(llciwp) = lid + lenid
1659 IF (info(12) .NE. 0) lsavr = ldelta + neq
1663 IF (info(16) .NE. 0) lvt = lwt + neq
1665 lwm = lphi + (iwork(lmxord)+1)*neq
1666 IF (info(1) .EQ. 1)
GO TO 400
1680 CALL ddawts(neq,info(2),rtol,atol,y,rwork(lwt),rpar,ipar)
1681 CALL dinvwt(neq,rwork(lwt),ier)
1682 IF (ier .NE. 0)
GO TO 713
1683 IF (info(16) .NE. 0)
THEN
1685 305 rwork(lvt+i-1) =
max(iwork(lid+i-1),0)*rwork(lwt+i-1)
1691 rwork(lround) = uround
1692 hmin = 4.0d0*uround*
max(abs(t),abs(tout))
1696 IF (info(11) .NE. 0)
THEN
1697 IF( info(17) .EQ. 0)
THEN
1698 rwork(lstol) = uround**.6667d0
1700 IF (rwork(lstol) .LE. 0.0d0)
GO TO 725
1707 rwork(lepcon) = 0.33d0
1709 rwork(lsqrn) = sqrt(floatn)
1710 rwork(lrsqrn) = 1.d0/rwork(lsqrn)
1714 tdist = abs(tout - t)
1715 IF(tdist .LT. hmin)
GO TO 714
1719 IF (info(8) .EQ. 0)
GO TO 310
1721 IF ((tout - t)*h0 .LT. 0.0d0)
GO TO 711
1722 IF (h0 .EQ. 0.0d0)
GO TO 712
1730 ypnorm =
ddwnrm(neq,yprime,rwork(lvt),rpar,ipar)
1731 IF (ypnorm .GT. 0.5d0/h0) h0 = 0.5d0/ypnorm
1732 h0 = sign(h0,tout-t)
1736 320
IF (info(7) .EQ. 0)
GO TO 330
1737 rh = abs(h0)/rwork(lhmax)
1738 IF (rh .GT. 1.0d0) h0 = h0/rh
1742 330
IF (info(4) .EQ. 0)
GO TO 340
1743 tstop = rwork(ltstop)
1744 IF ((tstop - t)*h0 .LT. 0.0d0)
GO TO 715
1745 IF ((t + h0 - tstop)*h0 .GT. 0.0d0) h0 = tstop - t
1746 IF ((tstop - tout)*h0 .LT. 0.0d0)
GO TO 709
1748 340
IF (info(11) .EQ. 0)
GO TO 370
1757 epconi = rwork(lepin)*rwork(lepcon)
1758 350
IF (info(12) .EQ. 0)
THEN
1762 CALL ddasic(tn,y,yprime,neq,info(11),iwork(lid),
1763 * res,jac,psol,h0,rwork(lwt),nwt,idid,rpar,ipar,
1764 * rwork(lphi),rwork(lsavr),rwork(ldelta),rwork(le),
1765 * rwork(lyic),rwork(lypic),rwork(lpwk),rwork(lwm),iwork(liwm),
1766 * hmin,rwork(lround),rwork(lepli),rwork(lsqrn),rwork(lrsqrn),
1767 * epconi,rwork(lstol),info(15),icnflg,iwork(licns),
ddasid)
1768 ELSE IF (info(12) .EQ. 1)
THEN
1772 CALL ddasic(tn,y,yprime,neq,info(11),iwork(lid),
1773 * res,jac,psol,h0,rwork(lwt),nwt,idid,rpar,ipar,
1774 * rwork(lphi),rwork(lsavr),rwork(ldelta),rwork(le),
1775 * rwork(lyic),rwork(lypic),rwork(lpwk),rwork(lwm),iwork(liwm),
1776 * hmin,rwork(lround),rwork(lepli),rwork(lsqrn),rwork(lrsqrn),
1777 * epconi,rwork(lstol),info(15),icnflg,iwork(licns),
ddasik)
1780 IF (idid .LT. 0)
GO TO 600
1785 IF (nwt .EQ. 2)
GO TO 355
1787 CALL ddawts(neq,info(2),rtol,atol,y,rwork(lwt),rpar,ipar)
1788 CALL dinvwt(neq,rwork(lwt),ier)
1789 IF (ier .NE. 0)
GO TO 713
1794 355
IF (info(14) .EQ. 1)
THEN
1797 IF (info(11) .EQ. 1) rwork(lhold) = h0
1803 CALL ddawts(neq,info(2),rtol,atol,y,rwork(lwt),rpar,ipar)
1804 CALL dinvwt(neq,rwork(lwt),ier)
1805 IF (ier .NE. 0)
GO TO 713
1806 IF (info(16) .NE. 0)
THEN
1808 357 rwork(lvt+i-1) =
max(iwork(lid+i-1),0)*rwork(lwt+i-1)
1815 IF (info(8) .NE. 0)
THEN
1821 ypnorm =
ddwnrm(neq,yprime,rwork(lvt),rpar,ipar)
1822 IF (ypnorm .GT. 0.5d0/h0) h0 = 0.5d0/ypnorm
1823 h0 = sign(h0,tout-t)
1825 360
IF (info(7) .NE. 0)
THEN
1826 rh = abs(h0)/rwork(lhmax)
1827 IF (rh .GT. 1.0d0) h0 = h0/rh
1832 IF (info(4) .NE. 0)
THEN
1833 tstop = rwork(ltstop)
1834 IF ((t + h0 - tstop)*h0 .GT. 0.0d0) h0 = tstop - t
1846 rwork(lphi + i - 1) = y(i)
1847 380 rwork(itemp + i - 1) = h*yprime(i)
1858 uround=rwork(lround)
1862 IF(info(7) .EQ. 0)
GO TO 410
1863 rh = abs(h)/rwork(lhmax)
1864 IF(rh .GT. 1.0d0) h = h/rh
1866 IF(t .EQ. tout)
GO TO 719
1867 IF((t - tout)*h .GT. 0.0d0)
GO TO 711
1868 IF(info(4) .EQ. 1)
GO TO 430
1869 IF(info(3) .EQ. 1)
GO TO 420
1870 IF((tn-tout)*h.LT.0.0d0)
GO TO 490
1871 CALL ddatrp(tn,tout,y,yprime,neq,iwork(lkold),
1872 * rwork(lphi),rwork(lpsi))
1877 420
IF((tn-t)*h .LE. 0.0d0)
GO TO 490
1878 IF((tn - tout)*h .GT. 0.0d0)
GO TO 425
1879 CALL ddatrp(tn,tn,y,yprime,neq,iwork(lkold),
1880 * rwork(lphi),rwork(lpsi))
1886 CALL ddatrp(tn,tout,y,yprime,neq,iwork(lkold),
1887 * rwork(lphi),rwork(lpsi))
1892 430
IF(info(3) .EQ. 1)
GO TO 440
1894 IF((tn-tstop)*h.GT.0.0d0)
GO TO 715
1895 IF((tstop-tout)*h.LT.0.0d0)
GO TO 709
1896 IF((tn-tout)*h.LT.0.0d0)
GO TO 450
1897 CALL ddatrp(tn,tout,y,yprime,neq,iwork(lkold),
1898 * rwork(lphi),rwork(lpsi))
1903 440 tstop = rwork(ltstop)
1904 IF((tn-tstop)*h .GT. 0.0d0)
GO TO 715
1905 IF((tstop-tout)*h .LT. 0.0d0)
GO TO 709
1906 IF((tn-t)*h .LE. 0.0d0)
GO TO 450
1907 IF((tn - tout)*h .GT. 0.0d0)
GO TO 445
1908 CALL ddatrp(tn,tn,y,yprime,neq,iwork(lkold),
1909 * rwork(lphi),rwork(lpsi))
1915 CALL ddatrp(tn,tout,y,yprime,neq,iwork(lkold),
1916 * rwork(lphi),rwork(lpsi))
1925 IF(abs(tn-tstop).GT.100.0d0*uround*
1926 * (abs(tn)+abs(h)))
GO TO 460
1927 CALL ddatrp(tn,tstop,y,yprime,neq,iwork(lkold),
1928 * rwork(lphi),rwork(lpsi))
1934 IF((tnext-tstop)*h.LE.0.0d0)
GO TO 490
1938 490
IF (done)
GO TO 590
1953 IF((iwork(lnst)-iwork(lnstl)).LT.500)
GO TO 505
1959 505
IF (info(12) .EQ. 0)
GO TO 510
1960 nstd = iwork(lnst) - iwork(lnstl)
1961 nnid = iwork(lnni) - nni0
1962 IF (nstd .LT. 10 .OR. nnid .EQ. 0)
GO TO 510
1963 avlin =
real(iwork(lnli) - nli0)/
real(nnid)
1964 rcfn =
real(iwork(lncfn) - ncfn0)/
real(nstd)
1965 rcfl =
real(iwork(lncfl) - ncfl0)/
real(nnid)
1966 fmaxl = iwork(lmaxl)
1967 lavl = avlin .GT. fmaxl
1968 lcfn = rcfn .GT. 0.9d0
1969 lcfl = rcfl .GT. 0.9d0
1970 lwarn = lavl .OR. lcfn .OR. lcfl
1971 IF (.NOT.lwarn)
GO TO 510
1973 IF (nwarn .GT. 10)
GO TO 510
1975 msg =
'DASPK-- Warning. Poor iterative algorithm performance '
1976 CALL xerrwd (msg, 56, 501, 0, 0, 0, 0, 0, 0.0d0, 0.0d0)
1977 msg =
' at T = R1. Average no. of linear iterations = R2 '
1978 CALL xerrwd (msg, 56, 501, 0, 0, 0, 0, 2, tn, avlin)
1981 msg =
'DASPK-- Warning. Poor iterative algorithm performance '
1982 CALL xerrwd (msg, 56, 502, 0, 0, 0, 0, 0, 0.0d0, 0.0d0)
1983 msg =
' at T = R1. Nonlinear convergence failure rate = R2'
1984 CALL xerrwd (msg, 56, 502, 0, 0, 0, 0, 2, tn, rcfn)
1987 msg =
'DASPK-- Warning. Poor iterative algorithm performance '
1988 CALL xerrwd (msg, 56, 503, 0, 0, 0, 0, 0, 0.0d0, 0.0d0)
1989 msg =
' at T = R1. Linear convergence failure rate = R2 '
1990 CALL xerrwd (msg, 56, 503, 0, 0, 0, 0, 2, tn, rcfl)
1995 510
CALL ddawts(neq,info(2),rtol,atol,rwork(lphi),rwork(lwt),
1997 CALL dinvwt(neq,rwork(lwt),ier)
1998 IF (ier .NE. 0)
THEN
2002 IF (info(16) .NE. 0)
THEN
2004 515 rwork(lvt+i-1) =
max(iwork(lid+i-1),0)*rwork(lwt+i-1)
2009 r =
ddwnrm(neq,rwork(lphi),rwork(lwt),rpar,ipar)*100.0d0*uround
2010 IF (r .LE. 1.0d0)
GO TO 525
2014 IF(info(2).EQ.1)
GO TO 523
2021 524 atol(i)=r*atol(i)
2028 hmin=4.0d0*uround*
max(abs(tn),abs(tout))
2031 IF (info(7) .NE. 0)
THEN
2032 rh = abs(h)/rwork(lhmax)
2033 IF (rh .GT. 1.0d0) h = h/rh
2040 IF (info(12) .EQ. 0)
THEN
2041 CALL ddstp(tn,y,yprime,neq,
2042 * res,jac,psol,h,rwork(lwt),rwork(lvt),info(1),idid,rpar,ipar,
2043 * rwork(lphi),rwork(lsavr),rwork(ldelta),rwork(le),
2044 * rwork(lwm),iwork(liwm),
2045 * rwork(lalpha),rwork(lbeta),rwork(
lgamma),
2046 * rwork(lpsi),rwork(lsigma),
2047 * rwork(lcj),rwork(lcjold),rwork(lhold),rwork(ls),hmin,
2048 * rwork(lround), rwork(lepli),rwork(lsqrn),rwork(lrsqrn),
2049 * rwork(lepcon), iwork(lphase),iwork(ljcalc),info(15),
2050 * iwork(lk), iwork(lkold),iwork(lns),nonneg,info(12),
2052 ELSE IF (info(12) .EQ. 1)
THEN
2053 CALL ddstp(tn,y,yprime,neq,
2054 * res,jac,psol,h,rwork(lwt),rwork(lvt),info(1),idid,rpar,ipar,
2055 * rwork(lphi),rwork(lsavr),rwork(ldelta),rwork(le),
2056 * rwork(lwm),iwork(liwm),
2057 * rwork(lalpha),rwork(lbeta),rwork(
lgamma),
2058 * rwork(lpsi),rwork(lsigma),
2059 * rwork(lcj),rwork(lcjold),rwork(lhold),rwork(ls),hmin,
2060 * rwork(lround), rwork(lepli),rwork(lsqrn),rwork(lrsqrn),
2061 * rwork(lepcon), iwork(lphase),iwork(ljcalc),info(15),
2062 * iwork(lk), iwork(lkold),iwork(lns),nonneg,info(12),
2066 527
IF(idid.LT.0)
GO TO 600
2073 IF(info(4).NE.0)
GO TO 540
2074 IF(info(3).NE.0)
GO TO 530
2075 IF((tn-tout)*h.LT.0.0d0)
GO TO 500
2076 CALL ddatrp(tn,tout,y,yprime,neq,
2077 * iwork(lkold),rwork(lphi),rwork(lpsi))
2081 530
IF((tn-tout)*h.GE.0.0d0)
GO TO 535
2085 535
CALL ddatrp(tn,tout,y,yprime,neq,
2086 * iwork(lkold),rwork(lphi),rwork(lpsi))
2090 540
IF(info(3).NE.0)
GO TO 550
2091 IF((tn-tout)*h.LT.0.0d0)
GO TO 542
2092 CALL ddatrp(tn,tout,y,yprime,neq,
2093 * iwork(lkold),rwork(lphi),rwork(lpsi))
2097 542
IF(abs(tn-tstop).LE.100.0d0*uround*
2098 * (abs(tn)+abs(h)))
GO TO 545
2100 IF((tnext-tstop)*h.LE.0.0d0)
GO TO 500
2103 545
CALL ddatrp(tn,tstop,y,yprime,neq,
2104 * iwork(lkold),rwork(lphi),rwork(lpsi))
2108 550
IF((tn-tout)*h.GE.0.0d0)
GO TO 555
2109 IF(abs(tn-tstop).LE.100.0d0*uround*(abs(tn)+abs(h)))
GO TO 552
2113 552
CALL ddatrp(tn,tstop,y,yprime,neq,
2114 * iwork(lkold),rwork(lphi),rwork(lpsi))
2118 555
CALL ddatrp(tn,tout,y,yprime,neq,
2119 * iwork(lkold),rwork(lphi),rwork(lpsi))
2140 GO TO (610,620,630,700,655,640,650,660,670,675,
2141 * 680,685,690,695), itemp
2146 610 msg =
'DASPK-- AT CURRENT T (=R1) 500 STEPS'
2147 CALL xerrwd(msg,38,610,0,0,0,0,1,tn,0.0d0)
2148 msg =
'DASPK-- TAKEN ON THIS CALL BEFORE REACHING TOUT'
2149 CALL xerrwd(msg,48,611,0,0,0,0,0,0.0d0,0.0d0)
2154 620 msg =
'DASPK-- AT T (=R1) TOO MUCH ACCURACY REQUESTED'
2155 CALL xerrwd(msg,47,620,0,0,0,0,1,tn,0.0d0)
2156 msg =
'DASPK-- FOR PRECISION OF MACHINE. RTOL AND ATOL'
2157 CALL xerrwd(msg,48,621,0,0,0,0,0,0.0d0,0.0d0)
2158 msg =
'DASPK-- WERE INCREASED TO APPROPRIATE VALUES'
2159 CALL xerrwd(msg,45,622,0,0,0,0,0,0.0d0,0.0d0)
2164 630 msg =
'DASPK-- AT T (=R1) SOME ELEMENT OF WT'
2165 CALL xerrwd(msg,38,630,0,0,0,0,1,tn,0.0d0)
2166 msg = .LE.
'DASPK-- HAS BECOME 0.0'
2167 CALL xerrwd(msg,28,631,0,0,0,0,0,0.0d0,0.0d0)
2172 640 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2173 CALL xerrwd(msg,44,640,0,0,0,0,2,tn,h)
2174 msg=
'DASPK-- ERROR TEST FAILED REPEATEDLY OR WITH ABS(H)=HMIN'
2175 CALL xerrwd(msg,57,641,0,0,0,0,0,0.0d0,0.0d0)
2180 650 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2181 CALL xerrwd(msg,44,650,0,0,0,0,2,tn,h)
2182 msg =
'DASPK-- NONLINEAR SOLVER FAILED TO CONVERGE'
2183 CALL xerrwd(msg,44,651,0,0,0,0,0,0.0d0,0.0d0)
2184 msg =
'DASPK-- REPEATEDLY OR WITH ABS(H)=HMIN'
2185 CALL xerrwd(msg,40,652,0,0,0,0,0,0.0d0,0.0d0)
2190 655 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2191 CALL xerrwd(msg,44,655,0,0,0,0,2,tn,h)
2192 msg =
'DASPK-- PRECONDITIONER HAD REPEATED FAILURES.'
2193 CALL xerrwd(msg,46,656,0,0,0,0,0,0.0d0,0.0d0)
2198 660 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2199 CALL xerrwd(msg,44,660,0,0,0,0,2,tn,h)
2200 msg =
'DASPK-- ITERATION MATRIX IS SINGULAR.'
2201 CALL xerrwd(msg,38,661,0,0,0,0,0,0.0d0,0.0d0)
2206 670 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2207 CALL xerrwd(msg,44,670,0,0,0,0,2,tn,h)
2208 msg =
'DASPK-- NONLINEAR SOLVER COULD NOT CONVERGE.'
2209 CALL xerrwd(msg,45,671,0,0,0,0,0,0.0d0,0.0d0)
2210 msg =
'DASPK-- ALSO, THE ERROR TEST FAILED REPEATEDLY.'
2211 CALL xerrwd(msg,49,672,0,0,0,0,0,0.0d0,0.0d0)
2216 675 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2217 CALL xerrwd(msg,44,675,0,0,0,0,2,tn,h)
2218 msg =
'DASPK-- NONLINEAR SYSTEM SOLVER COULD NOT CONVERGE'
2219 CALL xerrwd(msg,51,676,0,0,0,0,0,0.0d0,0.0d0)
2220 msg =
'DASPK-- BECAUSE IRES WAS EQUAL TO MINUS ONE'
2221 CALL xerrwd(msg,44,677,0,0,0,0,0,0.0d0,0.0d0)
2226 680 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2)'
2227 CALL xerrwd(msg,40,680,0,0,0,0,2,tn,h)
2228 msg =
'DASPK-- IRES WAS EQUAL TO MINUS TWO'
2229 CALL xerrwd(msg,36,681,0,0,0,0,0,0.0d0,0.0d0)
2234 685 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2235 CALL xerrwd(msg,44,685,0,0,0,0,0,0.0d0,0.0d0)
2236 msg =
'DASPK-- INITIAL (Y,YPRIME) COULD NOT BE COMPUTED'
2237 CALL xerrwd(msg,49,686,0,0,0,0,2,tn,h0)
2242 690 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2)'
2243 CALL xerrwd(msg,40,690,0,0,0,0,2,tn,h)
2244 msg =
'DASPK-- IER WAS NEGATIVE FROM PSOL'
2245 CALL xerrwd(msg,35,691,0,0,0,0,0,0.0d0,0.0d0)
2250 695 msg =
'DASPK-- AT T (=R1) AND STEPSIZE H (=R2) THE'
2251 CALL xerrwd(msg,44,695,0,0,0,0,2,tn,h)
2252 msg =
'DASPK-- LINEAR SYSTEM SOLVER COULD NOT CONVERGE.'
2253 CALL xerrwd(msg,50,696,0,0,0,0,0,0.0d0,0.0d0)
2271 701 msg =
'DASPK-- ELEMENT (=I1) OF INFO VECTOR IS NOT VALID'
2272 CALL xerrwd(msg,50,1,0,1,itemp,0,0,0.0d0,0.0d0)
2274 702 msg = .LE.
'DASPK-- NEQ (=I1) 0'
2275 CALL xerrwd(msg,25,2,0,1,neq,0,0,0.0d0,0.0d0)
2277 703 msg =
'DASPK-- MAXORD (=I1) NOT IN RANGE'
2278 CALL xerrwd(msg,34,3,0,1,mxord,0,0,0.0d0,0.0d0)
2280 704 msg=
'DASPK-- RWORK LENGTH NEEDED, LENRW (=I1), EXCEEDS LRW (=I2)'
2281 CALL xerrwd(msg,60,4,0,2,lenrw,lrw,0,0.0d0,0.0d0)
2283 705 msg=
'DASPK-- IWORK LENGTH NEEDED, LENIW (=I1), EXCEEDS LIW (=I2)'
2284 CALL xerrwd(msg,60,5,0,2,leniw,liw,0,0.0d0,0.0d0)
2286 706 msg = .LT.
'DASPK-- SOME ELEMENT OF RTOL IS 0'
2287 CALL xerrwd(msg,39,6,0,0,0,0,0,0.0d0,0.0d0)
2289 707 msg = .LT.
'DASPK-- SOME ELEMENT OF ATOL IS 0'
2290 CALL xerrwd(msg,39,7,0,0,0,0,0,0.0d0,0.0d0)
2292 708 msg =
'DASPK-- ALL ELEMENTS OF RTOL AND ATOL ARE ZERO'
2293 CALL xerrwd(msg,47,8,0,0,0,0,0,0.0d0,0.0d0)
2295 709 msg=
'DASPK-- INFO(4) = 1 AND TSTOP (=R1) BEHIND TOUT (=R2)'
2296 CALL xerrwd(msg,54,9,0,0,0,0,2,tstop,tout)
2298 710 msg = .LT.
'DASPK-- HMAX (=R1) 0.0'
2299 CALL xerrwd(msg,28,10,0,0,0,0,1,hmax,0.0d0)
2301 711 msg =
'DASPK-- TOUT (=R1) BEHIND T (=R2)'
2302 CALL xerrwd(msg,34,11,0,0,0,0,2,tout,t)
2304 712 msg =
'DASPK-- INFO(8)=1 AND H0=0.0'
2305 CALL xerrwd(msg,29,12,0,0,0,0,0,0.0d0,0.0d0)
2307 713 msg = .LE.
'DASPK-- SOME ELEMENT OF WT IS 0.0'
2308 CALL xerrwd(msg,39,13,0,0,0,0,0,0.0d0,0.0d0)
2310 714 msg=
'DASPK-- TOUT (=R1) TOO CLOSE TO T (=R2) TO START INTEGRATION'
2311 CALL xerrwd(msg,60,14,0,0,0,0,2,tout,t)
2313 715 msg =
'DASPK-- INFO(4)=1 AND TSTOP (=R1) BEHIND T (=R2)'
2314 CALL xerrwd(msg,49,15,0,0,0,0,2,tstop,t)
2316 717 msg = .LT..GT.
'DASPK-- ML (=I1) ILLEGAL. EITHER 0 OR NEQ'
2317 CALL xerrwd(msg,52,17,0,1,iwork(lml),0,0,0.0d0,0.0d0)
2319 718 msg = .LT..GT.
'DASPK-- MU (=I1) ILLEGAL. EITHER 0 OR NEQ'
2320 CALL xerrwd(msg,52,18,0,1,iwork(lmu),0,0,0.0d0,0.0d0)
2322 719 msg =
'DASPK-- TOUT (=R1) IS EQUAL TO T (=R2)'
2323 CALL xerrwd(msg,39,19,0,0,0,0,2,tout,t)
2325 720 msg = .LT..GT.
'DASPK-- MAXL (=I1) ILLEGAL. EITHER 1 OR NEQ'
2326 CALL xerrwd(msg,54,20,0,1,iwork(lmaxl),0,0,0.0d0,0.0d0)
2328 721 msg = .LT..GT.
'DASPK-- KMP (=I1) ILLEGAL. EITHER 1 OR MAXL'
2329 CALL xerrwd(msg,54,21,0,1,iwork(lkmp),0,0,0.0d0,0.0d0)
2331 722 msg = .LT.
'DASPK-- NRMAX (=I1) ILLEGAL. 0'
2332 CALL xerrwd(msg,36,22,0,1,iwork(lnrmax),0,0,0.0d0,0.0d0)
2334 723 msg = .LE..GE.
'DASPK-- EPLI (=R1) ILLEGAL. EITHER 0.D0 OR 1.D0'
2335 CALL xerrwd(msg,58,23,0,0,0,0,1,rwork(lepli),0.0d0)
2337 724 msg = .NE.
'DASPK-- ILLEGAL IWORK VALUE FOR INFO(11) 0'
2338 CALL xerrwd(msg,48,24,0,0,0,0,0,0.0d0,0.0d0)
2340 725 msg =
'DASPK-- ONE OF THE INPUTS FOR INFO(17) = 1 IS ILLEGAL'
2341 CALL xerrwd(msg,54,25,0,0,0,0,0,0.0d0,0.0d0)
2343 726 msg = .NE.
'DASPK-- ILLEGAL IWORK VALUE FOR INFO(10) 0'
2344 CALL xerrwd(msg,48,26,0,0,0,0,0,0.0d0,0.0d0)
2346 727 msg =
'DASPK-- Y(I) AND IWORK(40+I) (I=I1) INCONSISTENT'
2347 CALL xerrwd(msg,49,27,0,1,iret,0,0,0.0d0,0.0d0)
2349 750
IF(info(1).EQ.-1)
GO TO 760
2353 760 msg =
'DASPK-- REPEATED OCCURRENCES OF ILLEGAL INPUT'
2354 CALL xerrwd(msg,46,701,0,0,0,0,0,0.0d0,0.0d0)
2355 770 msg =
'DASPK-- RUN TERMINATED. APPARENT INFINITE LOOP'
2356 CALL xerrwd(msg,47,702,1,0,0,0,0,0.0d0,0.0d0)
charNDArray max(char d, const charNDArray &m)
charNDArray min(char d, const charNDArray &m)
double precision function d1mach(i)
ColumnVector real(const ComplexColumnVector &a)
subroutine dcnst0(NEQ, Y, ICNSTR, IRET)
subroutine ddasic(X, Y, YPRIME, NEQ, ICOPT, ID, RES, JAC, PSOL, H, WT, NIC, IDID, RPAR, IPAR, PHI, SAVR, DELTA, E, YIC, YPIC, PWK, WM, IWM, HMIN, UROUND, EPLI, SQRTN, RSQRTN, EPCONI, STPTOL, JFLG, ICNFLG, ICNSTR, NLSIC)
subroutine ddasid(X, Y, YPRIME, NEQ, ICOPT, ID, RES, JACD, PDUM, H, WT, JSDUM, RPAR, IPAR, DUMSVR, DELTA, R, YIC, YPIC, DUMPWK, WM, IWM, CJ, UROUND, DUME, DUMS, DUMR, EPCON, RATEMX, STPTOL, JFDUM, ICNFLG, ICNSTR, IERNLS)
subroutine ddasik(X, Y, YPRIME, NEQ, ICOPT, ID, RES, JACK, PSOL, H, WT, JSKIP, RPAR, IPAR, SAVR, DELTA, R, YIC, YPIC, PWK, WM, IWM, CJ, UROUND, EPLI, SQRTN, RSQRTN, EPCON, RATEMX, STPTOL, JFLG, ICNFLG, ICNSTR, IERNLS)
subroutine ddaspk(RES, NEQ, T, Y, YPRIME, TOUT, INFO, RTOL, ATOL, IDID, RWORK, LRW, IWORK, LIW, RPAR, IPAR, JAC, PSOL)
subroutine ddatrp(X, XOUT, YOUT, YPOUT, NEQ, KOLD, PHI, PSI)
subroutine ddawts(NEQ, IWT, RTOL, ATOL, Y, WT, RPAR, IPAR)
subroutine ddstp(X, Y, YPRIME, NEQ, RES, JAC, PSOL, H, WT, VT, JSTART, IDID, RPAR, IPAR, PHI, SAVR, DELTA, E, WM, IWM, ALPHA, BETA, GAMMA, PSI, SIGMA, CJ, CJOLD, HOLD, S, HMIN, UROUND, EPLI, SQRTN, RSQRTN, EPCON, IPHASE, JCALC, JFLG, K, KOLD, NS, NONNEG, NTYPE, NLS)
double precision function ddwnrm(NEQ, V, RWT, RPAR, IPAR)
subroutine dinvwt(NEQ, WT, IER)
subroutine dnedd(X, Y, YPRIME, NEQ, RES, JACD, PDUM, H, WT, JSTART, IDID, RPAR, IPAR, PHI, GAMMA, DUMSVR, DELTA, E, WM, IWM, CJ, CJOLD, CJLAST, S, UROUND, DUME, DUMS, DUMR, EPCON, JCALC, JFDUM, KP1, NONNEG, NTYPE, IERNLS)
subroutine dnedk(X, Y, YPRIME, NEQ, RES, JACK, PSOL, H, WT, JSTART, IDID, RPAR, IPAR, PHI, GAMMA, SAVR, DELTA, E, WM, IWM, CJ, CJOLD, CJLAST, S, UROUND, EPLI, SQRTN, RSQRTN, EPCON, JCALC, JFLG, KP1, NONNEG, NTYPE, IERNLS)
subroutine xerrwd(MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)