share/colnew/fortran/gderiv.f

   1       SUBROUTINE GDERIV ( GI, NROW, IROW, ZVAL, DGZ, MODE, DGSUB)
   2 C
   3 C**********************************************************************
   4 C
   5 C   purpose:
   6 C
   7 C      construct a collocation matrix row according to mode:
   8 C      mode = 1  -  a row corresponding to a initial condition
   9 C                   (i.e. at the left end of the subinterval).
  10 C      mode = 2  -  a row corresponding to a final condition.
  11 C
  12 C   variables:
  13 C
  14 C      gi     - the sub-block of the global bvp matrix in
  15 C               which the equations are to be formed.
  16 C      nrow   - no. of rows in gi.
  17 C      irow   - the row in gi to be used for equations.
  18 C      zval   - z(xi)
  19 C      dg     - the derivatives of the side condition.
  20 C
  21 C**********************************************************************
  22       IMPLICIT REAL*8 (A-H,O-Z)
  23       DIMENSION GI(NROW,1), ZVAL(1), DGZ(1), DG(40)
  24 C
  25       COMMON /COLORD/ KDUM, NDUM, MSTAR, KD, MMAX, M(20)
  26       COMMON /COLSID/ ZETA(40), ALEFT, ARIGHT, IZETA, IDUM
  27       COMMON /COLNLN/ NONLIN, ITER, LIMIT, ICARE, IGUESS
  28 C
  29 C...  zero jacobian dg
  30 C
  31       DO 10 J=1,MSTAR
  32    10   DG(J) = 0.D0
  33 C
  34 C...  evaluate jacobian dg
  35 C
  36       CALL DGSUB (IZETA, ZVAL, DG)
  37 C
  38 C...  evaluate  dgz = dg * zval  once for a new mesh
  39 C
  40       IF (NONLIN .EQ. 0 .OR. ITER .GT. 0)           GO TO 30
  41       DOT = 0.D0
  42       DO 20 J = 1, MSTAR
  43    20   DOT = DOT  +  DG(J) * ZVAL(J)
  44       DGZ(IZETA) = DOT
  45 C
  46 C...  branch according to  m o d e
  47 C
  48    30 IF ( MODE .EQ. 2 )                            GO TO 50
  49 C
  50 C...  provide coefficients of the j-th linearized side condition.
  51 C...  specifically, at x=zeta(j) the j-th side condition reads
  52 C...  dg(1)*z(1) + ... +dg(mstar)*z(mstar) + g = 0
  53 C
  54 C
  55 C...  handle an initial condition
  56 C
  57       DO 40 J = 1, MSTAR
  58         GI(IROW,J) =  DG(J)
  59    40 GI(IROW,MSTAR+J) = 0.D0
  60       RETURN
  61 C
  62 C...  handle a final condition
  63 C
  64    50 DO 60 J= 1, MSTAR
  65         GI(IROW,J) = 0.D0
  66    60 GI(IROW,MSTAR+J) = DG(J)
  67       RETURN
  68       END