output_manager.f

Go to the documentation of this file.

MODULE output_man
   CONTAINS
!----------------------------------------------------------------------!
!                                                                      !
!  Subroutine: OUTPUT_MANAGER                                          !
!  Author: J.Musser                                   Date:            !
!                                                                      !
!  Purpose: Relocate calls to write output files (RES, SPx, VTP). This !
!  was done to simplify the time_march code.                           !
!                                                                      !
!----------------------------------------------------------------------!
      SUBROUTINE output_manager(EXIT_SIGNAL, FINISHED)

! Global Variables:
!---------------------------------------------------------------------//

      use compar, only: mype, pe_io
      use discretelement, only: discrete_element
      use machine, only: wall_time
      use output, only: disk, disk_tot
      use output, only: out_time, out_dt
      use output, only: res_backup_time, res_backup_dt
      use output, only: res_time, res_dt
      use output, only: spx_time, spx_dt
      use output, only: usr_time, usr_dt
      use param, only: dimension_usr
      use param1, only: n_spx
      use qmom_kinetic_equation, only: qmomk
      use run, only: time, dt, tstop, steady_state
      use time_cpu, only: cpu_io
      use vtk, only:    vtk_time, vtk_dt
      use vtk, only: dimension_vtk
      use vtk, only: write_vtk_files
      use vtp, only: write_vtp_file

      IMPLICIT NONE

! Dummy Arguments:
!---------------------------------------------------------------------//
! Flag that the the user specified batch time (plus buffer) is met.
      LOGICAL, INTENT(IN) :: EXIT_SIGNAL
! Flag that a steady state case is completed.
      LOGICAL, INTENT(IN) :: FINISHED

! Local Variables:
!---------------------------------------------------------------------//
! Loop counter and counter
      INTEGER :: LC, IDX
! Flag to write NetCDF output
      LOGICAL :: bWRITE_NETCDF_FILES
! Flag that the header (time) has not be written.
      LOGICAL :: HDR_MSG
! SPX file extensions.
      CHARACTER(LEN=35) ::  EXT_END
! Wall time at the start of IO operations.
      DOUBLE PRECISION :: WALL_START

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

! Initialize the SPx file extension array.
      ext_end = '123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
! Initial the header flag.
      hdr_msg = .true.

! Get the current time before any IO operations begin
      wall_start = wall_time()

! Create a backup copy of the RES file.
      IF(time+0.1d0*dt>=res_backup_time) THEN
         res_backup_time = next_time(res_backup_dt)
         CALL backup_res
      ENDIF

! Write restart file, if needed
      IF(check_time(res_time) .OR. exit_signal) THEN

         res_time = next_time(res_dt)
         CALL write_res1
         CALL notify_user('.RES;')

         IF(discrete_element) THEN
            CALL write_res0_des
            CALL notify_user('DES.RES;')
         ENDIF

         IF(qmomk) THEN
            CALL qmomk_write_restart
            CALL notify_user('QMOMK.RES;')
         ENDIF

      ENDIF

! Write SPx files, if needed
      idx = 0
      bwrite_netcdf_files = .false.

      DO lc=1, n_spx
         IF(check_time(spx_time(lc))) THEN
            spx_time(lc) = next_time(spx_dt(lc))

            CALL write_spx1(lc, 0)
            CALL notify_user('SPx:',ext_end(lc:lc))

            disk_tot = disk_tot + disk(lc)
            idx = idx + 1

            bwrite_netcdf_files = .true.
         ENDIF
      ENDDO
      IF(idx /=0) CALL flush_list


! Write standard output, if needed
      IF(check_time(out_time)) THEN
         out_time = next_time(out_dt)
         CALL write_out1
         CALL notify_user('.OUT;')
      ENDIF

! Write special output, if needed
      idx = 0
      DO lc = 1, dimension_usr
         IF(check_time(usr_time(lc))) THEN
            usr_time(lc) = next_time(usr_dt(lc))
            CALL write_usr1 (lc)
            CALL notify_user('.USR:',ext_end(lc:lc))
            idx = idx + 1
         ENDIF
      ENDDO
      IF(idx /=0) CALL flush_list

      CALL flush_notify_user

