|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ################################################################################# 00002 SUBROUTINE COUPLING_SURF_ATM_n(HPROGRAM, HCOUPLING, PTIMEC, & 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 !!**** *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the 00014 !! four surface types (SEA, WATER, NATURE, TOWN) 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 !! Modified 09/2011 by S.Queguiner: Add total CO2 surface flux (anthropo+biogenic) as diagnostic 00034 !! Modified 11/2011 by S.Queguiner: Add total Chemical surface flux (anthropo) as diagnostic 00035 !!------------------------------------------------------------- 00036 ! 00037 USE MODD_SURF_CONF, ONLY : CPROGNAME 00038 USE MODD_SURF_PAR, ONLY : XUNDEF 00039 USE MODD_CSTS, ONLY : XP00, XCPD, XRD, XAVOGADRO 00040 USE MODD_SURF_ATM_GRID_n,ONLY : XLON 00041 USE MODD_SURF_ATM_n, ONLY : NSIZE_SEA, NSIZE_WATER, NSIZE_TOWN, NSIZE_NATURE, & 00042 NR_SEA, NR_WATER, NR_TOWN, NR_NATURE, & 00043 XSEA, XWATER, XTOWN, XNATURE, & 00044 TTIME, NSIZE_FULL 00045 USE MODD_SURF_ATM_SSO_n, ONLY : CROUGH 00046 USE MODD_DATA_COVER_PAR, ONLY : NTILESFC 00047 USE MODD_SV_n, ONLY : NBEQ,NSV_CHSBEG,NSV_CHSEND, & 00048 NDSTEQ,NSV_DSTBEG,NSV_DSTEND,& 00049 NAEREQ,NSV_AERBEG,NSV_AEREND, CSV 00050 ! 00051 USE MODD_CH_SURF_n, ONLY : LCH_SURF_EMIS, LCH_EMIS, CCH_EMIS 00052 USE MODD_CH_EMIS_FIELD_n,ONLY : TSEMISS 00053 ! 00054 USE MODD_SURFEX_MPI, ONLY : XTIME_SEA, XTIME_WATER, XTIME_NATURE, XTIME_TOWN 00055 ! 00056 USE MODI_ADD_FORECAST_TO_DATE_SURF 00057 USE MODI_AVERAGE_FLUX 00058 USE MODI_AVERAGE_RAD 00059 USE MODI_DIAG_INLINE_SURF_ATM_n 00060 USE MODI_CH_EMISSION_FLUX_n 00061 USE MODI_CH_EMISSION_SNAP_n 00062 USE MODI_CH_EMISSION_TO_ATM_n 00063 USE MODI_SSO_Z0_FRICTION_n 00064 USE MODI_SSO_BE04_FRICTION_n 00065 ! 00066 USE MODI_RW_PRECIP_n 00067 ! 00068 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00069 USE PARKIND1 ,ONLY : JPRB 00070 ! 00071 USE MODI_ABOR1_SFX 00072 ! 00073 USE MODI_COUPLING_INLAND_WATER_n 00074 ! 00075 USE MODI_COUPLING_NATURE_n 00076 ! 00077 USE MODI_COUPLING_SEA_n 00078 ! 00079 USE MODI_COUPLING_TOWN_n 00080 ! 00081 IMPLICIT NONE 00082 ! 00083 #ifndef NOMPI 00084 INCLUDE 'mpif.h' 00085 #endif 00086 ! 00087 !* 0.1 declarations of arguments 00088 ! 00089 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00090 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00091 ! 'E' : explicit 00092 ! 'I' : implicit 00093 REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation 00094 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00095 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00096 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00097 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00098 INTEGER, INTENT(IN) :: KI ! number of points 00099 INTEGER, INTENT(IN) :: KSV ! number of scalars 00100 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00101 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00102 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00103 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00104 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00105 ! 00106 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00107 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00108 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00109 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00110 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00111 ! ! 00112 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00113 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00114 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00115 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00116 ! ! (W/m2) 00117 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00118 ! ! (W/m2) 00119 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00120 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) 00121 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) 00122 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00123 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00124 ! ! (W/m2) 00125 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00126 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00127 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00128 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00129 REAL, DIMENSION(KI), INTENT(INOUT) :: PSNOW ! snow precipitation (kg/m2/s) 00130 REAL, DIMENSION(KI), INTENT(INOUT) :: PRAIN ! liquid precipitation (kg/m2/s) 00131 ! 00132 ! 00133 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00134 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00135 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00136 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00137 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00138 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00139 ! 00140 REAL, DIMENSION(KI), INTENT(INOUT) :: PTRAD ! radiative temperature (K) 00141 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00142 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00143 REAL, DIMENSION(KI), INTENT(INOUT) :: PEMIS ! emissivity (-) 00144 ! 00145 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00146 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00147 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00148 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00149 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00150 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00151 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00152 ! 00153 ! 00154 !* 0.2 declarations of local variables 00155 ! 00156 INTEGER :: JTILE ! loop on type of surface 00157 LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented 00158 INTEGER :: ISWB ! number of shortwave spectral bands 00159 ! 00160 REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients 00161 REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I' 00162 REAL, DIMENSION(KI) :: ZPET_A_COEF 00163 REAL, DIMENSION(KI) :: ZPEQ_A_COEF 00164 REAL, DIMENSION(KI) :: ZPET_B_COEF 00165 REAL, DIMENSION(KI) :: ZPEQ_B_COEF 00166 ! 00167 ! Tile outputs: 00168 ! 00169 REAL, DIMENSION(KI,NTILESFC) :: ZSFTH_TILE ! surface heat flux (Km/s) 00170 REAL, DIMENSION(KI,NTILESFC) :: ZSFTQ_TILE ! surface vapor flux (kgm/kg/s) 00171 REAL, DIMENSION(KI,KSV,NTILESFC) :: ZSFTS_TILE ! scalar surface flux 00172 REAL, DIMENSION(KI,NTILESFC) :: ZSFCO2_TILE ! surface CO2 flux 00173 REAL, DIMENSION(KI,NTILESFC) :: ZSFU_TILE ! zonal momentum flux 00174 REAL, DIMENSION(KI,NTILESFC) :: ZSFV_TILE ! meridian momentum flux 00175 REAL, DIMENSION(KI,NTILESFC) :: ZTRAD_TILE ! radiative surface temperature 00176 REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE ! emissivity 00177 REAL, DIMENSION(KI,NTILESFC) :: ZFRAC_TILE ! fraction of each surface type 00178 ! 00179 REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo 00180 REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo 00181 ! 00182 DOUBLE PRECISION :: XTIME0 00183 ! 00184 INTEGER :: IINDEXEND 00185 INTEGER :: INBTS, JI 00186 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00187 ! 00188 !------------------------------------------------------------------------------------- 00189 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',0,ZHOOK_HANDLE) 00190 CPROGNAME=HPROGRAM 00191 ! 00192 IF (HTEST/='OK') THEN 00193 CALL ABOR1_SFX('COUPLING_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER') 00194 END IF 00195 ! 00196 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00197 ! Time evolution 00198 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00199 ! 00200 TTIME%TIME = TTIME%TIME + PTSTEP 00201 CALL ADD_FORECAST_TO_DATE_SURF(TTIME%TDATE%YEAR,TTIME%TDATE%MONTH,TTIME%TDATE%DAY,TTIME%TIME) 00202 ! 00203 !------------------------------------------------------------------------------------- 00204 ! Preliminaries: Tile related operations 00205 !------------------------------------------------------------------------------------- 00206 ! FLAGS for the various surfaces: 00207 ! 00208 GSEA = NSIZE_SEA >0 00209 GWATER = NSIZE_WATER >0 00210 GTOWN = NSIZE_TOWN >0 00211 GNATURE = NSIZE_NATURE >0 00212 ! 00213 ! Tile counter: 00214 ! 00215 JTILE = 0 00216 ! 00217 ! Number of shortwave spectral bands 00218 ! 00219 ISWB = SIZE(PSW_BANDS) 00220 ! 00221 ! Initialization: Outputs to atmosphere over each tile: 00222 ! 00223 ZSFTH_TILE(:,:) = XUNDEF 00224 ZTRAD_TILE(:,:) = XUNDEF 00225 ZDIR_ALB_TILE(:,:,:) = XUNDEF 00226 ZSCA_ALB_TILE(:,:,:) = XUNDEF 00227 ZEMIS_TILE(:,:) = XUNDEF 00228 ZSFTQ_TILE(:,:) = XUNDEF 00229 ZSFTS_TILE(:,:,:) = 0. 00230 ZSFCO2_TILE(:,:) = 0. 00231 ZSFU_TILE(:,:) = XUNDEF 00232 ZSFV_TILE(:,:) = XUNDEF 00233 ! 00234 ! Fractions for each tile: 00235 ! 00236 ZFRAC_TILE(:,:) = 0.0 00237 00238 ! 00239 ! initialization of implicit coefficients: 00240 ! 00241 IF (HCOUPLING=='I') THEN 00242 ZPEW_A_COEF = PPEW_A_COEF 00243 ZPEW_B_COEF = PPEW_B_COEF 00244 ZPET_A_COEF = PPET_A_COEF 00245 ZPEQ_A_COEF = PPEQ_A_COEF 00246 ZPET_B_COEF = PPET_B_COEF 00247 ZPEQ_B_COEF = PPEQ_B_COEF 00248 ELSE 00249 ZPEW_A_COEF = 0. 00250 ZPEW_B_COEF = SQRT(PU**2+PV**2) 00251 ZPET_A_COEF = XUNDEF 00252 ZPET_B_COEF = XUNDEF 00253 ZPEQ_A_COEF = XUNDEF 00254 ZPEQ_B_COEF = XUNDEF 00255 END IF 00256 ! 00257 !-------------------------------------------------------------------------------------- 00258 ! Initialize/Save precip and zenith field for a ARPEGE/ALADIN run 00259 !-------------------------------------------------------------------------------------- 00260 ! 00261 CALL RW_PRECIP_n(HPROGRAM,PRAIN,PSNOW) 00262 ! 00263 !-------------------------------------------------------------------------------------- 00264 ! Call ALMA interfaces for sea, water, nature and town here... 00265 !-------------------------------------------------------------------------------------- 00266 ! 00267 #ifndef NOMPI 00268 XTIME0 = MPI_WTIME() 00269 #endif 00270 ! 00271 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00272 ! SEA Tile calculations: 00273 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00274 ! 00275 ! first, pack vector...then call ALMA routine 00276 ! 00277 JTILE = JTILE + 1 00278 ! 00279 IF(GSEA)THEN 00280 ! 00281 ZFRAC_TILE(:,JTILE) = XSEA(:) 00282 ! 00283 CALL TREAT_SURF(JTILE,NSIZE_SEA,NR_SEA) 00284 ! 00285 ENDIF 00286 ! 00287 #ifndef NOMPI 00288 XTIME_SEA = XTIME_SEA + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_SEA) 00289 XTIME0 = MPI_WTIME() 00290 #endif 00291 ! 00292 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00293 ! INLAND WATER Tile calculations: 00294 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00295 ! 00296 JTILE = JTILE + 1 00297 ! 00298 IF(GWATER)THEN 00299 ! 00300 ZFRAC_TILE(:,JTILE) = XWATER(:) 00301 ! 00302 CALL TREAT_SURF(JTILE,NSIZE_WATER,NR_WATER) 00303 ! 00304 ENDIF 00305 ! 00306 #ifndef NOMPI 00307 XTIME_WATER = XTIME_WATER + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_WATER) 00308 XTIME0 = MPI_WTIME() 00309 #endif 00310 ! 00311 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00312 ! NATURAL SURFACE Tile calculations: 00313 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00314 ! 00315 JTILE = JTILE + 1 00316 ! 00317 IF(GNATURE)THEN 00318 ! 00319 ZFRAC_TILE(:,JTILE) = XNATURE(:) 00320 ! 00321 CALL TREAT_SURF(JTILE,NSIZE_NATURE,NR_NATURE) 00322 ! 00323 ENDIF 00324 ! 00325 #ifndef NOMPI 00326 XTIME_NATURE = XTIME_NATURE + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_NATURE) 00327 XTIME0 = MPI_WTIME() 00328 #endif 00329 ! 00330 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00331 ! URBAN Tile calculations: 00332 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00333 ! 00334 JTILE = JTILE + 1 00335 ! 00336 IF(GTOWN)THEN 00337 ! 00338 ZFRAC_TILE(:,JTILE) = XTOWN(:) 00339 ! 00340 CALL TREAT_SURF(JTILE,NSIZE_TOWN,NR_TOWN) 00341 ! 00342 ENDIF 00343 ! 00344 #ifndef NOMPI 00345 XTIME_TOWN = XTIME_TOWN + (MPI_WTIME() - XTIME0)*100./MAX(1,NSIZE_TOWN) 00346 #endif 00347 ! 00348 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00349 ! Grid box average fluxes/properties: 00350 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00351 ! 00352 CALL AVERAGE_FLUX(ZFRAC_TILE, & 00353 ZSFTH_TILE, ZSFTQ_TILE, & 00354 ZSFTS_TILE, ZSFCO2_TILE, & 00355 ZSFU_TILE, ZSFV_TILE, & 00356 PSFTH, PSFTQ, PSFTS, PSFCO2, & 00357 PSFU, PSFV ) 00358 ! 00359 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00360 ! Chemical Emissions: 00361 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00362 ! 00363 IF ((NBEQ > 0).AND.(LCH_SURF_EMIS)) THEN 00364 IF (CCH_EMIS=='AGGR') THEN 00365 IF (NSV_AEREND < 0) THEN 00366 IINDEXEND = NSV_CHSEND ! case only gas chemistry 00367 ELSE 00368 IINDEXEND = NSV_AEREND ! case aerosol + gas chemistry 00369 ENDIF 00370 INBTS=0 00371 DO JI=1,SIZE(TSEMISS) 00372 IF (SIZE(TSEMISS(JI)%NETIMES).GT.INBTS) INBTS=SIZE(TSEMISS(JI)%NETIMES) 00373 ENDDO 00374 CALL CH_EMISSION_FLUX_n(HPROGRAM,PTIME,PSFTS(:,NSV_CHSBEG:IINDEXEND),PRHOA,PTSTEP,INBTS) 00375 ELSE IF (CCH_EMIS=='SNAP') THEN 00376 CALL CH_EMISSION_SNAP_n(HPROGRAM,NSIZE_FULL,PTIME,PTSUN,KYEAR,KMONTH,KDAY,PRHOA,XLON) 00377 CALL CH_EMISSION_TO_ATM_n(PSFTS,PRHOA) 00378 END IF 00379 END IF 00380 ! 00381 WHERE(PSFTS(:,:)==XUNDEF) PSFTS(:,:)=0. 00382 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00383 ! CO2 Flux : adds biogenic and anthropogenic emissions 00384 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00385 ! CO2 FLUXES : PSFTS in molecules/m2/s 00386 ! PSFCO2 in kgCO2/kgair*m/s = *PRHOA kgCO2/m2/s 00387 ! PSFCO2 in kgCO2/m2/s = *Navogadro*1E3/Mco2(44g/mol) molecules/m2/s 00388 ! 00389 DO JI=1,SIZE(PSV,2) 00390 IF(TRIM(ADJUSTL(CSV(JI)))=="CO2") THEN 00391 ! CO2 Flux (Antrop + biog) (molec*m2/s) 00392 PSFTS(:,JI) = PSFTS(:,JI) + PSFCO2(:)*PRHOA(:)*(XAVOGADRO/44.)*1E3 00393 ! CO2 Flux (Antrop + biog) (kgCO2/kgair*m/s) 00394 PSFCO2(:) = PSFTS(:,JI)/(PRHOA(:)*(XAVOGADRO/44.)*1E3) 00395 END IF 00396 END DO 00397 ! 00398 ! 00399 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00400 ! Radiative fluxes 00401 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00402 CALL AVERAGE_RAD(ZFRAC_TILE, & 00403 ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTRAD_TILE, & 00404 PDIR_ALB, PSCA_ALB, PEMIS, PTRAD ) 00405 ! 00406 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00407 ! Orographic friction 00408 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00409 ! 00410 !* adds friction due to subscale orography to momentum fluxes 00411 ! but only over continental area 00412 ! 00413 IF (CROUGH=="Z01D" .OR. CROUGH=="Z04D") THEN 00414 CALL SSO_Z0_FRICTION_n(XSEA,PUREF,PRHOA,PU,PV,ZPEW_A_COEF,ZPEW_B_COEF,PSFU,PSFV) 00415 ELSE IF (CROUGH=="BE04") THEN 00416 CALL SSO_BE04_FRICTION_n(PTSTEP,XSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV) 00417 END IF 00418 ! 00419 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00420 ! Inline diagnostics for full surface 00421 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00422 ! 00423 CALL DIAG_INLINE_SURF_ATM_n(PUREF, PZREF, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2) 00424 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',1,ZHOOK_HANDLE) 00425 ! 00426 !======================================================================================= 00427 CONTAINS 00428 !======================================================================================= 00429 SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK) 00430 ! 00431 IMPLICIT NONE 00432 ! 00433 INTEGER, INTENT(IN) :: KTILE 00434 INTEGER, INTENT(IN) :: KSIZE 00435 INTEGER, INTENT(IN), DIMENSION(KI) :: KMASK 00436 ! 00437 REAL, DIMENSION(KSIZE) :: ZP_TSUN ! solar time (s from midnight) 00438 REAL, DIMENSION(KSIZE) :: ZP_ZREF ! height of T,q forcing (m) 00439 REAL, DIMENSION(KSIZE) :: ZP_UREF ! height of wind forcing (m) 00440 ! 00441 REAL, DIMENSION(KSIZE) :: ZP_TA ! air temperature forcing (K) 00442 REAL, DIMENSION(KSIZE) :: ZP_QA ! air specific humidity forcing (kg/m3) 00443 REAL, DIMENSION(KSIZE) :: ZP_RHOA ! air density (kg/m3) 00444 REAL, DIMENSION(KSIZE) :: ZP_U ! zonal wind (m/s) 00445 REAL, DIMENSION(KSIZE) :: ZP_V ! meridian wind (m/s) 00446 REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_SW ! direct solar radiation (on horizontal surf.) 00447 ! ! (W/m2) 00448 REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (on horizontal surf.) 00449 ! ! (W/m2) 00450 REAL, DIMENSION(KSIZE) :: ZP_ZENITH ! zenithal angle at t (radian from the vertical) 00451 REAL, DIMENSION(KSIZE) :: ZP_ZENITH2 ! zenithal angle at t+1(radian from the vertical) 00452 REAL, DIMENSION(KSIZE) :: ZP_AZIM ! azimuthal angle (radian from North, clockwise) 00453 REAL, DIMENSION(KSIZE) :: ZP_LW ! longwave radiation (on horizontal surf.) 00454 ! ! (W/m2) 00455 REAL, DIMENSION(KSIZE) :: ZP_PS ! pressure at atmospheric model surface (Pa) 00456 REAL, DIMENSION(KSIZE) :: ZP_PA ! pressure at forcing level (Pa) 00457 REAL, DIMENSION(KSIZE) :: ZP_ZS ! atmospheric model orography (m) 00458 REAL, DIMENSION(KSIZE) :: ZP_CO2 ! CO2 concentration in the air (kg/m3) 00459 REAL, DIMENSION(KSIZE,KSV) :: ZP_SV ! scalar concentration in the air 00460 REAL, DIMENSION(KSIZE) :: ZP_SNOW ! snow precipitation (kg/m2/s) 00461 REAL, DIMENSION(KSIZE) :: ZP_RAIN ! liquid precipitation (kg/m2/s) 00462 ! 00463 REAL, DIMENSION(KSIZE) :: ZP_SFTH ! flux of heat (W/m2) 00464 REAL, DIMENSION(KSIZE) :: ZP_SFTQ ! flux of water vapor (kg/m2/s) 00465 REAL, DIMENSION(KSIZE) :: ZP_SFU ! zonal momentum flux (m/s) 00466 REAL, DIMENSION(KSIZE) :: ZP_SFV ! meridian momentum flux (m/s) 00467 REAL, DIMENSION(KSIZE) :: ZP_SFCO2 ! flux of CO2 (kg/m2/s) 00468 REAL, DIMENSION(KSIZE,KSV) :: ZP_SFTS ! flux of scalar 00469 ! 00470 REAL, DIMENSION(KSIZE) :: ZP_TRAD ! radiative temperature (K) 00471 REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_ALB ! direct albedo for each spectral band (-) 00472 REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_ALB ! diffuse albedo for each spectral band (-) 00473 REAL, DIMENSION(KSIZE) :: ZP_EMIS ! emissivity 00474 ! 00475 REAL, DIMENSION(KSIZE) :: ZP_PEW_A_COEF ! implicit coefficients 00476 REAL, DIMENSION(KSIZE) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I' 00477 REAL, DIMENSION(KSIZE) :: ZP_PET_A_COEF 00478 REAL, DIMENSION(KSIZE) :: ZP_PEQ_A_COEF 00479 REAL, DIMENSION(KSIZE) :: ZP_PET_B_COEF 00480 REAL, DIMENSION(KSIZE) :: ZP_PEQ_B_COEF 00481 INTEGER :: JJ, JK 00482 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00483 ! 00484 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_n:TREAT_SURF',0,ZHOOK_HANDLE) 00485 ! 00486 !-------------------------------------------------------------------------------------------- 00487 ! 00488 !cdir nodep 00489 !cdir unroll=8 00490 DO JJ=1,KSIZE 00491 JI = KMASK(JJ) 00492 ZP_TSUN(JJ) = PTSUN (JI) 00493 ZP_ZENITH(JJ) = PZENITH (JI) 00494 ZP_ZENITH2(JJ) = PZENITH2 (JI) 00495 ZP_AZIM (JJ) = PAZIM (JI) 00496 ZP_ZREF(JJ) = PZREF (JI) 00497 ZP_UREF(JJ) = PUREF (JI) 00498 ZP_U(JJ) = PU (JI) 00499 ZP_V(JJ) = PV (JI) 00500 ZP_QA(JJ) = PQA (JI) 00501 ZP_TA(JJ) = PTA (JI) 00502 ZP_RHOA(JJ) = PRHOA (JI) 00503 ZP_CO2(JJ) = PCO2 (JI) 00504 ZP_RAIN(JJ) = PRAIN (JI) 00505 ZP_SNOW(JJ) = PSNOW (JI) 00506 ZP_LW(JJ) = PLW (JI) 00507 ZP_PS(JJ) = PPS (JI) 00508 ZP_PA(JJ) = PPA (JI) 00509 ZP_ZS(JJ) = PZS (JI) 00510 ENDDO 00511 ! 00512 DO JK=1,SIZE(PSV,2) 00513 !cdir nodep 00514 !cdir unroll=8 00515 DO JJ=1,KSIZE 00516 JI = KMASK(JJ) 00517 ZP_SV(JJ,JK) = PSV (JI,JK) 00518 ENDDO 00519 ENDDO 00520 ! 00521 DO JK=1,ISWB 00522 !cdir nodep 00523 !cdir unroll=8 00524 DO JJ=1,KSIZE 00525 JI = KMASK(JJ) 00526 ZP_DIR_SW(JJ,JK) = PDIR_SW (JI,JK) 00527 ZP_SCA_SW(JJ,JK) = PSCA_SW (JI,JK) 00528 ENDDO 00529 ENDDO 00530 ! 00531 !cdir nodep 00532 !cdir unroll=8 00533 DO JJ=1,KSIZE 00534 JI = KMASK(JJ) 00535 ZP_PEW_A_COEF(JJ) = ZPEW_A_COEF (JI) 00536 ZP_PEW_B_COEF(JJ) = ZPEW_B_COEF (JI) 00537 ZP_PET_A_COEF(JJ) = ZPET_A_COEF (JI) 00538 ZP_PET_B_COEF(JJ) = ZPET_B_COEF (JI) 00539 ZP_PEQ_A_COEF(JJ) = ZPEQ_A_COEF (JI) 00540 ZP_PEQ_B_COEF(JJ) = ZPEQ_B_COEF (JI) 00541 ENDDO 00542 ! 00543 !-------------------------------------------------------------------------------------------- 00544 ! 00545 IF (KTILE==1) THEN 00546 ! 00547 CALL COUPLING_SEA_n(HPROGRAM, HCOUPLING, PTIMEC, & 00548 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00549 NSIZE_SEA, KSV, KSW, & 00550 ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, & 00551 ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,& 00552 ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, & 00553 ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & 00554 ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, & 00555 ZP_PEW_A_COEF, ZP_PEW_B_COEF, & 00556 ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 00557 'OK' ) 00558 ! 00559 ELSEIF (KTILE==2) THEN 00560 ! 00561 CALL COUPLING_INLAND_WATER_n(HPROGRAM, HCOUPLING, PTIMEC, & 00562 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00563 NSIZE_WATER, KSV, KSW, & 00564 ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, & 00565 ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,& 00566 ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, & 00567 ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & 00568 ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, & 00569 ZP_PEW_A_COEF, ZP_PEW_B_COEF, & 00570 ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 00571 'OK' ) 00572 ! 00573 ELSEIF (KTILE==3) THEN 00574 ! 00575 CALL COUPLING_NATURE_n(HPROGRAM, HCOUPLING, PTIMEC, & 00576 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00577 NSIZE_NATURE, KSV, KSW, & 00578 ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, & 00579 ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,& 00580 ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, & 00581 ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & 00582 ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, & 00583 ZP_PEW_A_COEF, ZP_PEW_B_COEF, & 00584 ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 00585 'OK' ) 00586 ! 00587 ELSEIF (KTILE==4) THEN 00588 ! 00589 CALL COUPLING_TOWN_n(HPROGRAM, HCOUPLING, PTIMEC, & 00590 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00591 NSIZE_TOWN, KSV, KSW, & 00592 ZP_TSUN, ZP_ZENITH, ZP_AZIM, & 00593 ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,& 00594 ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, & 00595 ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & 00596 ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, & 00597 ZP_PEW_A_COEF, ZP_PEW_B_COEF, & 00598 ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & 00599 'OK' ) 00600 ! 00601 ENDIF 00602 ! 00603 !---------------------------------------------------------------------------------------------- 00604 ! 00605 !cdir nodep 00606 !cdir unroll=8 00607 DO JJ=1,KSIZE 00608 JI=KMASK(JJ) 00609 ZSFTQ_TILE (JI,KTILE) = ZP_SFTQ (JJ) 00610 ZSFTH_TILE (JI,KTILE) = ZP_SFTH (JJ) 00611 ZSFCO2_TILE (JI,KTILE) = ZP_SFCO2 (JJ) 00612 ZSFU_TILE (JI,KTILE) = ZP_SFU (JJ) 00613 ZSFV_TILE (JI,KTILE) = ZP_SFV (JJ) 00614 ZTRAD_TILE (JI,KTILE) = ZP_TRAD (JJ) 00615 ZEMIS_TILE (JI,KTILE) = ZP_EMIS (JJ) 00616 ENDDO 00617 ! 00618 DO JI=1,SIZE(ZP_SFTS,2) 00619 !cdir nodep 00620 !cdir unroll=8 00621 DO JJ=1,KSIZE 00622 ZSFTS_TILE (KMASK(JJ),JI,KTILE)= ZP_SFTS (JJ,JI) 00623 ENDDO 00624 ENDDO 00625 ! 00626 DO JI=1,SIZE(ZP_DIR_ALB,2) 00627 !cdir nodep 00628 !cdir unroll=8 00629 DO JJ=1,KSIZE 00630 ZDIR_ALB_TILE (KMASK(JJ),JI,KTILE)= ZP_DIR_ALB (JJ,JI) 00631 ZSCA_ALB_TILE (KMASK(JJ),JI,KTILE)= ZP_SCA_ALB (JJ,JI) 00632 ENDDO 00633 ENDDO 00634 ! 00635 !---------------------------------------------------------------------------------------------- 00636 ! 00637 IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_n:TREAT_SURF',1,ZHOOK_HANDLE) 00638 ! 00639 END SUBROUTINE TREAT_SURF 00640 !======================================================================================= 00641 END SUBROUTINE COUPLING_SURF_ATM_n
1.8.0
