C file formateig.for
C-----------------------------------------------------------------------
C 23 Apr 2007 - Check for end of file for temptape1
C 20 Apr 2007 - Allow raysets to be 90 character lines
C 21 Feb 2006 - Made changes to allow for more models being printed
C-----------------------------------------------------------------------
C                          Program FORMATEIGEN
C
C This program formats TAPE1 and RYSFIL (outputs from HARPA) for use
C with EIGEN. Specifically, it separates the portions before and after
C the ****SOFT EOF***+++++ in PUNCH into TAPE1 and RYSFIL, respectively.
C
C-----------------------------------------------------------------------
C
      PROGRAM formateigen

      ! Declare variables
      IMPLICIT double precision (a-h,o-z)
      CHARACTER(len=40) :: fname
      CHARACTER(len=3) :: id
      CHARACTER(len=80) :: templine,templinenext
      CHARACTER(len=90) :: rayline                                 ! 20 Apr 2007
      CHARACTER(len=102) :: titleline
      CHARACTER(len=65) :: modelline
      CHARACTER(len=15) :: smodelline
      CHARACTER(len=20) :: test = '****SOFT EOF***+++++'
      CHARACTER(len=20) :: twenty                                 !  20 Apr 2007
c      CHARACTER(len=80) :: eof = '                              
c     1                                                - '
      CHARACTER(len=80) :: eof                                    !  20 Apr 2007
      CHARACTER(len=90) :: eof90                                  !  20 Apr 2007
      LOGICAL :: foundline = .true.
      LOGICAL :: exst

      twenty = '                    '                             !  20 Apr 2007
      eof = twenty//twenty//twenty//'                  - '        !  20 Apr 2007
      eof90 = eof//'          '                                   !  20 Apr 2007

      WRITE (*,9) ' ','Formatting Files For Use With Eigen...'
9     FORMAT (/,A1,A38,/)

      ! Find TEMPTAPE1 file
      INQUIRE(FILE='TEMPTAPE1',EXIST=exst)
      IF (exst) THEN
         OPEN(10,FILE='TEMPTAPE1',STATUS='OLD',IOSTAT=ios)
         IF (ios.LT.0) THEN
            PRINT *,'Unexpected end of TEMPTAPE1 file during OPEN.'
            STOP
         ELSE IF (ios.GT.0) THEN
            PRINT *,100,ios
100         FORMAT('Error opening TEMPTAPE1 file. Error: ',I3)
            PRINT *,'Check error code in FORTRAN Reference Manual.'
            STOP
         ENDIF
      ELSE
         WRITE(*,*) 'No TEMPTAPE1 file exists for EIGEN program.'
110      WRITE(*,*) 'Enter filename on next line >>>>>'
         READ(*,'(A)') fname
         INQUIRE(FILE=fname,EXIST=exst)
         IF (.not. exst) THEN
            PRINT*,'Could not find file: ',fname
            GO TO 110
         ENDIF
         OPEN(10,FILE=fname,STATUS='OLD',IOSTAT=ios)
         IF (ios.LT.0) THEN
            PRINT *,'Unexpected end of TEMPTAPE1 file during OPEN.'
            STOP
         ELSE IF (ios.GT.0) THEN
            PRINT *,100,ios
            PRINT *,'Check error code in FORTRAN Reference Manual.'
            STOP
         ENDIF
         PRINT *,'Using file: ',fname
      ENDIF

      ! Clear existing TAPE1 file
      OPEN(20,FILE='TAPE1',STATUS='UNKNOWN',POSITION='REWIND')
      CLOSE(20,STATUS='DELETE',IOSTAT=ios)
      OPEN(20,FILE='TAPE1',STATUS='NEW',POSITION='REWIND')
      CLOSE(20,STATUS='KEEP',IOSTAT=ios)

      ! Format TAPE1 file from TEMPTAPE1 file
      DO
         READ(10,999,IOSTAT=ios) templine
         IF (templine(1:20) == test) EXIT
         OPEN(20,FILE='TAPE1',STATUS='OLD',POSITION='APPEND')
         WRITE(20,999) templine
         CLOSE(20,STATUS='KEEP',IOSTAT=ios)
      END DO
