close_io.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE close_io_mod
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This module closes input and output files using either the standard !
!  NetCDF library or the Parallel-IO (PIO) library.                    !
!                                                                      !
!  During initialization, the input input files need to be in closed   !
!  state to facilitate multi-file processing. This is important in     !
!  iterative algorithms that run the model kernels repetitevely.       !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_netcdf
#if defined PIO_LIB && defined DISTRIBUTE
      USE mod_pio_netcdf
#endif
      USE mod_scalars
!
      USE dateclock_mod, ONLY : get_date
      USE strings_mod,   ONLY : founderror
!
      implicit none
!
      PUBLIC :: close_file
      PUBLIC :: close_inp
      PUBLIC :: close_out
!
      CONTAINS
!
!***********************************************************************
      SUBROUTINE close_file (ng, model, S, ncname, Lupdate)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model
!
      TYPE(t_io), intent(inout) :: s
!
      logical, intent(in), optional :: lupdate
!
      character (len=*), intent(in), optional :: ncname
!
!  Local variable declarations.
!
      integer :: closedstate = -1
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", close_file_nf90"
!
!-----------------------------------------------------------------------
!  Close specified NetCDF file.
!-----------------------------------------------------------------------
!
      SELECT CASE (s%IOtype)
        CASE (io_nf90)
          IF (s%ncid.ne.closedstate) THEN
            CALL netcdf_close (ng, model, s%ncid,                       &
     &                         trim(ncname), lupdate)
            s%ncid=closedstate
          END IF
 
#if defined PIO_LIB && defined DISTRIBUTE
        CASE (io_pio)
          IF (ASSOCIATED(s%pioFile%iosystem)) THEN
            IF (s%pioFile%fh.ne.closedstate) THEN
              CALL pio_netcdf_close (ng, model, s%pioFile,              &
     &                               trim(ncname), lupdate)
              s%pioFile%fh=closedstate
            END IF
          END IF
#endif
      END SELECT
      IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
!
      RETURN
      END SUBROUTINE close_file
!
!***********************************************************************
      SUBROUTINE close_inp (ng, model)
!***********************************************************************
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model
!
!  Local variable declarations.
!
      integer :: fcount, i
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", close_inp"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  If multi-file input fields, close several input files.
!-----------------------------------------------------------------------
!
!  Skip if configuration error.
!
      IF ((exit_flag.eq.5).or.(exit_flag.eq.6)) RETURN
 
#ifdef FRC_FILE
!
!  If appropriate, close input forcing files and set several parameter
!  to closed state.
!
      DO i=1,nffiles(ng)
        IF ((frc(i,ng)%Nfiles.gt.0).and.(frc(i,ng)%ncid.ne.-1)) THEN
          fcount=frc(i,ng)%Fcount
          CALL close_file (ng, model, frc(i,ng),                        &
     &                     frc(i,ng)%files(fcount), .false.)
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          frcids=-1
          frcncid=-1
          fcount=1
          frc(i,ng)%Fcount=fcount
          frc(i,ng)%name=trim(frc(i,ng)%files(fcount))
        END IF
      END DO
#endif
!
!  If appropriate, close boundary files.
!
      IF (obcdata(ng)) THEN
        DO i=1,nbcfiles(ng)
          IF ((bry(i,ng)%Nfiles.gt.0).and.(bry(i,ng)%ncid.ne.-1)) THEN
            fcount=bry(i,ng)%Fcount
            CALL close_file (ng, model, bry(i,ng),                      &
     &                       bry(i,ng)%files(fcount), .false.)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            bryids=-1
            bryncid=-1
            fcount=1
            bry(i,ng)%Fcount=fcount
            bry(i,ng)%name=trim(bry(i,ng)%files(fcount))
          END IF
        END DO
      END IF
