|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_SEAFLUX_n(HPROGRAM, HCOUPLING, & 00003 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, & 00004 PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, & 00005 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 !!**** *COUPLING_SEAFLUX_n * - Driver of the WATER_FLUX scheme for sea 00014 !! 00015 !! PURPOSE 00016 !! ------- 00017 ! 00018 !!** METHOD 00019 !! ------ 00020 !! 00021 !! REFERENCE 00022 !! --------- 00023 !! 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! V. Masson 00028 !! 00029 !! MODIFICATIONS 00030 !! ------------- 00031 !! Original 01/2004 00032 !! Modified 01/2006 : sea flux parameterization. 00033 !! Modified 09/2006 : P. Tulet Introduce Sea salt aerosol Emission/Deposition 00034 !! Modified 03/2009 : B. Decharme SST could change during a run => ALB and EMIS 00035 !! Modified 05/2009 : V. Masson : implicitation of momentum fluxes 00036 !! Modified 09/2009 : B. Decharme Radiative properties at time t+1 00037 !! Modified 01/2010 : B. Decharme Add XTTS 00038 !! Modified 09/2012 : B. Decharme New wind implicitation 00039 !! Modified 10/2012 : P. Le Moigne CMO1D update 00040 !!--------------------------------------------------------------------- 00041 ! 00042 USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XLVTT, XTT, XTTS, XDAY 00043 USE MODD_SURF_PAR, ONLY : XUNDEF 00044 USE MODD_SURF_ATM, ONLY : LCPL_ESM, CIMPLICIT_WIND 00045 ! 00046 USE MODD_DATA_SEAFLUX_n, ONLY : LSST_DATA 00047 USE MODD_SEAFLUX_n, ONLY : XSST, XTICE, XZ0, XDIR_ALB, XSCA_ALB, XEMIS, TTIME, & 00048 CSEA_ALB, CSEA_FLUX, XUMER, XVMER, LINTERPOL_SST, & 00049 XICHCE, LPRECIP, LPWEBB , LPWG 00050 00051 USE MODD_OCEAN_n, ONLY : LMERCATOR 00052 USE MODD_CH_SEAFLUX_n, ONLY : CSV, CCH_DRY_DEP, XDEP, NBEQ, NSV_CHSBEG, NSV_CHSEND,& 00053 NSV_DSTBEG, NSV_DSTEND, NAEREQ, NDSTEQ, NSLTEQ, & 00054 NSV_AERBEG, NSV_AEREND, NSV_SLTBEG, NSV_SLTEND 00055 ! 00056 USE MODI_WATER_FLUX 00057 USE MODI_MR98 00058 USE MODI_ECUME_SEAFLUX 00059 USE MODI_COARE30_SEAFLUX 00060 USE MODI_ADD_FORECAST_TO_DATE_SURF 00061 USE MODI_MOD1D_n 00062 USE MODI_DIAG_INLINE_SEAFLUX_n 00063 USE MODI_CH_AER_DEP 00064 USE MODI_CH_DEP_WATER 00065 USE MODI_DSLT_DEP 00066 USE MODI_SST_UPDATE 00067 USE MODI_INTERPOL_SST_MTH 00068 USE MODI_UPDATE_RAD_SEAWAT 00069 ! 00070 USE MODE_DSLT_SURF 00071 USE MODD_DST_SURF 00072 USE MODD_SLT_SURF 00073 USE MODD_DST_n, ONLY: XEMISRADIUS_DST, XEMISSIG_DST 00074 USE MODD_SLT_n, ONLY: XEMISRADIUS_SLT, XEMISSIG_SLT 00075 ! 00076 USE MODD_SEAFLUX_GRID_n, ONLY : XLAT 00077 USE MODD_OCEAN_GRID_n, ONLY : NOCKMIN 00078 USE MODD_OCEAN_REL_n, ONLY : XSEAT_REL 00079 ! 00080 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00081 USE PARKIND1 ,ONLY : JPRB 00082 ! 00083 USE MODI_ABOR1_SFX 00084 ! 00085 USE MODI_COUPLING_ICEFLUX_n 00086 ! 00087 USE MODI_COUPLING_SLT_n 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) :: ZEXNA ! Exner function at forcing level 00162 REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface level 00163 REAL, DIMENSION(KI) :: ZU ! zonal wind 00164 REAL, DIMENSION(KI) :: ZV ! meridian wind 00165 REAL, DIMENSION(KI) :: ZWIND ! Wind 00166 REAL, DIMENSION(KI) :: ZCD ! Drag coefficient 00167 REAL, DIMENSION(KI) :: ZCDN ! Neutral Drag coefficient 00168 REAL, DIMENSION(KI) :: ZCH ! Heat transfer coefficient 00169 REAL, DIMENSION(KI) :: ZCE ! Vaporization heat transfer coefficient 00170 REAL, DIMENSION(KI) :: ZRI ! Richardson number 00171 REAL, DIMENSION(KI) :: ZHU ! Near surface relative humidity 00172 REAL, DIMENSION(KI) :: ZRESA_SEA ! aerodynamical resistance 00173 REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s) 00174 REAL, DIMENSION(KI) :: ZUSTAR2 ! square of friction velocity (m2/s2) 00175 REAL, DIMENSION(KI) :: ZZ0H ! heat roughness length over sea 00176 REAL, DIMENSION(KI) :: ZQSAT ! humidity at saturation 00177 REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) 00178 REAL, DIMENSION(KI) :: ZEMIS ! Emissivity at time t 00179 REAL, DIMENSION(KI) :: ZTRAD ! Radiative temperature at time t 00180 REAL, DIMENSION(KI) :: ZSFTH_ICE ! Sea ice flux of heat 00181 REAL, DIMENSION(KI) :: ZSFTQ_ICE ! Sea ice flux of ice sublimation 00182 ! 00183 REAL, DIMENSION(KI) :: ZMASK 00184 ! 00185 REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST 00186 REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST 00187 REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST 00188 ! 00189 INTEGER :: ISIZE_WATER ! number of points of sea water 00190 INTEGER :: ISIZE_ICE ! and of sea ice 00191 ! 00192 INTEGER :: ISWB ! number of shortwave spectral bands 00193 INTEGER :: JSWB ! loop counter on shortwave spectral bands 00194 INTEGER :: ISLT ! number of sea salt variable 00195 ! 00196 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00197 !------------------------------------------------------------------------------------- 00198 ! Preliminaries: 00199 !------------------------------------------------------------------------------------- 00200 IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',0,ZHOOK_HANDLE) 00201 IF (HTEST/='OK') THEN 00202 CALL ABOR1_SFX('COUPLING_SEAFLUXN: FATAL ERROR DURING ARGUMENT TRANSFER') 00203 END IF 00204 !------------------------------------------------------------------------------------- 00205 ! 00206 ZEXNA (:) = XUNDEF 00207 ZEXNS (:) = XUNDEF 00208 ZU (:) = XUNDEF 00209 ZV (:) = XUNDEF 00210 ZWIND (:) = XUNDEF 00211 ZCD (:) = XUNDEF 00212 ZCDN (:) = XUNDEF 00213 ZCH (:) = XUNDEF 00214 ZCE (:) = XUNDEF 00215 ZRI (:) = XUNDEF 00216 ZHU (:) = XUNDEF 00217 ZRESA_SEA(:) = XUNDEF 00218 ZUSTAR (:) = XUNDEF 00219 ZUSTAR2 (:) = XUNDEF 00220 ZZ0H (:) = XUNDEF 00221 ZQSAT (:) = XUNDEF 00222 ZEMIS (:) = XUNDEF 00223 ZTRAD (:) = XUNDEF 00224 ZDIR_ALB (:,:) = XUNDEF 00225 ZSCA_ALB (:,:) = XUNDEF 00226 ! 00227 IF(LCPL_ESM)THEN 00228 ZSFTQ_ICE(:) = XUNDEF 00229 ZSFTH_ICE(:) = XUNDEF 00230 ENDIF 00231 ! 00232 !------------------------------------------------------------------------------------- 00233 ! 00234 ZEXNS(:) = (PPS(:)/XP00)**(XRD/XCPD) 00235 ZEXNA(:) = (PPA(:)/XP00)**(XRD/XCPD) 00236 ! 00237 IF(LCPL_ESM)THEN 00238 !Sea currents are taken into account 00239 ZU(:)=PU(:)-XUMER(:) 00240 ZV(:)=PV(:)-XVMER(:) 00241 ELSE 00242 ZU(:)=PU(:) 00243 ZV(:)=PV(:) 00244 ENDIF 00245 ! 00246 ZWIND(:) = SQRT(ZU(:)**2+ZV(:)**2) 00247 ! 00248 PSFTS(:,:) = 0. 00249 ! 00250 ZHU = 1. 00251 ! 00252 ZQA(:) = PQA(:) / PRHOA(:) 00253 ! 00254 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00255 ! update sea surface temperature 00256 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00257 ! 00258 IF (LSST_DATA .AND. (.NOT. LMERCATOR)) CALL SST_UPDATE(XSST, TTIME) 00259 ! 00260 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00261 ! Time evolution 00262 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00263 ! 00264 TTIME%TIME = TTIME%TIME + PTSTEP 00265 CALL ADD_FORECAST_TO_DATE_SURF(TTIME%TDATE%YEAR,TTIME%TDATE%MONTH,TTIME%TDATE%DAY,TTIME%TIME) 00266 ! 00267 !-------------------------------------------------------------------------------------- 00268 ! Fluxes over water according to Charnock formulae 00269 !-------------------------------------------------------------------------------------- 00270 ! 00271 ZMASK(:) = XSST(:) - XTTS 00272 ISIZE_WATER = COUNT(ZMASK(:)>=0.) 00273 ISIZE_ICE = SIZE(XSST) - ISIZE_WATER 00274 ! 00275 SELECT CASE (CSEA_FLUX) 00276 CASE ('DIRECT') 00277 CALL WATER_FLUX(XZ0, & 00278 PTA, ZEXNA, PRHOA, XSST, ZEXNS, ZQA, PRAIN, & 00279 PSNOW, XTTS, & 00280 ZWIND, PZREF, PUREF, & 00281 PPS, ZQSAT, & 00282 PSFTH, PSFTQ, ZUSTAR, & 00283 ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H ) 00284 CASE ('ITERAT') 00285 CALL MR98 (XZ0, & 00286 PTA, ZEXNA, PRHOA, XSST, ZEXNS, ZQA, & 00287 XTTS, & 00288 ZWIND, PZREF, PUREF, & 00289 PPS, ZQSAT, & 00290 PSFTH, PSFTQ, ZUSTAR, & 00291 ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H ) 00292 00293 CASE ('ECUME ') 00294 CALL ECUME_SEAFLUX(XZ0, ZMASK, ISIZE_WATER, ISIZE_ICE, & 00295 PTA, ZEXNA ,PRHOA, XSST, ZEXNS, ZQA, PRAIN, & 00296 PSNOW, & 00297 ZWIND, PZREF, PUREF, & 00298 PPS, XICHCE, LPRECIP, LPWEBB, LPWG, ZQSAT, & 00299 PSFTH, PSFTQ, ZUSTAR, & 00300 ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H ) 00301 00302 CASE ('COARE3') 00303 CALL COARE30_SEAFLUX(XZ0, ZMASK, ISIZE_WATER, ISIZE_ICE, & 00304 PTA, ZEXNA ,PRHOA, XSST, ZEXNS, ZQA, PRAIN, & 00305 PSNOW, & 00306 ZWIND, PZREF, PUREF, & 00307 PPS, ZQSAT, & 00308 PSFTH, PSFTQ, ZUSTAR, & 00309 ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H ) 00310 END SELECT 00311 ! 00312 !------------------------------------------------------------------------------------- 00313 ! Outputs: 00314 !------------------------------------------------------------------------------------- 00315 ! 00316 ! Momentum fluxes 00317 ! 00318 IF(CIMPLICIT_WIND=='OLD')THEN 00319 ! old implicitation (m2/s2) 00320 ZUSTAR2(:) = (ZCD(:)*ZWIND(:)*PPEW_B_COEF(:)) / & 00321 (1.0-PRHOA(:)*ZCD(:)*ZWIND(:)*PPEW_A_COEF(:)) 00322 ELSE 00323 ! new implicitation (m2/s2) 00324 ZUSTAR2(:) = (ZCD(:)*ZWIND(:)*(2.*PPEW_B_COEF(:)-ZWIND(:))) /& 00325 (1.0-2.0*PRHOA(:)*ZCD(:)*ZWIND(:)*PPEW_A_COEF(:)) 00326 ! 00327 ZWIND(:) = PRHOA(:)*PPEW_A_COEF(:)*ZUSTAR2(:) + PPEW_B_COEF(:) 00328 ZWIND(:) = MAX(ZWIND(:),0.) 00329 ! 00330 WHERE(PPEW_A_COEF(:)/= 0.) 00331 ZUSTAR2(:) = MAX( ( ZWIND(:) - PPEW_B_COEF(:) ) / (PRHOA(:)*PPEW_A_COEF(:)), 0.) 00332 ENDWHERE 00333 ! 00334 ENDIF 00335 ! 00336 PSFU = 0. 00337 PSFV = 0. 00338 WHERE (ZWIND(:)>0.) 00339 PSFU(:) = - PRHOA(:) * ZUSTAR2(:) * ZU(:) / ZWIND(:) 00340 PSFV(:) = - PRHOA(:) * ZUSTAR2(:) * ZV(:) / ZWIND(:) 00341 END WHERE 00342 ! 00343 ! CO2 flux 00344 ! 00345 ! PSFCO2 = E * deltapCO2 00346 ! According to Wanninkhof (medium hypothesis) : 00347 ! E = 1.13.10^-3 * WIND^2 CO2mol.m-2.yr-1.µatm-1 00348 ! = 1.13.10^-3 * WIND^2 * Mco2.10^-3 * (1/365*24*3600) 00349 ! deltapCO2 = -8.7 µatm (Table 1 half hypothesis) 00350 00351 PSFCO2(:) = - ZWIND(:)**2 * 1.13E-3 * 8.7 * 44.E-3 / ( 365*24*3600 ) 00352 ! 00353 ! 00354 !------------------------------------------------------------------------------------- 00355 !radiative properties at time t 00356 !------------------------------------------------------------------------------------- 00357 ! 00358 ISWB = SIZE(PSW_BANDS) 00359 ! 00360 DO JSWB=1,ISWB 00361 ZDIR_ALB(:,JSWB) = XDIR_ALB(:) 00362 ZSCA_ALB(:,JSWB) = XSCA_ALB(:) 00363 END DO 00364 ! 00365 ZEMIS = XEMIS 00366 ZTRAD = XSST 00367 ! 00368 !------------------------------------------------------------------------------------- 00369 !Specific fields for GELATO when using earth system model 00370 !(intermediate step before explicit sea and ice fluxes comutation) 00371 !------------------------------------------------------------------------------------- 00372 ! 00373 IF(LCPL_ESM)THEN 00374 CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, XTICE, ZEXNS, & 00375 ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, & 00376 PPS, XSST, XTTS, ZSFTH_ICE, ZSFTQ_ICE ) 00377 ENDIF 00378 ! 00379 !------------------------------------------------------------------------------------- 00380 ! Scalar fluxes: 00381 !------------------------------------------------------------------------------------- 00382 ! 00383 IF (NBEQ>0) THEN 00384 IF (CCH_DRY_DEP == "WES89") THEN 00385 00386 CALL CH_DEP_WATER (ZRESA_SEA, ZUSTAR, PTA, ZTRAD, & 00387 PSV(:,NSV_CHSBEG:NSV_CHSEND), & 00388 CSV(NSV_CHSBEG:NSV_CHSEND), & 00389 XDEP(:,1:NBEQ) ) 00390 00391 PSFTS(:,NSV_CHSBEG:NSV_CHSEND) = - PSV(:,NSV_CHSBEG:NSV_CHSEND) & 00392 * XDEP(:,1:NBEQ) 00393 IF (NAEREQ > 0 ) THEN 00394 CALL CH_AER_DEP(PSV(:,NSV_AERBEG:NSV_AEREND),& 00395 PSFTS(:,NSV_AERBEG:NSV_AEREND),& 00396 ZUSTAR,ZRESA_SEA,PTA,PRHOA) 00397 END IF 00398 00399 ELSE 00400 PSFTS(:,NSV_CHSBEG:NSV_CHSEND) =0. 00401 IF (NSV_AEREND.GT.NSV_AERBEG) PSFTS(:,NSV_AERBEG:NSV_AEREND) =0. 00402 ENDIF 00403 ENDIF 00404 ! 00405 IF (NSLTEQ>0) THEN 00406 ISLT = NSV_SLTEND - NSV_SLTBEG + 1 00407 00408 CALL COUPLING_SLT_n( & 00409 SIZE(ZUSTAR,1), & !I [nbr] number of sea point 00410 ISLT, & !I [nbr] number of sea salt variables 00411 ZWIND, & !I [m/s] wind velocity 00412 PSFTS(:,NSV_SLTBEG:NSV_SLTEND) ) 00413 ENDIF 00414 ! 00415 IF (NDSTEQ>0) THEN 00416 CALL DSLT_DEP(PSV(:,NSV_DSTBEG:NSV_DSTEND), PSFTS(:,NSV_DSTBEG:NSV_DSTEND), & 00417 ZUSTAR, ZRESA_SEA, PTA, PRHOA, XEMISSIG_DST, XEMISRADIUS_DST, & 00418 JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, & 00419 ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, & 00420 CVERMOD ) 00421 00422 CALL MASSFLUX2MOMENTFLUX( & 00423 PSFTS(:,NSV_DSTBEG:NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 00424 PRHOA, & !I [kg/m3] air density 00425 XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3) 00426 XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3) 00427 NDSTMDE, & 00428 ZCONVERTFACM0_DST, & 00429 ZCONVERTFACM6_DST, & 00430 ZCONVERTFACM3_DST, & 00431 LVARSIG_DST, LRGFIX_DST ) 00432 ENDIF 00433 00434 00435 IF (NSLTEQ>0) THEN 00436 CALL DSLT_DEP(PSV(:,NSV_SLTBEG:NSV_SLTEND), PSFTS(:,NSV_SLTBEG:NSV_SLTEND), & 00437 ZUSTAR, ZRESA_SEA, PTA, PRHOA, XEMISSIG_SLT, XEMISRADIUS_SLT, & 00438 JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, & 00439 ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, & 00440 CVERMOD ) 00441 00442 CALL MASSFLUX2MOMENTFLUX( & 00443 PSFTS(:,NSV_SLTBEG:NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 00444 PRHOA, & !I [kg/m3] air density 00445 XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3) 00446 XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3) 00447 NSLTMDE, & 00448 ZCONVERTFACM0_SLT, & 00449 ZCONVERTFACM6_SLT, & 00450 ZCONVERTFACM3_SLT, & 00451 LVARSIG_SLT, LRGFIX_SLT ) 00452 ENDIF 00453 ! 00454 !------------------------------------------------------------------------------- 00455 ! OCEANIC COUPLING 00456 !------------------------------------------------------------------------------- 00457 IF (LMERCATOR) THEN 00458 00459 ! Update SST reference profile for relaxation purpose 00460 IF (LSST_DATA) CALL SST_UPDATE(XSEAT_REL(:,NOCKMIN+1), TTIME) 00461 ! 00462 ! Convert to degree C for ocean model 00463 XSEAT_REL(:,NOCKMIN+1) = XSEAT_REL(:,NOCKMIN+1) - XTT 00464 ! 00465 CALL MOD1D_n(HPROGRAM,PTIME,ZEMIS(:),ZDIR_ALB(:,1:KSW),ZSCA_ALB(:,1:KSW),& 00466 PLW(:),PSCA_SW(:,1:KSW),PDIR_SW(:,1:KSW),PSFTH(:), & 00467 PSFTQ(:),PSFU(:),PSFV(:),PRAIN(:),XSST(:)) 00468 00469 ENDIF 00470 ! 00471 !------------------------------------------------------------------------------- 00472 ! Inline diagnostics at time t 00473 !------------------------------------------------------------------------------- 00474 ! 00475 CALL DIAG_INLINE_SEAFLUX_n(PTSTEP, PTA, XSST, ZQA, PPA, PPS, PRHOA, PU, PV, PZREF,& 00476 PUREF,ZCD, ZCDN, ZCH, ZCE, ZRI, ZHU, XZ0, ZZ0H, ZQSAT, & 00477 PSFTH, PSFTQ, PSFU, PSFV, PDIR_SW, PSCA_SW, PLW, & 00478 ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTRAD, PRAIN, PSNOW, & 00479 XTICE, ZSFTH_ICE, ZSFTQ_ICE ) 00480 ! 00481 !------------------------------------------------------------------------------- 00482 !Radiative properties at time t+1 (see by the atmosphere) in order to close 00483 !the energy budget between surfex and the atmosphere 00484 !------------------------------------------------------------------------------- 00485 ! 00486 IF (LINTERPOL_SST.AND.MOD(TTIME%TIME,XDAY) == 0.) THEN 00487 CALL INTERPOL_SST_MTH(TTIME%TDATE%YEAR,TTIME%TDATE%MONTH,TTIME%TDATE%DAY,XSST) 00488 ENDIF 00489 ! 00490 CALL UPDATE_RAD_SEAWAT(CSEA_ALB,XSST,PZENITH2,XTTS,XEMIS,XDIR_ALB, & 00491 XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD ) 00492 ! 00493 !======================================================================================= 00494 ! 00495 IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',1,ZHOOK_HANDLE) 00496 END SUBROUTINE COUPLING_SEAFLUX_n
1.8.0
