sfx_xios_declare_field.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_declare_field(HREC, HDOMAIN, HAXIS, KLEV, HAXIS2, KLEV2, HCOMMENT ,KFREQOP) 
!!
!!
!!     PURPOSE
!!     --------
!!
!!     Declare field HREC and some attributes to XIOS if needed 

!!      If 'units' or 'long_name' attribute is not defined using XIOS
!!     config files , use HCOMMENT to declare it. Same for domain and
!!     other axis, either using relevant args or with default values
!!
!!     If haxis si provided and is the name of dimension 'patch' and
!!     haxis2 is not provided, rather proceed by a loop of 2D
!!     fields declarations
!!  
!!     IMPLICIT ARGUMENTS :
!!     -------------------- 
!!
!!     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    03/2016
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_xios,       ONLY     : lxios_def_closed, ypatch_dim_name, nbase_xios_freq
USE modd_surf_par,   ONLY     : xundef

#ifdef WXIOS
USE xios
#endif
!
USE modi_set_axis
USE modi_abor1_sfx
!
USE yomhook, ONLY  : lhook,   dr_hook
USE parkind1, ONLY : jprb, jpim
!
IMPLICIT NONE

!
!   Arguments
!
 CHARACTER(LEN=*)   ,INTENT(IN)            :: HREC     ! field id
 CHARACTER(LEN=*)   ,INTENT(IN), OPTIONAL  :: HDOMAIN  ! name of the horiz domain
 CHARACTER(LEN=*)   ,INTENT(IN), OPTIONAL  :: HAXIS    ! name of the additional axis
INTEGER             ,INTENT(IN), OPTIONAL  :: KLEV     ! Axis size 
 CHARACTER(LEN=*)   ,INTENT(IN), OPTIONAL  :: HAXIS2   ! name of second additional axis
INTEGER            ,INTENT(IN), OPTIONAL  :: KLEV2    ! Second axis size
 CHARACTER(LEN=*)   ,INTENT(IN), OPTIONAL  :: HCOMMENT ! Comment string a la Surfex
INTEGER(KIND=JPIM)  ,INTENT(IN), OPTIONAL  :: KFREQOP  ! Sampling frequency, in minutes
!
 CHARACTER(1000)    :: YLDOMAIN
 CHARACTER(1000)    :: YLCOMMENT
 CHARACTER(1000)    :: YAXIS,YAXIS2
 CHARACTER(3)       :: YIDIM
!
INTEGER(KIND=JPIM) :: IFREQOP  ! Sampling frequency, in minutes
INTEGER(KIND=JPIM) :: IIDIM, ILEV, ILEV2
LOGICAL            :: GGRIDDEF
!
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_FIELD',0,zhook_handle)
!
#ifdef WXIOS
!
! ----------------------------------------------------------------------
!   If XIOS init phase is over, just returns
! ----------------------------------------------------------------------
!
IF (lxios_def_closed) THEN
   IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_FIELD_INTERNAL',1,zhook_handle)
   RETURN
