|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_TEB_GARDEN(HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_TEB_GARDEN* - Prepares ISBA fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! V. Masson 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 01/2004 00024 !! Modified by P. Le Moigne (11/2004): AGS fields 00025 !! Modified by B. Decharme (2008) : Floodplains 00026 !! Modified by B. Decharme (01/2009): Consistency with Arpege deep soil 00027 !! temperature 00028 !! Modified by B. Decharme (03/2009): Consistency with Arpege permanent 00029 !! snow/ice treatment 00030 !!------------------------------------------------------------------ 00031 ! 00032 ! 00033 USE MODI_PREP_HOR_TEB_GARDEN_FIELD 00034 USE MODI_PREP_VER_TEB_GARDEN 00035 ! 00036 USE MODD_SURF_ATM, ONLY : LVERTSHIFT 00037 ! 00038 USE MODD_TEB_VEG_n, ONLY : CPHOTO, CRESPSL, & 00039 NNBIOMASS, & 00040 CISBA 00041 USE MODD_TEB_GARDEN_n, ONLY : XRESA, XLAI, & 00042 XAN, XANFM, XANDAY, XLE, & 00043 XBSLAI, XBSLAI_NITRO, XBIOMASS, XRESP_BIOMASS,& 00044 XWSAT, XWG, XWGI, XTG, XVEGTYPE 00045 ! A FAIRE : 00046 ! IL FAUT RAJOUTER TSNOW 00047 ! ---------------------- 00048 USE MODD_CSTS, ONLY : XTT 00049 USE MODD_SNOW_PAR, ONLY : XZ0SN 00050 USE MODD_ISBA_PAR, ONLY : XWGMIN 00051 USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCA_NIT, XCC_NIT 00052 USE MODD_SURF_PAR, ONLY : XUNDEF 00053 ! 00054 USE MODN_PREP_ISBA 00055 USE MODE_POS_SURF 00056 ! 00057 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00058 USE PARKIND1 ,ONLY : JPRB 00059 ! 00060 IMPLICIT NONE 00061 ! 00062 !* 0.1 declarations of arguments 00063 ! 00064 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00065 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file 00066 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file 00067 CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the Atmospheric file 00068 CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file 00069 ! 00070 !* 0.2 declarations of local variables 00071 ! 00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00073 ! 00074 !------------------------------------------------------------------------------------- 00075 ! 00076 !* 1. Default of configuration 00077 ! 00078 !* 1.1 Default 00079 ! 00080 ! 00081 !------------------------------------------------------------------------------------- 00082 ! 00083 !* 2. Reading and horizontal interpolations 00084 ! 00085 ! 00086 !* 2.1 Soil Water reservoirs 00087 ! 00088 IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN',0,ZHOOK_HANDLE) 00089 CALL PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00090 ! 00091 !* 2.2 Soil ice reservoirs 00092 ! 00093 CALL PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00094 ! 00095 !* 2.3 Leaves interception water reservoir 00096 ! 00097 CALL PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00098 ! 00099 !* 2.4 Temperature profile 00100 ! 00101 CALL PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00102 ! 00103 !* 2.5 Snow variables 00104 ! 00105 CALL PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00106 00107 ! 00108 !* 2.6 LAI 00109 ! 00110 IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='LST') & 00111 CALL PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00112 ! 00113 !------------------------------------------------------------------------------------- 00114 ! 00115 !* 3. Physical limitation: 00116 ! 00117 ! If whole ice reservoir is empty (grib from ecmwf case) and surface temperature is 00118 ! lower than -10°C, then ice content is maximum and water content minimum 00119 ! 00120 IF (ALL(XWGI(:,:)==0.)) THEN 00121 WHERE(XTG(:,1:SIZE(XWG,2)) < XTT-10.) 00122 XWGI(:,:) = XWSAT(:,:)-XWGMIN 00123 XWG (:,:) = XWGMIN 00124 END WHERE 00125 ENDIF 00126 ! 00127 ! No ice for force restore third layer: 00128 IF (CISBA == '3-L') THEN 00129 WHERE(XWG(:,3) /= XUNDEF) 00130 XWG(:,3) = MIN(XWG(:,3)+XWGI(:,3),XWSAT(:,3)) 00131 XWGI(:,3) = 0. 00132 END WHERE 00133 ENDIF 00134 ! 00135 ! Total water content should not exceed saturation: 00136 WHERE(XWG(:,:) /= XUNDEF .AND. (XWG(:,:) + XWGI(:,:)) > XWSAT(:,:) ) 00137 XWGI(:,:) = XWSAT(:,:) - XWG(:,:) 00138 END WHERE 00139 ! 00140 !------------------------------------------------------------------------------------- 00141 ! 00142 !* 3. Vertical interpolations of all variables 00143 ! 00144 IF(LVERTSHIFT)THEN 00145 CALL PREP_VER_TEB_GARDEN 00146 ENDIF 00147 ! 00148 ! 00149 !------------------------------------------------------------------------------------- 00150 ! 00151 !* 5. Half prognostic fields 00152 ! 00153 ALLOCATE(XRESA(SIZE(XLAI,1))) 00154 XRESA = 100. 00155 ! 00156 !------------------------------------------------------------------------------------- 00157 ! 00158 !* 6. Isba-Ags prognostic fields 00159 ! 00160 IF (CPHOTO /= 'NON') THEN 00161 ! 00162 ALLOCATE(XAN(SIZE(XLAI,1))) 00163 XAN = 0. 00164 ! 00165 ALLOCATE(XANDAY(SIZE(XLAI,1))) 00166 XANDAY = 0. 00167 ! 00168 ALLOCATE(XANFM(SIZE(XLAI,1))) 00169 XANFM = XANFMINIT 00170 ! 00171 ALLOCATE(XLE(SIZE(XLAI,1))) 00172 XLE = 0. 00173 ! 00174 ENDIF 00175 ! 00176 IF (CPHOTO == 'AGS' .OR. CPHOTO == 'AST') THEN 00177 ! 00178 ALLOCATE(XBIOMASS(SIZE(XLAI,1),NNBIOMASS)) 00179 XBIOMASS(:,1) = 0. 00180 ! 00181 ALLOCATE(XRESP_BIOMASS(SIZE(XLAI,1),NNBIOMASS)) 00182 XRESP_BIOMASS(:,:) = 0. 00183 ! 00184 ELSEIF (CPHOTO == 'LAI' .OR. CPHOTO == 'LST') THEN 00185 ! 00186 ALLOCATE(XBIOMASS(SIZE(XLAI,1),NNBIOMASS)) 00187 XBIOMASS(:,1) = XLAI(:) * XBSLAI(:) 00188 ! 00189 ALLOCATE(XRESP_BIOMASS(SIZE(XLAI,1),NNBIOMASS)) 00190 XRESP_BIOMASS(:,:) = 0. 00191 ! 00192 ELSEIF (CPHOTO == 'NIT' .OR. CPHOTO == 'NCB') THEN 00193 ! 00194 ALLOCATE(XBIOMASS(SIZE(XLAI,1),NNBIOMASS)) 00195 XBIOMASS(:,1) = XLAI(:) * XBSLAI_NITRO(:) 00196 XBIOMASS(:,2) = MAX( 0., (XBIOMASS(:,1)/ (XCC_NIT/10.**XCA_NIT)) & 00197 **(1.0/(1.0-XCA_NIT)) - XBIOMASS(:,1) ) 00198 XBIOMASS(:,3:NNBIOMASS) = 0. 00199 ! 00200 ALLOCATE(XRESP_BIOMASS(SIZE(XLAI,1),NNBIOMASS)) 00201 XRESP_BIOMASS(:,:) = 0. 00202 ! 00203 ENDIF 00204 ! 00205 !------------------------------------------------------------------------------------- 00206 ! 00207 IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN',1,ZHOOK_HANDLE) 00208 ! 00209 !------------------------------------------------------------------------------------- 00210 ! 00211 END SUBROUTINE PREP_TEB_GARDEN
1.8.0
