write_surf_xios.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 write_surf_xios(HREC, HCOMMENT, KFIELD, PFIELD, OFIELD, HFIELD, PFIELD1, PFIELD2, PFIELD3, HAXIS, HAXIS2) 
!!
!!
!!     PURPOSE
!!     --------
!!
!!    Use XIOS API to provide usual behaviour for write_surf_xx routines, namely either :
!!          - 'write' a scalar , here by defining a NetCDF global attribute in 
!!            default Surfex diags file (be it a real, double, integer or string)
!!          - or 'write' a field, here using sfx_xios_send_block
!!
!!     Thanks to the routine called (sfx_xios_send_block) this routine can be called 
!!     both during XIOS context intialization phase (it will declare the field to XIOS 
!!     if needed) and afterwrads, for actual output
!!
!!     This routine will not work properly if more (or less) than one of the optional 
!!     field args is actually provided
!!
!!     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
!              ------------
!
#ifdef WXIOS
USE modd_xios, ONLY           : lxios_def_closed, coutput_default, yxios_domain, ypatch_dim_name
USE xios
!
USE modi_sfx_xios_declare_field
USE modi_sfx_xios_send_block
#endif
!
USE modd_surf_par, ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx 
!
IMPLICIT NONE
!
!   Arguments
!
 CHARACTER(LEN=*),      INTENT(IN)            :: HREC     ! name of the field 
 CHARACTER(LEN=*),      INTENT(IN)            :: HCOMMENT !
!
INTEGER         ,      INTENT(IN), OPTIONAL :: KFIELD   ! value
REAL            ,      INTENT(IN), OPTIONAL :: PFIELD   ! value
REAL,DIMENSION(:),     INTENT(IN), OPTIONAL :: PFIELD1  ! value
REAL,DIMENSION(:,:)   ,INTENT(IN), OPTIONAL :: PFIELD2  ! value
REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELD3  ! value
LOGICAL         ,      INTENT(IN), OPTIONAL :: OFIELD   ! value
 CHARACTER(LEN=*),      INTENT(IN), OPTIONAL :: HFIELD   ! value
 CHARACTER(LEN=*) ,     INTENT(IN), OPTIONAL :: HAXIS    ! Name of 2nd dimension. Not necessary even for a 2d field
 CHARACTER(LEN=*) ,     INTENT(IN) , OPTIONAL :: HAXIS2   ! Name of 3rd dimension
!
!  Local variables
!
 CHARACTER(LEN=1000) :: YAXIS, YAXIS2
 CHARACTER(LEN=1000) :: YNAME    
 CHARACTER(LEN=10)   :: YLVL
LOGICAL         :: GRET
INTEGER         :: JI
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
#ifdef WXIOS
TYPE(xios_variable) :: var_hdl
TYPE(xios_file) :: file_hdl
#endif
!
IF (lhook) CALL dr_hook('WRITE_SURF_XIOS',0,zhook_handle)
!
#ifdef WXIOS
!$OMP SINGLE
!
IF (PRESENT(kfield) .OR. PRESENT(pfield) .OR. PRESENT(hfield) .OR. PRESENT(ofield)) THEN
  !
  ! Case of writing a scalar
  !
  IF (.NOT. lxios_def_closed) THEN
    !
    ! ----------------------------------------------------------------------
    !  We are still in the XIOS init phase ->
    !  Create a NetCDF file attribute using an XIOS variable , in default  
    !  output file (if it is a valid file) , and set the value
    ! ----------------------------------------------------------------------
    !
!doesn't work for the moment
!    IF ( XIOS_IS_VALID_FILE(COUTPUT_DEFAULT)) THEN 
!
!      CALL XIOS_GET_HANDLE(COUTPUT_DEFAULT,file_hdl)
!      CALL XIOS_ADD_CHILD(file_hdl,var_hdl,HREC)
!
!      IF (PRESENT(KFIELD) ) THEN 
!        CALL XIOS_SET_ATTR(var_hdl,type="int")
!        GRET = XIOS_SETVAR(HREC,KFIELD)
!      ENDIF
!      IF (PRESENT(PFIELD)) THEN 
!        CALL XIOS_SET_ATTR(var_hdl,type="float")
!        GRET = XIOS_SETVAR(HREC,PFIELD)
!      ENDIF
!      IF (PRESENT(OFIELD)) THEN 
!        CALL XIOS_SET_ATTR(var_hdl,type="bool")
!        GRET = XIOS_SETVAR(HREC,OFIELD)
!      ENDIF
!      IF (PRESENT(HFIELD)) THEN 
!        CALL XIOS_SET_ATTR(var_hdl,type="string")
!        GRET = XIOS_SETVAR(HREC,HFIELD)
!      ENDIF
!
!    ENDIF

  ENDIF
  !
