This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / epdchn.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:17  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE EPDCHN(DUM1,DUM2)
11 C-----SUBROUTINE NAME CHANGED FROM **CHAIN**.  LIBRARY, APRIL 72.
12 C
13       DIMENSION DUM(9)
14       DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
15      1NT5(390,2),UMAT(3250),NUMPT(2900),DIFCO(2900,5),P(12)
16       COMMON C5,C95,NT3,UT3,NT4,HT4,KT4,NT5,NE3,NE4,NE5,NC,NR,KODBAS,
17      1DX,DY,JOBNUM,UMAT,NEQU,NPIA,EWANT,BFINAL,NLITS,NBFREF,DUM,
18      2OPM,BETA,BEEPR,EIGEN,NIT,NITP,NUMPT,DIFCO
19       GNORML=1.0
20       MTAPE=4
21       IF(C5-0.0002)21,72,21
22    72 NLITS=0
23       OPM=1.0
24       C5=0.0002001
25 C*UL   71 NPIA=NC*NR
26       NPIA=NC*NR
27       READ 100,BFINAL,EWANT,INPTMK
28       EWANT=EWANT/100.0
29       MKCON=0
30 C*UL   10 NTAPE=5
31       NTAPE=5
32       IF(INPTMK-1)1,6,6
33     1 MKCON=0
34       EIGEN=0.95
35       NIT=0
36       BETA=1.0
37       IF(BFINAL-1.0)3,3,2
38     2 EIGEN=BFINAL-1.0
39     3 DO 4 I=1,NPIA
40     4 UMAT(I)=0.0
41       GO TO 9
42     6 READ (NTAPE,101)JUNK,WOT,WOT,NRO,NCO
43       IF(NR+NC-NRO-NCO)7,8,7
44     7 REWIND NTAPE
45       GO TO 1
46     8 READ (NTAPE,108)BFINAL,EIGEN,BETA,BEEPR,NIT,JUNK, (UMAT(I),I=1,NPI
47      1A)
48       REWIND NTAPE
49     9 NITSUB=0
50       IF(MKCON)16,11,16
51    11 NITSUB=NIT
52    16 DO 18 I3=1,NE3
53       JK=NT3(I3)
54    18 UMAT(JK)=UT3(I3)
55 C*UL   20 CALL USER1
56       CALL USER1
57    21 CALL EPDECC
58 C         BEGIN ITERATION
59    22 NC12=0
60    23 CALL EPDITR(BETA,DMAX,UCORR,ICORR,GNORM)
61       NIT=NIT+1
62       EMAX=EIGEN*DMAX/(ABS(UCORR)*(1.0-EIGEN))
63       NC12=NC12+1
64       NITA=NIT-NITSUB
65       WRITE(6,103)NITA,BETA,GNORM,NUMPT(ICORR),DMAX,UCORR,EIGEN,EMAX
66       IF(EMAX-EWANT)75,75,35
67    75 IF(OPM)30,76,30
68    30 WRITE (MTAPE,101)JOBNUM,DX,DY,NR,NC
69       WRITE (MTAPE,102)BFINAL,EIGEN,BETA,BEEPR,NITA,(UMAT(I),I=1,NPIA)
70       WRITE (MTAPE,105)NE3,NE4,NE5,(NT3(I),UT3(I),I=1,NE3)
71       WRITE (MTAPE,106)(NT4(I),(HT4(I,J),J=1,4),KT4(I),I=1,NE4)
72       WRITE (MTAPE,107)(NT5(I,1),NT5(I,2),I=1,NE5)
73 C  THE NEXT TWO COMMENTED INSTRUCTIONS ARE REQUIRED IF MTAPE REFERS TO
74 C  A TAPE TO BE PRINTED OFF LINE.
75 C 555 END FILE MTAPE
76 C     REWIND MTAPE
77    76 IF(EMAX-EWANT)31,31,42
78    31 CALL USER2
79       GO TO 21
80    35 IF(NIT-1)36,36,40
81    36 BETA=1.375
82       IF(BFINAL)22,22,38
83    38 BETA=BFINAL
84       GO TO 22
85    40 IF(BFINAL)45,45,22
86    42 GOTO 777
87 C---------
88    45 P(NC12)=GNORM/GNORML
89       IF(NC12-12)47,49,49
90    47 GNORML=GNORM
91       GO TO 23
92    49 IF(NIT-13)50,51,50
93    50 EIGEN=P(12)
94       GO TO 58
95    51 D10=P(10)-P(11)
96       D11=P(11)-P(12)
97       IF(D11)56,56,55
98    55 IF(D10-D11)50,50,57
99    56 IF(D11-D10)50,50,57
100    57 EIGEN=P(10)-D10**2/(D10-D11)
101       IF(EIGEN-1.0)58,50,50
102    58 IF(EIGEN-1.0)59,60,60
103    59 BEENW=2.0/(1.0+SQRT(1.0-(EIGEN+BETA-1.0)**2/(EIGEN*BETA**2)))
104       IF(ABS(BEENW-BEEPR)/(2.0-BEENW)-.05)60,65,65
105    60 BFINAL=BEENW
106       BETA=BFINAL
107       EIGEN=BETA-1.0
108       GO TO 70
109    65 BEEPR=BEENW
110       BETA=BEENW-(2.0-BEENW)/4.0
111    70 WRITE(6,104)P(10),P(11),P(12),EIGEN,BEENW
112       GO TO 22
113 C-------------
114   777 STOP
115   100 FORMAT(2E15.7,15X,I5)
116   101 FORMAT(I15,2E15.7,2I15)
117   102 FORMAT(4E15.7,I15//(1P,7E15.7))
118   104 FORMAT(//5F15.7//)
119   103 FORMAT(I5,1P,2E15.7,I5,4E15.7)
120   105 FORMAT(///3I15///(I6,1P,E15.7))
121   106 FORMAT(///(I6,4F10.6,I6))
122   107 FORMAT(///(2I6))
123   108 FORMAT(4E15.7,I15/I10/(7E15.7))
124       END