*
* $Id: epdchn.F,v 1.1.1.1 1996/04/01 15:02:17 mclareni Exp $
*
* $Log: epdchn.F,v $
* Revision 1.1.1.1  1996/04/01 15:02:17  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE EPDCHN(DUM1,DUM2)
C-----SUBROUTINE NAME CHANGED FROM **CHAIN**.  LIBRARY, APRIL 72.
C
      DIMENSION DUM(9)
      DIMENSION NT3(780),UT3(780),NT4(780),HT4(780,4),KT4(780),
     1NT5(390,2),UMAT(3250),NUMPT(2900),DIFCO(2900,5),P(12)
      COMMON C5,C95,NT3,UT3,NT4,HT4,KT4,NT5,NE3,NE4,NE5,NC,NR,KODBAS,
     1DX,DY,JOBNUM,UMAT,NEQU,NPIA,EWANT,BFINAL,NLITS,NBFREF,DUM,
     2OPM,BETA,BEEPR,EIGEN,NIT,NITP,NUMPT,DIFCO
      GNORML=1.0
      MTAPE=4
      IF(C5-0.0002)21,72,21
   72 NLITS=0
      OPM=1.0
      C5=0.0002001
C*UL   71 NPIA=NC*NR
      NPIA=NC*NR
      READ 100,BFINAL,EWANT,INPTMK
      EWANT=EWANT/100.0
      MKCON=0
C*UL   10 NTAPE=5
      NTAPE=5
      IF(INPTMK-1)1,6,6
    1 MKCON=0
      EIGEN=0.95
      NIT=0
      BETA=1.0
      IF(BFINAL-1.0)3,3,2
    2 EIGEN=BFINAL-1.0
    3 DO 4 I=1,NPIA
    4 UMAT(I)=0.0
      GO TO 9
    6 READ (NTAPE,101)JUNK,WOT,WOT,NRO,NCO
      IF(NR+NC-NRO-NCO)7,8,7
    7 REWIND NTAPE
      GO TO 1
    8 READ (NTAPE,108)BFINAL,EIGEN,BETA,BEEPR,NIT,JUNK, (UMAT(I),I=1,NPI
     1A)
      REWIND NTAPE
    9 NITSUB=0
      IF(MKCON)16,11,16
   11 NITSUB=NIT
   16 DO 18 I3=1,NE3
      JK=NT3(I3)
   18 UMAT(JK)=UT3(I3)
C*UL   20 CALL USER1
      CALL USER1
   21 CALL EPDECC
C         BEGIN ITERATION
   22 NC12=0
   23 CALL EPDITR(BETA,DMAX,UCORR,ICORR,GNORM)
      NIT=NIT+1
      EMAX=EIGEN*DMAX/(ABS(UCORR)*(1.0-EIGEN))
      NC12=NC12+1
      NITA=NIT-NITSUB
      WRITE(6,103)NITA,BETA,GNORM,NUMPT(ICORR),DMAX,UCORR,EIGEN,EMAX
      IF(EMAX-EWANT)75,75,35
   75 IF(OPM)30,76,30
   30 WRITE (MTAPE,101)JOBNUM,DX,DY,NR,NC
      WRITE (MTAPE,102)BFINAL,EIGEN,BETA,BEEPR,NITA,(UMAT(I),I=1,NPIA)
      WRITE (MTAPE,105)NE3,NE4,NE5,(NT3(I),UT3(I),I=1,NE3)
      WRITE (MTAPE,106)(NT4(I),(HT4(I,J),J=1,4),KT4(I),I=1,NE4)
      WRITE (MTAPE,107)(NT5(I,1),NT5(I,2),I=1,NE5)
C  THE NEXT TWO COMMENTED INSTRUCTIONS ARE REQUIRED IF MTAPE REFERS TO
C  A TAPE TO BE PRINTED OFF LINE.
C 555 END FILE MTAPE
C     REWIND MTAPE
   76 IF(EMAX-EWANT)31,31,42
   31 CALL USER2
      GO TO 21
   35 IF(NIT-1)36,36,40
   36 BETA=1.375
      IF(BFINAL)22,22,38
   38 BETA=BFINAL
      GO TO 22
   40 IF(BFINAL)45,45,22
   42 GOTO 777
C---------
   45 P(NC12)=GNORM/GNORML
      IF(NC12-12)47,49,49
   47 GNORML=GNORM
      GO TO 23
   49 IF(NIT-13)50,51,50
   50 EIGEN=P(12)
      GO TO 58
   51 D10=P(10)-P(11)
      D11=P(11)-P(12)
      IF(D11)56,56,55
   55 IF(D10-D11)50,50,57
   56 IF(D11-D10)50,50,57
   57 EIGEN=P(10)-D10**2/(D10-D11)
      IF(EIGEN-1.0)58,50,50
   58 IF(EIGEN-1.0)59,60,60
   59 BEENW=2.0/(1.0+SQRT(1.0-(EIGEN+BETA-1.0)**2/(EIGEN*BETA**2)))
      IF(ABS(BEENW-BEEPR)/(2.0-BEENW)-.05)60,65,65
   60 BFINAL=BEENW
      BETA=BFINAL
      EIGEN=BETA-1.0
      GO TO 70
   65 BEEPR=BEENW
      BETA=BEENW-(2.0-BEENW)/4.0
   70 WRITE(6,104)P(10),P(11),P(12),EIGEN,BEENW
      GO TO 22
C-------------
  777 STOP
  100 FORMAT(2E15.7,15X,I5)
  101 FORMAT(I15,2E15.7,2I15)
  102 FORMAT(4E15.7,I15//(1P,7E15.7))
  104 FORMAT(//5F15.7//)
  103 FORMAT(I5,1P,2E15.7,I5,4E15.7)
  105 FORMAT(///3I15///(I6,1P,E15.7))
  106 FORMAT(///(I6,4F10.6,I6))
  107 FORMAT(///(2I6))
  108 FORMAT(4E15.7,I15/I10/(7E15.7))
      END