! N. R. BADNELL  OM2OMU       UoS                               09/01/19
!
      PROGRAM MAIN
!
      IMPLICIT REAL*8 (A-H,O-Z)
!
! CONVERT FORMATED OMEGA FILE TO UNFORMATTED.
!
      ALLOCATABLE :: ENAT(:),LAT(:),ISAT(:),OMEGA(:),NRD(:)
!
      call cpu_time(timei)
!
      OPEN(7,FILE='OMEGA',STATUS='OLD',FORM='FORMATTED')        !INPUT
      OPEN(8,FILE='OMEGAU',STATUS='UNKNOWN',FORM='UNFORMATTED') !OUTPUT
      OPEN(9,STATUS='SCRATCH',FORM='FORMATTED')
!
!  READ-IN BASIC DATA
!
      READ(7,*)NZED,NELC
      WRITE(8)NZED,NELC
!
      READ(7,*)NAST,MXE0,NOMWRT
      WRITE(8)NAST,MXE0,NOMWRT
!
      IF(NZED.EQ.NELC)THEN
        NOMT=(NAST*(NAST+1))/2
        IONE=0
        NOT=(NAST*(NAST-1))/2
      ELSE
        NOMT=(NAST*(NAST-1))/2
        IONE=1
        NOT=(NAST*(NAST+1))/2
      ENDIF
!
      IF(NOMWRT.NE.0)THEN
        NOMT=IABS(NOMWRT)
        IF(NOMT.EQ.NOT)THEN
          IONE=ABS(IONE-1)
          WRITE(*,*)'*** ASSUMING NON-DEFAULT ELASTIC TRANSITIONS'
        ENDIF
      ENDIF
!
      MXE=IABS(MXE0)                                    !CASE AS-DW FLAG
!
      ALLOCATE (ENAT(NAST),LAT(NAST),ISAT(NAST),OMEGA(NOMT),NRD(MXE)    &
     &         ,STAT=IERR)
      IF(IERR.NE.0)THEN                              
        WRITE(0,*)'ALLOCATION FAILS FOR NAST,NOMT,MXE=',NAST,NOMT,MXE
        STOP 'ABORT'                                         
      ENDIF                                          
!
      READ(7,*)(ISAT(I),LAT(I),I=1,NAST)
      READ(7,*)(ENAT(I),I=1,NAST)
      WRITE(8)(ISAT(I),LAT(I),I=1,NAST)
      WRITE(8)(ENAT(I),I=1,NAST)
!
      IF(NOMWRT.GE.0)THEN                            !AND CASE MXE0.LT.0
        DO I=1,MXE
          READ(7,*)E,(OMEGA(N),N=1,NOMT)    
          WRITE(8)E,(OMEGA(N),N=1,NOMT) 
        ENDDO
      ELSE
        IE=1
   2    READ(7,*)E0                 !CHECK FIRST E
        BACKSPACE(7)
        I=IE
        IF(E0.GE.ENAT(NAST))GO TO 1    !ALL OPEN - EARLY EXIT
        I0=1
        NO=NOPEN(E0,ENAT,NAST,IONE,I0)
        NO=MIN(NO,NOMT)
        READ(7,*)E0,(DUM,N=1,NO)
        NREC=2+(NO-1)/6
        IF(MXE.GT.IE)THEN
          READ(7,*)E                  !=E0+EINCR
        ELSE
          NREC=NREC-1
          E=E0
        ENDIF
        DO N=1,NREC
          BACKSPACE(7)
        ENDDO
        EINCR=E-E0
        E0=E0-EINCR
        DO I=IE,MXE
          E=E0+(I-IE+1)*EINCR
          WRITE(9,700)E
          BACKSPACE(9)
          READ(9,700)E
          BACKSPACE(9)
          IF(E.GE.ENAT(NAST))GO TO 1
          NRD(I)=NOPEN(E,ENAT,NAST,IONE,I0)
          NRD(I)=MIN(NRD(I),NOMT)
        ENDDO
        I=MXE+1
   1    II=I
        DO I=II,MXE
          NRD(I)=NOMT
        ENDDO
!
        EINCH=EINCR*0.001
        DO I=IE,MXE
          READ(7,*)E,(OMEGA(N),N=1,NRD(I))    
          ET=E0+(I-IE+1)*EINCR
          IF(ABS(E-ET).GT.EINCH)THEN
            IF(NRD(I-1).LT.NOMT)THEN
              IE=I
              NREC=1+(NRD(I)-1)/6
              DO N=1,NREC
                BACKSPACE(7)
              ENDDO
              GO TO 2
            ELSE
              EINCH=999.
            ENDIF
          ENDIF
          WRITE(8)E,(OMEGA(N),N=1,NRD(I)) 
        ENDDO     
      ENDIF
!
      DEALLOCATE (ENAT,LAT,ISAT,OMEGA,NRD,STAT=IERR)
      IF(IERR.NE.0)THEN                              
        WRITE(0,*)'DE-ALLOCATION FAILS FOR NAST,NOMT,MXE...'
        STOP 'ABORT'                                         
      ENDIF                                          
!
      call cpu_time(timef)
!
      time=(timef-timei)/60.
      write(*,777)time
 777  format(' CPU TIME=',f9.3,' MIN')
!
      STOP 'NORMAL FINISH TO CONVERSION'
!
  700 FORMAT(1PE14.8,6(1PE11.3)/(14X,6(E11.3)))
!
      END
!
!************************************************
!
      INTEGER FUNCTION NOPEN(E,ENAT,NAST,IONE,I0)
      IMPLICIT REAL*8 (A-H,O-Z)
!
      DIMENSION ENAT(NAST)
!
      DO I=I0,NAST
        IF(E.LT.ENAT(I))GO TO 1
      ENDDO
      I=NAST+1
   1  I0=I-1
      NOPEN=(I0*(I0-2*IONE+1))/2
!
      RETURN
      END
