open_files.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Module name: OPEN_FILES                                             !
!  Author: P. Nicoletti                               Date: 12-DEC-91  !
!                                                                      !
!  Purpose: open all the files for this run                            !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE open_files(RUN_NAME, RUN_TYPE, N_SPX)

      USE machine
      USE funits
      USE compar
      USE cdist

      use error_manager

      IMPLICIT NONE

! Error index: 0 - no error, 1 could not open file
      INTEGER :: IER(0:numpes-1)
! RUN_NAME (as specified in input file)
      CHARACTER(LEN=*) :: RUN_NAME
! Run_type (as specified in input file)
      CHARACTER(LEN=*) :: RUN_TYPE
! Number of single precision output files (param.inc)
      INTEGER :: N_SPX
! local variables
      CHARACTER(len=4) :: EXT
! run_name + extension
      CHARACTER(len=255) :: FILE_NAME
! Loop counter
      INTEGER :: LC
! index to first blank character in run_name
      INTEGER :: NB
      CHARACTER(len=35) :: EXT_END
      CHARACTER(len=10) :: CSTATUS
! Character error code.
      CHARACTER(len=32) :: CER
!-----------------------------------------------


! Initialize the error manager.
      CALL init_err_msg("OPEN_FILES")

! Initialize the error flag array.
      ier = 0

! Initialize the generic SPx extension.
      ext = '.SPx'

! Generic SPx end characters in order.
      ext_end = '123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'

! Get the length of RUN_NAME. Note that len_trim would allow the
! name to still contain spaces. The following approach truncates
! RUN_NAME at the first blank character.
      nb = index(run_name,' ')

! Only PE_IO opens the RUN_NAME.OUT file.
      IF(mype == pe_io) CALL open_file (run_name, nb, unit_out, '.OUT',&
         file_name, 'UNKNOWN', 'SEQUENTIAL','FORMATTED',132, ier(mype))

! Check if there was an error opening the file.
      IF(error_opening(ier)) THEN
         WRITE(err_msg,3000)
         CALL flush_err_msg(abort=.true.)
      ENDIF


! Open the RES and SPx files. By default, only PE_IO opens these files,
! but all ranks open a rank-specific copy for distributed IO runs.
      SELECT CASE (trim(run_type))

! Open the RES and SPx files for a new run.
!......................................................................
      CASE ('NEW')

         IF(mype==pe_io .OR.  bdist_io) THEN

! Open the RES file.
            CALL open_file (run_name, nb, unit_res, '.RES', file_name, &
               'NEW', 'DIRECT', 'UNFORMATTED', open_n1, ier(mype))
! Report errors.
            IF (ier(mype) == 100) THEN
               WRITE(err_msg, 1000)'RES', 'NEW', trim(file_name)
               CALL flush_err_msg
               GO TO 100
            ELSEIF(ier(mype) /= 0) THEN
               cer=''; WRITE(cer,*)
               WRITE(err_msg, 2000) trim(file_name), trim(cer)
               CALL flush_err_msg
               GO TO 100
            ENDIF

! Open the SPx files.
            DO lc = 1, n_spx
               ext(4:4) = ext_end(lc:lc)
               CALL open_file(run_name, nb, unit_spx+lc, ext,file_name,&
                  'NEW', 'DIRECT', 'UNFORMATTED', open_n1, ier(mype))
! Report errors.
               IF (ier(mype) == 100) THEN
                  WRITE(err_msg, 1000)ext(2:4), 'NEW', trim(file_name)
                  CALL flush_err_msg
                  GO TO 100
               ELSEIF(ier(mype) /= 0) THEN
                  cer=''; WRITE(cer,*)
                  WRITE(err_msg, 2000) trim(file_name), trim(cer)
                  CALL flush_err_msg
                  GO TO 100
               ENDIF
            ENDDO
         ENDIF


! Open the RES and SPx files for a typical restart run.
!......................................................................
      CASE ('RESTART_1')

! Open the RES file.
         IF(mype == pe_io .or. bdist_io) THEN
            CALL open_file(run_name, nb, unit_res, '.RES', file_name,  &
               'OLD', 'DIRECT', 'UNFORMATTED', open_n1, ier(mype))
