SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/init

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE INIT_VEG_n(KPATCH, KI, OCANOPY, HROUGH, TPSNOW, &
00003                          HPHOTO, PLAIMIN, PH_TREE, PVEGTYPE_PATCH, PLAI, PZ0, PVEG, PEMIS, &
00004                          OTR_ML, PFAPARC, PFAPIRC, PLAI_EFFC, PMUS, &
00005                          PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, PALBNIR, PALBVIS, PALBUV, &
00006                          OSURF_DIAG_ALBEDO, PPSN, PPSNG, PPSNV, PPSNV_A, &
00007                          PDIR_ALB, PSCA_ALB, PEMIS_OUT, PTSRAD )  
00008 !#############################################################
00009 !
00010 !!****  *INIT_VEG_n* - routine to initialize ISBA
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !!
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    EXTERNAL
00019 !!    --------
00020 !!
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------
00024 !!
00025 !!    REFERENCE
00026 !!    ---------
00027 !!
00028 !!
00029 !!    AUTHOR
00030 !!    ------
00031 !!      V. Masson   *Meteo France*      
00032 !!
00033 !!    MODIFICATIONS
00034 !!
00035 !-------------------------------------------------------------------------------
00036 !
00037 !*       0.    DECLARATIONS
00038 !              ------------
00039 !
00040 USE MODD_TYPE_SNOW
00041 USE MODD_SNOW_PAR,       ONLY : XEMISSN
00042 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
00043 !
00044 USE MODI_SET_ROUGH
00045 USE MODI_INIT_SNOW_LW
00046 USE MODI_Z0V_FROM_LAI
00047 USE MODI_VEG_FROM_LAI
00048 USE MODI_EMIS_FROM_VEG
00049 !
00050 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00051 USE PARKIND1  ,ONLY : JPRB
00052 !
00053 IMPLICIT NONE
00054 !
00055 !*       0.1   Declarations of arguments
00056 !              -------------------------
00057 !
00058 INTEGER, INTENT(IN) :: KPATCH
00059 INTEGER, INTENT(IN) :: KI
00060 LOGICAL, INTENT(IN) :: OCANOPY
00061  CHARACTER(LEN=4), INTENT(INOUT) :: HROUGH
00062 TYPE(SURF_SNOW),      INTENT(INOUT) :: TPSNOW  ! snow characteristics
00063 !
00064  CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
00065 REAL, DIMENSION(:,:), INTENT(IN) :: PLAIMIN
00066 REAL, DIMENSION(:,:), INTENT(IN) :: PH_TREE
00067 REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE_PATCH
00068 REAL, DIMENSION(:,:), INTENT(INOUT) :: PLAI
00069 REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0
00070 REAL, DIMENSION(:,:), INTENT(INOUT) :: PVEG
00071 REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMIS
00072 !
00073 LOGICAL, INTENT(IN) :: OTR_ML
00074 REAL, DIMENSION(:,:), POINTER :: PFAPARC
00075 REAL, DIMENSION(:,:), POINTER :: PFAPIRC
00076 REAL, DIMENSION(:,:), POINTER :: PLAI_EFFC
00077 REAL, DIMENSION(:,:), POINTER :: PMUS
00078 !
00079 REAL, DIMENSION(:,:), POINTER :: PALBNIR_SOIL
00080 REAL, DIMENSION(:,:), POINTER :: PALBVIS_SOIL
00081 REAL, DIMENSION(:,:), POINTER :: PALBUV_SOIL
00082 REAL, DIMENSION(:,:), POINTER :: PALBNIR
00083 REAL, DIMENSION(:,:), POINTER :: PALBVIS
00084 REAL, DIMENSION(:,:), POINTER :: PALBUV
00085 !
00086 LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
00087 !
00088 REAL, DIMENSION(:,:), POINTER :: PPSN
00089 REAL, DIMENSION(:,:), POINTER :: PPSNG
00090 REAL, DIMENSION(:,:), POINTER :: PPSNV
00091 REAL, DIMENSION(:,:), POINTER :: PPSNV_A
00092 !
00093 REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB
00094 REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB
00095 REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_OUT
00096 REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD
00097 !
00098 !*       0.2   Declarations of local variables
00099 !              -------------------------------
00100 !
00101 INTEGER :: JPATCH  ! loop counter on tiles
00102 INTEGER :: JILU     ! loop increment
00103 !
00104 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00105 !
00106 !-------------------------------------------------------------------------------
00107 !
00108 !               Initialisation for IO
00109 !
00110 IF (LHOOK) CALL DR_HOOK('INIT_VEG_n',0,ZHOOK_HANDLE)
00111 !
00112 !-------------------------------------------------------------------------------
00113 !
00114 !*      13.     Roughness length option
00115 !               -----------------------
00116 !
00117  CALL SET_ROUGH(OCANOPY,HROUGH)
00118 !
00119 !-------------------------------------------------------------------------------
00120 !
00121 !*      14.     Radiative fields and snow/flood fracion initialization:
00122 !               -------------------------------------------------------
00123 !
00124 !* snow long-wave properties (not initialized in read_gr_snow)
00125 !
00126  CALL INIT_SNOW_LW(XEMISSN,TPSNOW)
00127 !
00128 !-------------------------------------------------------------------------------
00129 !
00130 !* z0 and vegetation fraction estimated from LAI
00131 IF (HPHOTO=='LAI' .OR. HPHOTO=='LST' .OR. HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
00132   DO JPATCH=1,KPATCH
00133     DO JILU=1,KI    
00134       IF(PLAI(JILU,JPATCH)/=XUNDEF) THEN
00135         IF (PLAI(JILU,JPATCH).LT.PLAIMIN(JILU,JPATCH)) THEN
00136           PLAI(JILU,JPATCH) = PLAIMIN(JILU,JPATCH)
00137         ENDIF
00138            PZ0  (JILU,JPATCH) = Z0V_FROM_LAI(PLAI(JILU,JPATCH),PH_TREE(JILU,JPATCH),PVEGTYPE_PATCH(JILU,:,JPATCH))
00139            PVEG (JILU,JPATCH) = VEG_FROM_LAI(PLAI(JILU,JPATCH),PVEGTYPE_PATCH(JILU,:,JPATCH))
00140            PEMIS(JILU,JPATCH) = EMIS_FROM_VEG(PVEG(JILU,JPATCH),PVEGTYPE_PATCH(JILU,:,JPATCH))
00141         END IF  
00142      END DO
00143   END DO
00144 END IF
00145 !
00146 !-------------------------------------------------------------------------------
00147 !
00148 IF (OTR_ML) THEN
00149   ALLOCATE(PFAPARC   (KI, KPATCH))
00150   ALLOCATE(PFAPIRC   (KI, KPATCH))
00151   ALLOCATE(PLAI_EFFC (KI, KPATCH))
00152   ALLOCATE(PMUS      (KI, KPATCH))
00153   PFAPARC   (:,:) = 0.
00154   PFAPIRC   (:,:) = 0.
00155   PLAI_EFFC (:,:) = 0.
00156   PMUS      (:,:) = 0.
00157 ELSE
00158   ALLOCATE(PFAPARC   (0,0))
00159   ALLOCATE(PFAPIRC   (0,0))
00160   ALLOCATE(PLAI_EFFC (0,0))
00161   ALLOCATE(PMUS      (0,0))
00162 ENDIF        
00163 !
00164 !-------------------------------------------------------------------------------
00165 !
00166 !* albedo per tile and averaged albedo, emissivity and radiative temperature
00167 !
00168 ALLOCATE(PALBNIR_SOIL(KI,KPATCH))
00169 ALLOCATE(PALBVIS_SOIL(KI,KPATCH))
00170 ALLOCATE(PALBUV_SOIL (KI,KPATCH))
00171 ALLOCATE(PALBNIR     (KI,KPATCH))
00172 ALLOCATE(PALBVIS     (KI,KPATCH))
00173 ALLOCATE(PALBUV      (KI,KPATCH))
00174 PALBNIR_SOIL(:,:) = XUNDEF
00175 PALBVIS_SOIL(:,:) = XUNDEF
00176 PALBUV_SOIL (:,:) = XUNDEF
00177 PALBNIR     (:,:) = XUNDEF
00178 PALBVIS     (:,:) = XUNDEF
00179 PALBUV      (:,:) = XUNDEF
00180 !
00181 OSURF_DIAG_ALBEDO = .TRUE.
00182 !
00183 !* Initialization of total albedo, emissivity and snow/flood fractions
00184 !
00185 ALLOCATE(PPSN (KI,KPATCH))
00186 ALLOCATE(PPSNG(KI,KPATCH))
00187 ALLOCATE(PPSNV(KI,KPATCH))
00188 PPSN  = 0.0
00189 PPSNG = 0.0
00190 PPSNV = 0.0
00191 !
00192 IF(TPSNOW%SCHEME=='EBA')THEN
00193    ALLOCATE(PPSNV_A(KI,KPATCH))
00194    PPSNV_A = 0.0
00195 ELSE
00196    ALLOCATE(PPSNV_A(0,0))
00197 ENDIF
00198 !
00199 PDIR_ALB = XUNDEF
00200 PSCA_ALB = XUNDEF
00201 PEMIS_OUT= XUNDEF
00202 PTSRAD   = XUNDEF
00203 !
00204 IF (LHOOK) CALL DR_HOOK('INIT_VEG_n',1,ZHOOK_HANDLE)
00205 !
00206 END SUBROUTINE INIT_VEG_n