sfx_xios_set_domain.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
SUBROUTINE sfx_xios_set_domain(HGRID, HNAME, KDIM1, KDIM2, KEXT1, KINDEX,&
                         ODMASK, PLON, PLAT, PCORNER_LON, PCORNER_LAT, KMASK) 
#ifdef WXIOS 
!!
!!
!!     PURPOSE
!!     --------
!!
!!
!!     Initialize an XIOS domain, representing Surfex packing for a
!!     tile (or full domain) Declare Surfex grids and masks for XIOS,
!!     accounting for 2D and 1D geometries
!!
!!
!!     IMPLICIT ARGUMENTS :
!!     -------------------- 
!!
!!     LXIOS, YXIOS_CONTEXT, TXIOS_CONTEXT, LGAUSS
!!
!!
!!     EXTERNAL
!!     --------
!!
!!     XIOS LIBRARY
!!
!!
!!     REFERENCE
!!     ---------
!!
!!     XIOS Reference guide - Yann Meurdesoif - 10/10/2014 :
!!       svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ; 
!!       cd <dir>/doc ; ....
!!
!!     AUTHOR
!!     ------
!!
!!     S.Sénési, CNRM
!!
!!     MODIFICATION
!!     --------------
!!
!!     Original    08/2015
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!-------------------------------------------------------------------------------
!
USE xios     ,ONLY : xios_domain, xios_domaingroup, xios_axisgroup, xios_axis, &
                     xios_get_handle, xios_add_child, xios_set_domain_attr,    &
                     xios_is_defined_domain_attr
!
USE modi_get_surf_grid_dim_n
USE modi_latlon_gridtype_lonlat_reg
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), INTENT(IN) :: HGRID
 CHARACTER(LEN=*), INTENT(IN) :: HNAME  ! Name to set in XIOS for the Surfex domain/tile
INTEGER, INTENT(IN)          :: KDIM1  ! Global grid size for dimension 1 (incl. extension zone if any)
                                       ! Can be set to O for offline case
INTEGER, INTENT(IN)          :: KDIM2  ! Global grid size for dimension 2
INTEGER, INTENT(IN)          :: KEXT1  ! Size of extension zone if any (Aladin : NEXTI)
                                       ! Should be O for offline case
!
INTEGER, INTENT(IN), DIMENSION(:)           :: KINDEX ! Index of the MPI-task cells 
                                                      ! in global 1D grid (from 0)
LOGICAL, INTENT(IN), DIMENSION(:)           :: ODMASK ! mask for the MPI-task cells 
REAL   , INTENT(IN), DIMENSION(:),OPTIONAL  :: PLON ! Longitudes for the MPI-task cells
REAL   , INTENT(IN), DIMENSION(:),OPTIONAL  :: PLAT ! Latitudes  for the MPI-task cells
REAL   , INTENT(IN), DIMENSION(:,:),OPTIONAL:: PCORNER_LON, PCORNER_LAT 
INTEGER, INTENT(IN), DIMENSION(:),OPTIONAL  :: KMASK ! Local Surfex packing mask for the tile
!
TYPE(xios_domaingroup) :: domaingroup_hdl
TYPE(xios_domain)      :: domain_hdl
!
INTEGER             :: ISIZE             ! Number of points for the MPI-task (among all tiles)
LOGICAL             :: GRECT             ! T if rectangular grid (inc Aladin)
INTEGER             :: JK
!
INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, JINDEX   
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('SFX_XIOS_SET_DOMAIN',0,zhook_handle)
!
!$OMP SINGLE
!
 CALL xios_get_handle("domain_definition",domaingroup_hdl)
 CALL xios_add_child(domaingroup_hdl,domain_hdl,hname)