ENDIF
!
yldomain='FULL'
IF (PRESENT(hdomain)) yldomain=trim(hdomain)
ylcomment=''
IF (PRESENT(hcomment)) ylcomment=trim(hcomment)
ifreqop=0
IF (PRESENT(kfreqop)) ifreqop=kfreqop
ilev=0          
IF (PRESENT(klev))     ilev=klev
ilev2=0         
IF (PRESENT(klev2))    ilev2=klev2
yaxis=''        
IF (PRESENT(haxis))    yaxis=trim(haxis)
yaxis2=''       
IF (PRESENT(haxis2))   yaxis2=trim(haxis2)
!
IF (PRESENT(haxis) .AND. (yaxis==trim(ypatch_dim_name)) .AND. .NOT. PRESENT(haxis2)) THEN
  ! For historical reason, in that case, a special treatment for
  ! avoiding that 'patch' dimension (provided as 1st dimension) is
  ! actually used : proceed by declaring a set of individual arrays
  IF ( ilev == 0 ) CALL xios_get_axis_attr(haxis, n_glo=ilev)
  DO iidim=1,ilev
    IF ( iidim < 10 ) THEN 
      WRITE(yidim,'(I1)') iidim
    ELSE
      IF ( iidim < 100 ) THEN 
        WRITE(yidim,'(I2)') iidim
      ELSE
        WRITE(yidim,'(I2)') iidim
      ENDIF
    ENDIF
    !write(0,*) '<field id="'//trim(HREC)//'_'//TRIM(YIDIM)//'", domain_ref="'//trim(CLDOMAIN)//'" />'
    CALL sfx_xios_declare_field_internal(trim(hrec)//'_'//trim(yidim), yldomain, ylcomment, ifreqop)
  END DO
  !
ELSE
  !
  ! Standard case
  ! 
  CALL sfx_xios_declare_field_internal(hrec, yldomain, ylcomment, ifreqop)
  IF (PRESENT(haxis))  CALL sfx_xios_declare_axis_internal(hrec,yaxis,ilev)
  IF (PRESENT(haxis2)) CALL sfx_xios_declare_axis_internal(hrec,yaxis2,ilev2,osecond=.true.)
ENDIF
#endif
!
IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_FIELD',1,zhook_handle)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


CONTAINS 

SUBROUTINE sfx_xios_declare_field_internal(HREC, HDOMAIN, HCOMMENT , KFREQOP) 
USE modd_xios,       ONLY     : coutput_default
USE modd_surf_par,   ONLY     : xundef
USE yomhook    , ONLY         : lhook,   dr_hook
USE parkind1   , ONLY         : jprb, jpim
!
#ifdef WXIOS
USE xios
#endif
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!   Arguments
!
 CHARACTER(LEN=*)   ,INTENT(IN)  :: HREC     ! field id
 CHARACTER(LEN=*)   ,INTENT(IN)  :: HDOMAIN  ! name of the horiz domain
 CHARACTER(LEN=*)   ,INTENT(IN)  :: HCOMMENT ! Comment string a la Surfex
INTEGER(KIND=JPIM) ,INTENT(IN)  :: KFREQOP  ! Sampling frequency, in minutes
!
!  Local variables
!
LOGICAL            :: GISDEF, GGRIDDEF
INTEGER            :: IPO,IPF
!
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
!
#ifdef WXIOS
TYPE(xios_field)      :: field_hdl, other_field_hdl
TYPE(xios_fieldgroup) :: fieldgroup_hdl
TYPE(xios_file)       :: file_hdl
#endif
!
IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_FIELD',0,zhook_handle)
!
#ifdef WXIOS
!
!$OMP SINGLE
!
! ----------------------------------------------------------------------
!  We are still in the XIOS init phase =>  Define field if necessary 
! ----------------------------------------------------------------------
!
IF (.NOT. xios_is_valid_field(hrec))  THEN
        
  CALL xios_get_handle("field_definition",fieldgroup_hdl)
  CALL xios_add_child(fieldgroup_hdl,field_hdl,hrec)
  !IF (.NOT. XIOS_IS_VALID_FIELD("default_field")) &
  !    CALL ABOR1_SFX('sfx_xios_check_field:cannot output field '//HREC//' : no default_field is defined')
  CALL xios_set_attr(field_hdl,name=hrec)
  !
  ! ----------------------------------------------------------------------
  ! If default_ouput file is defined, add this field to it
  ! ----------------------------------------------------------------------
  !
  IF ( xios_is_valid_file(coutput_default)) THEN 
    CALL xios_get_handle(coutput_default,file_hdl)
    CALL xios_add_child(file_hdl,field_hdl)
    CALL xios_set_attr(field_hdl,field_ref=hrec)
  ENDIF

ENDIF
!
! ----------------------------------------------------------------------
!  If field attribute 'domain' is not defined, set it
! ----------------------------------------------------------------------
!
 CALL xios_is_defined_field_attr(hrec,grid_ref=ggriddef) 
 CALL xios_is_defined_field_attr(hrec,domain_ref=gisdef) 
!
IF (  .NOT. gisdef .AND. .NOT. ggriddef ) THEN 
  IF (trim(hdomain)=='') &
        CALL abor1_sfx('SFX_XIOS_DECLARE_FIELD_INTERNAL : MUST PROVIDE HDOMAIN '//hrec)
  !if (trim(hrec)=='PFRSO1') write(0,*) 'Setting domain for PFRSO1 !!!'
  CALL xios_set_field_attr(hrec, domain_ref=trim(hdomain))
  !CALL XIOS_SET_FIELD_ATTR(HREC, grid_ref=TRIM(HDOMAIN))
ELSE
   !write(0,*) 'Field '//trim(hrec)//' already has a grid or domain:',GGRIDDEF,GISDEF
ENDIF
!
! ----------------------------------------------------------------------
! If prec  is not defined , set it to the provided value (def : timestep)
! ----------------------------------------------------------------------
!
! CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,name=GISDEF) 
!IF ( .NOT. GISDEF ) THEN 
!  CALL XIOS_SET_FIELD_ATTR(HREC, name=trim(HREC))
!ENDIF
!
! ------------------------------------------------------------------------
! If field attribute 'unit' is not defined or empty, try to guess a value 
! from HCOMMENT (using rightmost string between parenthesis)
! ------------------------------------------------------------------------
!
 CALL xios_is_defined_field_attr(hrec,unit=gisdef)
IF ( .NOT. gisdef ) THEN 
   ipo=index(hcomment,"(",.true.)
   ipf=index(hcomment,")",.true.)
   IF ( (ipo > 0) .AND. (ipf>ipo+1) ) THEN
      CALL xios_set_field_attr(hrec,unit=hcomment(ipo+1:ipf-1))
   ENDIF
ENDIF
!
! ----------------------------------------------------------------------
! If field attribute 'long_name' is not defined or empty, set it 
! ----------------------------------------------------------------------
!
 CALL xios_is_defined_field_attr(hrec,long_name=gisdef) 
IF ( .NOT. gisdef .AND. (trim(hcomment) /= '') ) THEN 
  IF (ipo > 1) THEN 
    CALL xios_set_field_attr(hrec,long_name=trim(hcomment(1:ipo-1)))
  ELSE
    CALL xios_set_field_attr(hrec,long_name=trim(hcomment(:)))
  ENDIF
ENDIF
!
! ----------------------------------------------------------------------
! Set default value to Surfex's one
! ----------------------------------------------------------------------
!
 CALL xios_set_field_attr(hrec,default_value=xundef)
!
!$OMP END SINGLE
#endif
!
IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_FIELD_INTERNAL',1,zhook_handle)
! ----------------------------------------------------------------------
!
END SUBROUTINE sfx_xios_declare_field_internal

SUBROUTINE sfx_xios_declare_axis_internal(HREC, HAXIS, KLEV, OSECOND) 
!
USE yomhook    , ONLY         : lhook,   dr_hook
USE parkind1   , ONLY         : jprb
!
#ifdef WXIOS
USE xios
#endif
!
USE modi_abor1_sfx
!
!
IMPLICIT NONE
!
!   Arguments
!
 CHARACTER(LEN=*)   ,INTENT(IN) :: HREC     ! field id
 CHARACTER(LEN=*)   ,INTENT(IN) :: HAXIS    ! axis name 
INTEGER            ,INTENT(IN) :: KLEV     ! axis size
LOGICAL            ,INTENT(IN),OPTIONAL :: OSECOND  ! Is it a second axis
!
!  Local variables
!
LOGICAL            :: GISDEF, GGRIDDEF, GVALID_AXIS
 CHARACTER(1000)    :: YAXIS
INTEGER            :: INGLO
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_AXIS_INTERNAL',0,zhook_handle)
!
#ifdef WXIOS
 CALL xios_is_defined_field_attr(hrec,grid_ref=ggriddef) 
IF (.NOT. ggriddef ) THEN 
  ! If an axis is already declared, just do nothing, except
  ! if it is second call
  CALL xios_is_defined_field_attr(hrec,axis_ref=gisdef) 
  IF ( .NOT. gisdef .OR. PRESENT(osecond)) THEN
    IF ( trim(haxis) == '')  THEN
      gvalid_axis=.false.
      IF (PRESENT(osecond)) THEN
        yaxis='dim2_for_'//trim(hrec)
      ELSE
        yaxis='dim_for_'//trim(hrec)
      ENDIF
    ELSE
      gvalid_axis=xios_is_valid_axis(trim(haxis))
      yaxis=trim(haxis)
    ENDIF
    IF (.NOT. gvalid_axis) THEN 
       IF ( klev /= 0) THEN 
          CALL set_axis(trim(haxis),ksize=klev)
          !write(0,*) 'calling set_axis for '//trim(yaxis)//" "//HREC ; call flush(0)
       ELSE
          CALL abor1_sfx('SFX_XIOS_DECLARE_FIELD:SFX_XIOS_DECLARE_AXIS_INTERNAL'//&
               ': MUST PROVIDE KLEV OR AN ALREADY DECLARED HAXIS for '//hrec)
       ENDIF
    ENDIF
    CALL xios_set_field_attr(hrec, axis_ref=trim(yaxis))
  ELSE
    !write(0,*) 'An axis is already defined for '//HREC ; call flush(0)
  ENDIF
ELSE
   !write(0,*) 'A grid is already defined for '//HREC ; call flush(0)
ENDIF
#endif
!
IF (lhook) CALL dr_hook('SFX_XIOS_DECLARE_AXIS_INTERNAL',1,zhook_handle)
!
END SUBROUTINE sfx_xios_declare_axis_internal

END SUBROUTINE sfx_xios_declare_field