allocate_physio.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 allocate_physio (IO, KK, PK, PEK, KVEGTYPE )
!   ##########################################################################
!
!!****  *ALLOCATE_PHYSIO* - 
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    xx/xxxx
!!      Modified 10/2014 P. Samuelsson  MEB
!
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_k_t, isba_p_t, isba_pe_t
!
USE modd_type_date_surf
!
USE modd_agri,        ONLY : lagrip
!
USE modd_treedrag,       ONLY : ltreedrag
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_k_t), INTENT(INOUT) :: KK
TYPE(isba_p_t), INTENT(INOUT) :: PK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
INTEGER, INTENT(IN) :: KVEGTYPE
!
INTEGER :: ISIZE
INTEGER               :: ISIZE_LMEB_PATCH  ! Number of patches with MEB=true
!
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
! Mask and number of grid elements containing patches/tiles:
!
IF (lhook) CALL dr_hook('ALLOCATE_PHYSIO',0,zhook_handle)
!
isize = pk%NSIZE_P
!
isize_lmeb_patch=count(io%LMEB_PATCH(:))
!
ALLOCATE(pk%XDG                     (isize,io%NGROUND_LAYER)) 
ALLOCATE(pk%XD_ICE                  (isize              )) 
!
ALLOCATE(pek%XLAI                    (isize              )) 
ALLOCATE(pek%XVEG                    (isize              )) 
ALLOCATE(pek%XZ0                     (isize              )) 
ALLOCATE(pek%XEMIS                   (isize              )) 
!
ALLOCATE(pek%XRSMIN                  (isize              )) 
ALLOCATE(pek%XGAMMA                  (isize              )) 
ALLOCATE(pek%XWRMAX_CF               (isize              )) 
ALLOCATE(pek%XRGL                    (isize              )) 
ALLOCATE(pek%XCV                     (isize              )) 
ALLOCATE(pek%XALBNIR_VEG             (isize              )) 
ALLOCATE(pek%XALBVIS_VEG             (isize              )) 
ALLOCATE(pek%XALBUV_VEG              (isize              )) 
!
ALLOCATE(pk%XZ0_O_Z0H               (isize              )) 
!
IF (isize_lmeb_patch>0 .OR. io%CPHOTO/='NON') THEN
  ALLOCATE(pek%XBSLAI                  (isize              )) 
ELSE
  ALLOCATE(pek%XBSLAI     (0))  
ENDIF
! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
!
IF (io%CPHOTO/='NON'.OR.ltreedrag) THEN
  ALLOCATE(pk%XH_TREE                 (isize              ))
ELSE
  ALLOCATE(pk%XH_TREE                 (0                 ))
ENDIF
!
IF (io%CPHOTO/='NON') THEN
  ALLOCATE(pk%XRE25                   (isize              )) 
  ALLOCATE(pk%XDMAX                   (isize              ))  
  ALLOCATE(pek%XLAIMIN                (isize              )) 
  ALLOCATE(pek%XSEFOLD                (isize              )) 
  ALLOCATE(pek%XGMES                  (isize              )) 
  ALLOCATE(pek%XGC                    (isize              )) 
  ALLOCATE(pek%XF2I                   (isize              ))
  ALLOCATE(pek%LSTRESS                (isize              )) 
  IF (io%CPHOTO=='NIT' .OR. io%CPHOTO=='NCB') THEN
    ALLOCATE(pek%XCE_NITRO               (isize              )) 
    ALLOCATE(pek%XCF_NITRO               (isize              )) 
    ALLOCATE(pek%XCNA_NITRO              (isize              ))  
  ELSE
    ALLOCATE(pek%XCE_NITRO    (0))
    ALLOCATE(pek%XCF_NITRO    (0))
    ALLOCATE(pek%XCNA_NITRO   (0))
  ENDIF
ELSE
  ALLOCATE(pk%XRE25      (0))
  ALLOCATE(pk%XDMAX      (0))  
  ALLOCATE(pek%XLAIMIN   (0))
  ALLOCATE(pek%XSEFOLD   (0))  
  ALLOCATE(pek%XGMES     (0))
  ALLOCATE(pek%XGC       (0))
  ALLOCATE(pek%XF2I      (0))
  ALLOCATE(pek%LSTRESS   (0))
  ALLOCATE(pek%XCE_NITRO (0))
  ALLOCATE(pek%XCF_NITRO (0))
  ALLOCATE(pek%XCNA_NITRO(0))
ENDIF  
!
! - Irrigation, seeding and reaping
!
IF (lagrip .AND. (io%CPHOTO == 'NIT' .OR. io%CPHOTO == 'NCB'))  THEN
  ALLOCATE(pek%TSEED                  (isize              )) 
  ALLOCATE(pek%TREAP                  (isize              )) 
  ALLOCATE(pek%XWATSUP                (isize              )) 
  ALLOCATE(pek%XIRRIG                 (isize              ))
ELSE
  ALLOCATE(pek%TSEED     (0))
  ALLOCATE(pek%TREAP     (0))
  ALLOCATE(pek%XWATSUP   (0))
  ALLOCATE(pek%XIRRIG    (0))        
ENDIF
!
! - ISBA-DF scheme
!
IF(io%CISBA=='DIF')THEN
  ALLOCATE(pk%XROOTFRAC  (isize,io%NGROUND_LAYER))
  ALLOCATE(pk%NWG_LAYER  (isize))
  ALLOCATE(pk%XDROOT     (isize))
  ALLOCATE(pk%XDG2       (isize))
ELSE  
  ALLOCATE(pk%XROOTFRAC  (0,0))
  ALLOCATE(pk%NWG_LAYER  (0)  )
  ALLOCATE(pk%XDROOT     (0)  )        
  ALLOCATE(pk%XDG2       (0)  )        
ENDIF
!
ALLOCATE(pek%XGNDLITTER (isize))
ALLOCATE(pek%XZ0LITTER  (isize))
ALLOCATE(pek%XH_VEG     (isize))
!
IF (lhook) CALL dr_hook('ALLOCATE_PHYSIO',1,zhook_handle)
!
END SUBROUTINE allocate_physio