write_surf_field2d.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_field2d(HSELECT,HPROGRAM,PFIELD2D,HFIELDNAME,HCOMMENT,HCOMMENTUNIT,HDIR,HNAM_DIM)
!     #####################################
!
!!****  *WRITE_SURF_FIELD2D* - writes surfex field in output file using WRITE_SURF,
!!                           patch by patch if needed in MESONH
!!                           with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
!!                           because Z-parallel IO are not supported for 2D SURFEX fields.
!!                        
!!
!!    PURPOSE
!!    -------
!!      writes surfex field in output file using WRITE_SURF,
!!      patch by patch if needed in MESONH
!!      and NB_PROCIO_W > 1
!!      examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
!!      with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
!!      because Z-parallel IO are not supported for 2D SURFEX fields.
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      M.Moge   *LA - UPS*     
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    08/01/2016
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surf_par, ONLY : nundef
!
USE modi_write_surf
#ifdef SFX_MNH
USE modi_get_nb_procio_write_mnh
#endif
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 CHARACTER(LEN=6),                 INTENT(IN) :: HPROGRAM     ! calling program
REAL, DIMENSION(:,:),             INTENT(IN) :: PFIELD2D     ! 2D field to be written
 CHARACTER(LEN=12),                INTENT(IN) :: HFIELDNAME   ! name of the field PFIELD2D. Example : 'X_Y_TG'
 CHARACTER(LEN=100),               INTENT(IN) :: HCOMMENT     ! Comment string
 CHARACTER(LEN=100),               INTENT(IN) :: HCOMMENTUNIT ! unit of the datas in PFIELD2D
 CHARACTER(LEN=1),OPTIONAL,       INTENT(IN) :: HDIR ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: HNAM_DIM
 !
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
INTEGER           :: IPATCH         ! number of patches in PFIELD2D
 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=4 ) :: YPATCH         ! current patch
 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
INTEGER           :: INB_PROCIO     ! number of processes used for Z-parallel IO with MESO-NH
!
 CHARACTER(LEN=1)   :: YDIR
INTEGER :: JPATCH  ! loop counter on patches
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('WRITE_SURF_FIELD2D',0,zhook_handle)
!
ydir = 'H'
IF (PRESENT(hdir)) ydir = hdir
!
ipatch = SIZE( pfield2d, 2 )
!
inb_procio = 1
#ifdef SFX_MNH
IF (hprogram=='MESONH') THEN
  CALL get_nb_procio_write_mnh( inb_procio, iresp )
ENDIF
#endif
!
IF ( inb_procio > 1 ) THEN
!
  DO jpatch=1,ipatch
    WRITE(ypatch,'(I4.4)') jpatch
    ycomment=adjustl(hcomment(:len_trim(hcomment)))//'patch '//adjustl(ypatch(:len_trim(ypatch)))//  &
    '  ('//adjustl(hcommentunit(:len_trim(hcommentunit)))//')'
    yrecfm=adjustl(hfieldname(:len_trim(hfieldname)))
    IF ( ipatch > 1 ) THEN
      yrecfm=adjustl(yrecfm(:len_trim(yrecfm)))//ypatch
    ENDIF
    IF (PRESENT(hnam_dim)) THEN
      CALL write_surf(hselect,hprogram,yrecfm,pfield2d(:,jpatch),iresp,hcomment=ycomment,hdir=ydir,hnam_dim=hnam_dim)
    ELSE
      CALL write_surf(hselect,hprogram,yrecfm,pfield2d(:,jpatch),iresp,hcomment=ycomment,hdir=ydir)
    ENDIF
  ENDDO
!
ELSE
!
  ycomment=adjustl(hcomment(:len_trim(hcomment)))//  &
    '  ('//adjustl(hcommentunit(:len_trim(hcommentunit)))//')'
  yrecfm=adjustl(hfieldname(:len_trim(hfieldname)))
  IF (PRESENT(hnam_dim)) THEN
    CALL write_surf(hselect,hprogram,yrecfm,pfield2d(:,:),iresp,hcomment=ycomment,hdir=ydir,hnam_dim=hnam_dim)
  ELSE
    CALL write_surf(hselect,hprogram,yrecfm,pfield2d(:,:),iresp,hcomment=ycomment,hdir=ydir)
  ENDIF
!
ENDIF
!
IF (lhook) CALL dr_hook('WRITE_SURF_FIELD2D',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
      END SUBROUTINE write_surf_field2d