C====== MAIN PROGRAM FOR FCHF=========
C------  with a well------
C-------width of a well between RFW1 and RFW2--
C--------depth od a well -  VW
      INTEGER S,G,S1,DN,
     * P(500),SI1(500),SI2(500),KK(500),
     * SS1(30),ORT(30),N(30),L(30),Q(30),SPI(30)

      REAL*8 Z,R,BET,H,EPS,AKAP,DKAP,MU,
     *   RFW1,RFW2,VW,
     *   GAM(500),GAM1(500),
     *   TETA(30),ALM3(30),ALA(30),GAM2(30),
     *   C3(30),ALA1(30),ALA2(30)
       REAL*8 R1(4015),R2(4015),R3(4015),R4(4015),
     * R5(4015),R6(4015),R9(4015),R10(4015),
     * R8(120450),R7(150)

      NAMELIST/EXCITE/ K7,R7,Z,S,R,NE,BET,H,
     *N,L,Q,SPI,ORT,L1,S1,RFW1,RFW2,VW,
     *NU1,G,GAM,KK,SI1,AKAP,DKAP,K1,K2,EPS,
     *MU,DN,NR,IT,NU2,GAM1,GAM2

      KSU1=3

      OPEN(5,FILE='SYS$INPU',STATUS='OLD')
      READ(5,EXCITE)
      OPEN(6,FILE='SYS$OUTP',STATUS='NEW')
C     WRITE(6,EXCITE)
      OPEN(9,FILE='OLD$DB1',STATUS='OLD',FORM='UNFORMATTED')
      OPEN(11,FILE='NEW$DBAS',STATUS='NEW',FORM='UNFORMATTED')
C     IF(NR.GT.1)
C    *  OPEN(10,FILE='OLD$DB2',STATUS='OLD',FORM='UNFORMATTED')

      IF(NE.GT.2000.OR.S.GT.30.OR.NU1.GT.200) WRITE(6,10)
 10   FORMAT(' CHECK ARRAY"S DIMENSIONS')
      CALL FCHFW(K7,R7,Z,S,R,NE,BET,H,N,L,Q,L1,S1,
     *     NU1,G,GAM,KK,SI1,AKAP,DKAP,K1,K2,EPS,
     *     MU,DN,NR,IT,NU2,GAM1,GAM2,ORT,KSU1,
     *     SI2,P,SS1,TETA,ALM3,ALA,C3,ALA1,ALA2,SPI,
     *     RFW1,RFW2,VW,
     *     R1,R2,R3,R4,R5,R6,R9,R10,R8)

      STOP
      END
