|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_FLAKE_n(HPROGRAM, HCOUPLING, & 00003 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, & 00004 PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, & 00005 HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, & 00006 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & 00007 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00008 PPEW_A_COEF, PPEW_B_COEF, & 00009 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, & 00010 HTEST ) 00011 ! ############################################################################### 00012 00013 ! 00014 !!**** *COUPLING_FLAKE_n * - Driver for FLAKE scheme for lakes 00015 !! 00016 !! PURPOSE 00017 !! ------- 00018 ! 00019 !!** METHOD 00020 !! ------ 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! 00025 !! 00026 !! AUTHOR 00027 !! ------ 00028 !! V. Masson 00029 !! 00030 !! MODIFICATIONS 00031 !! ------------- 00032 !! Original 01/2004 00033 !! V. Masson 05/2009 Implicitation of momentum fluxes 00034 !! B. Decharme 01/2010 Add XTT in water_flux 00035 !! V. Masson 11/2011 Ch limited to 1.E-7 in all cases and Cd coming from 00036 !! Flake_interface routine if computed by flake 00037 !! B. Decharme 09/2012 New wind implicitation 00038 !! P. Le Moigne 10/2012 ECUME option for FLake. Remove wind threshold 00039 !!------------------------------------------------------------------ 00040 ! 00041 USE MODD_SURF_ATM, ONLY : CIMPLICIT_WIND 00042 ! 00043 USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XLVTT, XKARMAN, XTT, XTTS 00044 USE MODD_SURF_PAR, ONLY : XUNDEF 00045 ! 00046 USE MODD_FLAKE_n, ONLY : TTIME , XEMIS , XWATER_DEPTH , & 00047 XWATER_FETCH , XT_BS , XDEPTH_BS , & 00048 XCORIO , XDIR_ALB , XSCA_ALB , & 00049 XICE_ALB , XSNOW_ALB , XEXTCOEF_WATER, & 00050 XEXTCOEF_ICE , XEXTCOEF_SNOW , XT_SNOW , & 00051 XT_ICE , XT_MNW , XT_WML , & 00052 XT_BOT , XT_B1 , XCT , & 00053 XH_SNOW , XH_ICE , XH_ML , & 00054 XH_B1 , XTS , XZ0 , & 00055 XUSTAR , LSEDIMENTS , CFLK_FLUX , & 00056 CFLK_ALB , XICHCE , LPRECIP , & 00057 LPWEBB 00058 ! 00059 !salgado - keep the same ch_ routines and modules used in watflux_n 00060 USE MODD_CH_WATFLUX_n, ONLY : CSV, CCH_DRY_DEP, XDEP, NBEQ, NSV_CHSBEG, NSV_CHSEND,& 00061 NSV_DSTBEG, NSV_DSTEND, NAEREQ, NDSTEQ, NSLTEQ, & 00062 NSV_AERBEG, NSV_AEREND, NSV_SLTBEG, NSV_SLTEND 00063 ! 00064 USE MODD_SLT_SURF 00065 USE MODD_DST_SURF 00066 USE MODD_SLT_n, ONLY: XEMISRADIUS_SLT,XEMISSIG_SLT 00067 USE MODD_DST_n, ONLY: XEMISRADIUS_DST,XEMISSIG_DST 00068 ! 00069 USE MODE_DSLT_SURF 00070 USE MODE_THERMOS 00071 ! 00072 USE MODI_WATER_FLUX 00073 USE MODI_ECUME_SEAFLUX 00074 USE MODI_ADD_FORECAST_TO_DATE_SURF 00075 USE MODI_DIAG_INLINE_FLAKE_n 00076 USE MODI_DIAG_MISC_FLAKE_n 00077 USE MODI_CH_AER_DEP 00078 USE MODI_CH_DEP_WATER 00079 USE MODI_DSLT_DEP 00080 USE MODI_FLAKE_ALBEDO 00081 USE MODI_UPDATE_RAD_SEAWAT 00082 USE MODI_ABOR1_SFX 00083 USE MODI_FLAKE_INTERFACE 00084 ! 00085 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00086 USE PARKIND1 ,ONLY : JPRB 00087 ! 00088 ! 00089 IMPLICIT NONE 00090 ! 00091 !* 0.1 declarations of arguments 00092 ! 00093 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00094 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00095 ! 'E' : explicit 00096 ! 'I' : implicit 00097 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00098 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00099 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00100 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00101 INTEGER, INTENT(IN) :: KI ! number of points 00102 INTEGER, INTENT(IN) :: KSV ! number of scalars 00103 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00104 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00105 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00106 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00107 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00108 ! 00109 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00110 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00111 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00112 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00113 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00114 ! ! 00115 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00116 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00117 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00118 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00119 ! ! (W/m2) 00120 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00121 ! ! (W/m2) 00122 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00123 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) 00124 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1 (radian from the vertical) 00125 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00126 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00127 ! ! (W/m2) 00128 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00129 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00130 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00131 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00132 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00133 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00134 ! 00135 ! 00136 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00137 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00138 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00139 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00140 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00141 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00142 ! 00143 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00144 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00145 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00146 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00147 ! 00148 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients (m2s/kg) 00149 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' (m/s) 00150 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00151 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00152 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00153 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00154 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00155 ! 00156 !* 0.2 declarations of local variables 00157 ! 00158 REAL, DIMENSION(KI,KSW) :: ZDIR_ALB ! Direct albedo at time t , 00159 REAL, DIMENSION(KI,KSW) :: ZSCA_ALB ! Diffuse albedo at time t 00160 ! 00161 REAL, DIMENSION(KI) :: ZEMIS ! Emissivity at time t 00162 REAL, DIMENSION(KI) :: ZTRAD ! Radiative temperature at time t 00163 REAL, DIMENSION(KI) :: ZALB ! surface albedo 00164 ! 00165 REAL, DIMENSION(KI) :: ZEXNA ! Exner function at forcing level 00166 REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface level 00167 ! 00168 REAL, DIMENSION(KI) :: ZWIND ! Wind 00169 REAL, DIMENSION(KI) :: ZGLOBAL_SW ! Solar radiation flux at the surface (W/m2) 00170 REAL, DIMENSION(KI) :: ZQA ! Air specific humidity (kg/kg) 00171 ! 00172 REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s) 00173 REAL, DIMENSION(KI) :: ZUSTAR2! square of friction velocity (m2/s2) 00174 REAL, DIMENSION(KI) :: ZSFM ! flux of momentum (Pa) 00175 ! 00176 REAL, DIMENSION(KI) :: ZRESA_WATER ! aerodynamical resistance 00177 ! 00178 !salgado only for inline diagnostics - not used for the moment 00179 ! flake don't have it 00180 REAL, DIMENSION(KI) :: ZCD ! Drag coefficient 00181 REAL, DIMENSION(KI) :: ZCDN ! Neutral Drag coefficient 00182 REAL, DIMENSION(KI) :: ZCH ! Heat transfer coefficient 00183 REAL, DIMENSION(KI) :: ZCE ! Heat transfer coefficient 00184 REAL, DIMENSION(KI) :: ZRI ! Richardson number 00185 REAL, DIMENSION(KI) :: ZHU ! Near surface relative humidity 00186 REAL, DIMENSION(KI) :: ZZ0 ! roughness length 00187 REAL, DIMENSION(KI) :: ZZ0H ! heat roughness length 00188 REAL, DIMENSION(KI) :: ZQSAT ! humidity at saturation 00189 REAL, DIMENSION(KI) :: ZTSTEP ! time-step 00190 ! 00191 REAL, DIMENSION(KI) :: ZMASK ! 00192 ! 00193 REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST 00194 REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST 00195 REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST 00196 ! 00197 INTEGER :: ISWB ! number of shortwave spectral bands 00198 INTEGER :: JSWB ! loop counter on shortwave spectral bands 00199 ! 00200 INTEGER :: ISIZE_WATER! number of points of lake water 00201 INTEGER :: ISIZE_ICE ! and of lake ice 00202 ! 00203 INTEGER :: ILUOUT ! output logical unit 00204 ! 00205 LOGICAL :: GPWG = .FALSE. 00206 ! 00207 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00208 !------------------------------------------------------------------------------------- 00209 ! Preliminaries: 00210 !------------------------------------------------------------------------------------- 00211 IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_N',0,ZHOOK_HANDLE) 00212 IF (HTEST/='OK') THEN 00213 CALL ABOR1_SFX('COUPLING_FLAKEN: FATAL ERROR DURING ARGUMENT TRANSFER') 00214 END IF 00215 !------------------------------------------------------------------------------------- 00216 ! Variables needed by flake: 00217 !------------------------------------------------------------------------------------- 00218 ! 00219 ZDIR_ALB (:,:) = XUNDEF 00220 ZSCA_ALB (:,:) = XUNDEF 00221 ZEMIS (:) = XUNDEF 00222 ZTRAD (:) = XUNDEF 00223 ! 00224 ZTSTEP(:) = PTSTEP 00225 ! 00226 ZEXNS(:) = (PPS(:)/XP00)**(XRD/XCPD) 00227 ZEXNA(:) = (PPA(:)/XP00)**(XRD/XCPD) 00228 ! 00229 ! 00230 ZWIND(:) = SQRT(PU(:)**2+PV(:)**2) 00231 ! 00232 ZQA(:) = PQA/PRHOA 00233 ! 00234 PSFTS(:,:) = 0. 00235 ! 00236 ZHU = 1. 00237 ! 00238 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00239 ! Time evolution 00240 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00241 ! 00242 TTIME%TIME = TTIME%TIME + PTSTEP 00243 CALL ADD_FORECAST_TO_DATE_SURF(TTIME%TDATE%YEAR,TTIME%TDATE%MONTH,TTIME%TDATE%DAY,TTIME%TIME) 00244 ! 00245 !---------------------------------------- 00246 ZMASK(:) = XTS(:) - XTTS 00247 ISIZE_WATER = COUNT(ZMASK(:)>=0.) 00248 ISIZE_ICE = SIZE(XTS) - ISIZE_WATER 00249 ! 00250 PSFU = 0. 00251 PSFV = 0. 00252 ZSFM = 0. 00253 ! 00254 SELECT CASE (CFLK_FLUX) 00255 CASE ('DEF ') 00256 CALL WATER_FLUX(XZ0, & 00257 PTA, ZEXNA, PRHOA, XTS, ZEXNS, PQA,PRAIN, PSNOW, & 00258 XTT, ZWIND, PZREF, PUREF, & 00259 PPS, ZQSAT, & 00260 PSFTH, PSFTQ, ZUSTAR, & 00261 ZCD, ZCDN, ZCH, ZRI, ZRESA_WATER, ZZ0H ) 00262 00263 CASE ('ECUME') 00264 CALL ECUME_SEAFLUX(XZ0, ZMASK, ISIZE_WATER, ISIZE_ICE, & 00265 PTA, ZEXNA ,PRHOA, XTS, ZEXNS, ZQA, PRAIN, & 00266 PSNOW, & 00267 ZWIND, PZREF, PUREF, & 00268 PPS, XICHCE, LPRECIP,LPWEBB, GPWG, ZQSAT, & 00269 PSFTH, PSFTQ, ZUSTAR, & 00270 ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_WATER, ZZ0H ) 00271 00272 END SELECT 00273 ! 00274 IF (CFLK_FLUX=='DEF ' .OR. CFLK_FLUX=='ECUME') THEN 00275 ! 00276 IF(CIMPLICIT_WIND=='OLD')THEN 00277 ! old implicitation (m2/s2) 00278 ZUSTAR2(:) = (ZCD(:)*ZWIND(:)*PPEW_B_COEF(:))/ & 00279 (1.0-PRHOA(:)*ZCD(:)*ZWIND(:)*PPEW_A_COEF(:)) 00280 ELSE 00281 ! new implicitation (m2/s2) 00282 ZUSTAR2(:) = (ZCD(:)*ZWIND(:)*(2.*PPEW_B_COEF(:)-ZWIND(:))) /& 00283 (1.0-2.0*PRHOA(:)*ZCD(:)*ZWIND(:)*PPEW_A_COEF(:)) 00284 00285 00286 ! 00287 ZWIND(:) = PRHOA(:)*PPEW_A_COEF(:)*ZUSTAR2(:) + PPEW_B_COEF(:) 00288 ZWIND(:) = MAX(ZWIND(:),0.) 00289 ! 00290 WHERE(PPEW_A_COEF(:)/= 0.) 00291 ZUSTAR2(:) = MAX( ( ZWIND(:) - PPEW_B_COEF(:) ) / (PRHOA(:)*PPEW_A_COEF(:)), 0.) 00292 ENDWHERE 00293 ! 00294 ENDIF 00295 ! 00296 WHERE (ZWIND(:)>0.) 00297 ZSFM(:) = - PRHOA(:) * ZUSTAR2(:) 00298 PSFU(:) = ZSFM(:) * PU(:) / ZWIND(:) 00299 PSFV(:) = ZSFM(:) * PV(:) / ZWIND(:) 00300 END WHERE 00301 ! 00302 ! PSFTQ become temporarly the flux of heat flux (W/m2) 00303 PSFTQ = PSFTQ * XLVTT 00304 ! 00305 ELSE 00306 ZUSTAR(:) = XUSTAR(:) 00307 ENDIF 00308 ! 00309 !-------------------------------------------------------------------------------------- 00310 ! Call FLake 00311 ! to compute Fluxes over water if CFLK_FLUX=='FLAKE' 00312 ! to actualize FLake variables, namely water surface temperature 00313 !-------------------------------------------------------------------------------------- 00314 ! 00315 ZZ0 = XZ0 00316 ! 00317 !---------------------------------------- 00318 !radiative properties at t 00319 !---------------------------------------- 00320 ! 00321 ISWB = SIZE(PSW_BANDS) 00322 ! 00323 DO JSWB=1,ISWB 00324 ZDIR_ALB(:,JSWB) = XDIR_ALB(:) 00325 ZSCA_ALB(:,JSWB) = XSCA_ALB(:) 00326 END DO 00327 ! 00328 ZEMIS = XEMIS 00329 ! 00330 CALL FLAKE_ALBEDO(PDIR_SW,PSCA_SW,KSW,ZDIR_ALB,ZSCA_ALB,ZGLOBAL_SW,ZALB) 00331 ! 00332 CALL FLAKE_INTERFACE( KI, & 00333 ! Atmospheric forcing: 00334 PSNOW, ZGLOBAL_SW, PLW, PUREF, PZREF, ZWIND, PTA, ZQA, PPS, & 00335 ! Constant parameters 00336 XWATER_DEPTH, XWATER_FETCH, XDEPTH_BS, XT_BS, XCORIO,& 00337 ZTSTEP, & 00338 ! surface albedo 00339 ZEMIS, ZALB, & 00340 ! Parameters that may change (constants for the moment) 00341 XICE_ALB, XSNOW_ALB, XEXTCOEF_WATER, & 00342 XEXTCOEF_ICE, XEXTCOEF_SNOW, & 00343 ! Flake variables 00344 XT_SNOW, XT_ICE, XT_MNW, XT_WML, XT_BOT, XT_B1, XCT, & 00345 XH_SNOW, XH_ICE, XH_ML, XH_B1, XTS, & 00346 ! Surface heat and momentum fluxes 00347 PSFTH, PSFTQ, ZSFM, ZZ0, ZZ0H, ZRI, ZUSTAR, ZCD, & 00348 ! Flags 00349 LSEDIMENTS, CFLK_FLUX, PPEW_A_COEF, PPEW_B_COEF, & 00350 PRHOA, CIMPLICIT_WIND ) 00351 ! 00352 IF (CFLK_FLUX=='FLAKE') then 00353 XZ0 = ZZ0 00354 ENDIF 00355 ! 00356 !------------------------------------------------------------------------------------- 00357 ! Outputs: 00358 !------------------------------------------------------------------------------------- 00359 ! 00360 ! Momentum fluxes 00361 ! 00362 IF (CFLK_FLUX=='FLAKE') THEN 00363 PSFU = 0. 00364 PSFV = 0. 00365 WHERE (ZWIND(:)>0.) 00366 PSFU(:) = ZSFM(:) * PU(:) / ZWIND(:) 00367 PSFV(:) = ZSFM(:) * PV(:) / ZWIND(:) 00368 END WHERE 00369 ! 00370 ! 00371 ! ZUSTAR and ZRESA_WATER are not in Flake but are needed to the ch_* routines 00372 ! 00373 ZUSTAR(:) = SQRT (ABS(ZSFM(:))/PRHOA(:)) 00374 ZEXNS (:) = (PPS(:)/XP00)**(XRD/XCPD) 00375 ZEXNA (:) = (PPA(:)/XP00)**(XRD/XCPD) 00376 ZRESA_WATER=2.E4 00377 WHERE (PSFTH/=0.) 00378 ZRESA_WATER (:) = XCPD * PRHOA(:) * (XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:)) & 00379 / (PSFTH(:) * ZEXNS(:)) 00380 END WHERE 00381 ! 00382 ENDIF 00383 ! 00384 XUSTAR(:) = ZUSTAR(:) 00385 ! 00386 ! flux of water vapor (kg/m2/s) 00387 PSFTQ = PSFTQ / XLVTT 00388 ! 00389 ! CO2 flux 00390 ! 00391 PSFCO2(:) = 0.0 ! Assumes no CO2 emission over water bodies 00392 ! 00393 !---------------------------------------- 00394 !radiative properties at t 00395 !---------------------------------------- 00396 ! 00397 ZTRAD = XTS 00398 ! 00399 !------------------------------------------------------------------------------------- 00400 ! Scalar fluxes: 00401 !------------------------------------------------------------------------------------- 00402 ! 00403 ! 00404 !salgado The scalar fluxes are computed as in watflux 00405 IF (NBEQ>0) THEN 00406 IF (CCH_DRY_DEP == "WES89") THEN 00407 CALL CH_DEP_WATER (ZRESA_WATER, ZUSTAR, PTA, PTRAD, & 00408 PSV(:,NSV_CHSBEG:NSV_CHSEND), & 00409 CSV(NSV_CHSBEG:NSV_CHSEND), & 00410 XDEP(:,1:NBEQ) ) 00411 00412 PSFTS(:,NSV_CHSBEG:NSV_CHSEND) = - PSV(:,NSV_CHSBEG:NSV_CHSEND) & 00413 * XDEP(:,1:NBEQ) 00414 IF (NAEREQ > 0 ) THEN 00415 CALL CH_AER_DEP(PSV(:,NSV_AERBEG:NSV_AEREND),& 00416 PSFTS(:,NSV_AERBEG:NSV_AEREND),& 00417 ZUSTAR,ZRESA_WATER,PTA,PRHOA) 00418 END IF 00419 00420 ELSE 00421 PSFTS(:,NSV_CHSBEG:NSV_CHSEND) =0. 00422 IF(NSV_AERBEG.LT.NSV_AEREND) PSFTS(:,NSV_AERBEG:NSV_AEREND) =0. 00423 ENDIF 00424 ENDIF 00425 00426 IF (NDSTEQ>0) THEN 00427 CALL DSLT_DEP(PSV(:,NSV_DSTBEG:NSV_DSTEND), PSFTS(:,NSV_DSTBEG:NSV_DSTEND), & 00428 ZUSTAR, ZRESA_WATER, PTA, PRHOA, XEMISSIG_DST, XEMISRADIUS_DST, & 00429 JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, & 00430 ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, & 00431 CVERMOD ) 00432 00433 CALL MASSFLUX2MOMENTFLUX( & 00434 PSFTS(:,NSV_DSTBEG:NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 00435 PRHOA, & !I [kg/m3] air density 00436 XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3) 00437 XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3) 00438 NDSTMDE, & 00439 ZCONVERTFACM0_DST, & 00440 ZCONVERTFACM6_DST, & 00441 ZCONVERTFACM3_DST, & 00442 LVARSIG_DST, LRGFIX_DST ) 00443 ENDIF 00444 00445 00446 IF (NSLTEQ>0) THEN 00447 CALL DSLT_DEP(PSV(:,NSV_SLTBEG:NSV_SLTEND), PSFTS(:,NSV_SLTBEG:NSV_SLTEND), & 00448 ZUSTAR, ZRESA_WATER, PTA, PRHOA, XEMISSIG_SLT, XEMISRADIUS_SLT, & 00449 JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, & 00450 ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, & 00451 CVERMOD ) 00452 00453 CALL MASSFLUX2MOMENTFLUX( & 00454 PSFTS(:,NSV_SLTBEG:NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 00455 PRHOA, & !I [kg/m3] air density 00456 XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3) 00457 XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3) 00458 NSLTMDE, & 00459 ZCONVERTFACM0_SLT, & 00460 ZCONVERTFACM6_SLT, & 00461 ZCONVERTFACM3_SLT, & 00462 LVARSIG_SLT, LRGFIX_SLT ) 00463 ENDIF 00464 00465 ! 00466 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00467 ! Inline diagnostics 00468 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00469 ! 00470 IF (CFLK_FLUX=='FLAKE') THEN !compute some variables not present in FLake code 00471 ZCH = 1.E-7 00472 ! 00473 WHERE (ABS((XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:))) > 1.E-2 .AND. ZWIND(:)/=0.) 00474 ZCH = MAX(1.E-7,PSFTH / (XCPD * PRHOA(:) * ZWIND(:) * (XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:))) * ZEXNS(:)) 00475 END WHERE 00476 ! 00477 ! 00478 ZCDN = (XKARMAN/LOG(PUREF(:)/XZ0(:)))**2 00479 ! 00480 ZQSAT(:) = QSAT(XTS(:),PPS(:)) 00481 ENDIF 00482 ! 00483 CALL DIAG_INLINE_FLAKE_n(PTA, XTS, ZQA, PPA, PPS, PRHOA, PU, PV, PZREF, PUREF, & 00484 ZCD, ZCDN, ZCH, ZRI, ZHU, XZ0, ZZ0H, ZQSAT, & 00485 PSFTH, PSFTQ, PSFU, PSFV, PDIR_SW, PSCA_SW, PLW, & 00486 ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTRAD ) 00487 ! 00488 !------------------------------------------------------------------------------------- 00489 ! 00490 CALL DIAG_MISC_FLAKE_n(XT_WML,XT_BOT,XH_ML,XCT,XWATER_DEPTH) 00491 ! 00492 CALL UPDATE_RAD_SEAWAT(CFLK_ALB,XTS,PZENITH2,XTT,XEMIS,XDIR_ALB, & 00493 XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD ) 00494 ! 00495 IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_N',1,ZHOOK_HANDLE) 00496 ! 00497 !------------------------------------------------------------------------------------- 00498 ! 00499 END SUBROUTINE COUPLING_FLAKE_n
1.8.0
