Changeset 13016 for NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/IOM/iom.F90

Timestamp:

2020-06-03T12:48:36+02:00 (4 years ago)

Author:

andmirek

Message:

Ticket #2475 implementation of new interface

File:

• NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/IOM/iom.F90 (modified) (10 diffs)

NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/IOM/iom.F90

@@ -46 +46 @@
    USE lib_fortran 
    USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
+   USE netcdf
+   USE iom_nf90
 
    IMPLICIT NONE
@@ -58 +60 @@
    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_dom_context
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -65 +68 @@
    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_rstw_active, iom_set_rstr_active
+   PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active, iom_set_vars_active
 # endif
    PUBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars
@@ -306 +309 @@
 
    END SUBROUTINE iom_init_closedef
+
+   SUBROUTINE iom_set_vars_active(cdfname, idnum)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_vars_active  ***
+      !!
+      !! ** Purpose :  define filename in XIOS context for reading file,
+      !!               enable variables present in restart file for reading with XIOS 
+      !!               id of a file is assumed to be rrestart.
+      !!---------------------------------------------------------------------
+
+!sets enabled = .TRUE. for each field in restart file
+   CHARACTER(len=*), INTENT(IN) :: cdfname
+   INTEGER         , INTENT(IN) :: idnum 
+#if defined key_iomput
+   INTEGER                                    :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims
+   TYPE(xios_field)                           :: field_hdl
+   TYPE(xios_file)                            :: file_hdl
+   TYPE(xios_filegroup)                       :: filegroup_hdl
+   INTEGER                                    :: dimids(4), jv,i, idim
+   CHARACTER(LEN=256)                         :: clinfo               ! info character
+   INTEGER, ALLOCATABLE                       :: indimlens(:)
+   CHARACTER(LEN=nf90_max_name), ALLOCATABLE  :: indimnames(:)
+   CHARACTER(LEN=nf90_max_name)               :: dimname, varname
+   LOGICAL                                    :: lmeta
+
+        meta(1) = "nav_lat"
+        meta(2) = "nav_lon"
+        meta(3) = "nav_lev"
+        meta(4) = "time_instant"
+        meta(5) = "time_instant_bounds"
+        meta(6) = "time_counter"
+        meta(7) = "time_counter_bounds"
+        meta(8) = "x"
+        meta(9) = "y"
+        meta(10) = "numcat"
+
+        clinfo = '          iom_set_vars_active, file: '//TRIM(cdfname)
+
+        IF(lwp) write(numout, *) TRIM(clinfo)
+        IF(lwp) CALL FLUSH(numout)
+!set name of the restart file and enable available fields
+        CALL xios_get_handle("file_definition", filegroup_hdl )
+        CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart')
+        CALL xios_set_file_attr( "rrestart", name=trim(cdfname), type="one_file", &
+             par_access="collective", enabled=.TRUE., mode="read",                 &
+             output_freq=xios_timestep)
+
+        CALL iom_nf90_check( nf90_inquire(idnum, ndims, nvars, natts ), clinfo )
+        ALLOCATE(indimlens(ndims), indimnames(ndims))
+        CALL iom_nf90_check( nf90_inquire(idnum, unlimitedDimId = unlimitedDimId ), clinfo )
+
+        DO idim = 1, ndims
+           CALL iom_nf90_check( nf90_inquire_dimension(idnum, idim, dimname, dimlen ), clinfo )
+           indimlens(idim) = dimlen
+           indimnames(idim) = dimname
+        ENDDO
+
+        DO jv =1, nvars
+            lmeta = .FALSE.
+            CALL iom_nf90_check( nf90_inquire_variable(idnum, jv, varname, xtype, ndims, dimids, natts ), clinfo )
+            DO i = 1, NMETA
+               IF(TRIM(varname) == TRIM(meta(i))) THEN
+                  lmeta = .TRUE.
+               ENDIF
+            ENDDO
+            IF(.NOT.lmeta) THEN
+               CALL xios_add_child(file_hdl, field_hdl, TRIM(varname))
+               mdims = ndims
+
+               IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN
+                mdims = mdims - 1
+               ENDIF
+
+               IF(mdims == 3) THEN
+                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname),   &
+                                   domain_ref="grid_N", axis_ref=TRIM(iom_axis(indimlens(dimids(mdims)))), &
+                                   prec = 8, operation = "instant")
+               ELSEIF(mdims == 2) THEN
+                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), &
+                                          domain_ref="grid_N", prec = 8, operation = "instant") 
+               ELSEIF(mdims == 1) THEN
+                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), &
+                                          axis_ref=TRIM(iom_axis(indimlens(dimids(mdims)))), prec = 8, operation = "instant")
+               ELSEIF(mdims == 0) THEN
+                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), &
+                                                scalar_ref = "grid_scalar", prec = 8, operation = "instant")
+               ELSE
+                      WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 
+                      CALL ctl_stop( 'iom_set_vars_active:', ctmp1 )
+               ENDIF
+            ENDIF
+        ENDDO
+        DEALLOCATE(indimlens, indimnames)
+#endif
+   END SUBROUTINE iom_set_vars_active
+
+   FUNCTION iom_axis(idlev) result(axis_ref)
+     !!---------------------------------------------------------------------
+      !!                   ***  FUNCTION  iom_axis  ***
+      !!
+      !! ** Purpose : Used for grid definition when XIOS is used to read/write
+      !!              restart or configuration data. Returns axis corresponding 
+      !!              to the number of levels given as an input variable. Axes 
+      !!              are defined in routine iom_set_rst_context or iom_dom_context
+      !!              depending on context
+      !!---------------------------------------------------------------------
+    INTEGER, INTENT(IN) :: idlev
+    CHARACTER(len=lc)   :: axis_ref
+    CHARACTER(len=12)   :: str
+       IF(idlev == jpk) THEN
+         axis_ref="nav_lev"
+#if defined key_si3
+       ELSEIF(idlev == jpl) THEN
+         axis_ref="numcat"
+#endif         
+       ELSE
+         write(str, *) idlev
+         CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing')
+       ENDIF
+   END FUNCTION iom_axis
 
    SUBROUTINE iom_set_rstw_var_active(field)
