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 (I, &
                                hphoto, hisba, klu, kvegtype, kground_layer, kpatch, &
                               pvegtype, plai, pveg, pz0, pemis, pdg, pd_ice, &
                               prsmin, pgamma, pwrmax_cf, prgl, pcv, &
                               pz0_o_z0h, palbnir_veg, palbvis_veg, palbuv_veg, &
                               ph_tree, pre25, plaimin, pbslai, psefold, &
                               pgmes, pgc, pf2i, pdmax, ostress, &
                               pce_nitro, pcf_nitro, pcna_nitro, &
                               ptseed, ptreap, pwatsup, pirrig, &
                               prootfrac, kwg_layer, pdroot, pdg2, &
                               pgndlitter,prglgv,pgammagv,prsmingv,        &
                               prootfracgv,pwrmax_cfgv,plaigv,pz0litter,ph_veg         )
!   ##########################################################################
!
!!****  *ALLOCATE_PHYSIO* - 
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    xx/xxxx
!!      Modified 10/2014 P. Samuelsson  MEB
!
!
USE modd_isba_n, ONLY : isba_t
!
USE modd_type_date_surf
!
USE modd_treedrag,       ONLY : ltreedrag
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
TYPE(isba_t), INTENT(INOUT) :: i
!
INTEGER               :: isize_lmeb_patch  ! Number of patches with MEB=true
!
 CHARACTER(LEN=3),INTENT(IN)  :: hphoto
 CHARACTER(LEN=3),INTENT(IN)  :: hisba
!
INTEGER, INTENT(IN) :: klu
INTEGER, INTENT(IN) :: kvegtype
INTEGER, INTENT(IN) :: kground_layer
INTEGER, INTENT(IN) :: kpatch
!
REAL, DIMENSION(:,:), POINTER :: pvegtype
!
REAL, DIMENSION(:,:), POINTER :: plai
REAL, DIMENSION(:,:), POINTER :: pveg
REAL, DIMENSION(:,:), POINTER :: pz0
REAL, DIMENSION(:,:), POINTER :: pemis
!
REAL, DIMENSION(:,:,:), POINTER :: pdg
REAL, DIMENSION(:,:)  , POINTER :: pd_ice
!
REAL, DIMENSION(:,:), POINTER :: prsmin
REAL, DIMENSION(:,:), POINTER :: pgamma
REAL, DIMENSION(:,:), POINTER :: pwrmax_cf
REAL, DIMENSION(:,:), POINTER :: prgl
REAL, DIMENSION(:,:), POINTER :: pcv
REAL, DIMENSION(:,:), POINTER :: pz0_o_z0h
REAL, DIMENSION(:,:), POINTER :: palbnir_veg
REAL, DIMENSION(:,:), POINTER :: palbvis_veg
REAL, DIMENSION(:,:), POINTER :: palbuv_veg
!
REAL, DIMENSION(:,:), POINTER :: ph_tree
REAL, DIMENSION(:,:), POINTER :: pre25
REAL, DIMENSION(:,:), POINTER :: plaimin
REAL, DIMENSION(:,:), POINTER :: pbslai
REAL, DIMENSION(:,:), POINTER :: psefold
REAL, DIMENSION(:,:), POINTER :: pgmes
REAL, DIMENSION(:,:), POINTER :: pgc
REAL, DIMENSION(:,:), POINTER :: pf2i
REAL, DIMENSION(:,:), POINTER :: pdmax
LOGICAL, DIMENSION(:,:), POINTER :: ostress
REAL, DIMENSION(:,:), POINTER :: pce_nitro
REAL, DIMENSION(:,:), POINTER :: pcf_nitro
REAL, DIMENSION(:,:), POINTER :: pcna_nitro
!
TYPE(date_time), DIMENSION(:,:), POINTER :: ptseed
TYPE(date_time), DIMENSION(:,:), POINTER :: ptreap
REAL, DIMENSION(:,:), POINTER :: pwatsup
REAL, DIMENSION(:,:), POINTER :: pirrig
!
REAL, DIMENSION(:,:,:), POINTER :: prootfrac
INTEGER, DIMENSION(:,:), POINTER :: kwg_layer
REAL, DIMENSION(:,:), POINTER :: pdroot
REAL, DIMENSION(:,:), POINTER :: pdg2
!
REAL, DIMENSION(:,:), POINTER :: pgndlitter
REAL, DIMENSION(:,:), POINTER :: prglgv
REAL, DIMENSION(:,:), POINTER :: pgammagv
REAL, DIMENSION(:,:), POINTER :: prsmingv
REAL, DIMENSION(:,:,:), POINTER :: prootfracgv
REAL, DIMENSION(:,:), POINTER :: pwrmax_cfgv
REAL, DIMENSION(:,:), POINTER :: plaigv
REAL, DIMENSION(:,:), POINTER :: pz0litter
REAL, DIMENSION(:,:), POINTER :: ph_veg
!
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_lmeb_patch=count(i%LMEB_PATCH(:))
!
ALLOCATE(pvegtype(klu,kvegtype            ))
!
ALLOCATE(plai(klu,kpatch              )) 
ALLOCATE(pveg(klu,kpatch              )) 
ALLOCATE(pz0(klu,kpatch              )) 
ALLOCATE(pemis(klu,kpatch              )) 
!
ALLOCATE(pdg(klu,kground_layer,kpatch)) 
ALLOCATE(pd_ice(klu,kpatch              )) 
!
ALLOCATE(prsmin(klu,kpatch              )) 
ALLOCATE(pgamma(klu,kpatch              )) 
ALLOCATE(pwrmax_cf(klu,kpatch              )) 
ALLOCATE(prgl(klu,kpatch              )) 
ALLOCATE(pcv(klu,kpatch              )) 
ALLOCATE(pz0_o_z0h(klu,kpatch              )) 
ALLOCATE(palbnir_veg(klu,kpatch              )) 
ALLOCATE(palbvis_veg(klu,kpatch              )) 
ALLOCATE(palbuv_veg(klu,kpatch              )) 
!
IF (isize_lmeb_patch>0 .OR. hphoto/='NON') THEN
  ALLOCATE(pbslai(klu,kpatch              )) 