! Write vtk file, if needed
! Only regular (not debug) files are written (second argument is zero)
      IF(write_vtk_files) THEN
         DO lc = 1, dimension_vtk
            IF(check_time(vtk_time(lc))) THEN
               vtk_time(lc) = next_time(vtk_dt(lc))
               CALL write_vtu_file(lc,0)
               IF(discrete_element) CALL write_vtp_file(lc,0)
            ENDIF
         ENDDO
      ENDIF

! Write NetCDF files.
      IF(bwrite_netcdf_files) CALL write_netcdf(0,0,time)

! Add the amount of time needed for all IO operations to total.
      cpu_io = cpu_io + (wall_time() - wall_start)

      RETURN

      contains

!----------------------------------------------------------------------!
!                                                                      !
!----------------------------------------------------------------------!
      LOGICAL FUNCTION check_time(lTIME)

      DOUBLE PRECISION, INTENT(IN) :: lTIME

      IF(steady_state) THEN
         check_time = finished
      ELSE
         check_time = (time+0.1d0*dt>=ltime).OR.(time+0.1d0*dt>=tstop)
      ENDIF

      RETURN
      END FUNCTION check_time

!----------------------------------------------------------------------!
!                                                                      !
!----------------------------------------------------------------------!
      DOUBLE PRECISION FUNCTION next_time(lWRITE_DT)

      DOUBLE PRECISION, INTENT(IN) :: lWRITE_DT

      IF (.NOT.steady_state) THEN
         next_time = (int((time + 0.1d0*dt)/lwrite_dt)+1)*lwrite_dt
      ELSE
         next_time = lwrite_dt
      ENDIF

      RETURN
      END FUNCTION next_time

!----------------------------------------------------------------------!
!                                                                      !
!----------------------------------------------------------------------!
      SUBROUTINE notify_user(MSG, EXT)

      use output, only: full_log
      use funits, only: dmp_log
      use funits, only: unit_log

      CHARACTER(len=*), INTENT(IN) :: MSG
      CHARACTER(len=*), INTENT(IN), OPTIONAL :: EXT


      LOGICAL :: SCR_LOG

      scr_log = (full_log .and. mype.eq.pe_io)

      IF(hdr_msg) THEN
         IF(dmp_log) WRITE(unit_log, 1000, advance='NO') time
         IF(scr_log) WRITE(*, 1000, advance='NO') time
         hdr_msg = .false.
      ENDIF

 1000 FORMAT(' ',/' t=',f12.6,' Wrote')

      IF(.NOT.present(ext)) THEN
         IF(dmp_log) WRITE(unit_log, 1100, advance='NO') msg
         IF(scr_log) WRITE(*, 1100, advance='NO') msg
      ELSE
         IF(idx == 0) THEN
            IF(dmp_log) WRITE(unit_log, 1110, advance='NO') msg, ext
            IF(scr_log) WRITE(*, 1110, advance='NO') msg, ext
         ELSE
            IF(dmp_log) WRITE(unit_log, 1120, advance='NO') ext
            IF(scr_log) WRITE(*, 1120, advance='NO') ext
         ENDIF
      ENDIF

 1100 FORMAT(1x,a)
 1110 FORMAT(1x,a,1x,a)
 1120 FORMAT(',',a)

      RETURN
      END SUBROUTINE notify_user

!----------------------------------------------------------------------!
!                                                                      !
!----------------------------------------------------------------------!
      SUBROUTINE flush_list

      use output, only: full_log
      use funits, only: dmp_log
      use funits, only: unit_log

      LOGICAL :: SCR_LOG

      scr_log = (full_log .and. mype.eq.pe_io)

      IF(dmp_log) WRITE(unit_log,1000, advance='NO')
      IF(scr_log) WRITE(*,1000, advance='NO')

 1000 FORMAT(';')

      RETURN
      END SUBROUTINE flush_list


