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, I, &
                                       hprogram,hrec,kluout,ksize,pfield,kresp,kversion,hcomment,hdir)
!     #######################
!
!
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
!
USE modd_isba_n, ONLY : isba_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(isba_t), INTENT(INOUT) :: i
!
 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
REAL, DIMENSION(:,:),    INTENT(OUT):: pfield ! array containing the data field  

INTEGER                  ,INTENT(OUT) :: kresp      ! KRESP  : return-code if a problem appears
INTEGER, INTENT(IN) :: kversion
 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
!  ---------------
!
REAL, DIMENSION(KSIZE, NVEGTYPE)  :: zfield
REAL, DIMENSION(SIZE(PFIELD,1),1,I%NPATCH) :: zfield_patch
REAL, DIMENSION(SIZE(PFIELD,1),1,NVEGTYPE) :: zfield_vegtype
 CHARACTER(LEN=1)   :: ydir
INTEGER :: ini, jpatch, ipatch, jvegtype
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)
!
IF (kversion<7) THEN
  CALL read_surf(&
                 hprogram,hrec,zfield(:,1:i%NPATCH),kresp,hcomment=hcomment,hdir=ydir)
  IF (ini.NE.ksize) THEN
    CALL hor_interpol(dtco, u, &
                      kluout,zfield(:,1:i%NPATCH),pfield(:,1:i%NPATCH))
  ELSE
    pfield(:,1:i%NPATCH) = zfield(:,1:i%NPATCH)
  ENDIF
  DO jpatch = 1, i%NPATCH
    zfield_patch(:,1,jpatch) = pfield(:,jpatch)
  ENDDO
  CALL put_on_all_vegtypes(ini,1,i%NPATCH,nvegtype,zfield_patch,zfield_vegtype)
  pfield(:,:) = zfield_vegtype(:,1,:)
ELSE
  CALL read_surf(&
                 hprogram,hrec,zfield(:,:),kresp,hcomment=hcomment,hdir=ydir)
  IF (ini.NE.ksize) THEN
    CALL hor_interpol(dtco, u, &
                      kluout,zfield(:,:),zfield_vegtype(:,1,:))
  ELSE
    zfield_vegtype(:,1,:) = zfield(:,:)
  ENDIF  
  IF (SIZE(pfield,2).NE.nvegtype) THEN
    ipatch = SIZE(pfield,2)
    pfield(:,:) = 0.
    DO jvegtype = 1, nvegtype
      jpatch = vegtype_to_patch(jvegtype,ipatch)
      IF (jpatch<=ipatch) pfield(:,jpatch) = max(pfield(:,jpatch),zfield_vegtype(:,1,jvegtype))
    ENDDO
  ELSE
    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