read_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 read_surf_field2d( HPROGRAM,PFIELD2D,HFIELDNAME,HCOMMENT,HDIR,KRESP)
!     #####################################
!
!!****  *READ_SURF_FIELD2D* - reads surfex field in input file using READ_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
!!    -------
!!      reads surfex field in output file using WRITE_SURF,
!!      patch by patch if needed in MESONH
!!      and NB_PROCIO_R > 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
!!      J.Escobar : 20/04/2016 : Pb IOZ/NETCDF , add optional KRESP error code
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surf_par, ONLY : nundef
!
USE modi_read_surf
#ifdef SFX_MNH
USE modi_get_nb_procio_read_mnh
#endif
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=6),                 INTENT(IN) :: HPROGRAM     ! calling program
REAL, DIMENSION(:,:),          INTENT(INOUT) :: PFIELD2D     ! 2D field to be read
 CHARACTER(LEN=12),                INTENT(IN) :: HFIELDNAME   ! name of the field PFIELD2D. Example : 'X_Y_TG'
 CHARACTER(LEN=*), OPTIONAL,      INTENT(OUT) :: HCOMMENT   !comment string
 CHARACTER(LEN=1),OPTIONAL,        INTENT(IN) :: HDIR ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
INTEGER,OPTIONAL,               INTENT(OUT)  :: KRESP  
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(SIZE(PFIELD2D,1)) :: ZWORK
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
INTEGER           :: IPATCH         ! number of patches in PFIELD2D
 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=4 ) :: YPATCH         ! current patch
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 (PRESENT(kresp)) kresp = -1
!
IF (lhook) CALL dr_hook('READ_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_read_mnh( inb_procio, iresp )
ENDIF
#endif
!
IF ( inb_procio > 1 ) THEN
!
  DO jpatch=1,ipatch
    yrecfm=adjustl(hfieldname(:len_trim(hfieldname)))
    WRITE(ypatch,'(I4.4)') jpatch
    IF ( ipatch > 1 ) THEN
      yrecfm=adjustl(yrecfm(:len_trim(yrecfm)))//ypatch
    ENDIF
    CALL read_surf(hprogram,yrecfm,pfield2d(:,jpatch),iresp,hcomment=ycomment,hdir=ydir)
  ENDDO
!
ELSE
!
  yrecfm=adjustl(hfieldname(:len_trim(hfieldname)))
  CALL read_surf(hprogram,yrecfm,pfield2d(:,:),iresp,hcomment=ycomment,hdir=ydir)
!
ENDIF
!
IF (PRESENT(hdir)) hcomment = ycomment
!
IF (lhook) CALL dr_hook('READ_SURF_FIELD2D',1,zhook_handle)
!
IF (PRESENT(kresp)) kresp = iresp
!-------------------------------------------------------------------------------
!
      END SUBROUTINE read_surf_field2d