!----------------------------------------------------------------------!
!                                                                      !
!----------------------------------------------------------------------!
      SUBROUTINE flush_notify_user

      use discretelement, only: discrete_element, des_continuum_coupled
      use discretelement, only: dtsolid
      use error_manager
      use funits, only: dmp_log
      use funits, only: unit_log
      use machine, only: wall_time
      use run, only: get_tunit
      use output, only: full_log
      use output, only: nlog
      use run, only: time, nstep, steady_state
      use time_cpu, only: time_start
      use time_cpu, only: wall_start

      DOUBLE PRECISION :: WALL_ELAP, WALL_LEFT, WALL_NOW
      CHARACTER(LEN=9) :: CHAR_ELAP, CHAR_LEFT
      CHARACTER(LEN=4) :: UNIT_ELAP, UNIT_LEFT

      INTEGER :: TNITS
      LOGICAL :: SCR_LOG

      scr_log = (full_log .and. mype.eq.pe_io)

      IF(.NOT.hdr_msg) THEN
         IF(dmp_log) WRITE(unit_log,1000)
         IF(scr_log) WRITE(*,1000)
      ENDIF

 1000 FORMAT(' ',/' ')

! Write the elapsed time and estimated remaining time
      IF(mod(nstep,nlog) == 0) THEN

         IF(discrete_element .AND. .NOT.des_continuum_coupled) THEN
            tnits = ceiling(real((tstop-time)/dtsolid))
            WRITE(err_msg, 1100) time, dtsolid, trim(ival(tnits))
            CALL flush_err_msg(header=.false., footer=.false., log=.false.)
         ENDIF
 1100 FORMAT(/'Time: ',g12.5,3x,'DT: ',g12.5,3x,'Remaining DEM NITs: ',a)

         wall_now = wall_time()
! Calculate the elapsed wall time.
         wall_elap = wall_now - wall_start
         CALL get_tunit(wall_elap, unit_elap)
         char_elap=''; WRITE(char_elap,"(F9.2)") wall_elap
         char_elap = trim(adjustl(char_elap))
! Estimate the remaining wall time.
         wall_left = (wall_now-wall_start)*(tstop-time)/               &
            max(time-time_start,1.0d-6)
         CALL get_tunit(wall_left, unit_left)

         IF (.NOT.steady_state) THEN
            char_left=''; WRITE(char_left,"(F9.2)") wall_left
            char_left = trim(adjustl(char_left))
         ELSE
            char_left = '0.0'
            unit_left = 's'
         ENDIF

! Notify the user of usage/remaining wall times.
         WRITE(err_msg,2000)                                           &
            'Elapsed:', trim(char_elap), trim(unit_elap),              &
            'Est. Remaining:',trim(char_left), trim(unit_left)
         CALL flush_err_msg(header=.false., footer=.false.)
      ENDIF

 2000 FORMAT('Wall Time - ',2(a,1x,a,a,4x))

      RETURN
      END SUBROUTINE flush_notify_user

      END SUBROUTINE output_manager

!----------------------------------------------------------------------!
! Subroutine: INIT_OUTPUT_VARS                                         !
! Purpose: Initialize variables used for controling ouputs of the      !
! various files.                                                       !
!----------------------------------------------------------------------!
      SUBROUTINE init_output_vars

      use geometry, only: ijkmax2
      use machine, only: wall_time
      use output, only: disk, disk_tot
      use output, only: onemeg
      use output, only: out_time, out_dt
      use output, only: res_time, res_dt
      use output, only: spx_time, spx_dt
      use output, only: usr_time, usr_dt
      use output, only: res_backup_time, res_backup_dt
      use output, only: res_backups
      use param, only: dimension_usr
      use param1, only: n_spx
      use param1, only: undefined
      use param1, only: zero
      use physprop, only: mmax, nmax
      use run, only: k_epsilon
      use run, only: run_type
      use run, only: time, dt, steady_state
      use rxns, only: nrr
      use scalars, only: nscalar
      use time_cpu, only: cpu_io
      use time_cpu, only: time_start
      use time_cpu, only: wall_start
      use vtk, only:    vtk_time, vtk_dt
      use vtk, only: dimension_vtk
      use vtk, only: dimension_vtk
      use vtk, only: vtk_time, vtk_dt
      use vtk, only: write_vtk_files

      use param1, only:  undefined_i

      use funits, only: create_dir

      IMPLICIT NONE

