share/odepack/fortran/daigbt.f

   1 *DECK DAIGBT
   2       SUBROUTINE DAIGBT (RES, ADDA, NEQ, T, Y, YDOT,
   3      1                   MB, NB, PW, IPVT, IER )
   4       EXTERNAL RES, ADDA
   5       INTEGER NEQ, MB, NB, IPVT, IER
   6       INTEGER I, LENPW, LBLOX, LPB, LPC
   7       DOUBLE PRECISION T, Y, YDOT, PW
   8       DIMENSION Y(*), YDOT(*), PW(*), IPVT(*), NEQ(*)
   9 C-----------------------------------------------------------------------
  10 C This subroutine computes the initial value
  11 C of the vector YDOT satisfying
  12 C     A * YDOT = g(t,y)
  13 C when A is nonsingular.  It is called by DLSOIBT for
  14 C initialization only, when ISTATE = 0 .
  15 C DAIGBT returns an error flag IER:
  16 C   IER  =  0  means DAIGBT was successful.
  17 C   IER .ge. 2 means RES returned an error flag IRES = IER.
  18 C   IER .lt. 0 means the A matrix was found to have a singular
  19 C              diagonal block (hence YDOT could not be solved for).
  20 C-----------------------------------------------------------------------
  21       LBLOX = MB*MB*NB
  22       LPB = 1 + LBLOX
  23       LPC = LPB + LBLOX
  24       LENPW = 3*LBLOX
  25       DO 10 I = 1,LENPW
  26  10     PW(I) = 0.0D0
  27       IER = 1
  28       CALL RES (NEQ, T, Y, PW, YDOT, IER)
  29       IF (IER .GT. 1) RETURN
  30       CALL ADDA (NEQ, T, Y, MB, NB, PW(1), PW(LPB), PW(LPC) )
  31       CALL DDECBT (MB, NB, PW, PW(LPB), PW(LPC), IPVT, IER)
  32       IF (IER .EQ. 0) GO TO 20
  33       IER = -IER
  34       RETURN
  35  20   CALL DSOLBT (MB, NB, PW, PW(LPB), PW(LPC), YDOT, IPVT)
  36       RETURN
  37 C----------------------- End of Subroutine DAIGBT ----------------------
  38       END