!
isize = SIZE(kindex)
!
!
grect = (kdim2/=1)
!
IF (grect) THEN 
   !
   CALL xios_set_domain_attr(hname, ni_glo=kdim1-kext1, nj_glo=kdim2)
   CALL xios_set_domain_attr(hname, data_dim=1, ibegin=0)
   CALL xios_set_domain_attr(hname, ni=isize)
   CALL xios_set_domain_attr(hname, nj=1, data_nj=1)    ! To account for XIOS bugs 
   ! Must build i_index and j_index from kindex
   ALLOCATE(iindex(isize), jindex(isize))
   !
   DO jk = 1,isize
         iindex(jk)=mod(kindex(jk),kdim1-kext1) 
         jindex(jk)=kindex(jk)/(kdim1-kext1)  
         IF (jindex(jk) .GT. kdim2-1 ) &
              CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : Inconsistent jindex")
   ENDDO
   !
   CALL xios_set_domain_attr(hname, i_index=iindex, j_index=jindex)
   DEALLOCATE(iindex, jindex)
   CALL xios_set_domain_attr(hname, mask_1d=odmask)
   !
   IF (PRESENT(kmask)) THEN 
      CALL xios_set_domain_attr(hname, data_i_index=kmask(:), data_ni=size(kmask))
   ENDIF
   !
   !
   ! Process lat/lon and their corners
   !
   CALL xios_set_domain_attr(hname, lonvalue_1d=plon,latvalue_1d=plat)
   IF (hgrid=="LONLAT REG")  THEN 
     !
     CALL xios_set_domain_attr(hname, type='rectilinear')
     CALL xios_set_domain_attr(hname, lonvalue_1d=plon,latvalue_1d=plat)
     !
     !CALL XIOS_SET_DOMAIN_ATTR(HNAME, type='regular')
     !IDIM=KDIM1*KDIM2
     !ALLOCATE(ZLAT(IDIM),ZLON(IDIM),ZMESH(IDIM),ZDIR(IDIM))
     !CALL LATLON_GRIDTYPE_LONLAT_REG(SIZE(UG%XGRID_PAR),IDIM,&
     !     UG%XGRID_PAR,ZLAT,ZLON,ZMESH,ZDIR)
     !CALL XIOS_SET_DOMAIN_ATTR(HNAME, lonvalue_1d=ZLON(1:KDIM1-KEXT1))
     !CALL XIOS_SET_DOMAIN_ATTR(HNAME, latvalue_1d=(/(ZLAT(KK),KK=1,IDIM,KDIM1)/)  )
     !DEALLOCATE(ZLAT,ZLON,ZMESH,ZDIR)     
     CALL xios_set_domain_attr(hname, type='rectilinear')
     !
   ELSE
      IF (hgrid/="CONF PROJ ") &
           print*,"SFX_XIOS_SET_DOMAIN : Managing "//hgrid//" type grid is not yet tested "
      !
      CALL xios_set_domain_attr(hname, type="curvilinear")
      CALL xios_set_domain_attr(hname, lonvalue_1d=plon,latvalue_1d=plat)
      IF (PRESENT(pcorner_lat) .AND. (hgrid /='CARTESIAN')) THEN 
         CALL xios_set_domain_attr(hname, nvertex=4, &
              bounds_lon_1d=pcorner_lon,bounds_lat_1d=pcorner_lat)
      ENDIF      
      !
   ENDIF
   !
ELSE
   ! For 1D global grids (such as Gaussian reduced), just provide
   ! KINDEX, the local array of global cell indices
   !
   CALL xios_set_domain_attr(hname, type='unstructured', data_dim=1, ni_glo=kdim1*kdim2)
   CALL xios_set_domain_attr(hname, ibegin=0)
   if (maxval(kindex) > kdim1*kdim2-1 )  CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : maxval(i_index)")
   if (minval(kindex) < 0 )              CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : minval(i_index)")
   CALL xios_set_domain_attr(hname, i_index=kindex, ni=size(kindex) )
   ! CALL XIOS_SET_DOMAIN_ATTR(HNAME, mask_1d=LDMASK)
   IF (PRESENT(kmask)) THEN 
      !
      ! Use XIOS 'compression' feature to account for Surfex 'packing' 
      !
      !write(0,*) 'declaring '//trim(yname)//' with sizes : ',ISIZE,SIZE(KMASK), minval(kindex),maxval(kindex)&
      !     , minval(kmask),maxval(kmask)
      !call flush(0)
      if ( size(kmask) > 0 ) then 
         if (size(kmask) > size(kindex))       CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : size(kmask))")
         if (maxval(kmask) > size(kindex)-1 )  CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : maxval(data_i_index)")
         if (minval(kmask) < 0 )               CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : minval(data_i_index)")
      else
         !write(0,*) 'zero-size domain '//trim(yname)
      endif
      CALL xios_set_domain_attr(hname, data_i_index=kmask, data_ni=size(kmask))
      !ELSE
      !write(0,*) 'declaring '//trim(yname)//' with sizes : ',ISIZE, minval(kindex),maxval(kindex)
      !call flush(0)
   ENDIF
   !
   ! Process lat/lon and their corners
   !
   IF (PRESENT(plat) .AND. PRESENT(plon)) THEN
      CALL xios_set_domain_attr(hname, lonvalue_1d=plon,latvalue_1d=plat)
   ELSE
      CALL abor1_sfx("SFX_XIOS_SET_DOMAIN : Must provide lat and lon")
   ENDIF
   IF (PRESENT(pcorner_lat) .AND. PRESENT(pcorner_lon) .AND. &
        (hgrid/='CARTESIAN' )) THEN 
      CALL xios_set_domain_attr(hname, nvertex=4, &
           bounds_lat_1d=pcorner_lat, bounds_lon_1d=pcorner_lon )
   ENDIF
ENDIF
!
!$OMP END SINGLE
IF (lhook) CALL dr_hook('SFX_XIOS_SET_DOMAIN',1,zhook_handle)
!
#endif
END SUBROUTINE sfx_xios_set_domain