! Disk space needed for one variable and each SPX file
      DOUBLE PRECISION :: DISK_ONE

! Loop counter
      INTEGER :: LC

! Initialize times for writing outputs
      out_time = merge(time, undefined, out_dt /= undefined)

! Initialize the amount of time spent on IO
      cpu_io = 0.0d0

! Initialize disk space calculations
      disk_tot = zero
      disk_one = 4.0*ijkmax2/onemeg

      disk(1) = 1.0*disk_one                           ! EPg
      disk(2) = 2.0*disk_one                           ! Pg, Ps
      disk(3) = 3.0*disk_one                           ! Ug, Vg, Wg
      disk(4) = 3.0*disk_one*mmax                      ! Us, Vs, Ws
      disk(5) = 1.0*disk_one*mmax                      ! ROPs
      disk(6) = 1.0*disk_one*(mmax+1)                  ! Tg, Ts
      disk(7) = 1.0*disk_one*(sum(nmax(0:mmax)))       ! Xg, Xs
      disk(8) = 1.0*disk_one*mmax                      ! Theta
      disk(9) = 1.0*disk_one*nscalar                   ! User Scalars
      disk(10) = nrr*disk_one                          ! ReactionRates
      disk(11) = merge(2.0*disk_one, zero, k_epsilon)  ! K-Epsilon


! Initizle RES and SPX_TIME
      IF (run_type == 'NEW') THEN
         res_time = time
         spx_time(:n_spx) = time
      ELSE
         IF (.NOT. steady_state) THEN
            res_time = res_dt *                                        &
               (int((time + 0.1d0*dt)/res_dt) + 1)
            spx_time(:n_spx) = spx_dt(:n_spx) *                        &
               (int((time + 0.1d0*dt)/spx_dt(:n_spx)) + 1)
         ENDIF
      ENDIF

! Initizle RES_BACKUP_TIME
      res_backup_time = undefined
      IF(res_backup_dt /= undefined) res_backup_time =                 &
         res_backup_dt * (int((time+0.1d0*dt)/res_backup_dt)+1)

! Initialize USR_TIME
      DO lc = 1, dimension_usr
         usr_time(lc) = undefined
         IF (usr_dt(lc) /= undefined) THEN
            IF (run_type == 'NEW') THEN
               usr_time(lc) = time
            ELSE
               usr_time(lc) = usr_dt(lc) *                             &
                  (int((time+0.1d0*dt)/usr_dt(lc))+1)
            ENDIF
         ENDIF
      ENDDO

! Initialize VTK_TIME

      IF(write_vtk_files) THEN
         DO lc = 1, dimension_vtk
            vtk_time(lc) = undefined
            IF (vtk_dt(lc) /= undefined) THEN
               IF (run_type == 'NEW'.OR.run_type=='RESTART_2') THEN
                  vtk_time(lc) = time
               ELSE
                  vtk_time(lc) = vtk_dt(lc) *                          &
                     (int((time + 0.1d0*dt)/vtk_dt(lc))+1)
               ENDIF
            ENDIF
         ENDDO
      ENDIF

! Create a subdir for RES backup files.
      IF(res_backups /= undefined_i) CALL create_dir('BACKUP_RES')

      wall_start = wall_time()
      time_start = time

      RETURN
      END SUBROUTINE init_output_vars

!----------------------------------------------------------------------!
! Subroutine: BACKUP_RES                                               !
! Purpose: Shift existing RES file backup files by one index, then     !
! create a copy of the current RES file.                               !
!----------------------------------------------------------------------!
      SUBROUTINE backup_res

      use compar, only: mype, pe_io
      use output, only: res_backups
      use discretelement, only: discrete_element
      use param1, only: undefined_i

      IMPLICIT NONE

      CHARACTER(len=256) :: FNAME0, FNAME1

      INTEGER :: LC

      IF(mype /= pe_io) RETURN
      IF(res_backups == undefined_i) RETURN

