MINICERN/mathlib/gen/d/epdecc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:18  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE EPDECC
  11 C
  12 C     CALCULATE COEFFICIENTS OF DIFFERENCE EQUATIONS
  13       DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
  14      1NT5(390,2),UMAT(3250),NUMPT(2900),DIFCO(2900,5),
  15      2HL(4),COFFT(5),DUM(20)
  16       COMMON  C5     , C95    , NT3    , UT3    , NT4    , HT4
  17       COMMON  KT4    , NT5    , NE3    , NE4    , NE5    , NC
  18       COMMON  NR     , KODBAS , DX     , DY     , JOBNUM , UMAT
  19       COMMON  NEQU   , DUM    , NUMPT  , DIFCO
  20       NEQU=0
  21       J4=1
  22       K5=1
  23     4 IF(K5-NE5)6,6,5
  24     5 IF(J4-NE4)8,8,35
  25     6 IF(J4-NE4)7,7,20
  26     7 IF(NT5(K5,1)-NT4(J4))20,20,8
  27     8 IF(NT4(J4))16,16,9
  28     9 M=NT4(J4)
  29       Y=((M-1)/NC)*DY
  30       Q=MOD(M-1,NC)
  31       X=Q*DX
  32       DO 12 I=1,4
  33    12 HL(I)=HT4(J4,I)
  34       NEQU=NEQU+1
  35       CALL GETCO(X,Y,HL,M,KT4(J4),COFFT,NEQU)
  36       NUMPT(NEQU)=M
  37       DO 15 I=1,5
  38    15 DIFCO(NEQU,I)=COFFT(I)
  39    16 J4=J4+1
  40       GO TO 4
  41    20 NPL=NT5(K5,1)
  42       NPU=NT5(K5,2)
  43       DO 23 I=1,4
  44    23 HL(I)=1.0
  45       DO 31 M=NPL,NPU
  46       Y=((M-1)/NC)*DY
  47       Q=MOD(M-1,NC)
  48       X=Q*DX
  49       NEQU=NEQU+1
  50       CALL GETCO(X,Y,HL,M,KODBAS,COFFT,NEQU)
  51       NUMPT(NEQU)=M
  52       DO 30 I=1,5
  53    30 DIFCO(NEQU,I)=COFFT(I)
  54    31 CONTINUE
  55       K5=K5+1
  56       GO TO 4
  57    35 RETURN
  58       END