!
!  If appropriate, close climatology files.
!
      IF (clm_file(ng)) THEN
        DO i=1,nclmfiles(ng)
          IF ((clm(i,ng)%Nfiles.gt.0).and.(clm(i,ng)%ncid.ne.-1)) THEN
            fcount=clm(i,ng)%Fcount
            CALL close_file (ng, model, clm(i,ng),                      &
     &                       clm(i,ng)%files(fcount), .false.)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            clmids=-1
            clmncid=-1
            fcount=1
            clm(i,ng)%Fcount=fcount
            clm(i,ng)%name=trim(clm(i,ng)%files(fcount))
          END IF
        END DO
      END IF
!
      RETURN
      END SUBROUTINE close_inp
!
      SUBROUTINE close_out
!
!=======================================================================
!                                                                      !
! This subroutine flushes and closes all output files.                 !
!                                                                      !
!=======================================================================
!
!  Local variable declarations.
!
      logical :: first, lupdate
!
      integer :: fcount, myerror, i, ivalue, ng
!
      character (len=256) :: ana_string
 
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", close_out"
!
      sourcefile=myfile
!
!-----------------------------------------------------------------------
!  Close output NetCDF files. Set file indices to closed state.
!-----------------------------------------------------------------------
!
!  Skip if configuration error.
!
      IF ((exit_flag.eq.5).or.(exit_flag.eq.6)) RETURN
!
!  If appropriate, set switch for updating biology header file global
!  attribute in output NetCDF files.
!
#ifdef BIOLOGY
      lupdate=.true.
#else
      lupdate=.false.
#endif
!
!  Close output NetCDF files.
!
      DO ng=1,ngrids
        CALL close_file (ng, inlm, rst(ng), rst(ng)%name, lupdate)
#if defined FOUR_DVAR || defined ENKF_RESTART || defined VERIFICATION
        CALL close_file (ng, inlm, dai(ng), dai(ng)%name, lupdate)
        CALL close_file (ng, inlm, dav(ng), dav(ng)%name, lupdate)
#endif
#if defined FORWARD_READ || defined FORWARD_WRITE
        IF (fwd(ng)%IOtype.eq.io_nf90) THEN
          IF ((fwd(ng)%ncid.ne.-1).and.                                 &
     &        (fwd(ng)%ncid.eq.his(ng)%ncid)) THEN
            fwd(ng)%ncid=-1
          END IF
# if defined PIO_LIB && defined DISTRIBUTE
        ELSE IF (fwd(ng)%IOtype.eq.io_pio) THEN
          IF ((fwd(ng)%pioFile%fh.ne.-1).and.                           &
     &        (fwd(ng)%pioFile%fh.eq.his(ng)%pioFile%fh)) THEN
            fwd(ng)%pioFile%fh=-1
          END IF
# endif
        END IF
        CALL close_file (ng, inlm, fwd(ng), fwd(ng)%name, lupdate)
#endif
        CALL close_file (ng, inlm, his(ng), his(ng)%name, lupdate)
        CALL close_file (ng, inlm, qck(ng), qck(ng)%name, lupdate)
#ifdef SP4DVAR
        CALL close_file (ng, itlm, spt(ng), spt(ng)%name, lupdate)
        CALL close_file (ng, itlm, sct(ng), sct(ng)%name, lupdate)
        CALL close_file (ng, iadm, spa(ng), spa(ng)%name, lupdate)
#endif
#ifdef ADJOINT
        CALL close_file (ng, iadm, adm(ng), adm(ng)%name, lupdate)
#endif
#ifdef TANGENT
        CALL close_file (ng, itlm, itl(ng), itl(ng)%name, lupdate)
        CALL close_file (ng, itlm, tlm(ng), tlm(ng)%name, lupdate)
#endif
#if defined TL_IOMS && defined FOUR_DVAR
        CALL close_file (ng, irpm, irp(ng), irp(ng)%name, lupdate)
#endif
#ifdef WEAK_CONSTRAINT
        CALL close_file (ng, itlm, tlf(ng), tlf(ng)%name, lupdate)
