Changeset 11405 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcblk.F90

Timestamp:

2019-08-06T15:16:49+02:00 (5 years ago)

Author:

andmirek

Message:

ticket #2195: read weights for blk using XIOS

File:

• NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcblk.F90 (modified) (2 diffs)

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcblk.F90

@@ -280 +280 @@
          !
       ENDIF
+
+      IF(lxios_blkw) THEN
+         CALL iom_blk_wgt_init( cbwxios_context )
+         CALL iom_swap( cxios_context )
+      ENDIF
+      
       !
    END SUBROUTINE sbc_blk_init
@@ -681 +687 @@
       !
    END FUNCTION L_vap
+
+   SUBROUTINE iom_blk_wgt_init( cdname, ld_tmppatch ) 
+#if defined key_iomput
+      use xios
+#endif
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   initialize context for reading weights for surface
+      !!                forcing
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),           INTENT(in)  :: cdname
+      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch
+#if defined key_iomput
+      !
+      INTEGER, PARAMETER :: lcname = 26
+      CHARACTER(len=lc) :: clname
+      INTEGER           :: ji, jkmin
+      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity
+      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      LOGICAL ::   ll_global = .FALSE.     !: do we have variable on model grid
+      CHARACTER(len=lc), DIMENSION( jpts) :: cg_name(jpts)
+      CHARACTER(len=1), DIMENSION(lcname) :: cname
+      CHARACTER(len=lc)               :: cfname ! file name without .nc
+      TYPE(xios_duration)               :: dtime    = xios_duration(0, 0, 0, 0, 0, 0), &
+                                           outp_frq = xios_duration(0, 0, 0, 0, 0, 0)
+      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_file)                   :: file_hdl
+      TYPE(xios_filegroup)              :: filegroup_hdl
+      TYPE(xios_field)                  :: field_hdl
+      INTEGER                           :: jf, ni, nj, ipos, jfld
+      INTEGER, DIMENSION(3)             :: ndims         ! size of each dimension. this is surface 
+                                                         ! forcing, not more than 3: (x, y, t)
+      INTEGER                           :: ndim          ! number if dimensions 
+      INTEGER                           :: inum          ! file id
+      INTEGER                           :: ivid          ! varable id in netcdf file
+      CHARACTER (len=5)                 :: aname         !name of the field in wght file
+      INTEGER                           :: numwgt        !
+      LOGICAL                           :: lfound
+      INTEGER                           :: jg, id, jn
+      
+
+      cname(:)= (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', &
+                  'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', &
+                  'u', 'v', 'w', 'x', 'y', 'z'/)
+      !!----------------------------------------------------------------------
+      !
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      IF ( ll_tmppatch ) THEN
+         nldi_save = nldi   ;   nlei_save = nlei
+         nldj_save = nldj   ;   nlej_save = nlej
+         IF( nimpp           ==      1 ) nldi = 1
+         IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+         IF( njmpp           ==      1 ) nldj = 1
+         IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+      ENDIF
+      !
+      jfld = SIZE(sf)
+
+      IF(jfld > lcname) THEN
+      STOP 'lcname number is too small'
+      ENDIF
+
+      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 )
+      ! Calendar type is now defined in xml file 
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1948, 01, 01, 00, 00, 00), &
+          &                                    start_date = xios_date(nyear, nmonth, nday,00,00,00) )
+      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1948, 01, 01, 00, 00, 00), &
+          &                                    start_date = xios_date(nyear, nmonth, nday,00,00,00) )
+      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1948, 01, 01, 00, 00, 00), &
+          &                                    start_date = xios_date(nyear, nmonth, nday, 00, 00, 00) )
+      END SELECT
+
+
+      dtime%month = 1
+      CALL xios_set_timestep( dtime )
+
+      CALL xios_get_handle("domain_definition",domaingroup_hdl)
+      CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_global")
+      ni = nlei-nldi+1
+      nj = nlej-nldj+1
+      CALL xios_set_domain_attr("grid_global", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL xios_set_domain_attr("grid_global", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL xios_set_domain_attr("grid_global", type='curvilinear')
+
+      CALL xios_get_handle("file_definition", filegroup_hdl )
+
+      DO jf = 1, jfld
+!do we have weights file defined already?
+         lfound = .FALSE.
+         DO jg = 1, jf-1
+            IF(TRIM(sf(jf)%wgtname) == TRIM(sf(jg)%wgtname)) THEN
+               IF(lwp) write(numout, *) TRIM(sf(jf)%wgtname),' already defined, skipping '
+               lfound = .TRUE.
+               exit
+            ENDIF
+         ENDDO
+         IF(lfound) cycle
+!add next weights file
+         ipos = index(sf(jf)%wgtname,'.nc')
+         cfname(1:lc) = " "
+         IF(ipos > 0) THEN
+          cfname(1:ipos-1) = sf(jf)%wgtname(1:ipos-1)
+         ELSE
+          cfname(1:lc) = sf(jf)%wgtname(1:lc)
+         ENDIF
+
+         CALL xios_add_child(filegroup_hdl, file_hdl, cname(jf))
+         CALL xios_set_file_attr( cname(jf), name=TRIM(cfname),           &
+                type="one_file", par_access="collective", enabled=.TRUE., &
+                output_freq=xios_timestep, mode="read")
+
+         CALL iom_open ( sf(jf)%wgtname, inum )
+         id = iom_varid(inum, 'src05', ldstop=.FALSE.)
+         IF(id <= 0) THEN
+             numwgt = 4
+         ELSE
+             numwgt = 16
+         ENDIF
+         CALL iom_close ( inum )
+!define variables in weights file. Because all files have the same names src01,
+!dst01, ... add filename to the name to uniquely identify variables 
+         aname = ' '
+         DO jn = 1, numwgt
+            WRITE(aname,'(a3,i2.2)') 'src',jn
+            CALL xios_add_child(file_hdl, field_hdl, TRIM(aname)//TRIM(sf(jf)%wgtname))
+            CALL xios_set_attr (field_hdl, enabled = .TRUE., &
+                          name = TRIM(aname), domain_ref="grid_global", &
+                          operation = "instant")
+            CALL xios_add_child(file_hdl, field_hdl, TRIM(aname)//TRIM(sf(jf)%wgtname))
+            CALL xios_set_attr (field_hdl, enabled = .TRUE., &
+                          name = TRIM(aname), domain_ref="grid_global", &
+                          operation = "instant") 
+         ENDDO 
+      ENDDO   
+
+
+      CALL xios_close_context_definition()
+      CALL xios_update_calendar( 0 )
+
+      IF ( ll_tmppatch ) THEN
+         nldi = nldi_save   ;   nlei = nlei_save
+         nldj = nldj_save   ;   nlej = nlej_save
+      ENDIF
+#endif
+      !
+   END SUBROUTINE iom_blk_wgt_init
+
 
 #if defined key_si3