|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################# 00002 SUBROUTINE AVERAGE_DIAG_MISC_ISBA_n 00003 ! ############################# 00004 ! 00005 ! 00006 !!**** *AVERAGE_DIAG_MISC_ISBA_n* 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 ! Average the cumulated diagnostics from all ISBA tiles 00011 ! 00012 !!** METHOD 00013 !! ------ 00014 ! 00015 !! EXTERNAL 00016 !! -------- 00017 !! 00018 !! IMPLICIT ARGUMENTS 00019 !! ------------------ 00020 !! 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! P. Le Moigne * Meteo-France * 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! Original 10/2004 00032 !! B. Decharme 2008 New diag Total albedo, Total SWI, & Flood 00033 !! B. Decharme 09/2009 New diag Total soil SWI 00034 !! B. Decharme 2012 Averaged LAI 00035 !! B. Decharme 2012 New diag for DIF: 00036 !! F2 stress 00037 !! Root zone swi, wg and wgi 00038 !! swi, wg and wgi comparable to ISBA-FR-DG2 and DG3 layers 00039 !! active layer thickness over permafrost 00040 !! frozen layer thickness over non-permafrost 00041 !------------------------------------------------------------------------------- 00042 ! 00043 !* 0. DECLARATIONS 00044 ! ------------ 00045 ! 00046 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00047 ! 00048 USE MODD_CSTS, ONLY : XRHOLW 00049 ! 00050 USE MODD_ISBA_n, ONLY : CISBA, XPATCH, NGROUND_LAYER, & 00051 XDG, XDZG, XWG, XWGI, & 00052 NSIZE_NATURE_P, NWG_LAYER, & 00053 XDG2, XLAI, XROOTFRAC, XDROOT 00054 ! 00055 USE MODD_DIAG_MISC_ISBA_n, ONLY : LSURF_MISC_BUDGET, & 00056 LSURF_MISC_DIF, & 00057 XHV , XAVG_HV , & 00058 XSWI , XAVG_SWI , & 00059 XTSWI, XAVG_TSWI , & 00060 XDPSNG, XAVG_PSNG , & 00061 XDPSNV, XAVG_PSNV , & 00062 XDPSN , XAVG_PSN , & 00063 XALBT, XAVG_ALBT , & 00064 XDFFG , XAVG_FFG , & 00065 XDFFV , XAVG_FFV , & 00066 XDFF , XAVG_FF , & 00067 XDFSAT, XAVG_FSAT , & 00068 XTWSNOW, XAVG_TWSNOW , & 00069 XTDSNOW, XAVG_TDSNOW , & 00070 XTTSNOW, XAVG_TTSNOW , & 00071 XSOIL_TSWI, XSOIL_TWG, & 00072 XSOIL_TWGI, XSURF_TSWI, & 00073 XSURF_TWG, XSURF_TWGI, & 00074 XROOT_TSWI, XROOT_TWG, & 00075 XROOT_TWGI, XFRD2_TSWI, & 00076 XFRD2_TWG, XFRD2_TWGI, & 00077 XFRD3_TSWI, XFRD3_TWG, & 00078 XFRD3_TWGI, & 00079 XALT, XAVG_ALT, & 00080 XFLT, XAVG_FLT, & 00081 XAVG_LAI 00082 ! 00083 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00084 USE PARKIND1 ,ONLY : JPRB 00085 ! 00086 IMPLICIT NONE 00087 ! 00088 INTEGER :: JJ ! grid-cell loop counter 00089 INTEGER :: JPATCH ! tile loop counter 00090 INTEGER :: JLAYER ! layer loop counter 00091 REAL, DIMENSION(SIZE(XPATCH,1)) :: ZSUMPATCH 00092 REAL, DIMENSION(SIZE(XPATCH,1)) :: ZSUMDG, ZSNOW, ZSUMSURF, ZSUMROOT, 00093 ZSUMFRD2, ZSUMFRD3, ZPONDF2 00094 REAL, DIMENSION(SIZE(XPATCH,1),SIZE(XPATCH,2)) :: ZLAI, ZDROOT 00095 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZROOTFRAC 00096 REAL :: ZWORK 00097 INTEGER :: INI,INP,IDEPTH,IWORK 00098 ! 00099 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2)) :: ZPOND 00100 ! 00101 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00102 ! 00103 !------------------------------------------------------------------------------- 00104 ! 00105 ! 0. Initialization 00106 ! -------------- 00107 ! 00108 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE) 00109 ! 00110 IF (.NOT.LSURF_MISC_BUDGET) THEN 00111 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE) 00112 RETURN 00113 ENDIF 00114 ! 00115 INI=SIZE(XPATCH,1) 00116 INP=SIZE(XPATCH,2) 00117 ! 00118 ZSUMPATCH(:) = 0.0 00119 DO JPATCH=1,INP 00120 DO JJ=1,INI 00121 ZSUMPATCH(JJ) = ZSUMPATCH(JJ) + XPATCH(JJ,JPATCH) 00122 END DO 00123 END DO 00124 ! 00125 ZSUMSURF(:)=0.0 00126 ZSUMROOT(:)=0.0 00127 ZSUMFRD2(:)=0.0 00128 ZSUMFRD3(:)=0.0 00129 ZSUMDG (:)=0.0 00130 ZSNOW (:)=0.0 00131 ZPONDF2 (:)=0.0 00132 ! 00133 WHERE(XLAI(:,:)/=XUNDEF) 00134 ZLAI(:,:)=XLAI(:,:) 00135 ELSEWHERE 00136 ZLAI(:,:)=0.0 00137 ENDWHERE 00138 ! 00139 !------------------------------------------------------------------------------- 00140 ! 00141 ! 1. Surface Miscellaneous terms 00142 ! --------------------------- 00143 ! 00144 XAVG_HV (:) = 0. 00145 XAVG_PSNG(:) = 0. 00146 XAVG_PSNV(:) = 0. 00147 XAVG_PSN (:) = 0. 00148 XAVG_ALBT(:) = 0. 00149 XAVG_SWI (:,:) = 0. 00150 XAVG_TSWI(:,:) = 0. 00151 XAVG_FSAT(:) = 0. 00152 XAVG_FFG (:) = 0. 00153 XAVG_FFV (:) = 0. 00154 XAVG_FF (:) = 0. 00155 XAVG_TWSNOW(:) = 0. 00156 XAVG_TDSNOW(:) = 0. 00157 XAVG_TTSNOW(:) = 0. 00158 XAVG_LAI (:) = 0. 00159 ! 00160 XSOIL_TSWI(:) = 0. 00161 XSOIL_TWG (:) = 0. 00162 XSOIL_TWGI (:) = 0. 00163 ! 00164 IF(CISBA=='DIF')THEN 00165 ! 00166 XAVG_ALT (:) = 0. 00167 XAVG_FLT (:) = 0. 00168 ! 00169 ENDIF 00170 00171 IF(CISBA=='DIF'.AND.LSURF_MISC_DIF)THEN 00172 ! 00173 WHERE(XDROOT(:,:)/=XUNDEF) 00174 ZDROOT(:,:)=XDROOT(:,:) 00175 ELSEWHERE 00176 ZDROOT(:,:)=0.0 00177 ENDWHERE 00178 ! 00179 XSURF_TSWI (:) = 0. 00180 XSURF_TWG (:) = 0. 00181 XSURF_TWGI (:) = 0. 00182 ! 00183 XROOT_TSWI (:) = 0. 00184 XROOT_TWG (:) = 0. 00185 XROOT_TWGI (:) = 0. 00186 ! 00187 XFRD2_TSWI (:) = 0. 00188 XFRD2_TWG (:) = 0. 00189 XFRD2_TWGI (:) = 0. 00190 ! 00191 XFRD3_TSWI (:) = 0. 00192 XFRD3_TWG (:) = 0. 00193 XFRD3_TWGI (:) = 0. 00194 ! 00195 ENDIF 00196 ! 00197 DO JPATCH=1,INP 00198 ! 00199 !cdir nodep 00200 DO JJ=1,INI 00201 ! 00202 IF (ZSUMPATCH(JJ) > 0.) THEN 00203 ! 00204 ! Halstead coefficient 00205 XAVG_HV(JJ) = XAVG_HV(JJ) + XPATCH(JJ,JPATCH) * XHV(JJ,JPATCH) 00206 ! 00207 ! Snow fractions 00208 XAVG_PSNG(JJ) = XAVG_PSNG(JJ) + XPATCH(JJ,JPATCH) * XDPSNG(JJ,JPATCH) 00209 XAVG_PSNV(JJ) = XAVG_PSNV(JJ) + XPATCH(JJ,JPATCH) * XDPSNV(JJ,JPATCH) 00210 XAVG_PSN (JJ) = XAVG_PSN (JJ) + XPATCH(JJ,JPATCH) * XDPSN (JJ,JPATCH) 00211 ! 00212 ! Saturated fraction 00213 XAVG_FSAT (JJ) = XAVG_FSAT (JJ) + XPATCH(JJ,JPATCH) * XDFSAT (JJ,JPATCH) 00214 ! 00215 ! Flood fractions 00216 XAVG_FFG(JJ) = XAVG_FFG(JJ) + XPATCH(JJ,JPATCH) * XDFFG(JJ,JPATCH) 00217 XAVG_FFV(JJ) = XAVG_FFV(JJ) + XPATCH(JJ,JPATCH) * XDFFV(JJ,JPATCH) 00218 XAVG_FF (JJ) = XAVG_FF (JJ) + XPATCH(JJ,JPATCH) * XDFF (JJ,JPATCH) 00219 ! 00220 ! Total albedo 00221 XAVG_ALBT(JJ) = XAVG_ALBT(JJ) + XPATCH(JJ,JPATCH) * XALBT (JJ,JPATCH) 00222 ! 00223 ! Total LAI 00224 XAVG_LAI (JJ) = XAVG_LAI(JJ) + XPATCH(JJ,JPATCH) * ZLAI (JJ,JPATCH) 00225 ! 00226 ! Snow total outputs 00227 XAVG_TWSNOW(JJ) = XAVG_TWSNOW(JJ) + XPATCH(JJ,JPATCH) * XTWSNOW(JJ,JPATCH) 00228 XAVG_TDSNOW(JJ) = XAVG_TDSNOW(JJ) + XPATCH(JJ,JPATCH) * XTDSNOW(JJ,JPATCH) 00229 ! 00230 IF (XTWSNOW(JJ,JPATCH)>0.0) THEN 00231 XAVG_TTSNOW(JJ) = XAVG_TTSNOW(JJ) + XPATCH(JJ,JPATCH) * XTTSNOW(JJ,JPATCH) 00232 ZSNOW (JJ) = ZSNOW (JJ) + XPATCH(JJ,JPATCH) 00233 ENDIF 00234 ! 00235 ENDIF 00236 ! 00237 ENDDO 00238 ! 00239 ENDDO 00240 ! 00241 !------------------------------------------------------------------------------- 00242 ! 00243 ! 2. Specific treatement following CISBA option 00244 ! ------------------------------------------ 00245 ! 00246 ! Soil Wetness Index profile, Total Soil Wetness Index and 00247 ! Total Soil Water Content (Liquid+Solid) and Total Frozen Content 00248 ! 00249 !--------------------------------------------- 00250 IF(CISBA=='DIF')THEN ! DIF case 00251 !--------------------------------------------- 00252 ! 00253 ! Active and Frozen layers thickness 00254 DO JPATCH=1,INP 00255 DO JJ=1,INI 00256 IF (ZSUMPATCH(JJ) > 0.) THEN 00257 XAVG_ALT(JJ) = XAVG_ALT (JJ) + XPATCH(JJ,JPATCH) * XALT(JJ,JPATCH) 00258 XAVG_FLT(JJ) = XAVG_FLT (JJ) + XPATCH(JJ,JPATCH) * XFLT(JJ,JPATCH) 00259 ENDIF 00260 ENDDO 00261 ENDDO 00262 ! 00263 ZPOND(:,:)=0.0 00264 DO JPATCH=1,INP 00265 IF(NSIZE_NATURE_P(JPATCH) > 0 )THEN 00266 DO JLAYER = 1,NGROUND_LAYER 00267 ! cdir nodep 00268 DO JJ=1,INI 00269 IDEPTH=NWG_LAYER(JJ,JPATCH) 00270 IF(JLAYER<=IDEPTH.AND.IDEPTH/=NUNDEF)THEN 00271 ZWORK=XDZG(JJ,JLAYER,JPATCH) 00272 !Soil Wetness Index profile 00273 XAVG_SWI (JJ,JLAYER) = XAVG_SWI (JJ,JLAYER)+ZWORK*XPATCH(JJ,JPATCH)*XSWI (JJ,JLAYER,JPATCH) 00274 XAVG_TSWI(JJ,JLAYER) = XAVG_TSWI(JJ,JLAYER)+ZWORK*XPATCH(JJ,JPATCH)*XTSWI(JJ,JLAYER,JPATCH) 00275 ZPOND (JJ,JLAYER) = ZPOND (JJ,JLAYER)+ZWORK*XPATCH(JJ,JPATCH) 00276 !Total soil wetness index, total water and ice contents 00277 XSOIL_TSWI(JJ) = XSOIL_TSWI(JJ) + ZWORK * XPATCH(JJ,JPATCH) * XTSWI(JJ,JLAYER,JPATCH) 00278 ZSUMDG (JJ) = ZSUMDG (JJ) + ZWORK * XPATCH(JJ,JPATCH) 00279 XSOIL_TWG (JJ) = XSOIL_TWG (JJ) + ZWORK * XPATCH(JJ,JPATCH) * (XWG(JJ,JLAYER,JPATCH)+XWGI(JJ,JLAYER,JPATCH)) 00280 XSOIL_TWGI(JJ) = XSOIL_TWGI(JJ) + ZWORK * XPATCH(JJ,JPATCH) * XWGI(JJ,JLAYER,JPATCH) 00281 ENDIF 00282 ENDDO 00283 ENDDO 00284 ENDIF 00285 ENDDO 00286 ! 00287 WHERE(ZPOND(:,:)> 0.) 00288 XAVG_SWI (:,:) = XAVG_SWI (:,:) / ZPOND(:,:) 00289 XAVG_TSWI(:,:) = XAVG_TSWI(:,:) / ZPOND(:,:) 00290 ELSEWHERE 00291 XAVG_SWI (:,:) = XUNDEF 00292 XAVG_TSWI(:,:) = XUNDEF 00293 ENDWHERE 00294 ! 00295 ! --------------------------------------------- 00296 IF(LSURF_MISC_DIF)THEN ! LSURF_MISC_DIF case 00297 ! --------------------------------------------- 00298 ! 00299 ZROOTFRAC(:,1,:)=XROOTFRAC(:,1,:) 00300 DO JPATCH=1,INP 00301 IF(NSIZE_NATURE_P(JPATCH) > 0 )THEN 00302 DO JLAYER = 2,NGROUND_LAYER 00303 ! cdir nodep 00304 DO JJ=1,INI 00305 ZROOTFRAC(JJ,JLAYER,JPATCH) = XROOTFRAC(JJ,JLAYER,JPATCH) - XROOTFRAC(JJ,JLAYER-1,JPATCH) 00306 ENDDO 00307 ENDDO 00308 ENDIF 00309 ENDDO 00310 ! 00311 ! Surface soil wetness index, liquid water and ice contents 00312 DO JPATCH=1,INP 00313 DO JJ=1,INI 00314 IF(ZSUMPATCH(JJ) > 0.)THEN 00315 XSURF_TSWI(JJ) = XSURF_TSWI(JJ) + XPATCH(JJ,JPATCH) * XDG(JJ,1,JPATCH) * XTSWI(JJ,1,JPATCH) 00316 XSURF_TWG (JJ) = XSURF_TWG (JJ) + XPATCH(JJ,JPATCH) * XDG(JJ,1,JPATCH) * XWG (JJ,1,JPATCH) 00317 XSURF_TWGI(JJ) = XSURF_TWGI(JJ) + XPATCH(JJ,JPATCH) * XDG(JJ,1,JPATCH) * XWGI(JJ,1,JPATCH) 00318 ZSUMSURF (JJ) = ZSUMSURF (JJ) + XPATCH(JJ,JPATCH) * XDG(JJ,1,JPATCH) 00319 ENDIF 00320 ENDDO 00321 ENDDO 00322 ! 00323 DO JPATCH=1,INP 00324 ! 00325 IF (NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE 00326 ! 00327 DO JLAYER = 1,NGROUND_LAYER 00328 ! cdir nodep 00329 DO JJ=1,INI 00330 IDEPTH=NWG_LAYER(JJ,JPATCH) 00331 IF(JLAYER<=IDEPTH.AND.IDEPTH/=NUNDEF)THEN 00332 ! 00333 ! Root zone soil wetness index, Total water and ice contents 00334 ZWORK=MIN(XDZG(JJ,JLAYER,JPATCH),MAX(0.0,ZDROOT(JJ,JPATCH)-XDG(JJ,JLAYER,JPATCH)+XDZG(JJ,JLAYER,JPATCH))) 00335 IF(ZDROOT(JJ,JPATCH)>0.0)THEN 00336 XROOT_TSWI (JJ) = XROOT_TSWI (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XTSWI(JJ,JLAYER,JPATCH) 00337 ZSUMROOT (JJ) = ZSUMROOT (JJ) + ZWORK * XPATCH(JJ,JPATCH) 00338 ENDIF 00339 XROOT_TWG (JJ) = XROOT_TWG (JJ) + ZWORK * XPATCH(JJ,JPATCH) * (XWG (JJ,JLAYER,JPATCH)+XWGI(JJ,JLAYER,JPATCH)) 00340 XROOT_TWGI (JJ) = XROOT_TWGI (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XWGI(JJ,JLAYER,JPATCH) 00341 ! 00342 ! ISBA-FR-DG2 comparable soil wetness index, liquid water and ice contents 00343 ZWORK=MIN(XDZG(JJ,JLAYER,JPATCH),MAX(0.0,XDG2(JJ,JPATCH)-XDG(JJ,JLAYER,JPATCH)+XDZG(JJ,JLAYER,JPATCH))) 00344 XFRD2_TSWI (JJ) = XFRD2_TSWI (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XTSWI(JJ,JLAYER,JPATCH) 00345 XFRD2_TWG (JJ) = XFRD2_TWG (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XWG (JJ,JLAYER,JPATCH) 00346 XFRD2_TWGI (JJ) = XFRD2_TWGI (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XWGI (JJ,JLAYER,JPATCH) 00347 ZSUMFRD2 (JJ) = ZSUMFRD2 (JJ) + ZWORK * XPATCH(JJ,JPATCH) 00348 ! 00349 ! ISBA-FR-DG3 comparable soil wetness index, liquid water and ice contents 00350 ZWORK=MIN(XDZG(JJ,JLAYER,JPATCH),MAX(0.0,XDG(JJ,JLAYER,JPATCH)-XDG2(JJ,JPATCH))) 00351 XFRD3_TSWI (JJ) = XFRD3_TSWI (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XTSWI(JJ,JLAYER,JPATCH) 00352 XFRD3_TWG (JJ) = XFRD3_TWG (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XWG (JJ,JLAYER,JPATCH) 00353 XFRD3_TWGI (JJ) = XFRD3_TWGI (JJ) + ZWORK * XPATCH(JJ,JPATCH) * XWGI (JJ,JLAYER,JPATCH) 00354 ZSUMFRD3 (JJ) = ZSUMFRD3 (JJ) + ZWORK * XPATCH(JJ,JPATCH) 00355 ! 00356 ENDIF 00357 ENDDO 00358 ENDDO 00359 ! 00360 ENDDO 00361 ! 00362 WHERE(ZSUMSURF(:)>0.0) 00363 XSURF_TSWI (:) = XSURF_TSWI (:) / ZSUMSURF(:) 00364 XSURF_TWG (:) = XSURF_TWG (:) / ZSUMSURF(:) 00365 XSURF_TWGI (:) = XSURF_TWGI (:) / ZSUMSURF(:) 00366 ELSEWHERE 00367 XSURF_TSWI (:) = XUNDEF 00368 XSURF_TWG (:) = XUNDEF 00369 XSURF_TWGI (:) = XUNDEF 00370 ENDWHERE 00371 ! 00372 WHERE(ZSUMFRD2(:)>0.0) 00373 XFRD2_TSWI (:) = XFRD2_TSWI (:) / ZSUMFRD2(:) 00374 XFRD2_TWG (:) = XFRD2_TWG (:) / ZSUMFRD2(:) 00375 XFRD2_TWGI (:) = XFRD2_TWGI (:) / ZSUMFRD2(:) 00376 ELSEWHERE 00377 XFRD2_TSWI (:) = XUNDEF 00378 XFRD2_TWG (:) = XUNDEF 00379 XFRD2_TWGI (:) = XUNDEF 00380 ENDWHERE 00381 ! 00382 WHERE(ZSUMFRD3(:)>0.0) 00383 XFRD3_TSWI (:) = XFRD3_TSWI (:) / ZSUMFRD3(:) 00384 XFRD3_TWG (:) = XFRD3_TWG (:) / ZSUMFRD3(:) 00385 XFRD3_TWGI (:) = XFRD3_TWGI (:) / ZSUMFRD3(:) 00386 ELSEWHERE 00387 XFRD3_TSWI (:) = XUNDEF 00388 XFRD3_TWG (:) = XUNDEF 00389 XFRD3_TWGI (:) = XUNDEF 00390 ENDWHERE 00391 ! 00392 WHERE(ZSUMROOT(:)>0.0) 00393 XROOT_TSWI (:) = XROOT_TSWI (:) / ZSUMROOT(:) 00394 ELSEWHERE 00395 XROOT_TSWI (:) = XUNDEF 00396 ENDWHERE 00397 ! 00398 XROOT_TWG (:) = XROOT_TWG (:) * XRHOLW 00399 XROOT_TWGI (:) = XROOT_TWGI (:) * XRHOLW 00400 ! 00401 ! --------------------------------------------- 00402 ENDIF ! End LSURF_MISC_DIF case 00403 ! --------------------------------------------- 00404 ! 00405 !--------------------------------------------- 00406 ELSE ! Force-restore case 00407 !--------------------------------------------- 00408 ! 00409 DO JPATCH=1,INP 00410 DO JJ=1,INI 00411 IF(ZSUMPATCH(JJ) > 0.)THEN 00412 ! 00413 XAVG_SWI (JJ,1) = XAVG_SWI (JJ,1) + XPATCH(JJ,JPATCH) * XSWI (JJ,1,JPATCH) 00414 XAVG_SWI (JJ,2) = XAVG_SWI (JJ,2) + XPATCH(JJ,JPATCH) * XSWI (JJ,2,JPATCH) 00415 XAVG_TSWI(JJ,1) = XAVG_TSWI(JJ,1) + XPATCH(JJ,JPATCH) * XTSWI(JJ,1,JPATCH) 00416 XAVG_TSWI(JJ,2) = XAVG_TSWI(JJ,2) + XPATCH(JJ,JPATCH) * XTSWI(JJ,2,JPATCH) 00417 ! 00418 XSOIL_TSWI(JJ) = XSOIL_TSWI(JJ) + XPATCH(JJ,JPATCH) * XDG (JJ,2,JPATCH) * XTSWI(JJ,2,JPATCH) 00419 XSOIL_TWG (JJ) = XSOIL_TWG (JJ) + XPATCH(JJ,JPATCH) * XDG (JJ,2,JPATCH) * (XWG(JJ,2,JPATCH)+XWGI(JJ,2,JPATCH)) 00420 XSOIL_TWGI(JJ) = XSOIL_TWGI(JJ) + XPATCH(JJ,JPATCH) * XDG (JJ,2,JPATCH) * XWGI(JJ,2,JPATCH) 00421 ZSUMDG (JJ) = ZSUMDG (JJ) + XPATCH(JJ,JPATCH) * XDG(JJ,3,JPATCH) 00422 ! 00423 ENDIF 00424 ENDDO 00425 ENDDO 00426 ! 00427 IF(CISBA=='3-L')THEN 00428 ! 00429 ZPOND(:,:)=0.0 00430 DO JPATCH=1,INP 00431 DO JJ=1,SIZE(XPATCH,1) 00432 IF(ZSUMPATCH(JJ) > 0.)THEN 00433 ! 00434 ZWORK=MAX(0.0,XDG(JJ,3,JPATCH)-XDG(JJ,2,JPATCH)) 00435 ! 00436 ! Remenber: no ice in the third layer of 3-L 00437 ZPOND (JJ,3) = ZPOND (JJ,3) + XPATCH(JJ,JPATCH) * ZWORK 00438 XAVG_SWI (JJ,3) = XAVG_SWI (JJ,3) + XPATCH(JJ,JPATCH) * ZWORK * XSWI (JJ,3,JPATCH) 00439 XAVG_TSWI (JJ,3) = XAVG_TSWI (JJ,3) + XPATCH(JJ,JPATCH) * ZWORK * XTSWI(JJ,3,JPATCH) 00440 XSOIL_TSWI(JJ ) = XSOIL_TSWI(JJ ) + XPATCH(JJ,JPATCH) * ZWORK * XTSWI(JJ,3,JPATCH) 00441 XSOIL_TWG (JJ ) = XSOIL_TWG (JJ ) + XPATCH(JJ,JPATCH) * ZWORK * XWG (JJ,3,JPATCH) 00442 ! 00443 ENDIF 00444 ENDDO 00445 ENDDO 00446 ! 00447 WHERE(ZPOND(:,3)>0.0) 00448 XAVG_SWI (:,3) = XAVG_SWI (:,3) / ZPOND(:,3) 00449 XAVG_TSWI(:,3) = XAVG_TSWI(:,3) / ZPOND(:,3) 00450 ELSEWHERE 00451 XAVG_SWI (:,3) = XUNDEF 00452 XAVG_TSWI(:,3) = XUNDEF 00453 ENDWHERE 00454 ! 00455 ENDIF 00456 00457 ! 00458 !--------------------------------------------- 00459 ENDIF ! End ISBA soil scheme case 00460 !--------------------------------------------- 00461 ! 00462 ! 3. Final computation for grid-cell diag 00463 ! ------------------------------------ 00464 ! 00465 !Total Soil Wetness Index 00466 WHERE(ZSUMDG(:)>0.0)XSOIL_TSWI(:) = XSOIL_TSWI(:)/ZSUMDG(:) 00467 !Total Soil Water Content (Liquid+Solid) and Total Frozen Content (kg/m2) 00468 XSOIL_TWG (:)= XSOIL_TWG (:) * XRHOLW 00469 XSOIL_TWGI(:)= XSOIL_TWGI(:) * XRHOLW 00470 ! 00471 ! Snow temperature 00472 WHERE(ZSNOW(:)>0.0) 00473 XAVG_TTSNOW(:) = XAVG_TTSNOW(:)/ZSNOW(:) 00474 ELSEWHERE 00475 XAVG_TTSNOW(:) = XUNDEF 00476 ENDWHERE 00477 ! 00478 !------------------------------------------------------------------------------- 00479 ! 00480 IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE) 00481 !------------------------------------------------------------------------------- 00482 ! 00483 END SUBROUTINE AVERAGE_DIAG_MISC_ISBA_n
1.8.0