#endif
#ifdef FOUR_DVAR
        CALL close_file (ng, iadm, hss(ng), hss(ng)%name, lupdate)
        CALL close_file (ng, iadm, lcz(ng), lcz(ng)%name, lupdate)
#endif
#if defined AVERAGES    || \
   (defined ad_averages && defined adjoint) || \
   (defined rp_averages && defined tl_ioms) || \
   (defined tl_averages && defined tangent)
        CALL close_file (ng, inlm, avg(ng), avg(ng)%name, lupdate)
#endif
#if defined AVERAGES  && defined AVERAGES_DETIDE && \
   (defined ssh_tides || defined uv_tides)
        CALL close_file (ng, inlm, har(ng), har(ng)%name, lupdate)
#endif
#ifdef DIAGNOSTICS
        CALL close_file (ng, inlm, dia(ng), dia(ng)%name, lupdate)
#endif
#ifdef FLOATS
        CALL close_file (ng, inlm, flt(ng), flt(ng)%name, lupdate)
#endif
#ifdef STATIONS
        CALL close_file (ng, inlm, sta(ng), sta(ng)%name, lupdate)
#endif
#if defined WEAK_CONSTRAINT   && \
   (defined posterior_error_f || defined posterior_error_i)
        CALL close_file (ng, itlm, err(ng), err(ng)%name, lupdate)