ELSE
  !
  ! The data is not a scalar, but a field. 
  !
  IF (PRESENT(pfield1)) THEN

    IF (.NOT. lxios_def_closed ) THEN

      CALL sfx_xios_declare_field(hrec, yxios_domain, hcomment=hcomment)

    ELSE

!     IF (XIOS_IS_VALID_FIELD(HREC)) THEN 
!       IF (XIOS_FIELD_IS_ACTIVE(HREC)) THEN
      CALL sfx_xios_send_block(hrec,pfield=pfield1)
!       ENDIF
!     ENDIF

    ENDIF
    !
  ELSE IF (PRESENT(pfield2)) THEN 

    yaxis=''
    IF (PRESENT(haxis)) yaxis = trim(haxis)
    !
    ! Patch dimension is never used in output files
    !
    IF (trim(yaxis) /= trim(ypatch_dim_name)) THEN 

      IF (.NOT. lxios_def_closed ) THEN
        CALL sfx_xios_declare_field(hrec, yxios_domain, haxis=yaxis, klev=SIZE(pfield2,2), hcomment=hcomment)
      ELSE
        CALL sfx_xios_send_block(hrec,pfield2=pfield2)
      ENDIF

    ELSE ! Per-patch fields are written through a loop, and with patch number suffix

      DO ji=1,SIZE(pfield2,2)

        IF (ji < 10) THEN 
          WRITE(ylvl,'(I1)') ji
        ELSE
          WRITE(ylvl,'(I2)') ji
        ENDIF
        yname=hrec//'_'//trim(ylvl)

        IF (.NOT. lxios_def_closed ) THEN 
          CALL sfx_xios_declare_field(trim(yname), yxios_domain, hcomment=hcomment)
        ELSE
          CALL sfx_xios_send_block(trim(yname),pfield=pfield2(:,ji))
        ENDIF

      ENDDO

    ENDIF
    !
  ELSE IF (PRESENT(pfield3)) THEN 

    yaxis=''
    IF (PRESENT(haxis)) yaxis=trim(haxis)

    IF (trim(yaxis) /= trim(ypatch_dim_name)) THEN 

      ! Assume that dimension 2 is patch number and iterate on it
      DO ji=1,SIZE(pfield3,2)
        IF (ji < 10) THEN 
          WRITE(ylvl,'(I1)') ji
        ELSE
          WRITE(ylvl,'(I2)') ji
        ENDIF
        yname=hrec//'_'//trim(ylvl)

        IF (.NOT. lxios_def_closed ) THEN
          CALL sfx_xios_declare_field(yname, yxios_domain, hcomment=hcomment)
        ELSE
          CALL sfx_xios_send_block(yname,pfield2=pfield3(:,ji,:))
        ENDIF

      ENDDO

    ELSE

      IF (.NOT. lxios_def_closed ) THEN 

        yaxis2=''
        IF (PRESENT(haxis2)) yaxis2=haxis2
        CALL sfx_xios_declare_field(hrec, yxios_domain, haxis=yaxis, haxis2=yaxis2, hcomment=hcomment,&
                                    klev=SIZE(pfield2,2), klev2=SIZE(pfield3,3))
      ELSE
        CALL sfx_xios_send_block(yname,pfield3=pfield3)
      ENDIF

    ENDIF

  ENDIF

ENDIF
!
!$OMP END SINGLE
#endif
!
IF (lhook) CALL dr_hook('WRITE_SURF_XIOS',1,zhook_handle)
! ----------------------------------------------------------------------
!
END SUBROUTINE write_surf_xios