This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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