ELSE
  ALLOCATE(pbslai(0,0))  
ENDIF
! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
!
IF (hphoto/='NON'.OR.ltreedrag) THEN
  ALLOCATE(ph_tree(klu,kpatch              ))
ELSE
  ALLOCATE(ph_tree(0,0                     ))
ENDIF
!
IF (hphoto/='NON') THEN
  ALLOCATE(pre25(klu,kpatch              )) 
  ALLOCATE(plaimin(klu,kpatch              )) 
  ALLOCATE(psefold(klu,kpatch              )) 
  ALLOCATE(pgmes(klu,kpatch              )) 
  ALLOCATE(pgc(klu,kpatch              )) 
  ALLOCATE(pdmax(klu,kpatch              ))
  IF (hphoto/='AGS' .AND. hphoto/='LAI') THEN
    ALLOCATE(pf2i(klu,kpatch              ))
    ALLOCATE(ostress(klu,kpatch              )) 
    IF (hphoto=='NIT' .OR. hphoto=='NCB') THEN
      ALLOCATE(pce_nitro(klu,kpatch              )) 
      ALLOCATE(pcf_nitro(klu,kpatch              )) 
      ALLOCATE(pcna_nitro(klu,kpatch              ))  
    ELSE
      ALLOCATE(pce_nitro(0,0))
      ALLOCATE(pcf_nitro(0,0))
      ALLOCATE(pcna_nitro(0,0))
 
    ENDIF
  ELSE
    ALLOCATE(pf2i(0,0))
    ALLOCATE(ostress(0,0))
    ALLOCATE(pce_nitro(0,0))
    ALLOCATE(pcf_nitro(0,0))
    ALLOCATE(pcna_nitro(0,0))
  ENDIF
ELSE
  ALLOCATE(pre25(0,0))
  ALLOCATE(plaimin(0,0))
  ALLOCATE(psefold(0,0))  
  ALLOCATE(pgmes(0,0))
  ALLOCATE(pgc(0,0))
  ALLOCATE(pf2i(0,0))
  ALLOCATE(pdmax(0,0))
  ALLOCATE(ostress(0,0))
  ALLOCATE(pce_nitro(0,0))
  ALLOCATE(pcf_nitro(0,0))
  ALLOCATE(pcna_nitro(0,0))
ENDIF  
!
! - Irrigation, seeding and reaping
!
IF (hphoto == 'LAI' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB')  THEN
  ALLOCATE(ptseed(klu,kpatch              )) 
  ALLOCATE(ptreap(klu,kpatch              )) 
  ALLOCATE(pwatsup(klu,kpatch              )) 
  ALLOCATE(pirrig(klu,kpatch              ))
ELSE
  ALLOCATE(ptseed(0,0))
  ALLOCATE(ptreap(0,0))
  ALLOCATE(pwatsup(0,0))
  ALLOCATE(pirrig(0,0))        
ENDIF
!
! - ISBA-DF scheme
!
IF(hisba=='DIF')THEN
  ALLOCATE(prootfrac(klu,kground_layer,kpatch))
  ALLOCATE(kwg_layer(klu,kpatch))
  ALLOCATE(pdroot(klu,kpatch))
  ALLOCATE(pdg2(klu,kpatch))
ELSE  
  ALLOCATE(prootfrac(0,0,0))
  ALLOCATE(kwg_layer(0,0)  )
  ALLOCATE(pdroot(0,0)  )        
  ALLOCATE(pdg2(0,0)  )        
ENDIF
!
ALLOCATE(pgndlitter(klu,kpatch))
ALLOCATE(prglgv(klu,kpatch))
ALLOCATE(pgammagv(klu,kpatch))
ALLOCATE(prsmingv(klu,kpatch))
ALLOCATE(prootfracgv(klu,kground_layer,kpatch))
ALLOCATE(pwrmax_cfgv(klu,kpatch))
ALLOCATE(plaigv(klu,kpatch))
ALLOCATE(pz0litter(klu,kpatch))
ALLOCATE(ph_veg(klu,kpatch))
!
IF (lhook) CALL dr_hook('ALLOCATE_PHYSIO',1,zhook_handle)
!
END SUBROUTINE allocate_physio