|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################### 00002 SUBROUTINE ISBA_SGH_UPDATE(HISBA,HRUNOFF,HRAIN,PRAIN,PMUF,PFSAT) 00003 ! ############################################################### 00004 ! 00005 !!**** *SGH_UPDATE* 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 ! Calculates the evolution of the fraction, mu, of the grid cell 00011 ! reached by the rain, the Topmodel saturated fraction and the diagnostic 00012 ! wetland fraction. 00013 ! 00014 ! 00015 !!** METHOD 00016 !! ------ 00017 ! 00018 !! EXTERNAL 00019 !! -------- 00020 !! 00021 !! none 00022 !! 00023 !! IMPLICIT ARGUMENTS 00024 !! ------------------ 00025 !! 00026 !! 00027 !! REFERENCE 00028 !! --------- 00029 !! 00030 !! 00031 !! AUTHOR 00032 !! ------ 00033 !! 00034 !! B. Decharme * Meteo-France * 00035 !! 00036 !! MODIFICATIONS 00037 !! ------------- 00038 !! 07/2011 (B. Decharme) : Add fsat diag for dt92 00039 !! 00040 !------------------------------------------------------------------------------- 00041 ! 00042 ! 00043 !* 0. DECLARATIONS 00044 ! ------------ 00045 ! 00046 USE MODD_ISBA_n, ONLY : NGROUND_LAYER, NPATCH, XPATCH, XWG, XWWILT, & 00047 XWSAT, XTAB_FSAT, XTAB_WTOP, & 00048 XTI_MEAN, XSOILWGHT, XRUNOFFD, & 00049 NSIZE_NATURE_P, NLAYER_DUN, XWGI 00050 ! 00051 USE MODD_ISBA_GRID_n, ONLY : XMESH_SIZE 00052 ! 00053 USE MODD_SGH_PAR, ONLY : NDIMTAB, XMTOKM, XSTOHR, X001, & 00054 XMUREGP, XMUREGA 00055 ! 00056 USE MODD_SURF_PAR, ONLY : XUNDEF 00057 ! 00058 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00059 USE PARKIND1 ,ONLY : JPRB 00060 ! 00061 !------------------waiting for MEB-------------------------! 00062 USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT 00063 USE MODD_SNOW_PAR , ONLY : XWSNV 00064 !------------------waiting for MEB-------------------------! 00065 ! 00066 IMPLICIT NONE 00067 ! 00068 !* 0.1 declarations of arguments 00069 ! 00070 CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version: 00071 ! ! '2-L' (default) 00072 ! ! '3-L' 00073 ! ! 'DIF' 00074 ! 00075 CHARACTER(LEN=*), INTENT(IN) :: HRUNOFF! surface runoff formulation 00076 ! ! 'WSAT' 00077 ! ! 'DT92' 00078 ! ! 'SGH ' Topmodel 00079 ! 00080 ! 00081 CHARACTER(LEN=*), INTENT(IN) :: HRAIN ! Rainfall spatial distribution 00082 ! 'DEF' = No rainfall spatial distribution 00083 ! 'SGH' = Rainfall exponential spatial distribution 00084 ! 00085 REAL, DIMENSION(:), INTENT(IN) :: PRAIN 00086 ! PRAIN = rain rate (kg/m2/s) 00087 ! 00088 REAL, DIMENSION(:), INTENT(OUT) :: PMUF 00089 ! PMUF = fraction of the grid cell reached by the precipitation 00090 ! 00091 REAL, DIMENSION(:), INTENT(OUT) :: PFSAT 00092 ! PFSAT = Topmodel satured fraction 00093 ! 00094 !* 0.2 declarations of local variables 00095 ! 00096 REAL, DIMENSION(SIZE(PRAIN)) :: ZDIST, ZBETA ! HRAIN = SGH 00097 ! ZDIST = the cell scale (in km) 00098 ! ZBETA = cell scale dependency parameter 00099 ! 00100 REAL, DIMENSION(SIZE(PRAIN)) :: ZD_TOP, ZW_TOP ! HRUNOFF = SGH 00101 ! ZW_TOP = ative TOPMODEL-soil moisture at 't' (m3 m-3) 00102 ! ZD_TOP = Topmodel active layer 00103 ! 00104 INTEGER, DIMENSION(SIZE(PRAIN)) :: IUP,IDOWN ! HRUNOFF = SGH 00105 ! change in xsat (or fsat) index 00106 ! 00107 INTEGER, DIMENSION(SIZE(PRAIN)) :: NMASK ! indices correspondance between arrays 00108 ! 00109 REAL, DIMENSION(SIZE(PRAIN)) :: ZWSAT_AVG, ZWWILT_AVG 00110 ! Average soil properties content 00111 ! 00112 REAL :: ZF_UP, ZF_DOWN, ZW_UP, ZW_DOWN, ZSLOPEF 00113 ! 00114 INTEGER :: INI, JJ, JI, JPATCH, JTAB, ICOUNT, 00115 JL 00116 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00117 ! 00118 !------------------------------------------------------------------------------- 00119 ! 00120 IF (LHOOK) CALL DR_HOOK('ISBA_SGH_UPDATE',0,ZHOOK_HANDLE) 00121 ! 00122 INI=SIZE(PRAIN,1) 00123 ! 00124 PFSAT (:) = 0.0 00125 ! 00126 !* 1.0 Spatial distribution of precipitation 00127 ! --------------------------------------------- 00128 ! 00129 IF(HRAIN=='SGH')THEN 00130 ! 00131 WHERE(PRAIN(:)>0.0) 00132 PMUF (:) =1.0 00133 ELSEWHERE 00134 PMUF (:) =0.0 00135 ENDWHERE 00136 00137 ! 00138 ! calculate the cell scale (in km) 00139 ! 00140 ZDIST(:) = SQRT(XMESH_SIZE(:))/XMTOKM 00141 ! 00142 WHERE(ZDIST(:)>=15.0) 00143 ! 00144 ! calculate beta for the mu calculation 00145 ! 00146 ZBETA (:) = XMUREGA + XMUREGP * EXP(-X001*ZDIST(:)) 00147 ! 00148 ! calculate mu, precip is in mm/hr 00149 ! 00150 PMUF (:) = 1.0 - EXP(-ZBETA(:)*(PRAIN(:)*XSTOHR)) 00151 ! 00152 ENDWHERE 00153 ! 00154 ENDIF 00155 ! 00156 !* 2.0 Computation of the saturated fraction given by TOPMODEL 00157 ! ----------------------------------------------------------- 00158 ! 00159 IF(HRUNOFF=='SGH')THEN 00160 ! 00161 ! Calculation of the ative TOPMODEL-soil moisture at 't' (m) 00162 ! --------------------------------------------------------------- 00163 ! 00164 ZW_TOP (:) = 0.0 00165 ZD_TOP (:) = 0.0 00166 ZWSAT_AVG (:) = 0.0 00167 ZWWILT_AVG(:) = 0.0 00168 ! 00169 IF(HISBA=='DIF')THEN 00170 ! 00171 DO JPATCH=1,NPATCH 00172 IF (NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE 00173 DO JL=1,NLAYER_DUN 00174 DO JJ=1,INI 00175 ZD_TOP (JJ) = ZD_TOP (JJ) + XPATCH(JJ,JPATCH)*XSOILWGHT(JJ,JL,JPATCH) 00176 ZWSAT_AVG (JJ) = ZWSAT_AVG (JJ) + XPATCH(JJ,JPATCH)*XSOILWGHT(JJ,JL,JPATCH)*XWSAT (JJ,JL) 00177 ZWWILT_AVG(JJ) = ZWWILT_AVG(JJ) + XPATCH(JJ,JPATCH)*XSOILWGHT(JJ,JL,JPATCH)*XWWILT(JJ,JL) 00178 !------------------waiting for MEB-------------------------! 00179 IF(LSNOW_FRAC_TOT.OR.XWSNV<0.1)THEN 00180 ZW_TOP(JJ) = ZW_TOP(JJ) + XPATCH(JJ,JPATCH)*XSOILWGHT(JJ,JL,JPATCH)*XWG(JJ,JL,JPATCH) 00181 ELSE 00182 ZW_TOP(JJ) = ZW_TOP(JJ) + XPATCH(JJ,JPATCH)*XSOILWGHT(JJ,JL,JPATCH)*(XWG(JJ,JL,JPATCH)+XWGI(JJ,JL,JPATCH)) 00183 ENDIF 00184 !------------------waiting for MEB-------------------------! 00185 ENDDO 00186 ENDDO 00187 ENDDO 00188 ! 00189 WHERE(ZD_TOP(:)>0.0) 00190 ZWSAT_AVG (:) = ZWSAT_AVG (:)/ZD_TOP(:) 00191 ZWWILT_AVG(:) = ZWWILT_AVG(:)/ZD_TOP(:) 00192 ZW_TOP (:) = ZW_TOP (:)/ZD_TOP(:) 00193 ENDWHERE 00194 ! 00195 ELSE 00196 ! 00197 DO JPATCH=1,NPATCH 00198 IF (NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE 00199 DO JJ=1,INI 00200 ZD_TOP(JJ) = ZD_TOP(JJ)+XRUNOFFD(JJ,JPATCH)*XPATCH(JJ,JPATCH) 00201 ZW_TOP(JJ) = ZW_TOP(JJ)+XRUNOFFD(JJ,JPATCH)*XPATCH(JJ,JPATCH)*XWG(JJ,2,JPATCH) 00202 ENDDO 00203 ENDDO 00204 ! 00205 WHERE(ZD_TOP(:)>0.0) 00206 ZW_TOP(:) = ZW_TOP(:) / ZD_TOP(:) 00207 ENDWHERE 00208 ! 00209 ZWSAT_AVG (:) = XWSAT (:,1) 00210 ZWWILT_AVG(:) = XWWILT(:,1) 00211 ! 00212 ENDIF 00213 ! 00214 ! Find the boundary 00215 ! ----------------- 00216 ! 00217 NMASK(:)=0 00218 ICOUNT=0 00219 DO JJ=1,INI 00220 IF((XTI_MEAN(JJ)/=XUNDEF.AND.ZW_TOP(JJ)<ZWSAT_AVG(JJ).AND.ZW_TOP(JJ)>ZWWILT_AVG(JJ)))THEN 00221 ICOUNT=ICOUNT+1 00222 NMASK(ICOUNT)=JJ 00223 ENDIF 00224 IF(ZW_TOP(JJ)>=ZWSAT_AVG(JJ))THEN 00225 PFSAT (JJ) = 1.0 00226 ENDIF 00227 ENDDO 00228 ! 00229 ! compare wt_array and WT 00230 ! ----------------------- 00231 ! 00232 DO JTAB=1,NDIMTAB 00233 DO JJ=1,ICOUNT 00234 JI = NMASK(JJ) 00235 IF(XTAB_WTOP(JI,JTAB)>ZW_TOP(JI))THEN 00236 IUP(JJ)=JTAB 00237 IDOWN(JJ)=JTAB+1 00238 ELSEIF(XTAB_WTOP(JI,JTAB)==ZW_TOP(JI))THEN 00239 IUP(JJ)=JTAB 00240 IDOWN(JJ)=JTAB 00241 ENDIF 00242 ENDDO 00243 ENDDO 00244 ! 00245 ! calculate fsat 00246 ! -------------- 00247 ! 00248 DO JJ=1,ICOUNT 00249 ! 00250 JI = NMASK(JJ) 00251 ! 00252 ! new range 00253 ZF_UP = XTAB_FSAT(JI,IUP (JJ)) 00254 ZF_DOWN = XTAB_FSAT(JI,IDOWN(JJ)) 00255 ZW_UP = XTAB_WTOP(JI,IUP (JJ)) 00256 ZW_DOWN = XTAB_WTOP(JI,IDOWN(JJ)) 00257 ! 00258 ! Calculate new FSAT 00259 ZSLOPEF = 0.0 00260 IF(IUP(JJ)/=IDOWN(JJ))THEN 00261 ZSLOPEF = (ZF_UP-ZF_DOWN)/(ZW_UP-ZW_DOWN) 00262 ENDIF 00263 ! 00264 PFSAT(JI) = ZF_DOWN+(ZW_TOP(JI)-ZW_DOWN)*ZSLOPEF 00265 ! 00266 ENDDO 00267 ! 00268 ENDIF 00269 ! 00270 IF (LHOOK) CALL DR_HOOK('ISBA_SGH_UPDATE',1,ZHOOK_HANDLE) 00271 ! 00272 !------------------------------------------------------------- 00273 ! 00274 END SUBROUTINE ISBA_SGH_UPDATE
1.8.0
