iom.F90

MODULE iom
   !!======================================================================
   !!                    ***  MODULE  iom ***
   !! Input/Output manager :  Library to read input files
   !!======================================================================
   !! History :  2.0  ! 2005-12  (J. Belier) Original code
   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case
   !!            3.6  ! 2014-15  DIMG format removed
   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
   !!            4.0  ! 2017-11  (M. Andrejczuk) Extend IOM interface to write any 3D fields
   !!----------------------------------------------------------------------

   !!----------------------------------------------------------------------
   !!   iom_open       : open a file read only
   !!   iom_close      : close a file or all files opened by iom
   !!   iom_get        : read a field (interfaced to several routines)
   !!   iom_varid      : get the id of a variable in a file
   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
   !!----------------------------------------------------------------------
   USE dom_oce         ! ocean space and time domain
   USE domutl          !
   USE flo_oce         ! floats module declarations
   USE lbclnk          ! lateal boundary condition / mpp exchanges
   USE iom_def         ! iom variables definitions
   USE iom_nf90        ! NetCDF format with native NetCDF library
   USE in_out_manager  ! I/O manager
   USE lib_mpp           ! MPP library
   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes
#if defined key_si3
   USE ice      , ONLY :   jpl
#endif
   USE phycst          ! physical constants
   USE dianam          ! build name of file
#if defined key_xios
   USE xios
# endif
   USE ioipsl, ONLY :  ju2ymds    ! for calendar
   USE crs             ! Grid coarsening
#if defined key_top
   USE trc, ONLY    :  profsed
#endif
   USE lib_fortran
   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
   USE iom_nf90
   USE netcdf

   IMPLICIT NONE
   PUBLIC   !   must be public to be able to access iom_def through iom

#if defined key_xios
   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
#else
   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
#endif
   LOGICAL, PUBLIC            ::   l_iom = .TRUE.            !: RK3 iom flag prevent writing at stage 1&2
   PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
   PUBLIC iom_xios_setid

   PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
   PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
   PRIVATE iom_get_123d
   PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
   PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
   PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
   PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
#if defined key_xios
   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate
   PRIVATE iom_set_rst_context, iom_set_vars_active
# endif
   PRIVATE set_xios_context
   PRIVATE iom_set_rstw_active

   INTERFACE iom_get
      MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
      MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
   END INTERFACE
   INTERFACE iom_getatt
      MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt
   END INTERFACE
   INTERFACE iom_putatt
      MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt
   END INTERFACE
   INTERFACE iom_rstput
      MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
      MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
   END INTERFACE
   INTERFACE iom_put
      MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
      MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
   END INTERFACE iom_put

   !! * Substitutions
#  include "do_loop_substitute.h90"
   !!----------------------------------------------------------------------
   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
   !! $Id: iom.F90 15512 2021-11-15 17:22:03Z techene $
   !! Software governed by the CeCILL license (see ./LICENSE)
   !!----------------------------------------------------------------------
CONTAINS

   SUBROUTINE iom_init( cdname, kdid, ld_closedef )
      !!----------------------------------------------------------------------
      !!                     ***  ROUTINE   ***
      !!
      !! ** Purpose :
      !!
      !!----------------------------------------------------------------------
      CHARACTER(len=*),           INTENT(in)  :: cdname
      INTEGER         , OPTIONAL, INTENT(in)  :: kdid
      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef
#if defined key_xios
      !
      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
      TYPE(xios_date)     :: start_date
      CHARACTER(len=lc) :: clname
      INTEGER             :: irefyear, irefmonth, irefday
      INTEGER           :: ji
      LOGICAL           :: llrst_context              ! is context related to restart
      LOGICAL           :: llrstr, llrstw
      INTEGER           :: inum
      !
      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries
      LOGICAL ::   ll_closedef
      LOGICAL ::   ll_exist
      !!----------------------------------------------------------------------
      !
      ll_closedef = .TRUE.
      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef
      !
      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
      !
      clname = cdname
      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
      CALL xios_context_initialize(TRIM(clname), mpi_comm_oce)
      CALL iom_swap( cdname )

      llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt)
      llrstr = llrstr .OR. (cdname == cr_ablrst_cxt)
      llrstr = llrstr .OR. (cdname == cr_toprst_cxt)
      llrstr = llrstr .OR. (cdname == cr_sedrst_cxt)

      llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt)
      llrstw = llrstw .OR. (cdname == cw_ablrst_cxt)
      llrstw = llrstw .OR. (cdname == cw_toprst_cxt)
      llrstw = llrstw .OR. (cdname == cw_sedrst_cxt)

      llrst_context = llrstr .OR. llrstw

      ! Calendar type is now defined in xml file
      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900
      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01
      IF (.NOT.(xios_getvar('ref_day'  ,irefday  ))) irefday   = 01

      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
      CASE ( 1)   ;   CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
      CASE ( 0)   ;   CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
      CASE (30)   ;   CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
      END SELECT

      ! horizontal grid definition
      IF(.NOT.llrst_context) CALL set_scalar
      !
      IF( cdname == cxios_context ) THEN
         CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. )
         CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
         CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. )
         CALL set_grid_znl( gphit )
         !
         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
            CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp))
            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp))
            CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
            CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp))
            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
            CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif )
         ENDIF
      ENDIF
      !
      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN
         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
         !
         CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. )
         CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. )
         CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. )