@@ -659 +782 @@
       !
       CALL xios_set_current_context(nemo_hdl)
+      
 #endif
       !
@@ -980 +1104 @@
       ELSE
 #if defined key_iomput
-         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
-         CALL iom_swap( TRIM(crxios_context) )
+         IF(lwp) WRITE(numout,*) 'XIOS READ (0D): ', trim(cdvar)
          CALL xios_recv_field( trim(cdvar), pvar)
-         CALL iom_swap( TRIM(cxios_context) )
 #else
          WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar)
@@ -1334 +1456 @@
 #if defined key_iomput
 !would be good to be able to check which context is active and swap only if current is not restart
-         CALL iom_swap( TRIM(crxios_context) ) 
          IF( PRESENT(pv_r3d) ) THEN
             pv_r3d(:, :, :) = 0.
-            if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar)
+            if(lwp) write(numout,*) 'XIOS READ (3D): ',trim(cdvar)
             CALL xios_recv_field( trim(cdvar), pv_r3d)
             IF(idom /= jpdom_unknown ) then
@@ -1344 +1465 @@
          ELSEIF( PRESENT(pv_r2d) ) THEN
             pv_r2d(:, :) = 0.
-            if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar)
+            if(lwp) write(numout,*) 'XIOS READ (2D): ', trim(cdvar)
             CALL xios_recv_field( trim(cdvar), pv_r2d)
             IF(idom /= jpdom_unknown ) THEN
@@ -1351 +1472 @@
          ELSEIF( PRESENT(pv_r1d) ) THEN
             pv_r1d(:) = 0.
-            if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar)
+            if(lwp) write(numout,*) 'XIOS READ (1D): ', trim(cdvar)
             CALL xios_recv_field( trim(cdvar), pv_r1d)
          ENDIF
-         CALL iom_swap( TRIM(cxios_context) )
 #else
          istop = istop + 1 
@@ -1394 +1514 @@
    END SUBROUTINE iom_get_var
 
+   SUBROUTINE iom_dom_context(fdname, numr)  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_getszuld  ***
+      !!
+      !! ** Purpose : initialize context for reading domain information
+      !!-----------------------------------------------------------------------
+      INTEGER, PARAMETER                   :: maxf = 48
+      CHARACTER(len=*), INTENT(IN)         :: fdname
+      INTEGER,          INTENT(IN)         :: numr
+      !local variables
+      CHARACTER(len=lc)                    :: cxname
+      CHARACTER(len=lc)                    :: cfile
+      TYPE(xios_domaingroup)               :: domaingroup_hdl 
+      TYPE(xios_domain)                    :: domain_hdl 
+      TYPE(xios_axisgroup)                 :: axisgroup_hdl 
+      TYPE(xios_axis)                      :: axis_hdl 
+      TYPE(xios_scalar)                    :: scalar_hdl 
+      TYPE(xios_scalargroup)               :: scalargroup_hdl 
+      TYPE(xios_field) :: field_hdl
+      TYPE(xios_file) :: file_hdl
+      TYPE(xios_filegroup) :: filegroup_hdl
+      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
+      INTEGER :: i
+      INTEGER :: ni
+      INTEGER :: nj
+      !!-----------------------------------------------------------------------
+
+#if defined key_iomput
+      cxname = "dom_context"
+      IF( TRIM(Agrif_CFixed()) .NE. '0' ) THEN
+         CALL xios_context_initialize(TRIM(Agrif_CFixed())//"_"//TRIM(cxname), mpi_comm_oce)
+      ELSE
+         CALL xios_context_initialize(TRIM(cxname), mpi_comm_oce)
+      ENDIF
+      CALL iom_swap( cxname )
+!calendar must be defined always
+      CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1,1,1,00,00,00), &
+          &                                    start_date = xios_date(1,1,1,0,0,0) )
+     CALL xios_get_handle("domain_definition",domaingroup_hdl) 
+     CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 
+     ni = nlei-nldi+1
+     nj = nlej-nldj+1
+     !
+     CALL iom_set_domain_attr("grid_N", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+     CALL iom_set_domain_attr("grid_N", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+ 
+     CALL xios_get_handle("axis_definition",axisgroup_hdl) 
+     CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 
+!AGRIF fails to compile when unit= is in call to xios_set_axis_attr
+!    CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down")
+     CALL xios_set_axis_attr ("nav_lev", n_glo=jpk )
+
+     CALL xios_get_handle("scalar_definition", scalargroup_hdl) 
+     CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 
+
+     IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        cfile = TRIM(fdname)
+     ELSE
+        cfile = TRIM(Agrif_CFixed())//"_"//TRIM(fdname)
+     ENDIF
+     CALL iom_set_vars_active(cfile, iom_file(numr)%nfid)
+    ! set time step length
+     dtime%second = rn_Dt
+     CALL xios_set_timestep( dtime )
+
+     CALL iom_init_closedef
+#endif
+   END SUBROUTINE iom_dom_context
 
    FUNCTION iom_getszuld ( kiomid )