! N. R. BADNELL  OMC2OMR       UoS                              09/01/19
!
      PROGRAM MAIN
!
      IMPLICIT REAL*8 (A-H,O-Z)
!
      LOGICAL BFORM
!
! CONVERT (UN/FORMATED) COLUMNWISE OMEGA FILE TO ROWWISE.
!
      PARAMETER (ZERO=0.0)
!
      ALLOCATABLE :: ENAT(:),LAT(:),ISAT(:),OMEGAC(:),OMEGAR(:)         &
     &              ,NPOS(:,:)
!
      call cpu_time(timei)
!
      INQUIRE (FILE='OMEGAC',EXIST=BFORM)
      IF(BFORM)THEN
        OPEN(7,FILE='OMEGAC',STATUS='OLD',FORM='FORMATTED')        !INPUT
        OPEN(8,FILE='OMEGAR',STATUS='UNKNOWN',FORM='FORMATTED')    !OUTPUT
      ELSE
        OPEN(7,FILE='OMEGACU',STATUS='OLD',FORM='UNFORMATTED')     !INPUT
        OPEN(8,FILE='OMEGARU',STATUS='UNKNOWN',FORM='UNFORMATTED') !OUTPUT
      ENDIF
!
!  READ-IN BASIC DATA
!
      IF(BFORM)THEN
        READ(7,*)NZED,NELC !FIX IF NEUTRALS DON'T CONTAIN ELASTIC, INPUT NELC=-NELC
        WRITE(8,*)NZED,IABS(NELC)
      ELSE
        READ(7)NZED,NELC
        WRITE(8)NZED,NELC
      ENDIF
!
      IF(BFORM)THEN
        READ(7,*)NAST,MXE,NOMWRT
      ELSE
        READ(7)NAST,MXE,NOMWRT
      ENDIF
!
      IF(NOMWRT.GT.0)THEN
        WRITE(*,*)'INPUT ERROR: DETECTED ROWWISE OMEGA FILE'
        STOP
      ENDIF
!
      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
!
      NWR=NOMT
!
      IF(NOMWRT.NE.0)THEN
        NOMT=IABS(NOMWRT)
        IF(NOMT.EQ.NOT)THEN
          IONE=ABS(IONE-1)
          WRITE(*,*)'*** ASSUMING NON-DEFAULT ELASTIC TRANSITIONS'
          NWR=NOMT   !CAN'T RE-SET IN GENERAL SINCE COLWISE MORE COMPACT
        ENDIF
      ENDIF
!
!      WRITE(*,*)'INPUT NO OF OMEGAS TO BE WRITTEN ROWWISE:'
!      READ(*,*)NWR           !OPTION TO REDUCE WRITTEN OMEGAS
!
      NOMWRT=NWR              !ASSUME THAT EQUIV COLUMNWISE EXIST
!
      ALLOCATE (ENAT(NAST),LAT(NAST),ISAT(NAST),OMEGAC(NOMT),OMEGAR(NWR)&
     &         ,NPOS(NAST,NAST),STAT=IERR)
      IF(IERR.NE.0)THEN
        WRITE(0,*)'ALLOCATION FAILS FOR NAST,NOMT=',NAST,NWR
        STOP 'ABORT'
      ENDIF
!
      IF(BFORM)THEN
        WRITE(8,*)NAST,MXE,NOMWRT
        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,710)(ENAT(I),I=1,NAST)
      ELSE
        WRITE(8)NAST,MXE,NOMWRT
        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)
      ENDIF
!
      N=0
      DO J=1+IONE,NAST
        DO I=1,J-IONE
          N=N+1
          NPOS(I,J)=N
        ENDDO
      ENDDO
!
      I0=1
      DO IE=1,MXE
        IF(BFORM)READ(7,*)E
        IF(.NOT.BFORM)READ(7)E   
        IF(E.LT.ENAT(NAST))THEN
          NRD=NOPEN(E,ENAT,NAST,IONE,I0)
          NRD=MIN(NRD,NOMT)
        ELSE
          NRD=NOMT
        ENDIF
        BACKSPACE(7)
        IF(BFORM)READ(7,*)E,(OMEGAC(N),N=1,NRD)    
        IF(.NOT.BFORM)READ(7,err=5)E,(OMEGAC(N),N=1,NRD)    
   5    N=0
        DO I=1,NAST
          DO J=I+IONE,NAST
            N=N+1
            IF(N.GT.NWR)GO TO 10
            IF(N.GT.NRD)THEN
              OMEGAR(N)=ZERO
            ELSE
              OMEGAR(N)=OMEGAC(NPOS(I,J))
            ENDIF
          ENDDO
        ENDDO
  10    IF(BFORM)WRITE(8,700)E,(OMEGAR(N),N=1,NWR) 
        IF(.NOT.BFORM)WRITE(8)E,(OMEGAR(N),N=1,NWR) 
      ENDDO     
!
      DEALLOCATE (ENAT,LAT,ISAT,OMEGAC,OMEGAR,NPOS,STAT=IERR)
      IF(IERR.NE.0)THEN
        WRITE(0,*)'DE-ALLOCATION FAILS FOR NAST,NOMT...'
        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)))
  710 FORMAT(1P5E16.6)
!
      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