#endif
!
!  Report number of time records written.
!
        IF (master) THEN
          WRITE (stdout,10) ng
 
          IF (associated(his(ng)%Nrec)) THEN
            IF (any(his(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'HISTORY', sum(his(ng)%Nrec)
            END IF
          END IF
 
          IF (associated(rst(ng)%Nrec)) THEN
            fcount=rst(ng)%load
            IF (rst(ng)%Nrec(fcount).gt.0) THEN
              IF (lcyclerst(ng)) THEN
                IF (rst(ng)%Nrec(fcount).gt.1) THEN
                  rst(ng)%Nrec(fcount)=2
                ELSE
                  rst(ng)%Nrec(fcount)=1
                END IF
              END IF
              WRITE (stdout,20) 'RESTART', rst(ng)%Nrec(fcount)
            END IF
          END IF
 
#if defined FOUR_DVAR || defined ENKF_RESTART
          IF (associated(dai(ng)%Nrec)) THEN
            IF (any(dai(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'DA IC  ', sum(dai(ng)%Nrec)
            END IF
          END IF
#endif
 
#ifdef ADJOINT
          IF (associated(adm(ng)%Nrec)) THEN
            IF (any(adm(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'ADJOINT', sum(adm(ng)%Nrec)
            END IF
          END IF
#endif
 
#ifdef TANGENT
          IF (associated(tlm(ng)%Nrec)) THEN
            IF (any(tlm(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'TANGENT', sum(tlm(ng)%Nrec)
            END IF
          END IF
#endif
 
#if defined AVERAGES    || \
   (defined ad_averages && defined adjoint) || \
   (defined rp_averages && defined tl_ioms) || \
   (defined tl_averages && defined tangent)
          IF (associated(avg(ng)%Nrec)) THEN
            IF (any(avg(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'AVERAGE', sum(avg(ng)%Nrec)
            END IF
          END IF
#endif
 
#ifdef STATIONS
          IF (associated(sta(ng)%Nrec)) THEN
            IF (any(sta(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'STATION', sum(sta(ng)%Nrec)
            END IF
          END IF
#endif
 
#if defined WEAK_CONSTRAINT   && \
   (defined posterior_error_f || defined posterior_error_i)
          IF (associated(err(ng)%Nrec)) THEN
            IF (any(err(ng)%Nrec.gt.0)) THEN
              WRITE (stdout,20) 'ERROR  ', sum(err(ng)%Nrec)
            END IF
          END IF
#endif
        END IF
      END DO
!
!-----------------------------------------------------------------------
!  Report analytical header files used.
!-----------------------------------------------------------------------
!
      IF (master) THEN
        first=.true.
        DO i=1,39
          ana_string=trim(ananame(i))
          ivalue=ichar(ana_string(1:1))
          IF (ivalue.ge.47) THEN          ! decimal value for characters
            IF (exit_flag.ne.5) THEN
              IF (first) THEN
                first=.false.
                WRITE (stdout,30) ' Analytical header files used:'
              END IF
              WRITE (stdout,'(5x,a)') trim(adjustl(ananame(i)))
            END IF
          END IF
        END DO
      END IF
 
#ifdef BIOLOGY
!
!-----------------------------------------------------------------------
!  Report biology model header files used.
!-----------------------------------------------------------------------
!
      IF (master) THEN
        first=.true.
        DO i=1,4
          ana_string=trim(bioname(i))
          ivalue=ichar(ana_string(1:1))
          IF (ivalue.ge.47) THEN          ! decimal value for characters
            IF (exit_flag.ne.5) THEN
              IF (first) THEN
                first=.false.
                WRITE (stdout,30) ' Biology model header files used:'
              END IF
              WRITE (stdout,'(5x,a)') trim(adjustl(bioname(i)))
            END IF
          END IF
        END DO
      END IF
#endif
!
!-----------------------------------------------------------------------
!  If applicable, report internal exit errors.
!-----------------------------------------------------------------------
!
      IF (master.and.                                                   &
     &    (founderror(exit_flag, noerror, __line__, myfile))) THEN
        WRITE (stdout,40) rerror(exit_flag), exit_flag
      END IF
      IF (blowup.ne.0) THEN
        IF (master) WRITE (stdout,50) trim(blowup_string)
      ELSE IF (exit_flag.eq.noerror) THEN
        CALL get_date (date_str)
        IF (master) WRITE (stdout,60) trim(date_str)
      ELSE IF (exit_flag.eq.2) THEN
        IF (master) WRITE (stdout,70) nf90_strerror(ioerror)
      ELSE IF (exit_flag.eq.3) THEN
        IF (master) WRITE (stdout,80) nf90_strerror(ioerror)
      ELSE IF (exit_flag.eq.4) THEN
        IF (master) WRITE (stdout,90)
      ELSE IF (exit_flag.eq.5) THEN
        IF (master) WRITE (stdout,100)
      ELSE IF (exit_flag.eq.6) THEN
        IF (master) WRITE (stdout,110)
      ELSE IF (exit_flag.eq.7) THEN
        IF (master) WRITE (stdout,120)
      ELSE IF (exit_flag.eq.8) THEN
        IF (master) WRITE (stdout,130)
      END IF
 
#ifdef ROMS_STDOUT
!
!-----------------------------------------------------------------------
!  Close ROMS standard outpu file.
!-----------------------------------------------------------------------
!
      FLUSH (stdout)
      CLOSE (stdout)
#endif
!
 10   FORMAT (/,' ROMS - Output NetCDF summary for Grid ',              &
     &        i2.2,':')
 20   FORMAT (13x,'number of time records written in ',                 &
     &        a,' file = ',i0)
 30   FORMAT (/,a,/)
 40   FORMAT (/,a,i0,/)
 50   FORMAT (/,' MAIN: Abnormal termination: BLOWUP.',/,               &
     &          ' REASON: ',a)
 60   FORMAT (/,' ROMS: DONE... ',a)
 70   FORMAT (/,' ERROR: Abnormal termination: NetCDF INPUT.',/,        &
     &          ' REASON: ',a)
 80   FORMAT (/,' ERROR: Abnormal termination: NetCDF OUTPUT.',/,       &
     &          ' REASON: ',a)
 90   FORMAT (/,' ERROR: I/O related problem.')
100   FORMAT (/,' ERROR: Illegal model configuration.')
110   FORMAT (/,' ERROR: Illegal domain partition.')
120   FORMAT (/,' ERROR: Illegal input parameter.')
130   FORMAT (/,' ERROR: Fatal algorithm result.')
!
      RETURN
      END SUBROUTINE close_out
 
      END MODULE close_io_mod