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