      PROGRAM DNM2ASCI
C
C    ADAPTED FROM
C    PROGRAM OF KTT FOR READING DIPOLE MATRIX ELEMENT DATA
C    AND KB/WE FOR REDUCED MEMORY - ERRORS CORRECTED BY NRB 10/03/99.
C
      IMPLICIT REAL*8(A-H,O-Z)
C
      PARAMETER (MZCHF=   160)    !CHANNELS
      PARAMETER (MZMNP=  8000)    !R-MATRIX EIGENVALUES
C
      PARAMETER (MXTRAN=99)
      PARAMETER (MNPEXT=MZMNP+MZCHF)
      PARAMETER (MXLV=2)
C
      DIMENSION A(MZCHF,MZCHF),B(MZCHF,MZCHF,MXLV),C(MZCHF)
     X         ,D(MZCHF,MNPEXT,MXLV)          !USE MZCHF NOT MZNR2 - NRB
C
      LTAP1=3
      LTAP2=4
C
      LV=1                            !ASSUME LENGTH OR VELOCITY ON FILE
C      LV=2                          !ASSUME LENGTH AND VELOCITY ON FILE
C
      IF(LV.EQ.1)WRITE(6,*)'*** ONLY LENGTH *OR* VELOCITY READ/WRITE'
      IF(LV.EQ.2)WRITE(6,*)'*** BOTH LENGTH *AND* VELOCITY READ/WRITE'
C
      IF(LV.GT.MXLV)THEN
         WRITE(6,*)' ****INCREASE PARAMETER MXLV TO:',LV
         STOP
      ENDIF
C
      OPEN(LTAP1,FILE='DNM',STATUS='OLD',FORM='UNFORMATTED')
      OPEN(LTAP2,FILE='DNM.ASCI',STATUS='UNKNOWN',FORM='FORMATTED')
C
C --- READ D DATASET
C
      READ(LTAP1) NOTERM,MNP2D2,NCHND2,LRGLD2,NPTYD2,
     &  NSPND ,MNP2D1,NCHND1,LRGLD1
      WRITE(LTAP2,*) NOTERM,MNP2D2,NCHND2,LRGLD2,NPTYD2,
     &  NSPND ,MNP2D1,NCHND1,LRGLD1
C
C  CHECK DIMENSIONS FOR MNP2,MZCHF
C
      N=MAX(NCHND1,NCHND2)
      M=MAX(MNP2D1,MNP2D2)
      IF(M.GT.MZMNP.OR.N.GT.MZCHF) THEN
        WRITE(*,600)MNP2D1,NCHND1,MNP2D2,NCHND2
        STOP
      ENDIF
C
C  CHECK DIMENSION FOR "NR2".
C  IN SMALL CASES THE NO OF CHANNELS WILL BE LESS THAN THE NO OF BASIS
C  ORBITALS BUT IN LARGE CASES THE NO OF CHANNELS WILL BE LARGER. 
C  THE BUTTLE CORRECTION NEEDS MZCHF. WHICHEVER IS USED (MZCHF OR MZNR2)
C  DIMENSIONS NEED TO BE TESTED-FOR.  NRB
C
      IF(NOTERM.GT.MZCHF)THEN
        WRITE(6,601)NOTERM
        STOP
      ENDIF
C
C  CALCULATE NPTYD1
C
      NPTYD1=1-NPTYD2
      M1 = (NSPND*100+LRGLD1)*100+NPTYD1
      M2 = (NSPND*100+LRGLD2)*100+NPTYD2