! Report errors.
            IF (ier(mype) == 101) THEN
               WRITE(err_msg, 1001)'RES', 'RESTART_1',trim(file_name)
               CALL flush_err_msg
               GO TO 100
            ELSEIF(ier(mype) /= 0) THEN
               cer=''; WRITE(cer,*)
               WRITE(err_msg, 2000) trim(file_name), trim(cer)
               CALL flush_err_msg
               GO TO 100
            ENDIF

! Open the SPx files.
            DO lc = 1, n_spx
               ext(4:4) = ext_end(lc:lc)
               CALL open_file (run_name,nb, unit_spx+lc,ext, file_name,&
                  'OLD', 'DIRECT', 'UNFORMATTED', open_n1, ier(mype))
! Report errors.
               IF (ier(mype) == 101) THEN
                  WRITE(err_msg, 1001) ext(2:4), 'RESTART_1',         &
                     trim(file_name)
                  CALL flush_err_msg
                  GO TO 100
               ELSEIF(ier(mype) /= 0) THEN
                  cer=''; WRITE(cer,*)
                  WRITE(err_msg, 2000) trim(file_name), trim(cer)
                  CALL flush_err_msg
                  GO TO 100
               ENDIF
            END DO
         ENDIF


! Open the RES and SPx files for a typical restart run.
!......................................................................
      CASE ('RESTART_2')
! Open the RES file.
         cstatus = 'OLD'
         IF(mype == pe_io .OR. bdist_io) THEN
            IF(bstart_with_one_res) cstatus = 'UNKNOWN'
            CALL open_file (run_name, nb, unit_res, '.RES', file_name, &
               cstatus,'DIRECT', 'UNFORMATTED', open_n1, ier(mype))
! Report errors.
            IF (ier(mype) == 101) THEN
               WRITE(err_msg, 1001)'RES', 'RESTART_2',trim(file_name)
               CALL flush_err_msg
               GO TO 100
            ELSEIF(ier(mype) /= 0) THEN
               cer=''; WRITE(cer,*)
               WRITE(err_msg, 2000) trim(file_name), trim(cer)
               CALL flush_err_msg
               GO TO 100
            ENDIF

! Open the SPx files.
            DO lc = 1, n_spx
               ext(4:4) = ext_end(lc:lc)
               CALL open_file (run_name,nb,unit_spx+lc, ext, file_name,&
                  'NEW' , 'DIRECT', 'UNFORMATTED', open_n1, ier(mype))
! Report errors.
               IF (ier(mype) == 100) THEN
                  WRITE(err_msg, 1000)ext(2:4), 'RESTART_2',          &
                     trim(file_name)
                  CALL flush_err_msg
                  GO TO 100
               ELSEIF(ier(mype) /= 0) THEN
                  cer=''; WRITE(cer,*)
                  WRITE(err_msg, 2000) trim(file_name), trim(cer)
                  CALL flush_err_msg
                  GO TO 100
               ENDIF
            END DO
         ENDIF

      CASE DEFAULT
         WRITE(err_msg, 3000)
         CALL flush_err_msg
         GO TO 100

      END SELECT

! If an error was detected, abort the run.
  100 IF(error_opening(ier)) CALL mfix_exit(mype)

! Initialize the error manager.
      CALL finl_err_msg

      RETURN

 1000 FORMAT('Error 1000: ',a,' file detected but RUN_TYPE=',a/,       &
         'Cannot open file: ',a)

 1001 FORMAT('Error 1001: ',a,' file missing for RUN_TYPE=',a/,        &
         'Cannot open file: ',a)

 2000 FORMAT('Error 2000: Unknown error opening file ',a,/             &
         'Error code: ',a)

 3000 FORMAT('Error 3000: Unknown run type: ',a)


      CONTAINS


!``````````````````````````````````````````````````````````````````````!
! FUNCTION: ERROR_OPENING                                              !
! Purpose: Collect the error flags from all processes and sum them.    !
! RESULT: .TRUE.  :: Sum of IER over all processes is non-zero.        !
!         .FALSE. :: GLOBAL_ALL_SUM is zero.                           !
!                                                                      !
!......................................................................!
      LOGICAL FUNCTION error_opening(IER_l)

! MPI Wrapper function.
      use mpi_utility, only: global_all_sum

! Array containing error flags from all ranks.
      INTEGER, INTENT(IN) :: IER_L(0:numpes-1)
! Initialize error flags.
      error_opening = .false.
! Globally collect flags.
      CALL global_all_sum(ier)
