|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 SUBROUTINE COUPLING_DST_n( & 00002 HPROGRAM, &!I [char] Type of ISBA version 00003 KI, &!I [nbr] number of points in patch 00004 KDST, &!I Number of dust emission variables 00005 KPATCH, &!I [nbr] number of patch in question 00006 PCLAY, &!I [frc] mass fraction of clay 00007 PPS, &!I [Pa] surface pressure 00008 PQA, &!I [kg/kg] atmospheric specific humidity 00009 PRA, &!I [s/m] atmospheric resistance 00010 PRHOA, &!I [kg/m3] atmospheric density 00011 PSAND, &!I [frc] mass fraction of sand 00012 PSFTH, &!I [W/m2] surface heat flux 00013 PSFTQ, &!I [kg/m2/s] surface vapor flux 00014 PTA, &!I [K] Atmospheric temperature 00015 PTG, &!I [K] Ground temperature 00016 PU, &!I [m/s] zonal wind at atmospheric height 00017 PUREF, &!I [m] reference height of wind 00018 PV, &!I [m/s] meridional wind at atmospheric height 00019 PWG, &!I [m3/m3] ground volumetric water content 00020 PWSAT, &!I [m3/m3] saturation volumetric water content 00021 PZREF, &!I [m] reference height of wind 00022 PCD, &!I [] Drag Coefficient 00023 PRI, &!I [] Richardson number 00024 PZ0H_WITH_SNOW, &!I [frc] Z0 (heat) with snow 00025 PSFDST &!O [kg/m2/sec] flux of dust 00026 ) 00027 00028 !PURPOSE 00029 !------- 00030 !Recieve a full vector for a given patch containing dust emitter surface points 00031 !Pack it to vectors for which are purely dust emitter surfaces 00032 !Send back the vector PSFDST (kg/m2/s) coming from this patch. 00033 !In COUPLING_ISBA this will again be weighted by fraction_of_patch_in_nature_point 00034 00035 !AUTHOR 00036 !------- 00037 !ALF GRINI <alf.grini@cnrm.meteo.fr> 2005 00038 ! Modification P. Tulet introduce friction velocity for mode repartition upon 00039 ! Alfaro et al, 1998 (Geo. Res. Lett.) 00040 ! 00041 !! Modified 09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI 00042 ! 00043 USE MODD_CSTS, ONLY : XRD ! [J/K/kg] The universal gas constant 00044 00045 USE MODD_PACK_ISBA, ONLY : XP_VEGTYPE_PATCH ! Fraction of all vegtypes for all patches 00046 00047 USE MODD_DST_n, ONLY : NR_PATCH_DST, NVT_DST, & 00048 XMSS_FRC_SRC, Z0_EROD_DST, NSIZE_PATCH_DST 00049 USE MODD_DST_SURF 00050 00051 USE MODI_SURFACE_CD 00052 USE MODI_PARAM_CLS 00053 00054 USE MODI_DUSTFLUX_GET ! Dust mobilization routines 00055 USE MODI_DUSTFLUX_GET_MB ! Dust mobilization routines (M. Mokhtari) 00056 ! 00057 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00058 USE PARKIND1 ,ONLY : JPRB 00059 ! 00060 IMPLICIT NONE 00061 00062 !INPUT 00063 CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM !I Name of program 00064 INTEGER, INTENT(IN) :: KI !I Number of points in patch 00065 INTEGER, INTENT(IN) :: KDST !I Number of dust emission variables 00066 INTEGER, INTENT(IN) :: KPATCH !I Number of patch we are working on 00067 REAL, DIMENSION(KI), INTENT(IN) :: PCLAY !I [frc] mass fraction clay 00068 REAL, DIMENSION(KI), INTENT(IN) :: PPS !I [Pa] surface pressure 00069 REAL, DIMENSION(KI), INTENT(IN) :: PQA !I [kg/kg] atmospheric specific humidity 00070 REAL, DIMENSION(KI), INTENT(IN) :: PRA !I [s/m] surface resistance 00071 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA !I [kg/m3] atmospheric density 00072 REAL, DIMENSION(KI), INTENT(IN) :: PSAND !I [frc] mass fraction sand 00073 REAL, DIMENSION(KI), INTENT(IN) :: PSFTH !I [W/m2] surface sensible heat flux 00074 REAL, DIMENSION(KI), INTENT(IN) :: PSFTQ !I [kg/m2/sec] water vapor flux 00075 REAL, DIMENSION(KI), INTENT(IN) :: PTA !I [K] Atmospheric temperature 00076 REAL, DIMENSION(KI), INTENT(IN) :: PTG !I [K] Ground temperature 00077 REAL, DIMENSION(KI), INTENT(IN) :: PU !I [m/s] zonal wind at atmospheric height 00078 REAL, DIMENSION(KI), INTENT(IN) :: PUREF !I [m] reference height of wind 00079 REAL, DIMENSION(KI), INTENT(IN) :: PV !I [m/s] meridional wind at atmospheric height 00080 REAL, DIMENSION(KI), INTENT(IN) :: PWG !I [m3/m3] ground volumetric water content 00081 REAL, DIMENSION(KI), INTENT(IN) :: PWSAT !I [m3/m3] saturation volumetric water content 00082 REAL, DIMENSION(KI), INTENT(IN) :: PZREF !I [m] reference height of wind 00083 REAL, DIMENSION(KI), INTENT(IN) :: PCD !I [] Drag coefficient 00084 REAL, DIMENSION(KI), INTENT(IN) :: PRI !I [] Richardson number from isba 00085 REAL, DIMENSION(KI), INTENT(IN) :: PZ0H_WITH_SNOW !I [frc] Z0 heat with snow 00086 REAL, DIMENSION(KI,KDST), INTENT(OUT) :: PSFDST !O [kg/m2/sec] flux of dust for a patch 00087 00088 !LOCAL VARIABLES 00089 REAL, DIMENSION(KI,NVEGNO_DST,NDSTMDE) :: ZSFDST_TILE ![kg/m2] flux of dust for each vegetation types and each mode 00090 INTEGER :: JVEG ![idx] counter for vegetation types 00091 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00092 00093 00094 !Initialize output which is total flux of dust (kg/m2/sec) from this patch 00095 !This number will get weighted by fraction of patch later on (in coupling_isban) 00096 IF (LHOOK) CALL DR_HOOK('COUPLING_DST_N',0,ZHOOK_HANDLE) 00097 PSFDST(:,:)=0.d0 00098 00099 !Initiate dust emissions for all points in patch 00100 ZSFDST_TILE(:,:,:)=0.d0 00101 00102 DO JVEG=1,NVEGNO_DST 00103 00104 !Jump out of loop if no dust emitter points 00105 IF (NSIZE_PATCH_DST(JVEG,KPATCH)==0) CYCLE 00106 00107 CALL TREAT_SURF( & 00108 NSIZE_PATCH_DST(JVEG,KPATCH), &!I[idx] number of dust emitter points in patch 00109 NR_PATCH_DST(:,JVEG,KPATCH) &!I[idx] index translator from patch to dustemitter 00110 ) 00111 00112 ENDDO !Loop on dust emitter vegetation 00113 00114 !Average dust flux from the two vegetation "tiles" 00115 !Make sure you do this correctly so that area is OK. 00116 !Need to have this as kg/m2/sec from PATCH because 00117 !afterwards this is weighted by fraction of patch 00118 CALL AVG_FLUX_DST(NVEGNO_DST) 00119 00120 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00121 IF (LHOOK) CALL DR_HOOK('COUPLING_DST_N',1,ZHOOK_HANDLE) 00122 ! 00123 CONTAINS 00124 00125 SUBROUTINE TREAT_SURF(KSIZE,KMASK) 00126 00127 IMPLICIT NONE 00128 00129 INTEGER, INTENT(IN) :: KSIZE !Size of dust emitter vector 00130 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK !mask from patch vector to dust emitter vector 00131 00132 !ALLOCATABLE VARIABLES FOR ALL VEGETATION TYPES 00133 REAL, DIMENSION(KSIZE) :: ZP_CLAY ![frc] fraction of clay 00134 REAL, DIMENSION(KSIZE) :: ZP_MER10M ![m/s] meridional wind at 10m 00135 REAL, DIMENSION(KSIZE) :: ZP_PS ![Pa] surface pressure 00136 REAL, DIMENSION(KSIZE) :: ZP_QA ![kg_{H2O}/kg_{air}] specific humidity 00137 REAL, DIMENSION(KSIZE) :: ZP_Q2M ![kg_{H2O}/kg_{air}] speficic humidity 00138 REAL, DIMENSION(KSIZE) :: ZP_HU2M ![-] relative humidity 00139 REAL, DIMENSION(KSIZE) :: ZP_RHOA ![kg/m3] atmospheric density 00140 REAL, DIMENSION(KSIZE) :: ZP_RHOA_2M ![kg/m3] atmospheric density close to surface 00141 REAL, DIMENSION(KSIZE) :: ZP_SAND ![frc] fraction of sand 00142 REAL, DIMENSION(KSIZE) :: ZP_SFDST ![kg/m2/s] dust flux (kg/m2/s) 00143 REAL, DIMENSION(KSIZE,NDSTMDE) :: ZP_SFDST_MDE ![kg/m2/s] dust flux from modes 00144 REAL, DIMENSION(KSIZE) :: ZP_SFMER ![m/s] wind friction in meridional direction 00145 REAL, DIMENSION(KSIZE) :: ZP_SFTH ![W/m2] surface sensible heat flux 00146 REAL, DIMENSION(KSIZE) :: ZP_SFTQ ![kg/m2/s] water vapor flux 00147 REAL, DIMENSION(KSIZE) :: ZP_SFZON ![m/s] wind friction in zonal direction 00148 REAL, DIMENSION(KSIZE) :: ZP_TA ![K] Atmospheric temperature 00149 REAL, DIMENSION(KSIZE) :: ZP_TG ![K] ground temperature 00150 REAL, DIMENSION(KSIZE) :: ZP_T2M ![K] 2M temperature 00151 REAL, DIMENSION(KSIZE) :: ZP_U ![m/s] zonal wind at atmospheric height 00152 REAL, DIMENSION(KSIZE) :: ZP_UREF ![m] reference height for wind 00153 REAL, DIMENSION(KSIZE) :: ZP_USTAR ![m/s] wind friction speed 00154 REAL, DIMENSION(KSIZE) :: ZP_V ![m/s] meridional wind at atmospheric height 00155 REAL, DIMENSION(KSIZE) :: ZP_VMOD ![m/s] Wind at atmospheric height 00156 REAL, DIMENSION(KSIZE) :: ZP_WG ![m3/m3] ground volumetric water content 00157 REAL, DIMENSION(KSIZE) :: ZP_WIND10M ![m/s] wind at 10m 00158 REAL, DIMENSION(KSIZE) :: ZP_WSAT ![m3/m3] saturation volumetric water content 00159 REAL, DIMENSION(KSIZE) :: ZP_ZON10M ![m/s] zonal wind at 10m 00160 REAL, DIMENSION(KSIZE) :: ZP_ZREF ![m] reference height for wind 00161 REAL, DIMENSION(KSIZE) :: ZP_Z0_EROD ![m] roughness length for erodible surface 00162 REAL, DIMENSION(KSIZE,3) :: ZP_MSS_FRC_SRC ![%] dust mode fraction of emitted mass 00163 REAL, DIMENSION(KSIZE) :: ZP_INTER ![%] dust mode fraction of emitted mass 00164 REAL, DIMENSION(KSIZE) :: ZP_CD !I [] drag coefficient from isba 00165 REAL, DIMENSION(KSIZE) :: ZP_CD_DST ! drag coefficient uses by DEAD 00166 REAL, DIMENSION(KSIZE) :: ZP_CDN ![-] drag coefficient neutral atm 00167 REAL, DIMENSION(KSIZE) :: ZP_RI !I [-] Richardson number 00168 REAL, DIMENSION(KSIZE) :: ZP_Z0H_WITH_SNOW ![frc] Z0 heat with snow 00169 REAL, DIMENSION(KSIZE) :: ZP_DST_EROD !Erodable Surface (COVER004=1 and COVER005=0.01) 00170 REAL, DIMENSION(5) :: ZSEUIL 00171 REAL, DIMENSION(6,2) :: ZPCEN 00172 INTEGER :: JJ, JS !Counter for vector points 00173 INTEGER :: JMODE 00174 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00175 00176 IF (LHOOK) CALL DR_HOOK('COUPLING_DST_n:TREAT_SURF',0,ZHOOK_HANDLE) 00177 00178 !Pack patch-vectors to dust emitter vectors 00179 !i.e. allocate memory for the packed (dust emitter) vectors 00180 DO JJ=1,KSIZE 00181 ZP_CLAY(JJ) = PCLAY (KMASK(JJ)) 00182 ZP_PS(JJ) = PPS (KMASK(JJ)) 00183 ZP_QA(JJ) = PQA (KMASK(JJ)) 00184 ZP_RHOA(JJ) = PRHOA (KMASK(JJ)) 00185 ZP_SAND(JJ) = PSAND (KMASK(JJ)) 00186 ZP_SFTH(JJ) = PSFTH (KMASK(JJ)) 00187 ZP_SFTQ(JJ) = PSFTQ (KMASK(JJ)) 00188 ZP_TA(JJ) = PTA (KMASK(JJ)) 00189 ZP_TG(JJ) = PTG (KMASK(JJ)) 00190 ZP_U(JJ) = PU (KMASK(JJ)) 00191 ZP_UREF(JJ) = PUREF (KMASK(JJ)) 00192 ZP_V(JJ) = PV (KMASK(JJ)) 00193 ZP_WG(JJ) = PWG (KMASK(JJ)) 00194 ZP_WSAT(JJ) = PWSAT (KMASK(JJ)) 00195 ZP_ZREF(JJ) = PZREF (KMASK(JJ)) 00196 ZP_CD(JJ) = PCD (KMASK(JJ)) 00197 ZP_RI(JJ) = PRI (KMASK(JJ)) 00198 ZP_Z0H_WITH_SNOW(JJ) = PZ0H_WITH_SNOW(KMASK(JJ)) 00199 ENDDO 00200 ! 00201 !Manipulate some variables since we assume dust emission occurs over flat surface 00202 ZP_Z0_EROD(:) = Z0_EROD_DST(JVEG) !Set z0 to roughness of erodible surface 00203 ! 00204 IF (JVEG ==1) THEN 00205 ZP_DST_EROD(:) = 1. 00206 ELSE 00207 ZP_DST_EROD(:) = 0.01 00208 ENDIF 00209 ! 00210 ZP_CD_DST(:) = ZP_CD(:) 00211 ! 00212 IF (CVERMOD/='CMDVER') THEN 00213 !Re-calculate the drag over the dust emitter (erodable) surface. Since we 00214 !don't use the roughness length of the patch, but rather use specific roughness 00215 !lengths of dust emitter surfaces, the drag changes. 00216 CALL SURFACE_CD(ZP_RI, ZP_Z0_EROD, ZP_UREF, ZP_Z0_EROD, ZP_Z0H_WITH_SNOW, ZP_CD_DST, ZP_CDN) 00217 ENDIF 00218 ! 00219 !Get total wind speed 00220 ZP_VMOD(:) = SQRT(ZP_U(:)**2 + ZP_V(:)**2) 00221 ! 00222 ZP_USTAR(:) = SQRT(ZP_CD_DST(:))*ZP_VMOD 00223 !Get zonal friction speed (m/s) 00224 ZP_SFZON(:) = - SQRT(ZP_CD_DST(:))*ZP_U(:) 00225 !Get meridional surface stress 00226 ZP_SFMER(:) = - SQRT(ZP_CD_DST(:))*ZP_V(:) 00227 ! 00228 !Get the 10m wind speed (needed for one operation in dust model) 00229 !And get the density at 2m to feed into erosion model 00230 CALL PARAM_CLS( & 00231 ZP_TA, &!I [K] atmospheric temperature 00232 ZP_TG, &!I [K] ground temperature 00233 ZP_QA, &!I [kg_{H2O}/kg_{air} 00234 ZP_PS, &!I [Pa] atmospheric pressure 00235 ZP_RHOA, &!I [kg/m3] atmospheric density 00236 ZP_U, &!I [m/s] zonal wind at atm. height 00237 ZP_V, &!I [m/s] meridional wind at atm. height 00238 ZP_ZREF, &!I [m] reference height for wind 00239 ZP_UREF, &!I [m] reference height for wind 00240 ZP_SFTH, &!I [W/m2] heat flux 00241 ZP_SFTQ, &!I [kg/m2/s] water vapor flux 00242 ZP_SFZON, &!I [??] Zonal friction 00243 ZP_SFMER, &!I [??] meridional friction 00244 ZP_T2M, &!O [K] 2M temperature 00245 ZP_Q2M, &!O [kg_{H2O}/kg_{air}] 2M specific humidity 00246 ZP_HU2M, &!O [-] 2M relative humidity 00247 ZP_ZON10M, &!O [m/s] zonal wind at 2M 00248 ZP_MER10M &!O [m/s] meridional wind at 2M 00249 ) 00250 ! 00251 !Get density at 2 meters rho=P/(RT) 00252 ZP_RHOA_2M(:) = ZP_PS(:)/(ZP_T2M(:)*XRD) 00253 ! 00254 !Get wind speed at 10m heigh 00255 ZP_WIND10M(:) = SQRT(ZP_ZON10M(:)**2 + ZP_MER10M(:)**2) 00256 ! 00257 !the erodible surface 00258 ZP_WIND10M(:) = MAX(ZP_WIND10M(:), 1E-2) 00259 ! 00260 IF (CVERMOD=='CMDVER') THEN 00261 ! 00262 CALL DUSTFLUX_GET_MB( & 00263 ZP_USTAR, & !I [m/s] wind friction speed over erodible surface 00264 ZP_RHOA_2M, & !I [kg/m3] air density at surface 00265 ZP_WG, & !I [m3/m3] volumetric water content of ground 00266 ZP_Z0_EROD, & !I [m] roughness length of erodible surface 00267 ZP_WSAT, & !I [m3/m3] saturation water volumetric content 00268 ZP_CLAY, & !I [frc] mass fraction of clay 00269 ZP_SAND, & !I [frc] mass fraction of sand 00270 ZP_DST_EROD, & !I [frc] erodabilitC) de la surface (cover004 = 1 et cocer005=0.5) 00271 ZP_WIND10M, & !I [m/s] wind at 10m 00272 ZP_SFDST, & !O [kg/m2/sec] flux of dust 00273 KSIZE & !I [nbr] number of points for which we do calculation 00274 ) 00275 ! 00276 ELSE 00277 ! 00278 CALL DUSTFLUX_GET( & 00279 ZP_USTAR, &!I [m/s] wind friction speed over erodible surface 00280 ZP_RHOA_2M, &!I [kg/m3] air density at surface 00281 ZP_WG, &!I [m3/m3] volumetric water content of ground 00282 ZP_Z0_EROD, &!I [m] roughness length of erodible surface 00283 ZP_WSAT, &!I [m3/m3] saturation water volumetric content 00284 ZP_CLAY, &!I [frc] mass fraction of clay 00285 ZP_SAND, &!I [frc] mass fraction of sand 00286 ZP_WIND10M, &!I [m/s] wind at 10m 00287 ZP_SFDST, &!O [kg/m2/sec] flux of dust 00288 KSIZE &!I [nbr] number of points for which we do calculation 00289 ) 00290 ENDIF 00291 00292 ZP_MSS_FRC_SRC(:,:) = 0. 00293 00294 IF (CEMISPARAM_DST == "EXPLI" .OR. CEMISPARAM_DST == "AMMA ") THEN 00295 00296 ! For the repartition of mass fraction we uses the real USTAR 00297 ZP_USTAR(:) = sqrt(ZP_CD_DST(:))*ZP_VMOD(:) 00298 00299 ZSEUIL = (/0., 0.35, 0.42, 0.50 ,0.66/) 00300 00301 IF (CEMISPARAM_DST == "EXPLI") THEN 00302 ! Compute modes mass fraction of emitted dust upon Alfaro et al. 1998 00303 ZPCEN(:,1) = (/0., 0., 0.01, 0.08, 0.15, 0.15/) 00304 ZPCEN(:,2) = (/0., 0., 0.36, 0.43, 0.76, 0.76/) 00305 ! Case of u* < 35E-2 m/s 00306 ! only coarse mode is activated 00307 ! mode 1 = 0 00308 ! mode 2 = 0 00309 ! mode 3 = 100 00310 ! Case of 35E-2 m/s < u* < 42E-2 m/s 00311 ! 0 % < mode 1 < 1 % 00312 ! 0 % < mode 2 < 36 % 00313 ! 63 % < mode 3 < 100 % 00314 ! Case of 42E-2 m/s < u* < 50E-2 m/s 00315 ! 1 % < mode 1 < 8 % 00316 ! 36 % < mode 2 < 43 % 00317 ! 49 % < mode 3 < 63 % 00318 ! Case of 50E-2 m/s < u* < 66E-2 m/s 00319 ! 8 % < mode 1 < 15 % 00320 ! 43 % < mode 2 < 76 % 00321 ! 9 % < mode 3 < 49 % 00322 ! Case of u* > 66E-2 m/s 00323 ! mode 1 = 15 % 00324 ! mode 2 = 76 % 00325 ! mode 3 = 9 % 00326 ELSEIF (CEMISPARAM_DST == "AMMA ") THEN 00327 ! For the repartition of mass fraction we uses the real USTAR upon 00328 ! Alfaro/Gomes 2001, jgr, table 5, soil type Salty sand. 00329 ! Percentage of mass considered between the fin and accumulation modes 00330 ZPCEN(:,1) = (/0., 0., 0.0023, 0.0185, 0.0345, 0.0345/) 00331 ZPCEN(:,2) = (/0., 0., 0.0077, 0.0615, 0.1155, 0.1155/) 00332 ! Case of u* < 35E-2 m/s 00333 ! only coarse mode is activated 00334 ! mode 1 = 0 00335 ! mode 2 = 0 00336 ! mode 3 = 100 00337 ! Case of 35E-2 m/s < u* < 42E-2 m/s 00338 ! 0 % < mode 1 < 0.23 % 00339 ! 0 % < mode 2 < 0.77 % 00340 ! 99 % < mode 3 < 100 % 00341 ! Case of 42E-2 m/s < u* < 50E-2 m/s 00342 ! 0.23 % < mode 1 < 1.85 % 00343 ! 0.77 % < mode 2 < 6.15 % 00344 ! 92 % < mode 3 < 99 % 00345 ! Case of 50E-2 m/s < u* < 66E-2 m/s 00346 ! 1.85 % < mode 1 < 3.45 % 00347 ! 6.15 % < mode 2 < 11.55 % 00348 ! 85 % < mode 3 < 92 % 00349 ! Case of u* > 66E-2 m/s 00350 ! mode 1 = 15 % 00351 ! mode 2 = 76 % 00352 ! mode 3 = 9 % 00353 ENDIF 00354 00355 DO JS = 1, SIZE(ZSEUIL) - 1 00356 WHERE (ZP_USTAR(:) >= ZSEUIL(JS) .AND. ZP_USTAR(:) < ZSEUIL(JS+1)) 00357 ZP_INTER(:) = (ZP_USTAR(:) - ZSEUIL(JS)) / (ZSEUIL(JS+1) - ZSEUIL(JS)) 00358 ZP_MSS_FRC_SRC(:,1) = ZPCEN(JS,1) + (ZPCEN(JS+1,1) - ZPCEN(JS,1)) * ZP_INTER(:) 00359 ZP_MSS_FRC_SRC(:,2) = ZPCEN(JS,2) + (ZPCEN(JS+1,2) - ZPCEN(JS,2)) * ZP_INTER(:) 00360 END WHERE 00361 ENDDO 00362 00363 WHERE (ZP_USTAR(:) >= ZSEUIL(SIZE(ZSEUIL))) 00364 ZP_MSS_FRC_SRC(:,1) = ZPCEN(SIZE(ZSEUIL)+1,1) 00365 ZP_MSS_FRC_SRC(:,2) = ZPCEN(SIZE(ZSEUIL)+1,2) 00366 END WHERE 00367 00368 ZP_MSS_FRC_SRC(:,3) = 1. - ZP_MSS_FRC_SRC(:,1) - ZP_MSS_FRC_SRC(:,2) 00369 00370 ELSE 00371 DO JMODE = 1,NDSTMDE 00372 ZP_MSS_FRC_SRC(:,JORDER_DST(JMODE)) = XMSS_FRC_SRC(JMODE) 00373 ENDDO 00374 END IF 00375 00376 DO JMODE=1,NDSTMDE 00377 ! Explicit mass fraction from u* 00378 ZP_SFDST_MDE(:,JMODE) = ZP_SFDST(:) & !Total mass flux of dust 00379 * ZP_MSS_FRC_SRC(:,JORDER_DST(JMODE)) !Fraction of dust going to each mode 00380 ENDDO 00381 00382 00383 !Transfer the fluxes to each tile 00384 DO JMODE=1,NDSTMDE 00385 DO JJ=1,KSIZE 00386 ZSFDST_TILE(KMASK(JJ),JVEG,JMODE) = ZP_SFDST_MDE(JJ,JMODE) 00387 ENDDO 00388 ENDDO 00389 00390 IF (LHOOK) CALL DR_HOOK('COUPLING_DST_n:TREAT_SURF',1,ZHOOK_HANDLE) 00391 00392 END SUBROUTINE TREAT_SURF 00393 00394 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00395 SUBROUTINE AVG_FLUX_DST( & 00396 KTILE & ! Number of different dust emitter vegetations 00397 ) 00398 00399 ! Purpose: Average all fluxes from independent dust emitter surfaces (KTILE) 00400 ! Remember: XP_VEGTYPE_PATCH is m^2_{emittersurface}/m^{nature} 00401 ! The goal is to obtain PSFDST in kg_{dust}/m^2_{patch} 00402 00403 !INPUT 00404 INTEGER, INTENT(IN) :: KTILE ! Number of different dust emitter vegetation types 00405 00406 !LOCAL 00407 INTEGER :: II ! Counter for points in patch-vector 00408 INTEGER :: JJ ! Counter for vegetation types 00409 INTEGER :: JMODE ! Counter for modes 00410 INTEGER :: JSV_IDX ! Index for scalar variable 00411 INTEGER :: NMOMENT ! Number of moments 00412 REAL :: VEGFRAC_IN_PATCH ! fraction of total vegetation in this patch (m^2_{patch}/m^2_{nature}) 00413 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00414 ! 00415 !Remember: XP_VEGTYPE_PATCH is m^2_{emittersurface}/m^{nature} 00416 !The goal is to obtain PSFDST in kg_{dust}/m^2_{patch} 00417 ! 00418 !Start loop on modes 00419 IF (LHOOK) CALL DR_HOOK('AVG_FLUX_DST',0,ZHOOK_HANDLE) 00420 ! 00421 NMOMENT = INT(SIZE(PSFDST,2) / NDSTMDE) 00422 ! 00423 DO JMODE=1,NDSTMDE 00424 !Make sure dust mass emission is put in index 2, 5, 8 etc if 3 moments per mode 00425 !Make sure dust mass emission is put in index 2, 4, 6 etc if 2 moments per mode 00426 IF (NMOMENT == 1) THEN 00427 JSV_IDX = (JMODE-1)*NMOMENT + 1 !Counter for scalar variable 00428 ELSE 00429 JSV_IDX = (JMODE-1)*NMOMENT + 2 !Counter for scalar variable 00430 END IF 00431 00432 !Start loop on number of dust emitter surfaces 00433 DO JJ=1,KTILE 00434 !Loop on points inside patch 00435 DO II=1,KI 00436 00437 !Get sum of vegetation fraction in this patch 00438 !fxm: VERY BAD LOOP ORDER 00439 VEGFRAC_IN_PATCH = SUM(XP_VEGTYPE_PATCH(II,:)) 00440 00441 !Get production of flux by adding up the contribution 00442 !from the different tiles (here, "tiles" are dust emitter surfaces) 00443 PSFDST(II,JSV_IDX) = PSFDST(II,JSV_IDX) & ![kg/m^2_{patch}/sec] dust flux per patch 00444 + (ZSFDST_TILE(II,JJ,JMODE) & ![kg/m^2_{emittersurface}/sec] Dust flux per surface area of dust emitter surface 00445 * XP_VEGTYPE_PATCH(II,NVT_DST(JJ)) & ![frc] m^2_{emittersurface}/m^2_{nature} 00446 / VEGFRAC_IN_PATCH ) ![frc] m^2_{patch}/m^2_{nature} 00447 ENDDO !loop on point in patch 00448 ENDDO !loop on different dust emitter surfaces 00449 00450 ENDDO !Loop on modes 00451 00452 IF (LHOOK) CALL DR_HOOK('AVG_FLUX_DST',1,ZHOOK_HANDLE) 00453 00454 END SUBROUTINE AVG_FLUX_DST 00455 00456 END SUBROUTINE COUPLING_DST_n 00457
1.8.0
