      PROGRAM ASCI2H
      IMPLICIT REAL*8(A-H,O-Z)
C
      PARAMETER (MZCHF=   900)    !CHANNELS
      PARAMETER (MZLMX=    15)    !MULTIPOLES
      PARAMETER (MZTAR=  1200)    !TARGET STATES
      PARAMETER (MZLP1=    87)    !L VALUES FOR BUTTLE
      PARAMETER (MZMNP= 35000)    !R-MATRIX EIGENVALUES
      PARAMETER (MZNRG=    90)    !PARAMETER FOR NEW BUTTLE FIT (APPR.=NRANG2)
C
      DIMENSION ISAT(MZTAR),LAT(MZTAR),L2P(MZCHF),NCONAT(MZTAR)
      DIMENSION CF(MZCHF,MZCHF,MZLMX),COEFF(3,MZLP1),ENAT(MZTAR)
      DIMENSION WMAT(MZCHF,MZMNP),VALUE(MZMNP)
      DIMENSION EIGENS(MZNRG,1),ENDS(MZNRG,1)
C
      OPEN(3,FILE='H.ASCI',STATUS='OLD',FORM='FORMATTED')
      REWIND(3)
      OPEN(10,FILE='H.DAT',STATUS='UNKNOWN',FORM='UNFORMATTED')
      REWIND(10)
C
      READ(3,*)NELC,NZ,LRNG2,LAMAX,NASTY,RA,BSTO
      LRANG2=IABS(LRNG2)
      NAST=IABS(NASTY)
C
C DIMENSION TESTS
      IF(NAST.GT.MZTAR)THEN
      WRITE(*,609)NAST,MZTAR
  609 FORMAT('  NAST IS ',I3,' MAX. ALLOWED MZTAR ',I3)
      STOP
      ENDIF
      IF(LRANG2.GT.MZLP1)THEN
      WRITE(*,608)LRANG2,MZLP1
  608 FORMAT('  LRANG2 IS ',I3,' MAX. ALLOWED MZLP1 ',I3)
      STOP
      ENDIF
C
      WRITE(10)NELC,NZ,LRNG2,LAMAX,NASTY,RA,BSTO
C
      READ(3,*)(ENAT(I),I=1,NAST)
      READ(3,*)(LAT(I),I=1,NAST)
      READ(3,*)(ISAT(I),I=1,NAST)
      READ(3,*)((COEFF(I,L),I=1,3),L=1,LRANG2)
C
      WRITE(10)(ENAT(I),I=1,NAST)
      WRITE(10)(LAT(I),I=1,NAST)
      WRITE(10)(ISAT(I),I=1,NAST)
      WRITE(10)((COEFF(I,L),I=1,3),L=1,LRANG2)
C
      IF(NASTY.LT.0)THEN              !FOR PARTITIONED
        READ(3,*)IPRCENT,NRANG2
        WRITE(10)IPRCENT,NRANG2
        IF(NRANG2.GT.MZNRG)THEN
          WRITE(*,625)NRANG2,MZNRG
  625     FORMAT(//' ******* NRANG2 = ',I4,'  LARGER THAN ',
     +    'MZNRG = ',I4//)
          STOP 
        ENDIF
        DO L = 1,LRANG2
          READ (3,*) (EIGENS(N,1),N=1,NRANG2)
          READ (3,*) (ENDS(N,1),N=1,NRANG2)
          WRITE (10) (EIGENS(N,1),N=1,NRANG2)
          WRITE (10) (ENDS(N,1),N=1,NRANG2)
        ENDDO
      ENDIF
C
C READ R-MATRIX FILE FOR SLPI CASE
 1000 CONTINUE
      READ(3,*)LRGL2,NSPN2,NPTY2,NCHAN,MNP2,MORE2
C
C DIMENSION TESTS
      IF(NCHAN.GT.MZCHF)THEN
      WRITE(*,600)NSPN2,LRGL2,NPTY2,NCHAN,MZCHF
  600 FORMAT(' TOO MANY CHANNELS FOR (IS,IL,IP) = (',3I3,')'/
     *' NCHAN IS',I3,' MAX ALLOWED MZCHF ',I3) 
      STOP
      ENDIF
      IF(MNP2.GT.MZMNP)THEN
      WRITE(*,610)NSPN2,LRGL2,NPTY2,MNP2,MZMNP
  610 FORMAT(' TOO MANY POLES FOR (IS,IL,IP) = (',3I3,')'/
     *' MNP2 IS',I4,' MAX ALLOWED MZMNP ',I4) 
      STOP
      ENDIF
      IF(LAMAX.GT.MZLMX)THEN
      WRITE(*,620)LAMAX,MZLMX
  620 FORMAT(' TOO MANY MULTIPOLES '/
     *' LAMAX IS',I3,' MAX ALLOWED MZLMX ',I3) 
      STOP
      ENDIF
C
      READ(3,*)(NCONAT(I),I=1,NAST)
      READ(3,*)(L2P(I),I=1,NCHAN)
      IF(LAMAX.GT.0)
     X READ(3,*)(((CF(I,N,M),I=1,NCHAN),N=1,NCHAN),M=1,LAMAX)
      IF(NASTY.LT.0)READ(3,*)TRACE
C
      IF(MNP2.GE.0)THEN
        READ(3)(VALUE(I),I=1,MNP2)
        READ(3)((WMAT(K,I),K=1,NCHAN),I=1,MNP2)
      ELSE
        MNP2=-MNP2
        READ(3)(VALUE(I),I=1,MNP2)
        KK=0
 13     READ(3)ILOW,IUPPER,NDIV
        write(*,*)ilow,iupper,ndiv
        READ(3)((WMAT(K,I-ILOW+1+KK),K=1,NCHAN),I=ILOW,IUPPER)
        KK=KK+IUPPER-ILOW+1
        IF(ILOW.NE.1) GO TO 13
      ENDIF
C
      WRITE(10)LRGL2,NSPN2,NPTY2,NCHAN,MNP2,MORE2
      WRITE(10)(NCONAT(I),I=1,NAST)
      WRITE(10)(L2P(I),I=1,NCHAN)
      IF(LAMAX.GT.0)
     X WRITE(10)(((CF(I,N,M),I=1,NCHAN),N=1,NCHAN),M=1,LAMAX)
      IF(NASTY.LT.0)WRITE(10)TRACE
      WRITE(10)(VALUE(I),I=1,MNP2)
      WRITE(10)((WMAT(K,I),K=1,NCHAN),I=1,MNP2)
C
C CHECK WHETHER MORE DATA
      IF(MORE2.EQ.0)THEN
      GO TO 3000
      ELSE
      GO TO 1000
      ENDIF
 3000 CLOSE(10)
      CLOSE(3)
      WRITE(*,*)'H.DAT WRITTEN'
      END