! Report errors.
      IF(sum(ier_l) /= 0) error_opening = .true.

      RETURN
      END FUNCTION error_opening

      END SUBROUTINE open_files


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Module name: OPEN_PE_LOG                                            !
!  Author: P. Nicoletti                               Date: 12-DEC-91  !
!                                                                      !
!  Purpose: Every rank open a .LOG file for domain specific errors.    !
!  This routine should only be invoked before writing to the log and   !
!  exiting.                                                            !
!                                                                      !
!  This routine only opens files when the following are met:           !
!    (1) MFIX is run in DMP parallel (MPI)                             !
!    (2) ENABLE_DMP_LOG is not set in the mfix.dat file.               !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE open_pe_log(IER)

! Global Variables:
!---------------------------------------------------------------------//
! File unit for LOG files.
      USE funits, only: unit_log
! User specifed run name
      USE run, only: run_name
! MPI Rank of current process.
      USE compar, only: mype
! Total number of MPI ranks.
      USE compar, only: numpes
! Flag: My rank reports errors.
      use funits, only: dmp_log
! Flag: The log had to be opened.
      use funits, only: log_was_closed

      IMPLICIT NONE

! Dummy Arguments:
!---------------------------------------------------------------------//
! Error index.
      INTEGER, INTENT(inout) :: IER

! Local Variables:
!---------------------------------------------------------------------//
! Log file name.
      CHARACTER(len=255) :: LOGFILE
      CHARACTER(len=255) :: FILE_NAME
! Flag for LOG files that are already open.
      LOGICAL :: DO_NOTHING
! Index of first blank character in RUN_NAME
      INTEGER :: NB
!......................................................................!


! Enable output from this rank.
      dmp_log = .true.

! Return to the caller if this rank is already connect to a log file.
      INQUIRE(unit=unit_log, opened=do_nothing)
      IF(do_nothing) RETURN

! Flag that the log had to be opened.
      log_was_closed = .true.

! Verify the length of user-provided name.
      logfile = ''
      nb = index(run_name,' ')

! Specify the .LOG file name based on MPI Rank extenion.
      IF(numpes == 1) THEN
         WRITE(logfile,"(A)")run_name(1:(nb-1))
      ELSEIF(numpes <    10) THEN
         WRITE(logfile,"(A,'_',I1.1)") run_name(1:(nb-1)), mype
      ELSEIF(numpes <   100) THEN
         WRITE(logfile,"(A,'_',I2.2)") run_name(1:(nb-1)), mype
      ELSEIF(numpes <  1000) THEN
         WRITE(logfile,"(A,'_',I3.3)") run_name(1:(nb-1)), mype
      ELSEIF(numpes < 10000) THEN
         WRITE(logfile,"(A,'_',I4.4)") run_name(1:(nb-1)), mype
      ELSE
         WRITE(logfile,"(A,'_',I8.8)") run_name(1:(nb-1)), mype
      ENDIF

! Open the .LOG file. From here forward, all routines should store
! error messages (at a minimum) in the .LOG file.
      nb = len_trim(logfile)+1
      CALL open_file(logfile, nb, unit_log, '.LOG', file_name,         &
         'APPEND', 'SEQUENTIAL', 'FORMATTED', 132,  ier)

      RETURN
      END SUBROUTINE open_pe_log


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Module name: CLOSE_PE_LOG                                           !
!  Author: P. Nicoletti                               Date: 12-DEC-91  !
!                                                                      !
!  Purpose: Every rank open a .LOG file for domain specific errors.    !
!  This routine should only be invoked before writing to the log and   !
!  exiting.                                                            !
!                                                                      !
!  This routine only opens files when the following are met:           !
!    (1) MFIX is run in DMP parallel (MPI)                             !
!    (2) ENABLE_DMP_LOG is not set in the mfix.dat file.               !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE close_pe_log

! Global Variables:
!---------------------------------------------------------------------//
! File unit for LOG files.
      USE funits, only: unit_log
! Flag: My rank reports errors.
      use funits, only: dmp_log
! Flag: The log had to be opened.
      use funits, only: log_was_closed

      IMPLICIT NONE

!......................................................................!


! The log had to be opened for global error.
      IF(log_was_closed) THEN
! Reset the flag.
         log_was_closed = .false.
! Disable output from this rank and close connection to LOG.
         dmp_log = .false.
! Return to the caller if this rank is already connect to a log file.
         CLOSE(unit_log)
      ENDIF

      RETURN
      END SUBROUTINE close_pe_log