|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !############################################################# 00002 SUBROUTINE INIT_TEB_GARDEN_n(HPROGRAM,HINIT,KI,KSW,PSW_BANDS) 00003 !############################################################# 00004 ! 00005 !!**** *INIT_TEB_GARDEN_n* - routine to initialize ISBA 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! A. Lemonsu *Meteo France* 00027 !! 00028 !! MODIFICATIONS 00029 !! ------------- 00030 !! Original 09/2009 00031 !------------------------------------------------------------------------------- 00032 ! 00033 !* 0. DECLARATIONS 00034 ! ------------ 00035 ! 00036 USE MODD_TYPE_DATE_SURF 00037 USE MODD_TYPE_SNOW 00038 ! 00039 USE MODD_TEB_n, ONLY: TTIME, NTEB_PATCH, LCANOPY 00040 USE MODD_TEB_VEG_n, ONLY: CALBEDO, CCPSURF, CROUGH, CPHOTO, CISBA, LTR_ML 00041 USE MODD_TEB_GARDEN_n, ONLY: TSNOW, XLAI, & 00042 XLAIMIN, XZ0, XVEG, XEMIS, & 00043 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, & 00044 XALBNIR, XALBVIS, XALBUV, XWG, XTG, & 00045 XWSAT, XFAPARC, XFAPIRC, XLAI_EFFC, XMUS,& 00046 LPAR_GARDEN, XVEGTYPE, XH_TREE, & 00047 NGROUND_LAYER, & 00048 XALBVIS_DRY, XALBNIR_DRY, XALBUV_DRY, & 00049 XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG, & 00050 XALBVIS_WET, XALBNIR_WET, XALBUV_WET, & 00051 XPSN, XPSNG, XPSNV, XPSNV_A 00052 USE MODD_DIAG_MISC_TEB_n, ONLY: LSURF_DIAG_ALBEDO 00053 00054 USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE 00055 USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF 00056 00057 USE MODD_SURF_ATM, ONLY: LCPL_ARP 00058 ! 00059 USE MODI_GET_LUOUT 00060 USE MODI_READ_PREP_GARDEN_SNOW 00061 USE MODI_ALLOCATE_TEB_GARDEN 00062 USE MODI_ABOR1_SFX 00063 USE MODI_GET_CURRENT_TEB_PATCH 00064 USE MODI_READ_TEB_GARDEN_n 00065 USE MODI_INIT_VEG_GARDEN_n 00066 USE MODI_SOIL_ALBEDO 00067 USE MODI_INIT_FROM_DATA_GRDN_n 00068 USE MODI_AVG_ALBEDO_EMIS_GARDEN 00069 ! 00070 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00071 USE PARKIND1 ,ONLY : JPRB 00072 ! 00073 IMPLICIT NONE 00074 ! 00075 !* 0.1 Declarations of arguments 00076 ! ------------------------- 00077 ! 00078 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00079 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize 00080 INTEGER, INTENT(IN) :: KI ! number of points 00081 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00082 REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band 00083 ! 00084 ! 00085 ! 00086 !* 0.2 Declarations of local variables 00087 ! ------------------------------- 00088 ! 00089 INTEGER :: ILUOUT ! unit of output listing file 00090 ! 00091 INTEGER :: IDECADE ! decade of simulation 00092 ! 00093 INTEGER :: JTEB_PATCH ! loop counter on TEB patches 00094 CHARACTER(LEN=3) :: YPATCH ! patch identificator 00095 ! 00096 REAL, DIMENSION(KI) :: ZWG1 ! work array for surface water content 00097 REAL, DIMENSION(KI) :: ZTG1 ! work array for surface temperature 00098 REAL, DIMENSION(KI,KSW) :: ZDIR_ALB ! direct albedo for each band 00099 REAL, DIMENSION(KI,KSW) :: ZSCA_ALB ! diffuse albedo for each band 00100 REAL, DIMENSION(KI) :: ZEMIS ! emissivity 00101 REAL, DIMENSION(KI) :: ZTSRAD ! radiative temperature 00102 ! 00103 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00104 ! 00105 !------------------------------------------------------------------------------- 00106 ! 00107 ! Initialisation for IO 00108 ! 00109 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_N',0,ZHOOK_HANDLE) 00110 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00111 ! 00112 !* 1. Reading of snow configuration: 00113 ! ------------------------------ 00114 ! 00115 !* initialization of snow scheme (TSNOW defined in MODD_TEB_GARDEN_n) 00116 ! 00117 IF (HINIT=='PRE') THEN 00118 CALL READ_PREP_GARDEN_SNOW(HPROGRAM,TSNOW%SCHEME,TSNOW%NLAYER) 00119 ! 00120 IF (TSNOW%SCHEME.NE.'3-L' .AND. TSNOW%SCHEME.NE.'CRO' .AND. CISBA=='DIF') THEN 00121 CALL ABOR1_SFX("INIT_TEB_GARDEN_n: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO") 00122 ENDIF 00123 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_N',1,ZHOOK_HANDLE) 00124 RETURN 00125 ENDIF 00126 !------------------------------------------------------------------------------- 00127 ! 00128 CALL ALLOCATE_TEB_GARDEN(KI, NGROUND_LAYER) 00129 ! 00130 !------------------------------------------------------------------------------- 00131 ! 00132 IF( CCPSURF=='DRY' .AND. LCPL_ARP ) THEN 00133 CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP') 00134 ENDIF 00135 ! 00136 !------------------------------------------------------------------------------- 00137 ! 00138 IF (HINIT/='ALL') THEN 00139 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_N',1,ZHOOK_HANDLE) 00140 RETURN 00141 ENDIF 00142 ! 00143 !------------------------------------------------------------------------------- 00144 ! 00145 !* 10. Prognostic and semi-prognostic fields 00146 ! ------------------------------------- 00147 ! 00148 !* allocation of urban green area variables 00149 ! 00150 ! 00151 YPATCH=' ' 00152 CALL GET_CURRENT_TEB_PATCH(JTEB_PATCH) 00153 IF (NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',JTEB_PATCH,'_' 00154 ! 00155 CALL READ_TEB_GARDEN_n(HPROGRAM,YPATCH) 00156 ! 00157 ! 00158 CALL INIT_VEG_GARDEN_n(KI, LCANOPY, CROUGH, TSNOW, & 00159 CPHOTO, XLAIMIN, XH_TREE, XVEGTYPE, XLAI, XZ0, XVEG, XEMIS, & 00160 LTR_ML, XFAPARC, XFAPIRC, XLAI_EFFC, XMUS, & 00161 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, XALBNIR, XALBVIS, XALBUV, & 00162 LSURF_DIAG_ALBEDO, XPSN, XPSNG, XPSNV, XPSNV_A, & 00163 ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD ) 00164 ! 00165 ZWG1(:) = XWG(:,1) 00166 ZTG1(:) = XTG(:,1) 00167 ! 00168 IF (.NOT. LPAR_GARDEN) THEN 00169 CALL SOIL_ALBEDO(CALBEDO, & 00170 XWSAT(:,1),ZWG1, & 00171 XALBVIS_DRY,XALBNIR_DRY,XALBUV_DRY, & 00172 XALBVIS_WET,XALBNIR_WET,XALBUV_WET, & 00173 XALBVIS_SOIL,XALBNIR_SOIL,XALBUV_SOIL ) 00174 ELSE 00175 IF (TTIME%TDATE%MONTH /= NUNDEF) THEN 00176 IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1 00177 ELSE 00178 IDECADE = 1 00179 END IF 00180 CALL INIT_FROM_DATA_GRDN_n(IDECADE,CPHOTO, & 00181 PALBNIR_SOIL=XALBNIR_SOIL, & 00182 PALBVIS_SOIL=XALBVIS_SOIL, & 00183 PALBUV_SOIL=XALBUV_SOIL ) 00184 END IF 00185 ! 00186 CALL AVG_ALBEDO_EMIS_GARDEN(CALBEDO, & 00187 XVEG,XZ0,XLAI,ZTG1, & 00188 PSW_BANDS, & 00189 XALBNIR_VEG,XALBVIS_VEG,XALBUV_VEG, & 00190 XALBNIR_SOIL,XALBVIS_SOIL,XALBUV_SOIL, & 00191 XEMIS, & 00192 TSNOW, & 00193 XALBNIR,XALBVIS,XALBUV, & 00194 ZDIR_ALB, ZSCA_ALB, & 00195 ZEMIS,ZTSRAD ) 00196 ! 00197 ! 00198 ! 00199 !------------------------------------------------------------------------------- 00200 ! 00201 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_N',1,ZHOOK_HANDLE) 00202 ! 00203 !------------------------------------------------------------------------------- 00204 ! 00205 ! 00206 END SUBROUTINE INIT_TEB_GARDEN_n
1.8.0