! Shift all the existing backups by one.
      DO lc=res_backups,2,-1
         CALL set_fname(fname0,'.RES', lc-1)
         CALL set_fname(fname1,'.RES', lc)
         CALL shift_res(fname0, fname1, 'mv')

         IF(discrete_element) THEN
            CALL set_fname(fname0,'_DES.RES', lc-1)
            CALL set_fname(fname1,'_DES.RES', lc)
            CALL shift_res(fname0, fname1, 'mv')
         ENDIF
      ENDDO

! Copy RES to RES1
      CALL set_fname(fname0, '.RES')
      CALL set_fname(fname1, '.RES' ,1)
      CALL shift_res(fname0, fname1, 'cp')

      IF(discrete_element) THEN
         CALL set_fname(fname0, '_DES.RES')
         CALL set_fname(fname1, '_DES.RES' ,1)
         CALL shift_res(fname0, fname1, 'cp')
      ENDIF

      RETURN

      contains

!----------------------------------------------------------------------!
! Subroutine: SHIFT_RES                                                !
! Purpose: Shift RES(LC-1) to RES(LC)                                  !
!----------------------------------------------------------------------!
      SUBROUTINE shift_res(pFN0, pFN1, ACT)

      implicit none

      CHARACTER(LEN=*), INTENT(IN) :: pFN0, pFN1, ACT
      CHARACTER(len=1024) :: CMD
      LOGICAL :: EXISTS

      INQUIRE(file=trim(pfn0),exist=exists)
      IF(exists) THEN
         cmd=''; WRITE(cmd,1000)trim(act), trim(pfn0),trim(pfn1)
         CALL system(trim(cmd))
      ENDIF

 1000 FORMAT(a,1x,a,1x,a)

      RETURN
      END SUBROUTINE shift_res

!----------------------------------------------------------------------!
! Subroutine: SET_FNAME                                                !
! Purpose: Set the backup RES file name based on pINDX.                !
!----------------------------------------------------------------------!
      SUBROUTINE set_fname(pFNAME, pEXT, pINDX)

      use run, only: run_name

      implicit none

      CHARACTER(LEN=*), INTENT(OUT) :: pFNAME
      CHARACTER(LEN=*), INTENT(IN) ::  pEXT
      INTEGER, INTENT(IN), OPTIONAL :: pINDX

! Set the file format for backup copies
      pfname=''
      IF(.NOT.PRESENT(pindx)) THEN
         WRITE(pfname,1000) trim(run_name),pext
      ELSE
         IF(res_backups < 10) THEN
            WRITE(pfname,1001) trim(run_name), pext, pindx
         ELSEIF(res_backups < 100) THEN
            WRITE(pfname,1002) trim(run_name), pext, pindx
         ELSEIF(res_backups < 1000) THEN
            WRITE(pfname,1003) trim(run_name), pext, pindx
         ELSEIF(res_backups < 10000) THEN
            WRITE(pfname,1004) trim(run_name), pext, pindx
         ELSEIF(res_backups < 10000) THEN
            WRITE(pfname,1005) trim(run_name), pext, pindx
         ELSE
            WRITE(pfname,1006) trim(run_name), pext, pindx
         ENDIF
      ENDIF

 1000 FORMAT(2a)
 1001 FORMAT('BACKUP_RES/',2a,i1.1)
 1002 FORMAT('BACKUP_RES/',2a,i2.2)
 1003 FORMAT('BACKUP_RES/',2a,i3.3)
 1004 FORMAT('BACKUP_RES/',2a,i4.4)
 1005 FORMAT('BACKUP_RES/',2a,i5.5)
 1006 FORMAT('BACKUP_RES/',2a,i6.6)

      RETURN
      END SUBROUTINE set_fname

      END SUBROUTINE backup_res
END MODULE output_man