C
C  READ DIPOLE MATRIX
C
      IAIN1 = (MNP2D1 - 1) / NOTERM
      IBIN1 = ( MNP2D2 - 1) / NOTERM
      MCI = 0
      DO IK = 1 , IAIN1
        MCH = MCI + 1
        MCI = MCI + NOTERM
        NCI = 0
        DO JK = 1 , IBIN1
          NCH = NCI + 1
          NCI = NCI + NOTERM
          READ(LTAP1) (((D(I,J,L),J=1,NOTERM),I=1,NOTERM),L=1,LV)
          WRITE(LTAP2,*) (((D(I,J,L),J=1,NOTERM),I=1,NOTERM),L=1,LV)
        ENDDO
        NCH = NCI + 1
        NCI = MNP2D2
        NCP=NCI-NCH+1
        READ(LTAP1) (((D(I,J,L),J=1,NCP),I=1,NOTERM),L=1,LV)
        WRITE(LTAP2,*) (((D(I,J,L),J=1,NCP),I=1,NOTERM),L=1,LV)
      ENDDO
      MCH = MCI + 1
      MCI = MNP2D1
      MCP=MCI-MCH+1
      NCI = 0
      DO JK = 1 , IBIN1
        NCH = NCI + 1
        NCI = NCI + NOTERM
        READ(LTAP1) (((D(I,J,L),J=1,NOTERM),I=1,MCP),L=1,LV)
        WRITE(LTAP2,*) (((D(I,J,L),J=1,NOTERM),I=1,MCP),L=1,LV)
      ENDDO
      NCH = NCI + 1
      NCI = MNP2D2
      NCP=NCI-NCH+1
      READ(LTAP1) (((D(I,J,L),J=1,NCP),I=1,MCP),L=1,LV)
      WRITE(LTAP2,*) (((D(I,J,L),J=1,NCP),I=1,MCP),L=1,LV)
C
C  READ BUTTLE PART
C
      NCH=1
      NCI=MNP2D2
      MCH=MNP2D1+1
      MCI=MNP2D1+NCHND1
      READ(LTAP1) (((D(I,J,L),I=1,NCHND1),J=NCH,NCI),L=1,LV)
      WRITE(LTAP2,*) (((D(I,J,L),I=1,NCHND1),J=NCH,NCI),L=1,LV)
      NCH=MNP2D2+1
      NCI=MNP2D2+NCHND2
      MCH=1
      MCI=MNP2D1
      READ(LTAP1) (((D(J,I,L),J=1,NCHND2),I=MCH,MCI),L=1,LV)
      WRITE(LTAP2,*) (((D(J,I,L),J=1,NCHND2),I=MCH,MCI),L=1,LV)
      MCH=MNP2D1+1
      MCI=MNP2D1+NCHND1
      READ(LTAP1) (((D(I,J,L),J=1,NCHND2),I=1,NCHND1),L=1,LV)
      WRITE(LTAP2,*) (((D(I,J,L),J=1,NCHND2),I=1,NCHND1),L=1,LV)
C
C-----READ ANGULAR COEFFICIENTS
C
      READ(LTAP1) MAXM1,(C(M),M=1,MAXM1)
      WRITE(LTAP2,*) MAXM1,(C(M),M=1,MAXM1)
      READ(LTAP1) ((A(J,I),J=1,NCHND1),I=1,NCHND2),
     &    (((B(J,I,L),J=1,NCHND1),I=1,NCHND2),L=1,LV)
      WRITE(LTAP2,*) ((A(J,I),J=1,NCHND1),I=1,NCHND2),
     &    (((B(J,I,L),J=1,NCHND1),I=1,NCHND2),L=1,LV)
C
C --- END OF DIPOLE MATRIX.
C
      WRITE(*,*)'DNM.ASCI WRITTEN'
C
  600 FORMAT(//1X,30(1H*)//' DIMENSION FOR MNP2 OR NCHF TOO'
     &,' SMALL'//  ' MNP2D1, NCHND1 = ',I5,', ',I5/
     &  ' MNP2D2, NCHND2 = ',I5,', ',I5//1X,30(1H*)//)
  601 FORMAT(//1X,30(1H*)//' MZCHF TOO SMALL FOR BUFFER'//
     &  ' NEED AT LEAST ',I4//1X,30(1H*)//)
C
      END
