sfx_xios_setup_ol.F90

Go to the documentation of this file.

SUBROUTINE sfx_xios_setup_ol(YSC, KLUOUT, KYEAR, KMONTH, KDAY, PTIME, PSTEP)
!
!**** *SFX_XIOS_SETUP_OL*  - 
!
!     Purpose.
!     --------
!
!       Call SFX_XIOS_SETUP, providing it with Arpege MPI communicator
!       and passing args about : output logical unit, date, model
!       timestep and, for the whole MPI task : lat/lon of centers and
!       corners, cell index and mask, tile masks
!
!**   Interface.
!     ----------
!       *CALL*  *SFX_XIOS_SETUP_OL*
!
!     Input:
!     -----
!
!     Output:
!     ------
!
!
!     Method:
!     ------
!
!     Externals:
!     ---------
!
!     Reference:
!     ---------
!
!     Author:
!     -------
!      S.Senesi, aug 2015
!
!     Modifications.
!     --------------
!
!     -----------------------------------------------------------
!
USE modd_surfex_n,    ONLY : surfex_t
!
USE modn_io_offline, ONLY    : lallow_add_dim, lwrite_coord
USE modd_surfex_mpi, ONLY    : nrank, ncomm, nindex
!
USE modd_io_surf_ol, ONLY: nmask_ign
!
USE modd_xios,  ONLY : lxios, ladd_dim=>lallow_add_dim, nblock_xios=>nblock
!
USE modi_abor1_sfx
USE modi_get_surf_grid_dim_n
USE modi_get_mesh_corner
USE modi_sfx_xios_setup
USE modi_get_ign_maskall
!
USE parkind1  ,ONLY : jprb, jpim
USE yomhook   ,ONLY : lhook,   dr_hook
!
IMPLICIT NONE
!
TYPE(surfex_t),  INTENT(INOUT) :: YSC
INTEGER,            INTENT(IN) :: KLUOUT
INTEGER(KIND=JPIM), INTENT(IN) :: KYEAR      ! Current Year
INTEGER(KIND=JPIM), INTENT(IN) :: KMONTH     ! Current Month
INTEGER(KIND=JPIM), INTENT(IN) :: KDAY       ! Current Day 
REAL              , INTENT(IN) :: PTIME      ! Time in the day
REAL              , INTENT(IN) :: PSTEP      ! Atmospheric time step
!
! Local variables
!
INTEGER                              :: IX, JX
INTEGER, ALLOCATABLE, DIMENSION(:)   :: IXINDEX ! Index of the grid meshes for the 
                                       ! current MPI-task  in global 1D grid (start at 0)
LOGICAL, ALLOCATABLE, DIMENSION(:)   :: GLXMASK ! Cells mask
REAL,    ALLOCATABLE, DIMENSION(:,:) :: ZCORLON
REAL,    ALLOCATABLE, DIMENSION(:,:) :: ZCORLAT
INTEGER, ALLOCATABLE, DIMENSION(:)   :: IMN,IMS,IMW,IMT ! Tile masks, 0-based
REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZY
!
 CHARACTER(LEN=10)   :: YGRID      ! grid type 
LOGICAL             :: GRECT
INTEGER             :: IDIM1, IDIM2
!
REAL(KIND=JPRB)     :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('SFX_XIOS_SETUP_OL',0,zhook_handle)
!
#ifdef WXIOS
IF (lxios) THEN 
   !
   ladd_dim = lallow_add_dim
   !
   nblock_xios = 1

   !   Build XIOS index from Surfex's NINDEX
   ALLOCATE(ixindex(ysc%U%NSIZE_FULL))

   jx=0
   DO ix = 1,ysc%U%NDIM_FULL
      IF ( nindex(ix) == nrank ) THEN 
         jx = jx+1
         IF (jx > ysc%U%NSIZE_FULL ) THEN
            CALL abor1_sfx('sfx_xios_setup_ol : internal error with XIOS index')
         ENDIF
         ixindex(jx) = ix - 1
      ENDIF
   ENDDO
   !
   ALLOCATE(glxmask(ysc%U%NSIZE_FULL))
   glxmask(:)=.true.
   !
   ALLOCATE(imn(SIZE(ysc%U%NR_NATURE)))
   ALLOCATE(ims(SIZE(ysc%U%NR_SEA)))
   ALLOCATE(imw(SIZE(ysc%U%NR_WATER )))
   ALLOCATE(imt(SIZE(ysc%U%NR_TOWN  )))
   imn(:) = ysc%U%NR_NATURE-1
   ims(:) = ysc%U%NR_SEA   -1
   imw(:) = ysc%U%NR_WATER -1
   imt(:) = ysc%U%NR_TOWN  -1
   !   
   ALLOCATE(zcorlat(ysc%U%NSIZE_FULL,4))
   ALLOCATE(zcorlon(ysc%U%NSIZE_FULL,4))
   CALL get_mesh_corner(ysc%UG, kluout,zcorlat(:,:),zcorlon(:,:))
   !
   IF (lwrite_coord.AND.(trim(ysc%UG%G%CGRID)=='LONLATVAL'.OR.trim(ysc%UG%G%CGRID)=='IGN')) THEN
     idim1 = ysc%U%NDIM_FULL
     idim2 = 1     
   ELSE
     CALL get_surf_grid_dim_n(ysc%UG, ygrid, grect, idim1, idim2)
     IF (trim(ysc%UG%G%CGRID)=='IGN') THEN
       ALLOCATE(zx(idim1),zy(idim2))
       CALL get_ign_maskall(ysc%UG,ysc%U%NDIM_FULL,zx,zy)
       ixindex(:) = nmask_ign(ixindex(:)+1) -1
       DEALLOCATE(nmask_ign,zx,zy)
     ENDIF
   ENDIF
   !
   CALL sfx_xios_setup(ysc,ncomm,kluout,&
                       kyear,kmonth,kday,ptime,pstep,&
                       idim1,idim2,0,transpose(zcorlat),transpose(zcorlon),&
                       ixindex,glxmask,imn,ims,imw,imt)
   !
   DEALLOCATE(imn,ims,imw,imt)
   DEALLOCATE(zcorlat, zcorlon)
   DEALLOCATE(ixindex)
   DEALLOCATE(glxmask)
   !
ENDIF
#endif
!
IF (lhook) CALL dr_hook('SFX_XIOS_SETUP_OL',1,zhook_handle)
END SUBROUTINE sfx_xios_setup_ol