999   FORMAT(A80)

      ! Write TAPE1 end-of-file
      OPEN(20,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
      ENDFILE 20
      CLOSE(20,STATUS='KEEP',IOSTAT=ios)

      ! Delete TEMPTAPE1 file when finished
      CLOSE(10,STATUS='DELETE',IOSTAT=ios)

C     *****************************************************************

      ! FIND RYSFIL file
      INQUIRE(FILE='TEMPRYSFIL',EXIST=exst)
      IF (exst) THEN
         OPEN(30,FILE='TEMPRYSFIL',STATUS='OLD',IOSTAT=ios)
         IF (ios.LT.0) THEN
            PRINT *,'Unexpected end of TEMPRYSFIL file during OPEN.'
            STOP
         ELSE IF (ios.GT.0) THEN
            PRINT *,200,ios
200         FORMAT('Error opening TEMPRYSFIL file. Error: ',I3)
            PRINT *,'Check error code in FORTRAN Reference Manual.'
            STOP
         ENDIF
      ELSE
         WRITE(*,*) 'No TEMPRYSFIL file exists for EIGEN program.'
210      WRITE(*,*) 'Enter filename on next line >>>>>'
         READ(*,'(A)') fname
         INQUIRE(FILE=fname,EXIST=exst)
         IF (.not. exst) THEN
            PRINT*,'Could not find file: ',fname
            GO TO 210
         ENDIF
         OPEN(30,FILE=fname,STATUS='OLD',IOSTAT=ios)
         IF (ios.LT.0) THEN
            PRINT *,'Unexpected end of TEMPRYSFIL file during OPEN.'
            STOP
         ELSE IF (ios.GT.0) THEN
            PRINT *,200,ios
            PRINT *,'Check error code in FORTRAN Reference Manual.'
            STOP
         ENDIF
         PRINT *,'Using file: ',fname
      ENDIF

      ! Clear existing RYSFIL file
      OPEN(40,FILE='RYSFIL',STATUS='UNKNOWN',POSITION='REWIND')
      CLOSE(40,STATUS='DELETE',IOSTAT=ios)
      OPEN(40,FILE='RYSFIL',STATUS='NEW',POSITION='REWIND')
      CLOSE(40,STATUS='KEEP',IOSTAT=ios)

      ! Format RYSFIL file from TEMPRYSFIL file
      READ(30,999,IOSTAT=ios) templine
      n=0
      DO i=1,1000
         READ(30,999,IOSTAT=ios) templine
         IF (templine(25:27) == '***') n=n+1
      END DO

      ! Print warning to screen if many runsets
      IF (n >= 5) THEN
      WRITE (*,8) n,' runsets must be processed. This may take a few
     1 minutes.'
8     FORMAT(I3,A56)
      ENDIF

      REWIND 30
      DO i=1,1000
         READ(30,999,IOSTAT=ios) templine
         IF (templine(1:20) == test) THEN
            DO j=0,n-1
               READ(30,996,IOSTAT=ios) titleline
c               print *, 'titleline ios = ', ios
               if(ios.lt.0) exit                                   ! 23 Apr 2007
               OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
               WRITE(40,996) titleline
               CLOSE(40,STATUS='KEEP',IOSTAT=ios)
996            FORMAT(A102)
               DO k=1,5          ! 21 Feb 2006 Increased from 4
                  READ(30,997,IOSTAT=ios) modelline
                  OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
                  WRITE(40,997) modelline
                  CLOSE(40,STATUS='KEEP',IOSTAT=ios)
997               FORMAT(A65)
               END DO
c               READ(30,998,IOSTAT=ios) smodelline                 ! 21 Feb 2006
c            OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND') ! 21 Feb 2006
c               WRITE(40,998) smodelline                           ! 21 Feb 2006
c               CLOSE(40,STATUS='KEEP',IOSTAT=ios)                 ! 21 Feb 2006
998            FORMAT(A15) 
               DO k=1,20                                           ! 20 Apr 2007
                  READ(30,999,IOSTAT=ios) templine
                  IF (templine == eof) EXIT
                  OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
                  WRITE(40,999) templine
                  CLOSE(40,STATUS='KEEP',IOSTAT=ios)
               END DO
9999   FORMAT(A90)                                                 ! 20 Apr 2007
               DO
                  READ(30,9999,IOSTAT=ios) rayline                 ! 20 Apr 2007
                  IF (rayline == eof90) EXIT                       ! 20 Apr 2007
                  OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
                  WRITE(40,9999) rayline                           ! 20 Apr 2007
                  CLOSE(40,STATUS='KEEP',IOSTAT=ios)
               END DO
               OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
               WRITE(40,1000) '-'
c               print * , ' j= ', j, ' n-1 = ', n-1
               CLOSE(40,STATUS='KEEP',IOSTAT=ios)
1000           FORMAT(T79,A1)
c               print * , ' j= ', j, ' n-1 = ', n-1
            END DO
         ! Write end-of-file
         OPEN(40,FILE='RYSFIL',STATUS='OLD',POSITION='APPEND')
         ENDFILE 40
         CLOSE(40,STATUS='KEEP',IOSTAT=ios)
         EXIT
         ENDIF
      END DO

      ! Delete TEMPRYSFIL file when finished
      CLOSE(30,STATUS='DELETE',IOSTAT=ios)

      PRINT *,'Formatting Complete.'
      PRINT *,'Files TAPE1 and RYSFIL are ready to be input to EIGEN.'
      PRINT *,''

      END PROGRAM
C-----------------------------------------------------------------------
