MINICERN/mathlib/gen/d/epdtab.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 EPDTAB(M,HL,UWANT,MKR,KODE)
  11 C
  12 C     WRITE DETAILS OF POINT INTO APPROPRIATE TABLE OR SIGNAL ERROR.
  13       DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
  14      1NT5(390,2),HL(4)
  15       COMMON  C5     , C95    , NT3    , UT3    , NT4    , HT4
  16       COMMON  KT4    , NT5    , NE3    , NE4    , NE5    , NC
  17       COMMON  NR     , KODBAS
  18       DO 11 J=1,4
  19       IF(C5-HL(J))7,7,5
  20     5 HL(J)=0.0
  21        GO TO 11
  22     7 IF(HL(J)-C95)11,11,10
  23    10 HL(J)=1.0
  24    11 CONTINUE
  25        GO TO (15,37,31,26,40,42,44),MKR
  26    15 DO 17 J=1,4
  27       IF(HL(J)-1.0)30,17,30
  28    17 CONTINUE
  29        IF(NE5)20,21,20
  30    20 IF(M-NT5(NE5,2)-1)21,25,21
  31    21 NE5=NE5+1
  32       IF(NE5-390)23,23,22
  33    22 WRITE(6,103)
  34       STOP
  35 C---------
  36    23 NT5(NE5,1)=M
  37    25 NT5(NE5,2)=M
  38    26 RETURN
  39    30 KODE=KODBAS
  40    31 NE4=NE4+1
  41       IF(NE4-780)32,32,22
  42    32 NT4(NE4)=M
  43       KT4(NE4)=ABS(KODE)
  44       DO 35 J=1,4
  45    35 HT4(NE4,J)=HL(J)
  46       RETURN
  47    37 NE3=NE3+1
  48       IF(NE3-780)38,38,22
  49    38 NT3(NE3)=M
  50       UT3(NE3)=UWANT
  51       RETURN
  52    40 WRITE(6,100)M
  53       STOP
  54 C---------
  55    42 WRITE(6,101)M
  56       STOP
  57 C---------
  58    44 WRITE(6,102)M
  59       STOP
  60 C---------
  61   100 FORMAT('0 POINT',I5,' NEAR BOUNDARY WITH DERIVATIVE-TYPE',
  62      1 ' BOUNDARY CONDITIONS IS SUSPECT'/
  63      2 ' BOUNDARY SHOULD BE COINCIDENT WITH MESH LINE')
  64   101 FORMAT('0 THERE APPEAR TO BE TWO BOUNDARIES NEAR POINT',I5,'WITH'
  65      1 ,' DERIVATIVE-TYPE BOUNDARY CONDITIONS'/' THIS IS INADMISSIBLE')
  66   102 FORMAT('0 POINT',I5,' NEAR BOUNDARY WITH DERIVATIVE-TYPE BOUNDAR'
  67      1 ,'Y CONDITIONS',/' IS TOO CLOSE TO ANOTHER BOUNDARY')
  68   103 FORMAT('0 THE TABLE OF BOUNDARY, IRREGULAR OR REGULAR POINTS IS'
  69      1 ,'FULL. RERUN WITH COARSER MESH')
  70       END