read_surf_isba_parn.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_isba_par_n (DTCO, U, GCP, KPATCH, HPROGRAM, HREC, KLUOUT, KSIZE, &
                                       KVERSION, KBUGFIX, ODATA, PFIELD, KRESP, HCOMMENT, HDIR)
!     #######################
!
!!    MODIFICATIONS
!!    -------------
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_grid_conf_proj_n, ONLY : grid_conf_proj_t
!
USE modd_data_cover_par, ONLY : nvegtype
!
USE modi_read_surf
USE modi_hor_interpol
USE modi_put_on_all_vegtypes
USE modi_vegtype_to_patch
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
INTEGER, INTENT(IN) :: KPATCH
!
 CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM ! calling program
 CHARACTER(LEN=*),        INTENT(IN) :: HREC   ! name of the article to be read
!
INTEGER,                 INTENT(IN) :: KLUOUT
INTEGER,                 INTENT(IN) :: KSIZE
INTEGER,                 INTENT(IN) :: KVERSION
INTEGER,                 INTENT(IN) :: KBUGFIX
LOGICAL, DIMENSION(:),   INTENT(INOUT) :: ODATA
!
REAL, DIMENSION(:,:),    INTENT(OUT):: PFIELD ! array containing the data field  

INTEGER                  ,INTENT(OUT) :: KRESP      ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: HCOMMENT   ! name of the article to be read
 CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: HDIR       ! type of field :
!                                                   ! 'H' : field with
!                                                   !       horizontal spatial dim.
!                                                   ! '-' : no horizontal dim.
!
!* local variables
!  ---------------
!
 CHARACTER(LEN=12) :: YREC
 CHARACTER(LEN=3) :: YVEG
REAL, DIMENSION(KSIZE, NVEGTYPE)  :: ZFIELD
REAL, DIMENSION(SIZE(PFIELD,1),1,KPATCH) :: ZFIELD_PATCH
REAL, DIMENSION(SIZE(PFIELD,1),1,NVEGTYPE) :: ZFIELD_VEGTYPE
 CHARACTER(LEN=1)   :: YDIR
INTEGER :: INI, JP, IPATCH, JV, JV2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------
IF (lhook) CALL dr_hook('READ_SURF_ISBA_PAR_n',0,zhook_handle)
!
ydir = 'H'
IF (PRESENT(hdir)) ydir = hdir
!
ini = SIZE(pfield,1)
!
zfield(:,:) = 0.
!
IF (kversion<7) THEN
  !
  ! fields were written by patch
  CALL read_surf(hprogram,hrec,zfield(:,1:kpatch),kresp,hcomment=hcomment,hdir=ydir)
  ! case zoom
  IF (ini.NE.ksize) THEN
    CALL hor_interpol(dtco, u, gcp, kluout,zfield(:,1:kpatch),pfield(:,1:kpatch))
  ELSE
    ! classical case
    pfield(:,1:kpatch) = zfield(:,1:kpatch)
  ENDIF
  !
  ! classical case
  IF (SIZE(pfield,2)==nvegtype) THEN
    DO jp = 1, kpatch
      zfield_patch(:,1,jp) = pfield(:,jp)
    ENDDO         
    ! patchs shared on vegtypes
    CALL put_on_all_vegtypes(ini,1,kpatch,nvegtype,zfield_patch,zfield_vegtype)
    pfield(:,:) = zfield_vegtype(:,1,:)
  ENDIF
  !
ELSE
  !
  IF (kversion>8 .OR. (kversion==8 .AND. kbugfix>=1)) THEN
    !
    DO jv = 1,nvegtype
      IF (odata(jv)) THEN
        WRITE(yveg,fmt='(A1,I2.2)') 'V',jv
        yrec = trim(adjustl(hrec))//yveg
        CALL read_surf(hprogram,yrec,zfield(:,jv),kresp,hcomment=hcomment,hdir=ydir)
      ELSE

        !IF (HREC(1:3)=='LAI'.OR.HREC(1:10)=='ALBNIR_VEG'.OR.HREC(1:10)=='ALBVIS_VEG' &
        !       .OR. HREC(1:6)=='H_TREE') THEN
        !  IF (JV<=3) ZFIELD(:,JV) = 0.
        !  IF (HREC(1:6)=='H_TREE'.AND.((JV>=7.AND.JV<=12).OR.JV>=18)) ZFIELD(:,JV) = 0.
        !  ODATA(JV) = .TRUE.
        !ENDIF

        IF (.NOT.odata(jv)) THEN
          DO jv2=jv,1,-1
            IF (odata(jv2)) THEN
              zfield(:,jv) = zfield(:,jv2)
              EXIT
            ENDIF
          ENDDO
        ENDIF
      ENDIF
    ENDDO
    !
  ELSE
    !
    ! field written by vegtype
    CALL read_surf(hprogram,hrec,zfield(:,:),kresp,hcomment=hcomment,hdir=ydir)
    !
  ENDIF
  !
  ! case zoom
  IF (ini.NE.ksize) THEN
    CALL hor_interpol(dtco, u, gcp, kluout,zfield(:,:),zfield_vegtype(:,1,:))
  ELSE
    ! classical case
    zfield_vegtype(:,1,:) = zfield(:,:)
  ENDIF
  !
  ! case mode_read_extern
  IF (SIZE(pfield,2).NE.nvegtype) THEN
    ipatch = SIZE(pfield,2)
    pfield(:,:) = 0.
    DO jv = 1, nvegtype
      jp = vegtype_to_patch(jv,ipatch)
      ! artefact to simplify in mode_read_extern: we take the upper value
      pfield(:,jp) = max(pfield(:,jp),zfield_vegtype(:,1,jv))
    ENDDO
  ELSE
    ! classical case
    pfield(:,:) = zfield_vegtype(:,1,:)
  ENDIF        
ENDIF
!
IF (lhook) CALL dr_hook('READ_SURF_ISBA_PAR_n',1,zhook_handle)
!-------------------------------------------------------------------
!
END SUBROUTINE read_surf_isba_par_n