SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
coupling_surf_atmn.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #################################################################################
6 SUBROUTINE coupling_surf_atm_n (YSC, &
7  hprogram, hcoupling, ptimec, &
8  ptstep, kyear, kmonth, kday, ptime, ki, ksv, ksw, ptsun, pzenith, &
9  pzenith2,pazim,pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, &
10  hsv, prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
11  psftq, psfth, psfts, psfco2, psfu, psfv, &
12  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
13  ppew_a_coef, ppew_b_coef, &
14  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
15  htest )
16 ! #################################################################################
17 !
18 !!**** *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the
19 !! four surface types (SEA, WATER, NATURE, TOWN)
20 !!
21 !! PURPOSE
22 !! -------
23 !
24 !!** METHOD
25 !! ------
26 !!
27 !! REFERENCE
28 !! ---------
29 !!
30 !!
31 !! AUTHOR
32 !! ------
33 !! V. Masson
34 !!
35 !! MODIFICATIONS
36 !! -------------
37 !! Original 01/2004
38 !! Modified 09/2011 by S.Queguiner: Add total CO2 surface flux (anthropo+biogenic) as diagnostic
39 !! Modified 11/2011 by S.Queguiner: Add total Chemical surface flux (anthropo) as diagnostic
40 !! B. Decharme 04/2013 new coupling variables and replace RW_PRECIP_n by CPL_GCM_n
41 !! Modified 06/2013 by J.Escobar : replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
42 !! R. Séférian 03/2014 Adding decoupling between CO2 seen by photosynthesis and radiative CO2
43 !!-------------------------------------------------------------
44 !
45 !
46 USE modd_surfex_n, ONLY : surfex_t
47 !
48 USE modd_surf_conf, ONLY : cprogname
49 USE modd_surf_par, ONLY : xundef
50 USE modd_csts, ONLY : xp00, xcpd, xrd, xavogadro, xmd
51 USE modd_co2v_par, ONLY : xmco2
52 USE modd_surf_atm, ONLY : lcpl_gcm, xco2uncpl
53 USE modd_data_cover_par, ONLY : ntilesfc
54 !
55 !
56 USE modd_surfex_mpi, ONLY : xtime_sea, xtime_water, xtime_nature, xtime_town
57 !
58 USE modi_add_forecast_to_date_surf
59 USE modi_average_flux
60 USE modi_average_phy
61 USE modi_average_rad
62 USE modi_diag_inline_surf_atm_n
63 USE modi_ch_emission_flux_n
64 USE modi_ch_emission_snap_n
65 USE modi_ch_emission_to_atm_n
66 USE modi_sso_z0_friction_n
67 USE modi_sso_be04_friction_n
68 !
69 USE yomhook ,ONLY : lhook, dr_hook
70 USE parkind1 ,ONLY : jprb
71 !
72 USE modi_abor1_sfx
73 !
74 USE modi_coupling_inland_water_n
75 !
76 USE modi_coupling_nature_n
77 !
78 USE modi_coupling_sea_n
79 !
80 USE modi_coupling_town_n
81 !
82 USE modi_cpl_gcm_n
83 !
84 IMPLICIT NONE
85 !
86 #ifdef SFX_MPI
87 include 'mpif.h'
88 #endif
89 !
90 !* 0.1 declarations of arguments
91 !
92 TYPE(surfex_t), INTENT(INOUT) :: ysc
93 !
94  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling surf. schemes
95  CHARACTER(LEN=1), INTENT(IN) :: hcoupling ! type of coupling
96  ! 'E' : explicit
97  ! 'I' : implicit
98 REAL, INTENT(IN) :: ptimec ! cumulated time since beginning of simulation
99 INTEGER, INTENT(IN) :: kyear ! current year (UTC)
100 INTEGER, INTENT(IN) :: kmonth ! current month (UTC)
101 INTEGER, INTENT(IN) :: kday ! current day (UTC)
102 REAL, INTENT(IN) :: ptime ! current time since midnight (UTC, s)
103 INTEGER, INTENT(IN) :: ki ! number of points
104 INTEGER, INTENT(IN) :: ksv ! number of scalars
105 INTEGER, INTENT(IN) :: ksw ! number of short-wave spectral bands
106 REAL, DIMENSION(KI), INTENT(IN) :: ptsun ! solar time (s from midnight)
107 REAL, INTENT(IN) :: ptstep ! atmospheric time-step (s)
108 REAL, DIMENSION(KI), INTENT(IN) :: pzref ! height of T,q forcing (m)
109 REAL, DIMENSION(KI), INTENT(IN) :: puref ! height of wind forcing (m)
110 !
111 REAL, DIMENSION(KI), INTENT(IN) :: pta ! air temperature forcing (K)
112 REAL, DIMENSION(KI), INTENT(IN) :: pqa ! air humidity forcing (kg/m3)
113 REAL, DIMENSION(KI), INTENT(IN) :: prhoa ! air density (kg/m3)
114 REAL, DIMENSION(KI,KSV),INTENT(IN) :: psv ! scalar variables
115 ! ! chemistry: first char. in HSV: '#' (molecule/m3)
116 ! !
117  CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: hsv ! name of all scalar variables
118 REAL, DIMENSION(KI), INTENT(IN) :: pu ! zonal wind (m/s)
119 REAL, DIMENSION(KI), INTENT(IN) :: pv ! meridian wind (m/s)
120 REAL, DIMENSION(KI,KSW),INTENT(IN) :: pdir_sw ! direct solar radiation (on horizontal surf.)
121 ! ! (W/m2)
122 REAL, DIMENSION(KI,KSW),INTENT(IN) :: psca_sw ! diffuse solar radiation (on horizontal surf.)
123 ! ! (W/m2)
124 REAL, DIMENSION(KSW),INTENT(IN) :: psw_bands ! mean wavelength of each shortwave band (m)
125 REAL, DIMENSION(KI), INTENT(IN) :: pzenith ! zenithal angle at t (radian from the vertical)
126 REAL, DIMENSION(KI), INTENT(IN) :: pzenith2 ! zenithal angle at t+1(radian from the vertical)
127 REAL, DIMENSION(KI), INTENT(IN) :: pazim ! azimuthal angle (radian from North, clockwise)
128 REAL, DIMENSION(KI), INTENT(IN) :: plw ! longwave radiation (on horizontal surf.)
129 ! ! (W/m2)
130 REAL, DIMENSION(KI), INTENT(IN) :: pps ! pressure at atmospheric model surface (Pa)
131 REAL, DIMENSION(KI), INTENT(IN) :: ppa ! pressure at forcing level (Pa)
132 REAL, DIMENSION(KI), INTENT(IN) :: pzs ! atmospheric model orography (m)
133 REAL, DIMENSION(KI), INTENT(IN) :: pco2 ! CO2 concentration in the air (kg/m3)
134 REAL, DIMENSION(KI), INTENT(IN) :: psnow ! snow precipitation (kg/m2/s)
135 REAL, DIMENSION(KI), INTENT(IN) :: prain ! liquid precipitation (kg/m2/s)
136 !
137 !
138 REAL, DIMENSION(KI), INTENT(OUT) :: psfth ! flux of heat (W/m2)
139 REAL, DIMENSION(KI), INTENT(OUT) :: psftq ! flux of water vapor (kg/m2/s)
140 REAL, DIMENSION(KI), INTENT(OUT) :: psfu ! zonal momentum flux (Pa)
141 REAL, DIMENSION(KI), INTENT(OUT) :: psfv ! meridian momentum flux (Pa)
142 REAL, DIMENSION(KI), INTENT(OUT) :: psfco2 ! flux of CO2 (m/s*kg_CO2/kg_air)
143 REAL, DIMENSION(KI,KSV),INTENT(OUT):: psfts ! flux of scalar var. (kg/m2/s)
144 !
145 REAL, DIMENSION(KI), INTENT(INOUT) :: ptrad ! radiative temperature (K)
146 REAL, DIMENSION(KI,KSW),INTENT(OUT):: pdir_alb ! direct albedo for each spectral band (-)
147 REAL, DIMENSION(KI,KSW),INTENT(OUT):: psca_alb ! diffuse albedo for each spectral band (-)
148 REAL, DIMENSION(KI), INTENT(INOUT) :: pemis ! emissivity (-)
149 !
150 REAL, DIMENSION(KI), INTENT(OUT) :: ptsurf ! surface effective temperature (K)
151 REAL, DIMENSION(KI), INTENT(INOUT) :: pz0 ! roughness length for momentum (m)
152 REAL, DIMENSION(KI), INTENT(INOUT) :: pz0h ! roughness length for heat (m)
153 REAL, DIMENSION(KI), INTENT(INOUT) :: pqsurf ! specific humidity at surface (kg/kg)
154 !
155 REAL, DIMENSION(KI), INTENT(IN) :: ppew_a_coef! implicit coefficients
156 REAL, DIMENSION(KI), INTENT(IN) :: ppew_b_coef! needed if HCOUPLING='I'
157 REAL, DIMENSION(KI), INTENT(IN) :: ppet_a_coef
158 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_a_coef
159 REAL, DIMENSION(KI), INTENT(IN) :: ppet_b_coef
160 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_b_coef
161  CHARACTER(LEN=2), INTENT(IN) :: htest ! must be equal to 'OK'
162 !
163 !
164 !* 0.2 declarations of local variables
165 !
166 INTEGER :: jtile ! loop on type of surface
167 LOGICAL :: gnature, gtown, gwater, gsea ! .T. if the corresponding surface is represented
168 INTEGER :: iswb ! number of shortwave spectral bands
169 !
170 REAL, DIMENSION(KI) :: zpew_a_coef ! implicit coefficients
171 REAL, DIMENSION(KI) :: zpew_b_coef ! needed if HCOUPLING='I'
172 REAL, DIMENSION(KI) :: zpet_a_coef
173 REAL, DIMENSION(KI) :: zpeq_a_coef
174 REAL, DIMENSION(KI) :: zpet_b_coef
175 REAL, DIMENSION(KI) :: zpeq_b_coef
176 !
177 ! Tile outputs:
178 !
179 REAL, DIMENSION(KI,NTILESFC) :: zsfth_tile ! surface heat flux (Km/s)
180 REAL, DIMENSION(KI,NTILESFC) :: zsftq_tile ! surface vapor flux (kgm/kg/s)
181 REAL, DIMENSION(KI,KSV,NTILESFC) :: zsfts_tile ! scalar surface flux
182 REAL, DIMENSION(KI,NTILESFC) :: zsfco2_tile ! surface CO2 flux
183 REAL, DIMENSION(KI,NTILESFC) :: zsfu_tile ! zonal momentum flux
184 REAL, DIMENSION(KI,NTILESFC) :: zsfv_tile ! meridian momentum flux
185 REAL, DIMENSION(KI,NTILESFC) :: ztrad_tile ! radiative surface temperature
186 REAL, DIMENSION(KI,NTILESFC) :: zemis_tile ! emissivity
187 REAL, DIMENSION(KI,NTILESFC) :: zfrac_tile ! fraction of each surface type
188 REAL, DIMENSION(KI,NTILESFC) :: ztsurf_tile ! surface effective temperature
189 REAL, DIMENSION(KI,NTILESFC) :: zz0_tile ! roughness length for momentum
190 REAL, DIMENSION(KI,NTILESFC) :: zz0h_tile ! roughness length for heat
191 REAL, DIMENSION(KI,NTILESFC) :: zqsurf_tile ! specific humidity at surface
192 !
193 REAL, DIMENSION(KI,KSW,NTILESFC) :: zdir_alb_tile ! direct albedo
194 REAL, DIMENSION(KI,KSW,NTILESFC) :: zsca_alb_tile ! diffuse albedo
195 !
196 REAL :: xtime0
197 !
198 INTEGER :: iindexend
199 INTEGER :: inbts, ji
200 REAL(KIND=JPRB) :: zhook_handle
201 !
202 !-------------------------------------------------------------------------------------
203 IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_N',0,zhook_handle)
204  cprogname=hprogram
205 !
206 IF (htest/='OK') THEN
207  CALL abor1_sfx('COUPLING_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
208 END IF
209 !
210 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
211 ! Time evolution
212 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
213 !
214 ysc%U%TTIME%TIME = ysc%U%TTIME%TIME + ptstep
215  CALL add_forecast_to_date_surf(ysc%U%TTIME%TDATE%YEAR,ysc%U%TTIME%TDATE%MONTH,&
216  ysc%U%TTIME%TDATE%DAY,ysc%U%TTIME%TIME)
217 !
218 !-------------------------------------------------------------------------------------
219 ! Preliminaries: Tile related operations
220 !-------------------------------------------------------------------------------------
221 ! FLAGS for the various surfaces:
222 !
223 gsea = ysc%U%NDIM_SEA >0
224 gwater = ysc%U%NDIM_WATER >0
225 gtown = ysc%U%NDIM_TOWN >0
226 gnature = ysc%U%NDIM_NATURE >0
227 
228 !
229 ! Tile counter:
230 !
231 jtile = 0
232 !
233 ! Number of shortwave spectral bands
234 !
235 iswb = SIZE(psw_bands)
236 !
237 ! Initialization: Outputs to atmosphere over each tile:
238 !
239 zsfth_tile(:,:) = xundef
240 ztrad_tile(:,:) = xundef
241 zdir_alb_tile(:,:,:) = xundef
242 zsca_alb_tile(:,:,:) = xundef
243 zemis_tile(:,:) = xundef
244 zsftq_tile(:,:) = xundef
245 zsfts_tile(:,:,:) = 0.
246 zsfco2_tile(:,:) = 0.
247 zsfu_tile(:,:) = xundef
248 zsfv_tile(:,:) = xundef
249 ztsurf_tile(:,:) = xundef
250 zz0_tile(:,:) = xundef
251 zz0h_tile(:,:) = xundef
252 zqsurf_tile(:,:) = xundef
253 !
254 ! Fractions for each tile:
255 !
256 zfrac_tile(:,:) = 0.0
257 !
258 ! initialization of implicit coefficients:
259 !
260 IF (hcoupling=='I') THEN
261  zpew_a_coef = ppew_a_coef
262  zpew_b_coef = ppew_b_coef
263  zpet_a_coef = ppet_a_coef
264  zpeq_a_coef = ppeq_a_coef
265  zpet_b_coef = ppet_b_coef
266  zpeq_b_coef = ppeq_b_coef
267 ELSE
268  zpew_a_coef = 0.
269  zpew_b_coef = sqrt(pu**2+pv**2)
270  zpet_a_coef = xundef
271  zpet_b_coef = xundef
272  zpeq_a_coef = xundef
273  zpeq_b_coef = xundef
274 END IF
275 !
276 !--------------------------------------------------------------------------------------
277 ! Call ALMA interfaces for sea, water, nature and town here...
278 !--------------------------------------------------------------------------------------
279 !
280 #ifdef SFX_MPI
281 xtime0 = mpi_wtime()
282 #endif
283 !
284 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
285 ! SEA Tile calculations:
286 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
287 !
288 ! first, pack vector...then call ALMA routine
289 !
290 jtile = jtile + 1
291 !
292 IF(gsea)THEN
293 !
294  zfrac_tile(:,jtile) = ysc%U%XSEA(:)
295 !
296  CALL treat_surf(jtile,ysc%U%NSIZE_SEA,ysc%U%NR_SEA)
297 !
298 ENDIF
299 !
300 #ifdef SFX_MPI
301 xtime_sea = xtime_sea + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_SEA)
302 xtime0 = mpi_wtime()
303 #endif
304 !
305 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
306 ! INLAND WATER Tile calculations:
307 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
308 !
309 jtile = jtile + 1
310 !
311 IF(gwater)THEN
312 !
313  zfrac_tile(:,jtile) = ysc%U%XWATER(:)
314 !
315  CALL treat_surf(jtile,ysc%U%NSIZE_WATER,ysc%U%NR_WATER)
316 !
317 ENDIF
318 !
319 #ifdef SFX_MPI
320 xtime_water = xtime_water + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_WATER)
321 xtime0 = mpi_wtime()
322 #endif
323 !
324 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
325 ! NATURAL SURFACE Tile calculations:
326 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
327 !
328 jtile = jtile + 1
329 !
330 IF(gnature)THEN
331 !
332  zfrac_tile(:,jtile) = ysc%U%XNATURE(:)
333 !
334  CALL treat_surf(jtile,ysc%U%NSIZE_NATURE,ysc%U%NR_NATURE)
335 !
336 ENDIF
337 !
338 #ifdef SFX_MPI
339 xtime_nature = xtime_nature + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_NATURE)
340 xtime0 = mpi_wtime()
341 #endif
342 !
343 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
344 ! URBAN Tile calculations:
345 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
346 !
347 jtile = jtile + 1
348 !
349 IF(gtown)THEN
350 !
351  zfrac_tile(:,jtile) = ysc%U%XTOWN(:)
352 !
353  CALL treat_surf(jtile,ysc%U%NSIZE_TOWN,ysc%U%NR_TOWN)
354 !
355 ENDIF
356 !
357 #ifdef SFX_MPI
358 xtime_town = xtime_town + (mpi_wtime() - xtime0)*100./max(1,ysc%U%NSIZE_TOWN)
359 #endif
360 !
361 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
362 ! Grid box average fluxes/properties:
363 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
364 !
365  CALL average_flux(zfrac_tile, &
366  zsfth_tile, zsftq_tile, &
367  zsfts_tile, zsfco2_tile, &
368  zsfu_tile, zsfv_tile, &
369  psfth, psftq, psfts, psfco2, &
370  psfu, psfv )
371 !
372 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
373 ! Chemical Emissions:
374 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
375 !
376 IF ((ysc%SV%NBEQ > 0).AND.(ysc%CHU%LCH_SURF_EMIS)) THEN
377  IF (ysc%CHU%CCH_EMIS=='AGGR') THEN
378  IF (ysc%SV%NSV_AEREND < 0) THEN
379  iindexend = ysc%SV%NSV_CHSEND ! case only gas chemistry
380  ELSE
381  iindexend = ysc%SV%NSV_AEREND ! case aerosol + gas chemistry
382  ENDIF
383  inbts=0
384  DO ji=1,SIZE(ysc%CHE%TSEMISS)
385  IF (SIZE(ysc%CHE%TSEMISS(ji)%NETIMES).GT.inbts) inbts=SIZE(ysc%CHE%TSEMISS(ji)%NETIMES)
386  ENDDO
387  CALL ch_emission_flux_n(ysc, &
388  hprogram,ptime,psfts(:,ysc%SV%NSV_CHSBEG:iindexend),prhoa,ptstep,inbts)
389  ELSE IF (ysc%CHU%CCH_EMIS=='SNAP') THEN
390  CALL ch_emission_snap_n(ysc%CHN, &
391  hprogram,ysc%U%NSIZE_FULL,ptime,ptsun,kyear,kmonth,kday,prhoa,ysc%UG%XLON)
392  CALL ch_emission_to_atm_n(ysc%CHN, ysc%SV, &
393  psfts,prhoa)
394  END IF
395 END IF
396 !
397 WHERE(psfts(:,:)==xundef) psfts(:,:)=0.
398 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
399 ! CO2 Flux : adds biogenic and anthropogenic emissions
400 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
401 ! CO2 FLUXES : PSFTS in molecules/m2/s
402 ! PSFCO2 in kgCO2/kgair*m/s = *PRHOA kgCO2/m2/s
403 ! PSFCO2 in kgCO2/m2/s = *Navogadro*1E3/Mco2(44g/mol) molecules/m2/s
404 !
405 DO ji=1,SIZE(psv,2)
406  IF(trim(adjustl(ysc%SV%CSV(ji)))=="CO2") THEN
407  ! CO2 Flux (Antrop + biog) (molec*m2/s)
408  psfts(:,ji) = psfts(:,ji) + psfco2(:)*prhoa(:)*(xavogadro/44.)*1e3
409  ! CO2 Flux (Antrop + biog) (kgCO2/kgair*m/s)
410  psfco2(:) = psfts(:,ji)/(prhoa(:)*(xavogadro/44.)*1e3)
411  END IF
412 END DO
413 !
414 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
415 ! Radiative fluxes
416 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
417  CALL average_rad(zfrac_tile, &
418  zdir_alb_tile, zsca_alb_tile, zemis_tile, ztrad_tile, &
419  pdir_alb, psca_alb, pemis, ptrad )
420 !
421 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
422 ! Physical properties
423 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
424  CALL average_phy(zfrac_tile, &
425  ztsurf_tile, zz0_tile, &
426  zz0h_tile, zqsurf_tile, &
427  puref, pzref, &
428  ptsurf, pz0, pz0h, pqsurf )
429 !
430 ! store these field to write in restart file (important for AGCM)
431 !
432 IF(lcpl_gcm) CALL cpl_gcm_n(ysc%U, &
433  ki,pz0=pz0,pz0h=pz0h,pqsurf=pqsurf)
434 !
435 ! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
436 ! Orographic friction
437 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
438 !
439 !* adds friction due to subscale orography to momentum fluxes
440 ! but only over continental area
441 !
442 IF (ysc%USS%CROUGH=="Z01D" .OR. ysc%USS%CROUGH=="Z04D") THEN
443  CALL sso_z0_friction_n(ysc%USS, &
444  ysc%U%XSEA,puref,prhoa,pu,pv,zpew_a_coef,zpew_b_coef,psfu,psfv)
445 ELSE IF (ysc%USS%CROUGH=="BE04") THEN
446  CALL sso_be04_friction_n(ysc%SSCP, ysc%USS, &
447  ptstep,ysc%U%XSEA,puref,prhoa,pu,pv,psfu,psfv)
448 END IF
449 !
450 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
451 ! Inline diagnostics for full surface
452 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
453 !
454  CALL diag_inline_surf_atm_n(ysc%DGU, &
455  puref, pzref, pps, prhoa, ptrad, pemis, psfu, psfv, psfco2)
456 !
457 IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_N',1,zhook_handle)
458 !
459 !=======================================================================================
460  CONTAINS
461 !=======================================================================================
462 SUBROUTINE treat_surf(KTILE,KSIZE,KMASK)
463 !
464 IMPLICIT NONE
465 !
466 INTEGER, INTENT(IN) :: ktile
467 INTEGER, INTENT(IN) :: ksize
468 INTEGER, INTENT(IN), DIMENSION(KI) :: kmask
469 !
470 REAL, DIMENSION(KSIZE) :: zp_tsun ! solar time (s from midnight)
471 REAL, DIMENSION(KSIZE) :: zp_zref ! height of T,q forcing (m)
472 REAL, DIMENSION(KSIZE) :: zp_uref ! height of wind forcing (m)
473 !
474 REAL, DIMENSION(KSIZE) :: zp_ta ! air temperature forcing (K)
475 REAL, DIMENSION(KSIZE) :: zp_qa ! air specific humidity forcing (kg/m3)
476 REAL, DIMENSION(KSIZE) :: zp_rhoa ! air density (kg/m3)
477 REAL, DIMENSION(KSIZE) :: zp_u ! zonal wind (m/s)
478 REAL, DIMENSION(KSIZE) :: zp_v ! meridian wind (m/s)
479 REAL, DIMENSION(KSIZE,ISWB) :: zp_dir_sw ! direct solar radiation (on horizontal surf.)
480 ! ! (W/m2)
481 REAL, DIMENSION(KSIZE,ISWB) :: zp_sca_sw ! diffuse solar radiation (on horizontal surf.)
482 ! ! (W/m2)
483 REAL, DIMENSION(KSIZE) :: zp_zenith ! zenithal angle at t (radian from the vertical)
484 REAL, DIMENSION(KSIZE) :: zp_zenith2 ! zenithal angle at t+1(radian from the vertical)
485 REAL, DIMENSION(KSIZE) :: zp_azim ! azimuthal angle (radian from North, clockwise)
486 REAL, DIMENSION(KSIZE) :: zp_lw ! longwave radiation (on horizontal surf.)
487 ! ! (W/m2)
488 REAL, DIMENSION(KSIZE) :: zp_ps ! pressure at atmospheric model surface (Pa)
489 REAL, DIMENSION(KSIZE) :: zp_pa ! pressure at forcing level (Pa)
490 REAL, DIMENSION(KSIZE) :: zp_zs ! atmospheric model orography (m)
491 REAL, DIMENSION(KSIZE) :: zp_co2 ! CO2 concentration in the air (kg/m3)
492 REAL, DIMENSION(KSIZE,KSV) :: zp_sv ! scalar concentration in the air
493 REAL, DIMENSION(KSIZE) :: zp_snow ! snow precipitation (kg/m2/s)
494 REAL, DIMENSION(KSIZE) :: zp_rain ! liquid precipitation (kg/m2/s)
495 !
496 REAL, DIMENSION(KSIZE) :: zp_sfth ! flux of heat (W/m2)
497 REAL, DIMENSION(KSIZE) :: zp_sftq ! flux of water vapor (kg/m2/s)
498 REAL, DIMENSION(KSIZE) :: zp_sfu ! zonal momentum flux (m/s)
499 REAL, DIMENSION(KSIZE) :: zp_sfv ! meridian momentum flux (m/s)
500 REAL, DIMENSION(KSIZE) :: zp_sfco2 ! flux of CO2 (kg/m2/s)
501 REAL, DIMENSION(KSIZE,KSV) :: zp_sfts ! flux of scalar
502 !
503 REAL, DIMENSION(KSIZE) :: zp_trad ! radiative temperature (K)
504 REAL, DIMENSION(KSIZE,ISWB) :: zp_dir_alb ! direct albedo for each spectral band (-)
505 REAL, DIMENSION(KSIZE,ISWB) :: zp_sca_alb ! diffuse albedo for each spectral band (-)
506 REAL, DIMENSION(KSIZE) :: zp_emis ! emissivity
507 !
508 REAL, DIMENSION(KSIZE) :: zp_tsurf ! surface effective temperature (K)
509 REAL, DIMENSION(KSIZE) :: zp_z0 ! roughness length for momentum (m)
510 REAL, DIMENSION(KSIZE) :: zp_z0h ! roughness length for heat (m)
511 REAL, DIMENSION(KSIZE) :: zp_qsurf ! specific humidity at surface (kg/kg)
512 !
513 REAL, DIMENSION(KSIZE) :: zp_pew_a_coef ! implicit coefficients
514 REAL, DIMENSION(KSIZE) :: zp_pew_b_coef ! needed if HCOUPLING='I'
515 REAL, DIMENSION(KSIZE) :: zp_pet_a_coef
516 REAL, DIMENSION(KSIZE) :: zp_peq_a_coef
517 REAL, DIMENSION(KSIZE) :: zp_pet_b_coef
518 REAL, DIMENSION(KSIZE) :: zp_peq_b_coef
519 INTEGER :: jj, jk
520 REAL(KIND=JPRB) :: zhook_handle
521 !
522 IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_n:TREAT_SURF',0,zhook_handle)
523 !
524 !--------------------------------------------------------------------------------------------
525 !
526 !cdir nodep
527 !cdir unroll=8
528 DO jj=1,ksize
529  ji = kmask(jj)
530  zp_tsun(jj) = ptsun(ji)
531  zp_zenith(jj) = pzenith(ji)
532  zp_zenith2(jj) = pzenith2(ji)
533  zp_azim(jj) = pazim(ji)
534  zp_zref(jj) = pzref(ji)
535  zp_uref(jj) = puref(ji)
536  zp_u(jj) = pu(ji)
537  zp_v(jj) = pv(ji)
538  zp_qa(jj) = pqa(ji)
539  zp_ta(jj) = pta(ji)
540  zp_rhoa(jj) = prhoa(ji)
541  zp_co2(jj) = pco2(ji)
542  zp_rain(jj) = prain(ji)
543  zp_snow(jj) = psnow(ji)
544  zp_lw(jj) = plw(ji)
545  zp_ps(jj) = pps(ji)
546  zp_pa(jj) = ppa(ji)
547  zp_zs(jj) = pzs(ji)
548 ENDDO
549 !
550 !consider decoupling between CO2 emploied for photosynthesis and radiative CO2
551 !recommended as C4MIP option (XCO2UNCPL in ppmv)
552 IF(xco2uncpl/=xundef)THEN
553  zp_co2(:) = zp_rhoa(:) * xco2uncpl * 1.e-6 * xmco2 / xmd
554 ENDIF
555 !
556 DO jk=1,SIZE(psv,2)
557 !cdir nodep
558 !cdir unroll=8
559  DO jj=1,ksize
560  ji = kmask(jj)
561  zp_sv(jj,jk) = psv(ji,jk)
562  ENDDO
563 ENDDO
564 !
565 DO jk=1,iswb
566 !cdir nodep
567 !cdir unroll=8
568  DO jj=1,ksize
569  ji = kmask(jj)
570  zp_dir_sw(jj,jk) = pdir_sw(ji,jk)
571  zp_sca_sw(jj,jk) = psca_sw(ji,jk)
572  ENDDO
573 ENDDO
574 !
575 !cdir nodep
576 !cdir unroll=8
577 DO jj=1,ksize
578  ji = kmask(jj)
579  zp_pew_a_coef(jj) = zpew_a_coef(ji)
580  zp_pew_b_coef(jj) = zpew_b_coef(ji)
581  zp_pet_a_coef(jj) = zpet_a_coef(ji)
582  zp_pet_b_coef(jj) = zpet_b_coef(ji)
583  zp_peq_a_coef(jj) = zpeq_a_coef(ji)
584  zp_peq_b_coef(jj) = zpeq_b_coef(ji)
585 ENDDO
586 !
587 !--------------------------------------------------------------------------------------------
588 !
589 IF (ktile==1) THEN
590  !
591  CALL coupling_sea_n(ysc%SM, ysc%DGL, ysc%U, ysc%DST, ysc%SLT, &
592  hprogram, hcoupling, ptimec, &
593  ptstep, kyear, kmonth, kday, ptime, &
594  ysc%U%NSIZE_SEA, ksv, ksw, &
595  zp_tsun, zp_zenith, zp_zenith2,zp_azim, &
596  zp_zref, zp_uref, zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv, zp_co2, hsv,&
597  zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands, zp_ps, zp_pa, &
598  zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu, zp_sfv, &
599  zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf, zp_z0, zp_z0h, zp_qsurf, &
600  zp_pew_a_coef, zp_pew_b_coef, &
601  zp_pet_a_coef, zp_peq_a_coef, zp_pet_b_coef, zp_peq_b_coef, &
602  'OK' )
603  !
604 ELSEIF (ktile==2) THEN
605  !
606  CALL coupling_inland_water_n(ysc%FM, ysc%WM, ysc%DGL, ysc%U, ysc%DST, ysc%SLT, &
607  hprogram, hcoupling, ptimec, &
608  ptstep, kyear, kmonth, kday, ptime, &
609  ysc%U%NSIZE_WATER, ksv, ksw, &
610  zp_tsun, zp_zenith, zp_zenith2,zp_azim, &
611  zp_zref, zp_uref, zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv, zp_co2, hsv,&
612  zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands, zp_ps, zp_pa, &
613  zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu, zp_sfv, &
614  zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf, zp_z0, zp_z0h, zp_qsurf, &
615  zp_pew_a_coef, zp_pew_b_coef, &
616  zp_pet_a_coef, zp_peq_a_coef, zp_pet_b_coef, zp_peq_b_coef, &
617  'OK' )
618  !
619 ELSEIF (ktile==3) THEN
620  !
621  CALL coupling_nature_n(ysc%DTCO, ysc%UG, ysc%U, ysc%USS, ysc%IM, ysc%DTZ, &
622  ysc%GDM%DTGD, ysc%GRM%DTGR, ysc%GRM%TGRO, ysc%DGL, ysc%DST, ysc%SLT, &
623  hprogram, hcoupling, ptimec, &
624  ptstep, kyear, kmonth, kday, ptime, &
625  ysc%U%NSIZE_NATURE, ksv, ksw, &
626  zp_tsun, zp_zenith, zp_zenith2,zp_azim, &
627  zp_zref, zp_uref, zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv, zp_co2, hsv,&
628  zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands, zp_ps, zp_pa, &
629  zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu, zp_sfv, &
630  zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf, zp_z0, zp_z0h, zp_qsurf, &
631  zp_pew_a_coef, zp_pew_b_coef, &
632  zp_pet_a_coef, zp_peq_a_coef, zp_pet_b_coef, zp_peq_b_coef, &
633  'OK' )
634  !
635 ELSEIF (ktile==4) THEN
636  !
637  CALL coupling_town_n(ysc%DTCO, ysc%U, ysc%IM%DTI, ysc%IM%IG, ysc%IM%I, ysc%DGL, &
638  ysc%DST, ysc%SLT, ysc%TM, ysc%GDM, ysc%GRM, &
639  hprogram, hcoupling, ptimec, &
640  ptstep, kyear, kmonth, kday, ptime, &
641  ysc%U%NSIZE_TOWN, ksv, ksw, &
642  zp_tsun, zp_zenith, zp_azim, &
643  zp_zref, zp_uref, zp_zs, zp_u, zp_v, zp_qa, zp_ta, zp_rhoa, zp_sv, zp_co2, hsv,&
644  zp_rain, zp_snow, zp_lw, zp_dir_sw, zp_sca_sw, psw_bands, zp_ps, zp_pa, &
645  zp_sftq, zp_sfth, zp_sfts, zp_sfco2, zp_sfu, zp_sfv, &
646  zp_trad, zp_dir_alb, zp_sca_alb, zp_emis, zp_tsurf, zp_z0, zp_z0h, zp_qsurf, &
647  zp_pew_a_coef, zp_pew_b_coef, &
648  zp_pet_a_coef, zp_peq_a_coef, zp_pet_b_coef, zp_peq_b_coef, &
649  'OK' )
650  !
651 ENDIF
652 !
653 !----------------------------------------------------------------------------------------------
654 !
655 !cdir nodep
656 !cdir unroll=8
657 DO jj=1,ksize
658  ji=kmask(jj)
659  zsftq_tile(ji,ktile) = zp_sftq(jj)
660  zsfth_tile(ji,ktile) = zp_sfth(jj)
661  zsfco2_tile(ji,ktile) = zp_sfco2(jj)
662  zsfu_tile(ji,ktile) = zp_sfu(jj)
663  zsfv_tile(ji,ktile) = zp_sfv(jj)
664  ztrad_tile(ji,ktile) = zp_trad(jj)
665  zemis_tile(ji,ktile) = zp_emis(jj)
666  ztsurf_tile(ji,ktile) = zp_tsurf(jj)
667  zz0_tile(ji,ktile) = zp_z0(jj)
668  zz0h_tile(ji,ktile) = zp_z0h(jj)
669  zqsurf_tile(ji,ktile) = zp_qsurf(jj)
670 ENDDO
671 !
672 DO ji=1,SIZE(zp_sfts,2)
673 !cdir nodep
674 !cdir unroll=8
675  DO jj=1,ksize
676  zsfts_tile(kmask(jj),ji,ktile)= zp_sfts(jj,ji)
677  ENDDO
678 ENDDO
679 !
680 DO ji=1,SIZE(zp_dir_alb,2)
681 !cdir nodep
682 !cdir unroll=8
683  DO jj=1,ksize
684  zdir_alb_tile(kmask(jj),ji,ktile)= zp_dir_alb(jj,ji)
685  zsca_alb_tile(kmask(jj),ji,ktile)= zp_sca_alb(jj,ji)
686  ENDDO
687 ENDDO
688 !
689 !----------------------------------------------------------------------------------------------
690 !
691 IF (lhook) CALL dr_hook('COUPLING_SURF_ATM_n:TREAT_SURF',1,zhook_handle)
692 !
693 END SUBROUTINE treat_surf
694 !=======================================================================================
695 END SUBROUTINE coupling_surf_atm_n
modd_surfex_mpi
Definition: modd_surfex_mpi.F90:6
cpl_gcm_n
subroutine cpl_gcm_n(U, KI, PRAIN, PSNOW, PZ0, PZ0H, PQSURF)
Definition: cpl_gcmn.F90:6
modd_surfex_n
Definition: modd_surfexn.F90:5
ch_emission_to_atm_n
subroutine ch_emission_to_atm_n(CHN, SV, PSFSV, PRHOA)
Definition: ch_emission_to_atmn.F90:6
modd_co2v_par
Definition: modd_co2v_par.F90:6
modd_surfex_n::surfex_t
Definition: modd_surfexn.F90:197
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
coupling_nature_n
subroutine coupling_nature_n(DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DGL, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_naturen.F90:6
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
modd_surf_atm
Definition: modd_surf_atm.F90:6
sso_be04_friction_n
subroutine sso_be04_friction_n(SSCP, USS, PTSTEP, PSEA, PUREF, PRHOA, PU, PV, PSFU, PSFV)
Definition: sso_be04_frictionn.F90:6
average_phy
subroutine average_phy(PFRAC_TILE, PTSURF_TILE, PZ0_TILE, PZ0H_TILE, PQSURF_TILE, PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF)
Definition: average_phy.F90:6
modd_surf_conf
Definition: modd_surf_conf.F90:6
coupling_surf_atm_n
subroutine coupling_surf_atm_n(YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_surf_atmn.F90:6
average_rad
subroutine average_rad(PFRAC_TILE, PDIR_ALB_TILE, PSCA_ALB_TILE, PEMIS_TILE, PTRAD_TILE, PDIR_ALB, PSCA_ALB, PEMIS, PTRAD)
Definition: average_rad.F90:6
coupling_sea_n
subroutine coupling_sea_n(SM, DGL, U, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_sean.F90:6
average_flux
subroutine average_flux(PFRAC_TILE, PSFTH_TILE, PSFTQ_TILE, PSFTS_TILE, PSFCO2_TILE, PSFU_TILE, PSFV_TILE, PSFTH, PSFTQ, PSFTS, PSFCO2, PSFU, PSFV)
Definition: average_flux.F90:6
treat_surf
subroutine treat_surf(KMASK, YTYPE)
Definition: coare30_seaflux.F90:163
add_forecast_to_date_surf
subroutine add_forecast_to_date_surf(KYEAR, KMONTH, KDAY, PSEC)
Definition: add_forecast_to_date_surf.F90:6
coupling_town_n
subroutine coupling_town_n(DTCO, U, DTI, IG, I, DGL, DST, SLT, TM, GDM, GRM, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_townn.F90:6
ch_emission_flux_n
subroutine ch_emission_flux_n(YSC, HPROGRAM, PSIMTIME, PSFSV, PRHOA, PTSTEP, KNBTS_MAX)
Definition: ch_emission_fluxn.F90:6
modd_surf_par
Definition: modd_surf_par.F90:6
ch_emission_snap_n
subroutine ch_emission_snap_n(CHN, HPROGRAM, KSIZE, PSIMTIME, PSUNTIME, KYEAR, KMONTH, KDAY, PRHOA, PLON)
Definition: ch_emission_snapn.F90:6
coupling_inland_water_n
subroutine coupling_inland_water_n(FM, WM, DGL, U, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_inland_watern.F90:6
sso_z0_friction_n
subroutine sso_z0_friction_n(USS, PSEA, PUREF, PRHOA, PU, PV, PPEW_A_COEF, PPEW_B_COEF, PSFU, PSFV)
Definition: sso_z0_frictionn.F90:6
modd_csts
Definition: modd_csts.F90:6
diag_inline_surf_atm_n
subroutine diag_inline_surf_atm_n(DGU, PHW, PHT, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2)
Definition: diag_inline_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:01 for SURFEX by   doxygen 1.8.5