Context Navigation

pbl_surface_mod.F90 @ 5954

Last change on this file since 5954 was 5954, checked in by yann meurdesoif, 2 months ago
GPU port of climb_hq_up +climb_hq_down merge of commit r5878 YM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 255.3 KB

Line
1	!
2	! $Id: pbl_surface_mod.F90 5954 2025-12-18 18:05:43Z ymeurdesoif $
3	!
4	MODULE pbl_surface_mod
5	!
6	! Planetary Boundary Layer and Surface module
7	!
8	! This module manages the calculation of turbulent diffusion in the boundary layer
9	! and all interactions towards the differents sub-surfaces.
10	!
11	!
12	USE dimphy
13	USE mod_phys_lmdz_para, ONLY : mpi_size
14	USE mod_grid_phy_lmdz, ONLY : klon_glo
15	USE ioipsl
16	USE surface_data, ONLY : type_ocean, ok_veget, landice_opt, iflag_leads
17	USE surf_land_mod, ONLY : surf_land
18	USE surf_landice_mod, ONLY : surf_landice
19	USE surf_ocean_mod, ONLY : surf_ocean
20	USE surf_seaice_mod, ONLY : surf_seaice
21	USE cpl_mod, ONLY : gath2cpl
22	USE climb_hq_mod, ONLY : climb_hq_down, climb_hq_up
23	USE climb_qbs_mod, ONLY : climb_qbs_down, climb_qbs_up
24	USE climb_wind_mod, ONLY : climb_wind_down, climb_wind_up
25	USE coef_diff_turb_mod, ONLY : coef_diff_turb
26	USE lmdz_call_atke, ONLY : call_atke
27	USE ioipsl_getin_p_mod, ONLY : getin_p
28	USE cdrag_mod
29	USE stdlevvar_mod
30	USE wx_pbl_var_mod, ONLY : wx_pbl_init, wx_pbl_final, &
31	wx_pbl_prelim_0, wx_pbl_prelim_beta
32	USE wx_pbl_mod, ONLY : wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, &
33	wx_pbl_check, wx_pbl_dts_check, wx_evappot
34	use config_ocean_skin_m, only: activate_ocean_skin
35	#ifdef ISO
36	USE infotrac_phy, ONLY: niso,ntraciso=>ntiso
37	#endif
38
39	IMPLICIT NONE
40
41	! Declaration of variables saved in restart file
42	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: fder ! flux drift
43	!$OMP THREADPRIVATE(fder)
44	!GG
45	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: hice ! flux drift
46	!$OMP THREADPRIVATE(hice)
47	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tice ! flux drift
48	!$OMP THREADPRIVATE(tice)
49	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: bilg_cumul ! flux drift
50	!$OMP THREADPRIVATE(bilg_cumul)
51	!GG
52	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE :: snow ! snow at surface
53	!$OMP THREADPRIVATE(snow)
54	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: qsurf ! humidity at surface
55	!$OMP THREADPRIVATE(qsurf)
56	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ftsoil ! soil temperature
57	!$OMP THREADPRIVATE(ftsoil)
58	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: ydTs0, ydqs0
59	! nul forced temperature and humidity differences
60	!$OMP THREADPRIVATE(ydTs0, ydqs0)
61
62	#ifdef ISO
63	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: xtsnow ! snow at surface
64	!$OMP THREADPRIVATE(xtsnow)
65	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: Rland_ice ! snow at surface
66	!$OMP THREADPRIVATE(Rland_ice)
67	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: Roce ! snow at surface
68	!$OMP THREADPRIVATE(Roce)
69	#endif
70
71	INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
72	!$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
73	INTEGER, SAVE :: iflag_new_t2mq2m
74	!$OMP THREADPRIVATE(iflag_new_t2mq2m)
75	LOGICAL, SAVE :: ok_bug_zg_wk_pbl
76	!$OMP THREADPRIVATE(ok_bug_zg_wk_pbl)
77
78
79	!JYG<
80	REAL, SAVE, PROTECTED :: smallestreal
81	!$OMP THREADPRIVATE(smallestreal)
82
83	REAL, SAVE, PROTECTED :: beta_land ! beta for wx_dts
84	!$OMP THREADPRIVATE(beta_land)
85
86
87	!FC
88	! integer, save :: iflag_frein
89	! !$OMP THREADPRIVATE(iflag_frein)
90
91	CONTAINS
92
93	!
94	!****************************************************************************************
95	!
96	!GG
97	! SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
98	SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst, hice_rst,tice_rst,bilg_cumul_rst)
99	!GG
100
101	! This routine should be called after the restart file has been read.
102	! This routine initialize the restart variables and does some validation tests
103	! for the index of the different surfaces and tests the choice of type of ocean.
104
105	USE indice_sol_mod
106	USE print_control_mod, ONLY: lunout
107	USE ioipsl_getin_p_mod, ONLY : getin_p
108	USE dimsoil_mod_h, ONLY: nsoilmx
109	USE flux_arp_mod_h
110	USE cdrag_mod, ONLY : cdrag_init
111	USE climb_hq_mod, ONLY : climb_hq_init
112	IMPLICIT NONE
113
114	! Input variables
115	!****************************************************************************************
116	REAL, DIMENSION(klon), INTENT(IN) :: fder_rst
117	!GG
118	REAL, DIMENSION(klon), INTENT(IN) :: hice_rst
119	REAL, DIMENSION(klon), INTENT(IN) :: tice_rst
120	REAL, DIMENSION(klon), INTENT(IN) :: bilg_cumul_rst
121	!GG
122	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: snow_rst
123	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: qsurf_rst
124	REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
125
126	! Local variables
127	!****************************************************************************************
128	INTEGER :: ierr
129	CHARACTER(len=80) :: abort_message
130	CHARACTER(len = 20) :: modname = 'pbl_surface_init'
131
132	!****************************************************************************************
133	! Initialize some module variables
134	!****************************************************************************************
135	smallestreal = tiny(smallestreal)
136
137	!****************************************************************************************
138	! Allocate and initialize module variables with fields read from restart file.
139	!
140	!****************************************************************************************
141
142	ALLOCATE(fder(klon), stat=ierr)
143	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
144
145	!GG
146	ALLOCATE(hice(klon), stat=ierr)
147	IF (ierr /= 0) CALL abort_physic('pbl_surface_init hice', 'pb in allocation',1)
148
149	ALLOCATE(tice(klon), stat=ierr)
150	IF (ierr /= 0) CALL abort_physic('pbl_surface_init tice', 'pb in allocation',1)
151
152	ALLOCATE(bilg_cumul(klon), stat=ierr)
153	IF (ierr /= 0) CALL abort_physic('pbl_surface_init bilg', 'pb in allocation',1)
154	!GG
155
156	ALLOCATE(snow(klon,nbsrf), stat=ierr)
157	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
158
159	ALLOCATE(qsurf(klon,nbsrf), stat=ierr)
160	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
161
162	ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr)
163	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
164
165	ALLOCATE(ydTs0(klon), stat=ierr)
166	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
167
168	ALLOCATE(ydqs0(klon), stat=ierr)
169	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
170
171	fder(:) = fder_rst(:)
172	!GG
173	hice(:) = hice_rst(:)
174	tice(:) = tice_rst(:)
175	bilg_cumul(:) = bilg_cumul_rst(:)
176	!GG
177	snow(:,:) = snow_rst(:,:)
178	qsurf(:,:) = qsurf_rst(:,:)
179	ftsoil(:,:,:) = ftsoil_rst(:,:,:)
180	ydTs0(:) = 0.
181	ydqs0(:) = 0.
182
183	!****************************************************************************************
184	! Test for sub-surface indices
185	!
186	!****************************************************************************************
187	IF (is_ter /= 1) THEN
188	WRITE(lunout,)" Warning *"
189	WRITE(lunout,*)" is_ter n'est pas le premier surface, is_ter = ",is_ter
190	WRITE(lunout,*)"or on doit commencer par les surfaces continentales"
191	abort_message="voir ci-dessus"
192	CALL abort_physic(modname,abort_message,1)
193	ENDIF
194
195	IF ( is_oce > is_sic ) THEN
196	WRITE(lunout,)' Warning *'
197	WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
198	WRITE(lunout,*)' l''ocean doit etre traite avant la banquise'
199	WRITE(lunout,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic
200	abort_message='voir ci-dessus'
201	CALL abort_physic(modname,abort_message,1)
202	ENDIF
203
204	IF ( is_lic > is_sic ) THEN
205	WRITE(lunout,)' Warning *'
206	WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
207	WRITE(lunout,*)' la glace contineltalle doit etre traite avant la glace de mer'
208	WRITE(lunout,*)' or is_lic = ',is_lic, '> is_sic = ',is_sic
209	abort_message='voir ci-dessus'
210	CALL abort_physic(modname,abort_message,1)
211	ENDIF
212
213	!****************************************************************************************
214	! Validation of ocean mode
215	!
216	!****************************************************************************************
217
218	IF (type_ocean /= 'slab ' .AND. type_ocean /= 'force ' .AND. type_ocean /= 'couple') THEN
219	WRITE(lunout,)' Warning *'
220	WRITE(lunout,*)'Option couplage pour l''ocean = ', type_ocean
221	abort_message='option pour l''ocean non valable'
222	CALL abort_physic(modname,abort_message,1)
223	ENDIF
224
225	iflag_pbl_surface_t2m_bug=0
226	CALL getin_p('iflag_pbl_surface_t2m_bug',iflag_pbl_surface_t2m_bug)
227	WRITE(lunout,*) 'iflag_pbl_surface_t2m_bug=',iflag_pbl_surface_t2m_bug
228	!FC
229	! iflag_frein = 0
230	! CALL getin_p('iflag_frein',iflag_frein)
231	!
232	!jyg<
233	!****************************************************************************************
234	! Allocate variables for pbl splitting
235	!
236	!****************************************************************************************
237
238	!****************************************************************************************
239	! Initialisation and validation tests
240	! moved from only done first time entering this subroutine
241	!
242	!****************************************************************************************
243	iflag_new_t2mq2m=1
244	CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
245	WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
246
247	ok_bug_zg_wk_pbl=.TRUE.
248	CALL getin_p('ok_bug_zg_wk_pbl',ok_bug_zg_wk_pbl)
249	WRITE(lunout,*) 'ok_bug_zg_wk_pbl=',ok_bug_zg_wk_pbl
250
251	print*,'PBL SURFACE AVEC GUSTINESS'
252
253	! Initialize ok_flux_surf (for 1D model)
254	IF (klon_glo>1) ok_flux_surf=.FALSE.
255	IF (klon_glo>1) ok_forc_tsurf=.FALSE.
256
257	! intialize beta_land
258	beta_land = 0.5
259	call getin_p('beta_land', beta_land)
260
261
262	CALL wx_pbl_init
263	!>jyg
264
265	CALL cdrag_init
266	CALL climb_hq_init
267
268	END SUBROUTINE pbl_surface_init
269
270	#ifdef ISO
271	SUBROUTINE pbl_surface_init_iso(xtsnow_rst,Rland_ice_rst)
272
273	! This routine should be called after the restart file has been read.
274	! This routine initialize the restart variables and does some validation tests
275	! for the index of the different surfaces and tests the choice of type of ocean.
276
277	USE indice_sol_mod
278	USE print_control_mod, ONLY: lunout
279	#ifdef ISOVERIF
280	USE isotopes_mod, ONLY: iso_eau,ridicule
281	USE isotopes_verif_mod
282	#endif
283	USE dimsoil_mod_h, ONLY: nsoilmx
284	IMPLICIT NONE
285
286	! Input variables
287	!****************************************************************************************
288	REAL, DIMENSION(niso,klon, nbsrf), INTENT(IN) :: xtsnow_rst
289	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice_rst
290
291	! Local variables
292	!****************************************************************************************
293	INTEGER :: ierr
294	CHARACTER(len=80) :: abort_message
295	CHARACTER(len = 20) :: modname = 'pbl_surface_init'
296	integer i,ixt
297
298	!****************************************************************************************
299	! Allocate and initialize module variables with fields read from restart file.
300	!
301	!****************************************************************************************
302
303	ALLOCATE(xtsnow(niso,klon,nbsrf), stat=ierr)
304	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
305
306	ALLOCATE(Rland_ice(niso,klon), stat=ierr)
307	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
308
309	ALLOCATE(Roce(niso,klon), stat=ierr)
310	IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
311
312	xtsnow(:,:,:) = xtsnow_rst(:,:,:)
313	Rland_ice(:,:) = Rland_ice_rst(:,:)
314	Roce(:,:) = 0.0
315
316	#ifdef ISOVERIF
317	IF (iso_eau >= 0) THEN
318	CALL iso_verif_egalite_vect2D( &
319	& xtsnow,snow, &
320	& 'pbl_surface_mod 170',niso,klon,nbsrf)
321	DO i=1,klon
322	IF (iso_eau >= 0) THEN
323	CALL iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
324	& 'pbl_surf_mod 177')
325	ENDIF
326	ENDDO
327	ENDIF
328	#endif
329
330	END SUBROUTINE pbl_surface_init_iso
331	#endif
332	!
333	!****************************************************************************************
334	!
335	SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst &
336	#ifdef ISO
337	,xtsnow_rst,Rland_ice_rst &
338	#endif
339	)
340
341	USE indice_sol_mod
342	#ifdef ISO
343	#ifdef ISOVERIF
344	USE isotopes_mod, ONLY: iso_eau,ridicule
345	USE isotopes_verif_mod, ONLY: errmax,errmaxrel
346	#endif
347	#endif
348	USE dimsoil_mod_h, ONLY: nsoilmx
349
350	! Ouput variables
351	!****************************************************************************************
352	REAL, DIMENSION(klon), INTENT(OUT) :: fder_rst
353	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: snow_rst
354	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: qsurf_rst
355	REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
356	#ifdef ISO
357	REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT) :: xtsnow_rst
358	REAL, DIMENSION(niso,klon), INTENT(OUT) :: Rland_ice_rst
359	#endif
360
361
362	!****************************************************************************************
363	! Return module variables for writing to restart file
364	!
365	!****************************************************************************************
366	fder_rst(:) = fder(:)
367	snow_rst(:,:) = snow(:,:)
368	qsurf_rst(:,:) = qsurf(:,:)
369	ftsoil_rst(:,:,:) = ftsoil(:,:,:)
370	#ifdef ISO
371	xtsnow_rst(:,:,:) = xtsnow(:,:,:)
372	Rland_ice_rst(:,:) = Rland_ice(:,:)
373	#endif
374
375	!****************************************************************************************
376	! Deallocate module variables
377	!
378	!****************************************************************************************
379	! DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil)
380	IF (ALLOCATED(fder)) DEALLOCATE(fder)
381	IF (ALLOCATED(hice)) DEALLOCATE(hice)
382	IF (ALLOCATED(tice)) DEALLOCATE(tice)
383	IF (ALLOCATED(bilg_cumul)) DEALLOCATE(bilg_cumul)
384	IF (ALLOCATED(snow)) DEALLOCATE(snow)
385	IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
386	IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
387	IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
388	IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
389	#ifdef ISO
390	IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow)
391	IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice)
392	IF (ALLOCATED(Roce)) DEALLOCATE(Roce)
393	#endif
394
395	!jyg<
396	!****************************************************************************************
397	! Deallocate variables for pbl splitting
398	!
399	!****************************************************************************************
400
401	CALL wx_pbl_final
402	!>jyg
403
404	END SUBROUTINE pbl_surface_final
405	!
406	!****************************************************************************************
407	!
408
409	!albedo SB >>>
410	SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
411	evap, z0m, z0h, agesno, &
412	tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke &
413	#ifdef ISO
414	,xtevap &
415	#endif
416	& )
417	!albedo SB <<<
418	! Give default values where new fraction has appread
419
420	USE compbl_mod_h
421	USE clesphys_mod_h
422	USE indice_sol_mod
423	use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst, dter, &
424	dser, dt_ds
425	use config_ocean_skin_m, only: activate_ocean_skin
426
427	! Input variables
428	!****************************************************************************************
429	INTEGER, INTENT(IN) :: itime
430	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf_new, pctsrf_old
431
432	! InOutput variables
433	!****************************************************************************************
434	REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
435	!albedo SB >>>
436	REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir, alb_dif
437	INTEGER :: k
438	!albedo SB <<<
439	REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar,u10m, v10m
440	REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: evap, agesno
441	REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h
442	REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
443	#ifdef ISO
444	REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT) :: xtevap
445	#endif
446
447	! Local variables
448	!****************************************************************************************
449	INTEGER :: nsrf, nsrf_comp1, nsrf_comp2, nsrf_comp3, i
450	CHARACTER(len=80) :: abort_message
451	CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
452	INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
453	#ifdef ISO
454	INTEGER :: ixt
455	#endif
456	!
457	! All at once !!
458	!****************************************************************************************
459
460	DO nsrf = 1, nbsrf
461	! First decide complement sub-surfaces
462	SELECT CASE (nsrf)
463	CASE(is_oce)
464	nsrf_comp1=is_sic
465	nsrf_comp2=is_ter
466	nsrf_comp3=is_lic
467	CASE(is_sic)
468	nsrf_comp1=is_oce
469	nsrf_comp2=is_ter
470	nsrf_comp3=is_lic
471	CASE(is_ter)
472	nsrf_comp1=is_lic
473	nsrf_comp2=is_oce
474	nsrf_comp3=is_sic
475	CASE(is_lic)
476	nsrf_comp1=is_ter
477	nsrf_comp2=is_oce
478	nsrf_comp3=is_sic
479	END SELECT
480
481	! Initialize all new fractions
482	DO i=1, klon
483	IF (pctsrf_new(i,nsrf) > 0. .AND. pctsrf_old(i,nsrf) == 0.) THEN
484
485	IF (pctsrf_old(i,nsrf_comp1) > 0.) THEN
486	! Use the complement sub-surface, keeping the continents unchanged
487	qsurf(i,nsrf) = qsurf(i,nsrf_comp1)
488	evap(i,nsrf) = evap(i,nsrf_comp1)
489	z0m(i,nsrf) = z0m(i,nsrf_comp1)
490	z0h(i,nsrf) = z0h(i,nsrf_comp1)
491	tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
492	!albedo SB >>>
493	DO k=1,nsw
494	alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp1)
495	alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp1)
496	ENDDO
497	!albedo SB <<<
498	ustar(i,nsrf) = ustar(i,nsrf_comp1)
499	u10m(i,nsrf) = u10m(i,nsrf_comp1)
500	v10m(i,nsrf) = v10m(i,nsrf_comp1)
501	#ifdef ISO
502	DO ixt=1,ntraciso
503	xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp1)
504	ENDDO
505	#endif
506	IF (iflag_pbl > 1) THEN
507	tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
508	ENDIF
509	mfois(nsrf) = mfois(nsrf) + 1
510	! F. Codron sensible default values for ocean and sea ice
511	IF (nsrf.EQ.is_oce) THEN
512	tsurf(i,nsrf) = 271.35
513	! (temperature of sea water under sea ice, so that
514	! is also the temperature of appearing sea water)
515	DO k=1,nsw
516	alb_dir(i,k,nsrf) = 0.06 ! typical Ocean albedo
517	alb_dif(i,k,nsrf) = 0.06
518	ENDDO
519	if (activate_ocean_skin >= 1) then
520	if (activate_ocean_skin == 2 &
521	.and. type_ocean == "couple") then
522	delta_sal(i) = 0.
523	delta_sst(i) = 0.
524	dter(i) = 0.
525	dser(i) = 0.
526	dt_ds(i) = 0.
527	end if
528
529	ds_ns(i) = 0.
530	dt_ns(i) = 0.
531	end if
532	ELSE IF (nsrf.EQ.is_sic) THEN
533	tsurf(i,nsrf) = 271.35
534	! (Temperature at base of sea ice. Surface
535	! temperature could be higher, up to 0 Celsius
536	! degrees. We set it to -1.8 Celsius degrees for
537	! consistency with the ocean slab model.)
538	DO k=1,nsw
539	alb_dir(i,k,nsrf) = 0.3 ! thin ice
540	alb_dif(i,k,nsrf) = 0.3
541	ENDDO
542	ENDIF
543	ELSE
544	! The continents have changed. The new fraction receives the mean sum of the existent fractions
545	qsurf(i,nsrf) = qsurf(i,nsrf_comp2)pctsrf_old(i,nsrf_comp2) + qsurf(i,nsrf_comp3)pctsrf_old(i,nsrf_comp3)
546	evap(i,nsrf) = evap(i,nsrf_comp2) pctsrf_old(i,nsrf_comp2) + evap(i,nsrf_comp3) pctsrf_old(i,nsrf_comp3)
547	z0m(i,nsrf) = z0m(i,nsrf_comp2)pctsrf_old(i,nsrf_comp2) + z0m(i,nsrf_comp3)pctsrf_old(i,nsrf_comp3)
548	z0h(i,nsrf) = z0h(i,nsrf_comp2)pctsrf_old(i,nsrf_comp2) + z0h(i,nsrf_comp3)pctsrf_old(i,nsrf_comp3)
549	tsurf(i,nsrf) = tsurf(i,nsrf_comp2)pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)pctsrf_old(i,nsrf_comp3)
550	!albedo SB >>>
551	DO k=1,nsw
552	alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
553	alb_dir(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
554	alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
555	alb_dif(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
556	ENDDO
557	!albedo SB <<<
558	ustar(i,nsrf) = ustar(i,nsrf_comp2) pctsrf_old(i,nsrf_comp2) + ustar(i,nsrf_comp3) pctsrf_old(i,nsrf_comp3)
559	u10m(i,nsrf) = u10m(i,nsrf_comp2) pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) pctsrf_old(i,nsrf_comp3)
560	v10m(i,nsrf) = v10m(i,nsrf_comp2) pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) pctsrf_old(i,nsrf_comp3)
561	#ifdef ISO
562	DO ixt=1,ntraciso
563	xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) &
564	+ xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
565	ENDDO
566	#endif
567	IF (iflag_pbl > 1) THEN
568	tke(i,:,nsrf) = tke(i,:,nsrf_comp2)pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)pctsrf_old(i,nsrf_comp3)
569	ENDIF
570
571	! Security abort. This option has never been tested. To test, comment the following line.
572	! abort_message='The fraction of the continents have changed!'
573	! CALL abort_physic(modname,abort_message,1)
574	nfois(nsrf) = nfois(nsrf) + 1
575	ENDIF
576	snow(i,nsrf) = 0.
577	agesno(i,nsrf) = 0.
578	ftsoil(i,:,nsrf) = tsurf(i,nsrf)
579	#ifdef ISO
580	xtsnow(:,i,nsrf) = 0.
581	#endif
582	ELSE
583	pfois(nsrf) = pfois(nsrf)+ 1
584	ENDIF
585	ENDDO
586
587	ENDDO
588
589	END SUBROUTINE pbl_surface_newfrac
590
591
592	SUBROUTINE pbl_surface_main( &
593	dtime, date0, itap, jour, &
594	debut, lafin, &
595	rlon, rlat, rugoro, rmu0, &
596	lwdown_m, pphi, cldt, &
597	rain_f, snow_f, bs_f, solsw_m, solswfdiff_m, sollw_m, &
598	gustiness, &
599	t, q, qbs, u, v, &
600	wake_dlt, wake_dlq, &
601	wake_cstar, wake_s, &
602	pplay, paprs, pctsrf, &
603	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
604	cdragh, cdragm, zu1, zv1, &
605	beta, &
606	alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, &
607	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
608	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
609	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
610	d_t_w, d_q_w, &
611	d_t_x, d_q_x, &
612	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
613	delta_tsurf,wake_dens,cdragh_x,cdragh_w, &
614	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
615	zcoefh, zcoefm, slab_wfbils, &
616	qsol, zq2m, s_pblh, s_plcl, &
617	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
618	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
619	s_therm, s_trmb1, s_trmb2, s_trmb3, &
620	zustar,zu10m, zv10m, fder_print, &
621	zxqsurf, delta_qsurf, &
622	rh2m, zxfluxu, zxfluxv, &
623	z0m, z0h, agesno, sollw, solsw, &
624	d_ts, evap, fluxlat, t2m, &
625	wfbils, wfevap, &
626	flux_t, flux_u, flux_v, &
627	dflux_t, dflux_q, zxsnow, &
628	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, tke_x, eps_x, &
629	wake_dltke, &
630	treedrg,hice ,tice, bilg_cumul, &
631	fcds, fcdi, dh_basal_growth, dh_basal_melt, &
632	dh_top_melt, dh_snow2sic, &
633	dtice_melt, dtice_snow2sic , &
634	tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
635	cdragm_tersrf, cdragh_tersrf, &
636	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
637	#ifdef ISO
638	& ,xtrain_f, xtsnow_f,xt, &
639	& wake_dlxt,zxxtevap,xtevap, &
640	& d_xt,d_xt_w,d_xt_x, &
641	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
642	& h1_diag,runoff_diag,xtrunoff_diag &
643	#endif
644	& )
645
646	!****************************************************************************************
647	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
648	! Objet: interface de "couche limite" (diffusion verticale)
649	!
650	!AA REM:
651	!AA-----
652	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
653	!AA pour l'instant le calcul de la couche limite pour les traceurs
654	!AA se fait avec cltrac et ne tient pas compte de la differentiation
655	!AA des sous-fraction de sol.
656	!AA REM bis :
657	!AA----------
658	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
659	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
660	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
661	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
662	!AA si les informations des subsurfaces doivent etre prises en compte
663	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
664	!AA c'est a dire nbsrf (nbre de subsurface).
665	!
666	! Arguments:
667	!
668	! dtime----input-R- interval du temps (secondes)
669	! itap-----input-I- numero du pas de temps
670	! date0----input-R- jour initial
671	! t--------input-R- temperature (K)
672	! q--------input-R- vapeur d'eau (kg/kg)
673	! u--------input-R- vitesse u
674	! v--------input-R- vitesse v
675	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
676	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
677	!wake_cstar-input-R- wake gust front speed (m/s)
678	! wake_s---input-R- wake fractionnal area
679	! ts-------input-R- temperature du sol (en Kelvin)
680	! paprs----input-R- pression a intercouche (Pa)
681	! pplay----input-R- pression au milieu de couche (Pa)
682	! rlat-----input-R- latitude en degree
683	! z0m, z0h ----input-R- longeur de rugosite (en m)
684	! Martin
685	! cldt-----input-R- total cloud fraction
686	! Martin
687	!GG
688	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
689	!GG
690	!
691	! d_t------output-R- le changement pour "t"
692	! d_q------output-R- le changement pour "q"
693	! d_u------output-R- le changement pour "u"
694	! d_v------output-R- le changement pour "v"
695	! d_ts-----output-R- le changement pour "ts"
696	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
697	! (orientation positive vers le bas)
698	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
699	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
700	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
701	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
702	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
703	! dflux_t--output-R- derive du flux sensible
704	! dflux_q--output-R- derive du flux latent
705	! zu1------output-R- le vent dans la premiere couche
706	! zv1------output-R- le vent dans la premiere couche
707	! trmb1----output-R- deep_cape
708	! trmb2----output-R- inhibition
709	! trmb3----output-R- Point Omega
710	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
711	! plcl-----output-R- Niveau de condensation
712	! pblh-----output-R- HCL
713	! pblT-----output-R- T au nveau HCL
714	! treedrg--output-R- tree drag (m)
715	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
716	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
717	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
718	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
719	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
720	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
721	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
722	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
723	USE dimphy, ONLY : klon, klev
724	USE indice_sol_mod, ONLY : nbsrf, is_ter, is_oce, is_sic, is_lic
725	USE clesphys_mod_h, ONLY : nsw
726	USE dimsoil_mod_h, ONLY : nsoilmx
727	#ifdef ISO
728	USE infotrac_phy, ONLY: ntraciso=>ntiso
729	#endif
730	USE print_control_mod, ONLY : prt_level
731	USE lmdz_checksum, ONLY : checksum
732	USE mod_phys_lmdz_para, ONLY : is_master
733	USE print_control_mod, ONLY: lunout
734	IMPLICIT NONE
735
736
737	!****************************************************************************************
738	REAL, INTENT(IN) :: dtime ! time interval (s)
739	REAL, INTENT(IN) :: date0 ! initial day
740	INTEGER, INTENT(IN) :: itap ! time step
741	INTEGER, INTENT(IN) :: jour ! current day of the year
742	LOGICAL, INTENT(IN) :: debut ! true if first run step
743	LOGICAL, INTENT(IN) :: lafin ! true if last run step
744	REAL, DIMENSION(klon), INTENT(IN) :: rlon ! longitudes in degrees
745	REAL, DIMENSION(klon), INTENT(IN) :: rlat ! latitudes in degrees
746	REAL, DIMENSION(klon), INTENT(IN) :: rugoro ! rugosity length
747	REAL, DIMENSION(klon), INTENT(IN) :: rmu0 ! cosine of solar zenith angle
748	REAL, DIMENSION(klon), INTENT(IN) :: rain_f ! rain fall
749	REAL, DIMENSION(klon), INTENT(IN) :: snow_f ! snow fall
750	REAL, DIMENSION(klon), INTENT(IN) :: bs_f ! blowing snow fall
751	REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! net shortwave radiation at mean surface
752	REAL, DIMENSION(klon), INTENT(IN) :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
753	REAL, DIMENSION(klon), INTENT(IN) :: sollw_m ! net longwave radiation at mean surface
754	REAL, DIMENSION(klon,klev), INTENT(IN) :: t ! temperature (K)
755	REAL, DIMENSION(klon,klev), INTENT(IN) :: q ! water vapour (kg/kg)
756	REAL, DIMENSION(klon,klev), INTENT(IN) :: qbs ! blowing snow specific content (kg/kg)
757	REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed
758	REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed
759	REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay ! mid-layer pression (Pa)
760	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa)
761	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
762	REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downward longwave radiation at mean s
763	REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness
764	REAL, DIMENSION(klon,klev), INTENT(IN) :: pphi ! geopotential (m2/s2)
765	REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud
766	#ifdef ISO
767	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
768	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
769	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
770	#endif
771	REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlt !temperature difference between (w) and (x) (K)
772	REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlq !humidity difference between (w) and (x) (K)
773	REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides
774	REAL, DIMENSION(klon), INTENT(IN) :: wake_cstar! Vitesse d'expansion des poches froides
775	REAL, DIMENSION(klon), INTENT(IN) :: wake_dens
776	#ifdef ISO
777	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
778	#endif
779	! Input/Output variables
780	!****************************************************************************************
781	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: beta ! Aridity factor
782	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
783	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: delta_tsurf !surface temperature difference between
784	!wake and off-wake regions
785	!albedo SB >>>
786	REAL, DIMENSION(6), intent(in) :: SFRWL
787	REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
788	!albedo SB <<<
789	!jyg Pourquoi ustar et wstar sont-elles INOUT ?
790	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
791	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
792	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
793	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
794	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
795	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
796
797	! Output variables
798	!****************************************************************************************
799	REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(OUT) :: eps_x ! TKE dissipation rate
800
801	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q
802	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind
803	REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer
804	REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer
805	REAL, DIMENSION(klon, nsw), INTENT(OUT) :: alb_dir_m,alb_dif_m
806	REAL, DIMENSION(klon), INTENT(OUT) :: alb3_lic
807	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign
808	! (=> positive sign upwards)
809	REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards
810	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface
811	REAL, DIMENSION(klon), INTENT(OUT) :: icesub_lic ! ice (no snow!) sublimation over ice sheet
812	REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point
813	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_w ! !
814	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_w ! ! Tendances dans les poches
815	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_x ! !
816	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_x ! ! Tendances hors des poches
817	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point
818	REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point
819	INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: zn2mout ! number of times the 2m temperature is out of the [tsol,temp]
820	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m
821	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t ! change in temperature
822	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_diss ! change in temperature
823	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q ! change in water vapour
824	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u ! change in u speed
825	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v ! change in v speed
826	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_qbs ! change in blowing snow specific content
827	REAL, INTENT(OUT):: zcoefh(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
828	! coef for turbulent diffusion of T and Q, mean for each grid point
829	REAL, INTENT(OUT):: zcoefm(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
830	! coef for turbulent diffusion of U and V (?), mean for each grid point
831	#ifdef ISO
832	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
833	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
834	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
835	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
836	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
837	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
838	#endif
839	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche
840	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche
841	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche
842	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche
843
844	! Output only for diagnostics
845	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_x
846	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_w
847	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_x
848	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_w
849	REAL, DIMENSION(klon), INTENT(OUT) :: kh
850	REAL, DIMENSION(klon), INTENT(OUT) :: kh_x
851	REAL, DIMENSION(klon), INTENT(OUT) :: kh_w
852	REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points
853	REAL, DIMENSION(klon), INTENT(OUT) :: qsol ! water height in the soil (mm)
854	REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point
855	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
856	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
857	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
858	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level
859	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region
860	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region
861	REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL
862	REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL
863	REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL
864	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH
865	REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess
866	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point
867	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point
868	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point
869	REAL, DIMENSION(klon), INTENT(OUT) :: zustar ! u*
870	REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point
871	REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point
872	REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
873	REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point
874	REAL, DIMENSION(klon), INTENT(OUT) :: delta_qsurf! humidity difference at surface, mean for each grid point
875	REAL, DIMENSION(klon), INTENT(OUT) :: rh2m ! relative humidity at 2m
876	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point
877	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point
878	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
879	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: agesno ! age of snow at surface
880	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: solsw ! net shortwave radiation at surface
881	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw ! net longwave radiation at surface
882	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface
883	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
884	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux
885	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height
886	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface
887	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfevap ! water balance (evap) at surface weighted by srf
888	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
889	! positve orientation downwards
890	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
891	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
892	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m)
893	!AM heterogeneous continental sub-surfaces
894	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_tersrf ! surface temperature of continental sub-surfaces (K)
895	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: qsurf_tersrf ! surface specific humidity of continental sub-surfaces (kg/kg)
896	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_new_tersrf ! surface temperature of continental sub-surfaces (K)
897	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragm_tersrf ! momentum drag coefficient of continental sub-surfaces (-)
898	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragh_tersrf ! heat drag coefficient of continental sub-surfaces (-)
899	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: swnet_tersrf ! net shortwave radiation of continental sub-surfaces (W/m2)
900	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: lwnet_tersrf ! net longwave radiation of continental sub-surfaces (W/m2)
901	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxsens_tersrf ! sensible heat flux of continental sub-surfaces (W/m2)
902	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxlat_tersrf ! latent heat flux of continental sub-surfaces (W/m2)
903	REAL, DIMENSION(klon, nsoilmx, nbtersrf), INTENT(INOUT) :: tsoil_tersrf ! soil temperature of continental sub-surfaces (K)
904	#ifdef ISO
905	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
906	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
907	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
908	#endif
909
910
911	! Output not needed
912	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux
913	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux
914	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point
915	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point
916	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point
917	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxqbs ! blowing snow flux, mean for each grid point
918	REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height
919	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
920	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2
921
922	#ifdef ISO
923	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
924	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
925	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
926	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
927	#endif
928
929	! Martin
930	! inlandsis
931	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow ! snow water content
932	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt ! snow height
933	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice ! snow passed to ice
934	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow ! snow in snow model
935	REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice
936	REAL, DIMENSION(klon), INTENT(INOUT) :: hice ! hice
937	REAL, DIMENSION(klon), INTENT(INOUT) :: tice ! tice
938	REAL, DIMENSION(klon), INTENT(INOUT) :: bilg_cumul ! flux cumulated
939	REAL, DIMENSION(klon), INTENT(INOUT) :: fcds
940	REAL, DIMENSION(klon), INTENT(INOUT) :: fcdi
941	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_growth
942	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_melt
943	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_top_melt
944	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_snow2sic
945	REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_melt
946	REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_snow2sic
947
948	! variables temporaires en "klon" (nom compressée) passée en argument pour les sous-surface
949
950	INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout
951	INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout_x
952	INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout_w
953	REAL, DIMENSION(klon, klev) :: d_u_x
954	REAL, DIMENSION(klon, klev) :: d_u_w
955	REAL, DIMENSION(klon, klev) :: d_v_x
956	REAL, DIMENSION(klon, klev) :: d_v_w
957	REAL, DIMENSION(klon, nbsrf) :: windsp
958	REAL, DIMENSION(klon, nbsrf) :: t2m_x
959	REAL, DIMENSION(klon, nbsrf) :: q2m_x
960	REAL, DIMENSION(klon) :: rh2m_x
961	REAL, DIMENSION(klon) :: qsat2m_x
962	REAL, DIMENSION(klon, nbsrf) :: u10m_x
963	REAL, DIMENSION(klon, nbsrf) :: v10m_x
964	REAL, DIMENSION(klon, nbsrf) :: ustar_x
965	REAL, DIMENSION(klon, nbsrf) :: wstar_x
966	REAL, DIMENSION(klon, nbsrf) :: pblh_x
967	REAL, DIMENSION(klon, nbsrf) :: plcl_x
968	REAL, DIMENSION(klon, nbsrf) :: capCL_x
969	REAL, DIMENSION(klon, nbsrf) :: oliqCL_x
970	REAL, DIMENSION(klon, nbsrf) :: cteiCL_x
971	REAL, DIMENSION(klon, nbsrf) :: pblt_x
972	REAL, DIMENSION(klon, nbsrf) :: therm_x
973	REAL, DIMENSION(klon, nbsrf) :: trmb1_x
974	REAL, DIMENSION(klon, nbsrf) :: trmb2_x
975	REAL, DIMENSION(klon, nbsrf) :: trmb3_x
976	REAL, DIMENSION(klon, nbsrf) :: t2m_w
977	REAL, DIMENSION(klon, nbsrf) :: q2m_w
978	REAL, DIMENSION(klon) :: rh2m_w
979	REAL, DIMENSION(klon) :: qsat2m_w
980	REAL, DIMENSION(klon, nbsrf) :: u10m_w
981	REAL, DIMENSION(klon, nbsrf) :: v10m_w
982	REAL, DIMENSION(klon, nbsrf) :: ustar_w
983	REAL, DIMENSION(klon, nbsrf) :: wstar_w
984	!
985	REAL, DIMENSION(klon, nbsrf) :: pblh_w
986	REAL, DIMENSION(klon, nbsrf) :: plcl_w
987	REAL, DIMENSION(klon, nbsrf) :: capCL_w
988	REAL, DIMENSION(klon, nbsrf) :: oliqCL_w
989	REAL, DIMENSION(klon, nbsrf) :: cteiCL_w
990	REAL, DIMENSION(klon, nbsrf) :: pblt_w
991	REAL, DIMENSION(klon, nbsrf) :: therm_w
992	REAL, DIMENSION(klon, nbsrf) :: trmb1_w
993	REAL, DIMENSION(klon, nbsrf) :: trmb2_w
994	REAL, DIMENSION(klon, nbsrf) :: trmb3_w
995	!
996	REAL, DIMENSION(klon,nbsrf) :: pblh ! height of the planetary boundary layer
997	REAL, DIMENSION(klon,nbsrf) :: plcl ! condensation level
998	REAL, DIMENSION(klon,nbsrf) :: capCL
999	REAL, DIMENSION(klon,nbsrf) :: oliqCL
1000	REAL, DIMENSION(klon,nbsrf) :: cteiCL
1001	REAL, DIMENSION(klon,nbsrf) :: pblT
1002	REAL, DIMENSION(klon,nbsrf) :: therm
1003	REAL, DIMENSION(klon,nbsrf) :: trmb1 ! deep cape
1004	REAL, DIMENSION(klon,nbsrf) :: trmb2 ! inhibition
1005	REAL, DIMENSION(klon,nbsrf) :: trmb3 ! point Omega
1006	REAL, DIMENSION(klon, nbsrf) :: alb ! mean albedo for whole SW interval
1007	REAL, DIMENSION(klon,nbsrf) :: snowerosion
1008	REAL, DIMENSION(klon,klev) :: delp
1009	REAL, DIMENSION(klon,klev) :: d_t_diss_x, d_t_diss_w
1010	REAL, DIMENSION(klon, klev, nbsrf) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
1011	REAL, DIMENSION(klon, klev, nbsrf) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
1012	REAL, DIMENSION(klon, nbsrf) :: fluxlat_x, fluxlat_w
1013
1014
1015
1016	INTEGER :: iflag_split_ref
1017	INTEGER :: nsrf
1018	INTEGER :: i
1019	INTEGER :: knon
1020	INTEGER :: ni(klon)
1021
1022	IF (is_master) WRITE(lunout,) "*************** CHECKSUM IN **************************"
1023	CALL checksum("dtime", dtime)
1024	CALL checksum("date0", date0)
1025	CALL checksum("itap", itap)
1026	CALL checksum("jour", jour)
1027	CALL checksum("debut", debut)
1028	CALL checksum("lafin", lafin)
1029	CALL checksum("rlon", rlon)
1030	CALL checksum("rlat", rlat)
1031	CALL checksum("rugoro", rugoro)
1032	CALL checksum("rmu0", rmu0)
1033	CALL checksum("rain_f", rain_f)
1034	CALL checksum("snow_f", snow_f)
1035	CALL checksum("bs_f", bs_f)
1036	CALL checksum("solsw_m", solsw_m)
1037	CALL checksum("solswfdiff_m", solswfdiff_m)
1038	CALL checksum("sollw_m", sollw_m)
1039	CALL checksum("t", t)
1040	CALL checksum("q", q)
1041	CALL checksum("qbs", qbs)
1042	CALL checksum("u", u)
1043	CALL checksum("v", v)
1044	CALL checksum("pplay", pplay)
1045	CALL checksum("paprs", paprs)
1046	CALL checksum("pctsrf", pctsrf)
1047	CALL checksum("lwdown_m", lwdown_m)
1048	CALL checksum("gustiness", gustiness)
1049	CALL checksum("pphi", pphi)
1050	CALL checksum("cldt", cldt)
1051	CALL checksum("wake_dlt", wake_dlt)
1052	CALL checksum("wake_dlq", wake_dlq)
1053	CALL checksum("wake_s", wake_s)
1054	CALL checksum("wake_cstar", wake_cstar)
1055	CALL checksum("wake_dens", wake_dens)
1056	CALL checksum("beta", beta)
1057	CALL checksum("ts", ts)
1058	CALL checksum("delta_tsurf", delta_tsurf)
1059	CALL checksum("alb_dir", alb_dir)
1060	CALL checksum("alb_dif", alb_dif)
1061	CALL checksum("ustar", ustar)
1062	CALL checksum("wstar", wstar)
1063	CALL checksum("u10m", u10m)
1064	CALL checksum("v10m", v10m)
1065	CALL checksum("wake_dltke", wake_dltke)
1066	CALL checksum("eps_x", eps_x)
1067	CALL checksum("cdragh", cdragh)
1068	CALL checksum("cdragm", cdragm)
1069	CALL checksum("zu1", zu1)
1070	CALL checksum("zv1", zv1)
1071	CALL checksum("alb_dir_m", alb_dir_m)
1072	CALL checksum("alb_dif_m", alb_dif_m)
1073	CALL checksum("alb3_lic", alb3_lic)
1074	CALL checksum("zxsens", zxsens)
1075	CALL checksum("zxevap", zxevap)
1076	CALL checksum("zxsnowerosion", zxsnowerosion)
1077	CALL checksum("icesub_lic", icesub_lic)
1078	CALL checksum("zxtsol", zxtsol)
1079	CALL checksum("d_t_w", d_t_w)
1080	CALL checksum("d_q_w", d_q_w)
1081	CALL checksum("d_t_x", d_t_x)
1082	CALL checksum("d_q_x", d_q_x)
1083	CALL checksum("zxfluxlat", zxfluxlat)
1084	CALL checksum("zt2m", zt2m)
1085	CALL checksum("zn2mout", zn2mout)
1086	CALL checksum("qsat2m", qsat2m)
1087	CALL checksum("d_t", d_t)
1088	CALL checksum("d_t_diss", d_t_diss)
1089	CALL checksum("d_q", d_q)
1090	CALL checksum("d_u", d_u)
1091	CALL checksum("d_v", d_v)
1092	CALL checksum("d_qbs", d_qbs)
1093	CALL checksum("zcoefh", zcoefh)
1094	CALL checksum("zcoefm", zcoefm)
1095	CALL checksum("zxsens_x", zxsens_x)
1096	CALL checksum("zxsens_w", zxsens_w)
1097	CALL checksum("zxfluxlat_x", zxfluxlat_x)
1098	CALL checksum("zxfluxlat_w", zxfluxlat_w)
1099	CALL checksum("cdragh_x", cdragh_x)
1100	CALL checksum("cdragh_w", cdragh_w)
1101	CALL checksum("cdragm_x", cdragm_x)
1102	CALL checksum("cdragm_w", cdragm_w)
1103	CALL checksum("kh", kh)
1104	CALL checksum("kh_x", kh_x)
1105	CALL checksum("kh_w", kh_w)
1106	CALL checksum("slab_wfbils", slab_wfbils)
1107	CALL checksum("qsol", qsol)
1108	CALL checksum("zq2m", zq2m)
1109	CALL checksum("s_pblh", s_pblh)
1110	CALL checksum("s_pblh_x", s_pblh_x)
1111	CALL checksum("s_pblh_w", s_pblh_w)
1112	CALL checksum("s_plcl", s_plcl)
1113	CALL checksum("s_plcl_x", s_plcl_x)
1114	CALL checksum("s_plcl_w", s_plcl_w)
1115	CALL checksum("s_capCL", s_capCL)
1116	CALL checksum("s_oliqCL", s_oliqCL)
1117	CALL checksum("s_cteiCL", s_cteiCL)
1118	CALL checksum("s_pblT", s_pblT)
1119	CALL checksum("s_therm", s_therm)
1120	CALL checksum("s_trmb1", s_trmb1)
1121	CALL checksum("s_trmb2", s_trmb2)
1122	CALL checksum("s_trmb3", s_trmb3)
1123	CALL checksum("zustar", zustar)
1124	CALL checksum("zu10m", zu10m)
1125	CALL checksum("zv10m", zv10m)
1126	CALL checksum("fder_print", fder_print)
1127	CALL checksum("zxqsurf", zxqsurf)
1128	CALL checksum("delta_qsurf", delta_qsurf)
1129	CALL checksum("rh2m", rh2m)
1130	CALL checksum("zxfluxu", zxfluxu)
1131	CALL checksum("zxfluxv", zxfluxv)
1132	CALL checksum("z0m", z0m)
1133	CALL checksum("z0h", z0h)
1134	CALL checksum("agesno", agesno)
1135	CALL checksum("solsw", solsw)
1136	CALL checksum("sollw", sollw)
1137	CALL checksum("d_ts", d_ts)
1138	CALL checksum("evap", evap)
1139	CALL checksum("fluxlat", fluxlat)
1140	CALL checksum("t2m", t2m)
1141	CALL checksum("wfbils", wfbils)
1142	CALL checksum("wfevap", wfevap)
1143	CALL checksum("flux_t", flux_t)
1144	CALL checksum("flux_u", flux_u)
1145	CALL checksum("flux_v", flux_v)
1146	CALL checksum("treedrg", treedrg)
1147	CALL checksum("tsurf_tersrf", tsurf_tersrf)
1148	CALL checksum("qsurf_tersrf", qsurf_tersrf)
1149	CALL checksum("tsurf_new_tersrf", tsurf_new_tersrf)
1150	CALL checksum("cdragm_tersrf", cdragm_tersrf)
1151	CALL checksum("cdragh_tersrf", cdragh_tersrf)
1152	CALL checksum("swnet_tersrf", swnet_tersrf)
1153	CALL checksum("lwnet_tersrf", lwnet_tersrf)
1154	CALL checksum("fluxsens_tersrf", fluxsens_tersrf)
1155	CALL checksum("fluxlat_tersrf", fluxlat_tersrf)
1156	CALL checksum("tsoil_tersrf", tsoil_tersrf)
1157	CALL checksum("dflux_t", dflux_t)
1158	CALL checksum("dflux_q", dflux_q)
1159	CALL checksum("zxsnow", zxsnow)
1160	CALL checksum("zxfluxt", zxfluxt)
1161	CALL checksum("zxfluxq", zxfluxq)
1162	CALL checksum("zxfluxqbs", zxfluxqbs)
1163	CALL checksum("q2m", q2m)
1164	CALL checksum("flux_q", flux_q)
1165	CALL checksum("flux_qbs", flux_qbs)
1166	CALL checksum("qsnow", qsnow)
1167	CALL checksum("snowhgt", snowhgt)
1168	CALL checksum("to_ice", to_ice)
1169	CALL checksum("sissnow", sissnow)
1170	CALL checksum("runoff", runoff)
1171	CALL checksum("hice", hice)
1172	CALL checksum("tice", tice)
1173	CALL checksum("bilg_cumul", bilg_cumul)
1174	CALL checksum("fcds", fcds)
1175	CALL checksum("fcdi", fcdi)
1176	CALL checksum("dh_basal_growth", dh_basal_growth)
1177	CALL checksum("dh_basal_melt", dh_basal_melt)
1178	CALL checksum("dh_top_melt", dh_top_melt)
1179	CALL checksum("dh_snow2sic", dh_snow2sic)
1180	CALL checksum("dtice_melt", dtice_melt)
1181	CALL checksum("dtice_snow2sic", dtice_snow2sic)
1182	CALL checksum("n2mout", n2mout)
1183	CALL checksum("n2mout_x", n2mout_x)
1184
1185	CALL pbl_surface_uncompress_pre( &
1186	itap, &
1187	solsw_m, solswfdiff_m, sollw_m, &
1188	paprs, pctsrf, &
1189	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
1190	cdragh, cdragm, zu1, zv1, &
1191	alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, &
1192	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
1193	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
1194	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
1195	d_t_w, d_q_w, &
1196	d_t_x, d_q_x, &
1197	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
1198	cdragh_x,cdragh_w, &
1199	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
1200	zcoefh, zcoefm, slab_wfbils, &
1201	qsol, zq2m, s_pblh, s_plcl, &
1202	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
1203	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
1204	s_therm, s_trmb1, s_trmb2, s_trmb3, &
1205	zustar,zu10m, zv10m, fder_print, &
1206	zxqsurf, delta_qsurf, &
1207	rh2m, zxfluxu, zxfluxv, &
1208	z0m, z0h, sollw, solsw, &
1209	d_ts, evap, fluxlat, t2m, &
1210	wfbils, wfevap, &
1211	flux_t, flux_u, flux_v, &
1212	dflux_t, dflux_q, zxsnow, &
1213	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, tke_x, eps_x, &
1214	wake_dltke, iflag_split_ref, &
1215	delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w, &
1216	flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w, d_u_x, &
1217	d_u_w, d_v_x, d_v_w, windsp, t2m_x, q2m_x, rh2m_x, qsat2m_x, u10m_x, v10m_x, &
1218	ustar_x, wstar_x, pblh_x, plcl_x, capCL_x, oliqCL_x, cteiCL_x, pblt_x, therm_x, &
1219	trmb1_x, trmb2_x, trmb3_x, t2m_w, q2m_w, rh2m_w, qsat2m_w, u10m_w, v10m_w, &
1220	ustar_w, wstar_w , pblh_w, plcl_w, capCL_w, oliqCL_w, cteiCL_w, pblt_w, therm_w, &
1221	trmb1_w, trmb2_w, trmb3_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, therm, &
1222	trmb1, trmb2, trmb3, snowerosion, alb &
1223	#ifdef ISO
1224	& ,xtrain_f, xtsnow_f,xt, &
1225	& wake_dlxt,zxxtevap,xtevap, &
1226	& d_xt,d_xt_w,d_xt_x, &
1227	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
1228	& h1_diag,runoff_diag,xtrunoff_diag &
1229	#endif
1230	& )
1231
1232	DO nsrf = 1, nbsrf !<<<<<<<<<<<<<
1233	! IF (nsrf/=is_ter) CYCLE !<<<<<<<<<<<<<
1234	IF (prt_level >=10) print *,' Loop nsrf ',nsrf
1235
1236	! Search for index(ni) and size(knon) of domaine to treat
1237	ni(:) = 0
1238	knon = 0
1239	DO i = 1, klon
1240	IF (pctsrf(i,nsrf) > 0.) THEN
1241	knon = knon + 1
1242	ni(knon) = i
1243	ENDIF
1244	ENDDO
1245
1246	CALL pbl_surface_subsrf( nsrf, knon, ni(1:knon), &
1247	dtime, date0, itap, jour, &
1248	debut, lafin, &
1249	rlon, rlat, rugoro, rmu0, &
1250	lwdown_m, pphi, cldt, &
1251	rain_f, snow_f, bs_f, &
1252	gustiness, &
1253	t, q, qbs, u, v, &
1254	wake_dlt, wake_dlq, &
1255	wake_cstar, wake_s, &
1256	pplay, paprs, pctsrf, &
1257	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
1258	cdragh, cdragm, &
1259	beta, &
1260	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
1261	qsat2m, &
1262	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
1263	d_t_w, d_q_w, &
1264	d_t_x, d_q_x, &
1265	delta_tsurf,wake_dens,cdragh_x,cdragh_w, &
1266	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
1267	zcoefh, zcoefm, slab_wfbils, &
1268	qsol, s_pblh, &
1269	s_pblh_x, s_pblh_w, &
1270	delta_qsurf, &
1271	rh2m, &
1272	z0m, z0h, agesno, sollw, solsw, &
1273	d_ts, evap, fluxlat, t2m, &
1274	flux_t, flux_u, flux_v, &
1275	dflux_t, dflux_q, &
1276	q2m, flux_q, flux_qbs, tke_x, eps_x, &
1277	wake_dltke, &
1278	treedrg,hice ,tice, bilg_cumul, &
1279	fcds, fcdi, dh_basal_growth, dh_basal_melt, &
1280	dh_top_melt, dh_snow2sic, &
1281	dtice_melt, dtice_snow2sic , &
1282	tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
1283	cdragm_tersrf, cdragh_tersrf, &
1284	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
1285	#ifdef ISO
1286	& ,xtrain_f, xtsnow_f,xt, &
1287	& wake_dlxt,zxxtevap,xtevap, &
1288	& d_xt,d_xt_w,d_xt_x, &
1289	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
1290	& h1_diag,runoff_diag,xtrunoff_diag &
1291	#endif
1292	, n2mout, n2mout_x, n2mout_w, d_u_x, d_u_w, d_v_x, d_v_w, windsp, t2m_x, &
1293	q2m_x, rh2m_x, qsat2m_x, u10m_x, v10m_x, ustar_x, wstar_x, pblh_x, plcl_x, capCL_x, &
1294	oliqCL_x, cteiCL_x, pblt_x, therm_x, trmb1_x, trmb2_x, trmb3_x, t2m_w, q2m_w, rh2m_w, &
1295	qsat2m_w, u10m_w, v10m_w, ustar_w, wstar_w, pblh_w, plcl_w, capCL_w, oliqCL_w, cteiCL_w,&
1296	pblt_w, therm_w, trmb1_w, trmb2_w, trmb3_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, &
1297	therm, trmb1, trmb2, trmb3, alb, snowerosion, iflag_split_ref, delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w,&
1298	flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w)
1299
1300	ENDDO
1301
1302	CALL pbl_surface_uncompressed_post( &
1303	itap, dtime, &
1304	u, v, &
1305	wake_s, &
1306	pctsrf, &
1307	ts,ustar, u10m, v10m,wstar, &
1308	zu1, zv1, &
1309	zxsens, zxevap, zxsnowerosion, &
1310	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
1311	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
1312	zq2m, s_pblh, s_plcl, &
1313	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
1314	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
1315	s_therm, s_trmb1, s_trmb2, s_trmb3, &
1316	zustar,zu10m, zv10m, fder_print, &
1317	zxqsurf, &
1318	zxfluxu, zxfluxv, &
1319	z0m, z0h, sollw, solsw, &
1320	d_ts, evap, fluxlat, t2m, &
1321	wfbils, wfevap, &
1322	flux_t, flux_u, flux_v, &
1323	dflux_t, dflux_q, zxsnow, &
1324	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, bilg_cumul, iflag_split_ref, &
1325	n2mout, n2mout_x, flux_t_x, flux_q_x, flux_t_w, flux_q_w, flux_u_x, flux_v_x, flux_u_w, flux_v_w, &
1326	fluxlat_x, fluxlat_w, t2m_x, q2m_x, qsat2m_x, u10m_x, v10m_x, ustar_x, wstar_x, pblh_x, plcl_x, &
1327	capCL_x, oliqCL_x, cteiCL_x, pblt_x, therm_x, trmb1_x, trmb2_x, trmb3_x, t2m_w, qsat2m_w, &
1328	pblh_w, plcl_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3 &
1329	#ifdef ISO
1330	& ,xtrain_f, xtsnow_f,xt, &
1331	& wake_dlxt,zxxtevap,xtevap, &
1332	& d_xt,d_xt_w,d_xt_x, &
1333	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
1334	& h1_diag,runoff_diag,xtrunoff_diag &
1335	#endif
1336	& )
1337
1338	IF (is_master) WRITE(lunout,) "*************** CHECKSUM OUT **************************"
1339	CALL checksum("dtime", dtime)
1340	CALL checksum("date0", date0)
1341	CALL checksum("itap", itap)
1342	CALL checksum("jour", jour)
1343	CALL checksum("debut", debut)
1344	CALL checksum("lafin", lafin)
1345	CALL checksum("rlon", rlon)
1346	CALL checksum("rlat", rlat)
1347	CALL checksum("rugoro", rugoro)
1348	CALL checksum("rmu0", rmu0)
1349	CALL checksum("rain_f", rain_f)
1350	CALL checksum("snow_f", snow_f)
1351	CALL checksum("bs_f", bs_f)
1352	CALL checksum("solsw_m", solsw_m)
1353	CALL checksum("solswfdiff_m", solswfdiff_m)
1354	CALL checksum("sollw_m", sollw_m)
1355	CALL checksum("t", t)
1356	CALL checksum("q", q)
1357	CALL checksum("qbs", qbs)
1358	CALL checksum("u", u)
1359	CALL checksum("v", v)
1360	CALL checksum("pplay", pplay)
1361	CALL checksum("paprs", paprs)
1362	CALL checksum("pctsrf", pctsrf)
1363	CALL checksum("lwdown_m", lwdown_m)
1364	CALL checksum("gustiness", gustiness)
1365	CALL checksum("pphi", pphi)
1366	CALL checksum("cldt", cldt)
1367	CALL checksum("wake_dlt", wake_dlt)
1368	CALL checksum("wake_dlq", wake_dlq)
1369	CALL checksum("wake_s", wake_s)
1370	CALL checksum("wake_cstar", wake_cstar)
1371	CALL checksum("wake_dens", wake_dens)
1372	CALL checksum("beta", beta)
1373	CALL checksum("ts", ts)
1374	CALL checksum("delta_tsurf", delta_tsurf)
1375	CALL checksum("alb_dir", alb_dir)
1376	CALL checksum("alb_dif", alb_dif)
1377	CALL checksum("ustar", ustar)
1378	CALL checksum("wstar", wstar)
1379	CALL checksum("u10m", u10m)
1380	CALL checksum("v10m", v10m)
1381	CALL checksum("wake_dltke", wake_dltke)
1382	CALL checksum("eps_x", eps_x)
1383	CALL checksum("cdragh", cdragh)
1384	CALL checksum("cdragm", cdragm)
1385	CALL checksum("zu1", zu1)
1386	CALL checksum("zv1", zv1)
1387	CALL checksum("alb_dir_m", alb_dir_m)
1388	CALL checksum("alb_dif_m", alb_dif_m)
1389	CALL checksum("alb3_lic", alb3_lic)
1390	CALL checksum("zxsens", zxsens)
1391	CALL checksum("zxevap", zxevap)
1392	CALL checksum("zxsnowerosion", zxsnowerosion)
1393	CALL checksum("icesub_lic", icesub_lic)
1394	CALL checksum("zxtsol", zxtsol)
1395	CALL checksum("d_t_w", d_t_w)
1396	CALL checksum("d_q_w", d_q_w)
1397	CALL checksum("d_t_x", d_t_x)
1398	CALL checksum("d_q_x", d_q_x)
1399	CALL checksum("zxfluxlat", zxfluxlat)
1400	CALL checksum("zt2m", zt2m)
1401	CALL checksum("zn2mout", zn2mout)
1402	CALL checksum("qsat2m", qsat2m)
1403	CALL checksum("d_t", d_t)
1404	CALL checksum("d_t_diss", d_t_diss)
1405	CALL checksum("d_q", d_q)
1406	CALL checksum("d_u", d_u)
1407	CALL checksum("d_v", d_v)
1408	CALL checksum("d_qbs", d_qbs)
1409	CALL checksum("zcoefh", zcoefh)
1410	CALL checksum("zcoefm", zcoefm)
1411	CALL checksum("zxsens_x", zxsens_x)
1412	CALL checksum("zxsens_w", zxsens_w)
1413	CALL checksum("zxfluxlat_x", zxfluxlat_x)
1414	CALL checksum("zxfluxlat_w", zxfluxlat_w)
1415	CALL checksum("cdragh_x", cdragh_x)
1416	CALL checksum("cdragh_w", cdragh_w)
1417	CALL checksum("cdragm_x", cdragm_x)
1418	CALL checksum("cdragm_w", cdragm_w)
1419	CALL checksum("kh", kh)
1420	CALL checksum("kh_x", kh_x)
1421	CALL checksum("kh_w", kh_w)
1422	CALL checksum("slab_wfbils", slab_wfbils)
1423	CALL checksum("qsol", qsol)
1424	CALL checksum("zq2m", zq2m)
1425	CALL checksum("s_pblh", s_pblh)
1426	CALL checksum("s_pblh_x", s_pblh_x)
1427	CALL checksum("s_pblh_w", s_pblh_w)
1428	CALL checksum("s_plcl", s_plcl)
1429	CALL checksum("s_plcl_x", s_plcl_x)
1430	CALL checksum("s_plcl_w", s_plcl_w)
1431	CALL checksum("s_capCL", s_capCL)
1432	CALL checksum("s_oliqCL", s_oliqCL)
1433	CALL checksum("s_cteiCL", s_cteiCL)
1434	CALL checksum("s_pblT", s_pblT)
1435	CALL checksum("s_therm", s_therm)
1436	CALL checksum("s_trmb1", s_trmb1)
1437	CALL checksum("s_trmb2", s_trmb2)
1438	CALL checksum("s_trmb3", s_trmb3)
1439	CALL checksum("zustar", zustar)
1440	CALL checksum("zu10m", zu10m)
1441	CALL checksum("zv10m", zv10m)
1442	CALL checksum("fder_print", fder_print)
1443	CALL checksum("zxqsurf", zxqsurf)
1444	CALL checksum("delta_qsurf", delta_qsurf)
1445	CALL checksum("rh2m", rh2m)
1446	CALL checksum("zxfluxu", zxfluxu)
1447	CALL checksum("zxfluxv", zxfluxv)
1448	CALL checksum("z0m", z0m)
1449	CALL checksum("z0h", z0h)
1450	CALL checksum("agesno", agesno)
1451	CALL checksum("solsw", solsw)
1452	CALL checksum("sollw", sollw)
1453	CALL checksum("d_ts", d_ts)
1454	CALL checksum("evap", evap)
1455	CALL checksum("fluxlat", fluxlat)
1456	CALL checksum("t2m", t2m)
1457	CALL checksum("wfbils", wfbils)
1458	CALL checksum("wfevap", wfevap)
1459	CALL checksum("flux_t", flux_t)
1460	CALL checksum("flux_u", flux_u)
1461	CALL checksum("flux_v", flux_v)
1462	CALL checksum("treedrg", treedrg)
1463	CALL checksum("tsurf_tersrf", tsurf_tersrf)
1464	CALL checksum("qsurf_tersrf", qsurf_tersrf)
1465	CALL checksum("tsurf_new_tersrf", tsurf_new_tersrf)
1466	CALL checksum("cdragm_tersrf", cdragm_tersrf)
1467	CALL checksum("cdragh_tersrf", cdragh_tersrf)
1468	CALL checksum("swnet_tersrf", swnet_tersrf)
1469	CALL checksum("lwnet_tersrf", lwnet_tersrf)
1470	CALL checksum("fluxsens_tersrf", fluxsens_tersrf)
1471	CALL checksum("fluxlat_tersrf", fluxlat_tersrf)
1472	CALL checksum("tsoil_tersrf", tsoil_tersrf)
1473	CALL checksum("dflux_t", dflux_t)
1474	CALL checksum("dflux_q", dflux_q)
1475	CALL checksum("zxsnow", zxsnow)
1476	CALL checksum("zxfluxt", zxfluxt)
1477	CALL checksum("zxfluxq", zxfluxq)
1478	CALL checksum("zxfluxqbs", zxfluxqbs)
1479	CALL checksum("q2m", q2m)
1480	CALL checksum("flux_q", flux_q)
1481	CALL checksum("flux_qbs", flux_qbs)
1482	CALL checksum("qsnow", qsnow)
1483	CALL checksum("snowhgt", snowhgt)
1484	CALL checksum("to_ice", to_ice)
1485	CALL checksum("sissnow", sissnow)
1486	CALL checksum("runoff", runoff)
1487	CALL checksum("hice", hice)
1488	CALL checksum("tice", tice)
1489	CALL checksum("bilg_cumul", bilg_cumul)
1490	CALL checksum("fcds", fcds)
1491	CALL checksum("fcdi", fcdi)
1492	CALL checksum("dh_basal_growth", dh_basal_growth)
1493	CALL checksum("dh_basal_melt", dh_basal_melt)
1494	CALL checksum("dh_top_melt", dh_top_melt)
1495	CALL checksum("dh_snow2sic", dh_snow2sic)
1496	CALL checksum("dtice_melt", dtice_melt)
1497	CALL checksum("dtice_snow2sic", dtice_snow2sic)
1498	END SUBROUTINE pbl_surface_main
1499
1500
1501	SUBROUTINE pbl_surface_uncompress_pre( &
1502	itap, &
1503	solsw_m, solswfdiff_m, sollw_m, &
1504	paprs, pctsrf, &
1505	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
1506	cdragh, cdragm, zu1, zv1, &
1507	alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, &
1508	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
1509	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
1510	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
1511	d_t_w, d_q_w, &
1512	d_t_x, d_q_x, &
1513	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
1514	cdragh_x,cdragh_w, &
1515	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
1516	zcoefh, zcoefm, slab_wfbils, &
1517	qsol, zq2m, s_pblh, s_plcl, &
1518	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
1519	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
1520	s_therm, s_trmb1, s_trmb2, s_trmb3, &
1521	zustar,zu10m, zv10m, fder_print, &
1522	zxqsurf, delta_qsurf, &
1523	rh2m, zxfluxu, zxfluxv, &
1524	z0m, z0h, sollw, solsw, &
1525	d_ts, evap, fluxlat, t2m, &
1526	wfbils, wfevap, &
1527	flux_t, flux_u, flux_v, &
1528	dflux_t, dflux_q, zxsnow, &
1529	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, tke_x, eps_x, &
1530	wake_dltke, iflag_split_ref, &
1531	& delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w, &
1532	flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w, d_u_x, &
1533	d_u_w, d_v_x, d_v_w, windsp, t2m_x, q2m_x, rh2m_x, qsat2m_x, u10m_x, v10m_x, &
1534	ustar_x, wstar_x, pblh_x, plcl_x, capCL_x, oliqCL_x, cteiCL_x, pblt_x, therm_x, &
1535	trmb1_x, trmb2_x, trmb3_x, t2m_w, q2m_w, rh2m_w, qsat2m_w, u10m_w, v10m_w, &
1536	ustar_w, wstar_w , pblh_w, plcl_w, capCL_w, oliqCL_w, cteiCL_w, pblt_w, therm_w, &
1537	trmb1_w, trmb2_w, trmb3_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, therm, &
1538	trmb1, trmb2, trmb3, snowerosion, alb &
1539	#ifdef ISO
1540	& ,xtrain_f, xtsnow_f,xt, &
1541	& wake_dlxt,zxxtevap,xtevap, &
1542	& d_xt,d_xt_w,d_xt_x, &
1543	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
1544	& h1_diag,runoff_diag,xtrunoff_diag &
1545	#endif
1546	& )
1547	!$gpum horizontal klon
1548
1549	!****************************************************************************************
1550	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
1551	! Objet: interface de "couche limite" (diffusion verticale)
1552	!
1553	!AA REM:
1554	!AA-----
1555	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
1556	!AA pour l'instant le calcul de la couche limite pour les traceurs
1557	!AA se fait avec cltrac et ne tient pas compte de la differentiation
1558	!AA des sous-fraction de sol.
1559	!AA REM bis :
1560	!AA----------
1561	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
1562	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
1563	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
1564	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
1565	!AA si les informations des subsurfaces doivent etre prises en compte
1566	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
1567	!AA c'est a dire nbsrf (nbre de subsurface).
1568	!
1569	! Arguments:
1570	!
1571	! dtime----input-R- interval du temps (secondes)
1572	! itap-----input-I- numero du pas de temps
1573	! date0----input-R- jour initial
1574	! t--------input-R- temperature (K)
1575	! q--------input-R- vapeur d'eau (kg/kg)
1576	! u--------input-R- vitesse u
1577	! v--------input-R- vitesse v
1578	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
1579	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
1580	!wake_cstar-input-R- wake gust front speed (m/s)
1581	! wake_s---input-R- wake fractionnal area
1582	! ts-------input-R- temperature du sol (en Kelvin)
1583	! paprs----input-R- pression a intercouche (Pa)
1584	! pplay----input-R- pression au milieu de couche (Pa)
1585	! rlat-----input-R- latitude en degree
1586	! z0m, z0h ----input-R- longeur de rugosite (en m)
1587	! Martin
1588	! cldt-----input-R- total cloud fraction
1589	! Martin
1590	!GG
1591	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
1592	!GG
1593	!
1594	! d_t------output-R- le changement pour "t"
1595	! d_q------output-R- le changement pour "q"
1596	! d_u------output-R- le changement pour "u"
1597	! d_v------output-R- le changement pour "v"
1598	! d_ts-----output-R- le changement pour "ts"
1599	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
1600	! (orientation positive vers le bas)
1601	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
1602	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
1603	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
1604	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
1605	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
1606	! dflux_t--output-R- derive du flux sensible
1607	! dflux_q--output-R- derive du flux latent
1608	! zu1------output-R- le vent dans la premiere couche
1609	! zv1------output-R- le vent dans la premiere couche
1610	! trmb1----output-R- deep_cape
1611	! trmb2----output-R- inhibition
1612	! trmb3----output-R- Point Omega
1613	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
1614	! plcl-----output-R- Niveau de condensation
1615	! pblh-----output-R- HCL
1616	! pblT-----output-R- T au nveau HCL
1617	! treedrg--output-R- tree drag (m)
1618	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
1619	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
1620	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
1621	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
1622	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
1623	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
1624	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
1625	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
1626
1627	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, carbon_cycle_tr
1628	USE carbon_cycle_mod, ONLY : co2_send, nbcf_out, fields_out, cfname_out
1629	use hbtm_mod, only: hbtm
1630	USE indice_sol_mod
1631	USE mod_grid_phy_lmdz, ONLY : grid1dto2d_glo
1632	USE print_control_mod, ONLY : prt_level
1633	#ifdef ISO
1634	USE isotopes_mod, ONLY: Rdefault,iso_eau
1635	#ifdef ISOVERIF
1636	USE isotopes_verif_mod
1637	#endif
1638	#ifdef ISOTRAC
1639	USE isotrac_mod, only: index_iso
1640	#endif
1641	#endif
1642	USE dimpft_mod_h
1643	USE flux_arp_mod_h
1644	USE compbl_mod_h
1645	USE yoethf_mod_h
1646	USE clesphys_mod_h
1647	USE ioipsl_getin_p_mod, ONLY : getin_p
1648	use phys_state_var_mod, only: frac_tersrf, albedo_tersrf !AM
1649	USE dimsoil_mod_h, ONLY: nsoilmx
1650	USE surf_param_mod, ONLY: eff_surf_param !AM
1651	USE yomcst_mod_h
1652	USE phys_local_var_mod, only: l_mixmin, l_mix, wprime
1653	IMPLICIT NONE
1654
1655	INCLUDE "FCTTRE.h"
1656	!FC
1657
1658	!****************************************************************************************
1659	INTEGER, INTENT(IN) :: itap ! time step
1660	REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! net shortwave radiation at mean surface
1661	REAL, DIMENSION(klon), INTENT(IN) :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
1662	REAL, DIMENSION(klon), INTENT(IN) :: sollw_m ! net longwave radiation at mean surface
1663	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa)
1664	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
1665	#ifdef ISO
1666	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
1667	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
1668	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
1669	#endif
1670	#ifdef ISO
1671	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
1672	#endif
1673	! Input/Output variables
1674	!****************************************************************************************
1675	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
1676	REAL, DIMENSIOn(6),intent(in) :: SFRWL
1677	REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
1678	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
1679	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
1680	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
1681	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
1682	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
1683	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
1684
1685	! Output variables
1686	!****************************************************************************************
1687	REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(OUT) :: eps_x ! TKE dissipation rate
1688
1689	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q
1690	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind
1691	REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer
1692	REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer
1693	REAL, DIMENSION(klon, nsw), INTENT(OUT) :: alb_dir_m,alb_dif_m
1694	REAL, DIMENSION(klon), INTENT(OUT) :: alb3_lic
1695	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign
1696	! (=> positive sign upwards)
1697	REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards
1698	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface
1699	REAL, DIMENSION(klon), INTENT(OUT) :: icesub_lic ! ice (no snow!) sublimation over ice sheet
1700	REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point
1701	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_w ! !
1702	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_w ! ! Tendances dans les poches
1703	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_x ! !
1704	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_x ! ! Tendances hors des poches
1705	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point
1706	REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point
1707	INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: zn2mout ! number of times the 2m temperature is out of the [tsol,temp]
1708	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m
1709	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t ! change in temperature
1710	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_diss ! change in temperature
1711	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q ! change in water vapour
1712	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u ! change in u speed
1713	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v ! change in v speed
1714	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_qbs ! change in blowing snow specific content
1715	REAL, INTENT(OUT):: zcoefh(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
1716	! coef for turbulent diffusion of T and Q, mean for each grid point
1717	REAL, INTENT(OUT):: zcoefm(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
1718	! coef for turbulent diffusion of U and V (?), mean for each grid point
1719	#ifdef ISO
1720	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
1721	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
1722	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
1723	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
1724	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
1725	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
1726	#endif
1727	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche
1728	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche
1729	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche
1730	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche
1731	! Output only for diagnostics
1732	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_x
1733	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_w
1734	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_x
1735	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_w
1736	REAL, DIMENSION(klon), INTENT(OUT) :: kh
1737	REAL, DIMENSION(klon), INTENT(OUT) :: kh_x
1738	REAL, DIMENSION(klon), INTENT(OUT) :: kh_w
1739	REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points
1740	REAL, DIMENSION(klon), INTENT(OUT) :: qsol ! water height in the soil (mm)
1741	REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point
1742	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
1743	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
1744	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
1745	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level
1746	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region
1747	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region
1748	REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL
1749	REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL
1750	REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL
1751	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH
1752	REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess
1753	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point
1754	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point
1755	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point
1756	REAL, DIMENSION(klon), INTENT(OUT) :: zustar ! u*
1757	REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point
1758	REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point
1759	REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
1760	REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point
1761	REAL, DIMENSION(klon), INTENT(OUT) :: delta_qsurf! humidity difference at surface, mean for each grid point
1762	REAL, DIMENSION(klon), INTENT(OUT) :: rh2m ! relative humidity at 2m
1763	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point
1764	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point
1765	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
1766	! REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: agesno ! age of snow at surface
1767	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: solsw ! net shortwave radiation at surface
1768	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw ! net longwave radiation at surface
1769	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface
1770	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
1771	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux
1772	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height
1773	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface
1774	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfevap ! water balance (evap) at surface weighted by srf
1775	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
1776	! positve orientation downwards
1777	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
1778	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
1779	#ifdef ISO
1780	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
1781	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
1782	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
1783	#endif
1784
1785	! Output not needed
1786	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux
1787	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux
1788	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point
1789	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point
1790	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point
1791	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxqbs ! blowing snow flux, mean for each grid point
1792	REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height
1793	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
1794	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2
1795
1796	#ifdef ISO
1797	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
1798	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
1799	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
1800	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
1801	#endif
1802
1803	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow ! snow water content
1804	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt ! snow height
1805	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice ! snow passed to ice
1806	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow ! snow in snow model
1807	REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice
1808	INTEGER, INTENT(INOUT) :: iflag_split_ref
1809	! Other local variables
1810	!****************************************************************************************
1811	INTEGER :: n
1812	INTEGER :: iflag_split
1813	INTEGER :: i, k, nsrf
1814	REAL :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
1815	REAL, DIMENSION(klon) :: r_co2_ppm ! taux CO2 atmosphere
1816	REAL, DIMENSION(klon) :: ztsol
1817	REAL, DIMENSION(klon) :: meansqT ! mean square deviation of subsurface temperatures
1818	REAL, DIMENSION(klon) :: alb_m ! mean albedo for whole SW interval
1819	REAL, DIMENSION(klon,klev), INTENT(OUT) :: delp
1820	LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
1821	LOGICAL, PARAMETER :: check=.FALSE.
1822	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_diss_x, d_t_diss_w
1823	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
1824	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
1825	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat_x, fluxlat_w
1826	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_x
1827	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_w
1828	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_x
1829	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_w
1830	#ifdef ISO
1831	REAL, DIMENSION(ntraciso,klon,klev,nbsrf), INTENT(OUT) :: flux_xt_x, flux_xt_w
1832	#endif
1833	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: windsp
1834	!
1835	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_x
1836	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_x
1837	REAL, DIMENSION(klon), INTENT(OUT) :: rh2m_x
1838	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m_x
1839	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_x
1840	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_x
1841	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_x
1842	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_x
1843	!
1844	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_x
1845	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_x
1846	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_x
1847	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_x
1848	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_x
1849	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_x
1850	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_x
1851	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_x
1852	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_x
1853	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_x
1854	!
1855	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_w
1856	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_w
1857	REAL, DIMENSION(klon) , INTENT(OUT) :: rh2m_w
1858	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m_w
1859	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_w
1860	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_w
1861	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_w
1862	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_w
1863	!
1864	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_w
1865	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_w
1866	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_w
1867	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_w
1868	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_w
1869	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_w
1870	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_w
1871	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_w
1872	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_w
1873	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_w
1874
1875	REAL, PARAMETER :: facteur = 2. / 1.772 ! ( == 2. / SQRT(3.14))
1876	REAL, PARAMETER :: inertia=2000.
1877	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblh ! height of the planetary boundary layer
1878	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: plcl ! condensation level
1879	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: capCL
1880	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: oliqCL
1881	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: cteiCL
1882	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblT
1883	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: therm
1884	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb1 ! deep cape
1885	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb2 ! inhibition
1886	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb3 ! point Omega
1887	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: alb ! mean albedo for whole SW interval
1888	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: snowerosion
1889	REAL, DIMENSION(klon) :: albedo_eff
1890	#ifdef ISO
1891	INTEGER :: ixt
1892	#endif
1893
1894	!****************************************************************************************
1895	! End of declarations
1896	!****************************************************************************************
1897
1898	IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
1899	!
1900	!!jyg iflag_split = mod(iflag_pbl_split,2)
1901	!!jyg iflag_split = mod(iflag_pbl_split,10)
1902	!
1903	! Flags controlling the splitting of the turbulent boundary layer:
1904	! iflag_split_ref = 0 ==> no splitting
1905	! = 1 ==> splitting without coupling with surface temperature
1906	! = 2 ==> splitting with coupling with surface temperature over land
1907	! = 3 ==> splitting over ocean; no splitting over land
1908	! iflag_split: actual flag controlling the splitting.
1909	! iflag_split = iflag_split_ref outside the sub-surface loop
1910	! = iflag_split_ref if iflag_split_ref = 0, 1, or 2
1911	! = 0 over land if iflga_split_ref = 3
1912	! = 1 over ocean if iflga_split_ref = 3
1913
1914	iflag_split_ref = mod(iflag_pbl_split,10)
1915	iflag_split = iflag_split_ref
1916
1917	#ifdef ISO
1918	#ifdef ISOVERIF
1919	DO i=1,klon
1920	DO ixt=1,niso
1921	CALL iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608')
1922	ENDDO
1923	ENDDO
1924	#endif
1925	#ifdef ISOVERIF
1926	DO i=1,klon
1927	IF (iso_eau >= 0) THEN
1928	CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
1929	& 'pbl_surf_mod 585',errmax,errmaxrel)
1930	CALL iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), &
1931	& 'pbl_surf_mod 594',errmax,errmaxrel)
1932	IF (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), &
1933	& 'pbl_surf_mod 596',errmax,errmaxrel) == 1) THEN
1934	WRITE(,) 'i=',i
1935	STOP
1936	ENDIF
1937	DO nsrf=1,nbsrf
1938	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
1939	& 'pbl_surf_mod 598',errmax,errmaxrel)
1940	ENDDO
1941	ENDIF !IF (iso_eau >= 0) THEN
1942	ENDDO !DO i=1,knon
1943	DO k=1,klev
1944	DO i=1,klon
1945	IF (iso_eau >= 0) THEN
1946	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1947	& 'pbl_surf_mod 595',errmax,errmaxrel)
1948	ENDIF !IF (iso_eau >= 0) THEN
1949	ENDDO !DO i=1,knon
1950	ENDDO !DO k=1,klev
1951	#endif
1952	#endif
1953
1954
1955
1956	!****************************************************************************************
1957	! Force soil water content to qsol0 if qsol0>0 and VEGET=F (use bucket
1958	! instead of ORCHIDEE)
1959	IF (qsol0>=0.) THEN
1960	PRINT*,'WARNING : On impose qsol=',qsol0
1961	qsol(:)=qsol0
1962	#ifdef ISO
1963	DO ixt=1,niso
1964	xtsol(ixt,:)=qsol0*Rdefault(ixt)
1965	ENDDO
1966	#ifdef ISOTRAC
1967	DO ixt=1+niso,ntraciso
1968	xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt))
1969	ENDDO
1970	#endif
1971	#endif
1972	ENDIF
1973	!****************************************************************************************
1974
1975	!****************************************************************************************
1976	! 2) Initialization to zero
1977	!****************************************************************************************
1978	!
1979	! 2a) Initialization of all argument variables with INTENT(OUT)
1980	!****************************************************************************************
1981	cdragh(:)=0. ; cdragm(:)=0.
1982	zu1(:)=0. ; zv1(:)=0.
1983	!albedo SB >>>
1984	alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
1985	!albedo SB <<<
1986	zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. ; zxsnowerosion(:)=0.
1987	d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
1988	zxfluxlat(:)=0.
1989	zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
1990	zn2mout(:,:)=0 ;
1991	d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_qbs(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
1992	zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
1993	zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
1994	cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
1995	kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
1996	slab_wfbils(:)=0.
1997	s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
1998	s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
1999	s_capCL(:)=0. ; s_oliqCL(:)=0. ; s_cteiCL(:)=0. ; s_pblT(:)=0.
2000	s_therm(:)=0.
2001	s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
2002	zustar(:)=0.
2003	zu10m(:)=0. ; zv10m(:)=0.
2004	fder_print(:)=0.
2005	zxqsurf(:)=0.
2006	delta_qsurf(:) = 0.
2007	zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
2008	solsw(:,:)=0. ; sollw(:,:)=0.
2009	d_ts(:,:)=0.
2010	evap(:,:)=0.
2011	snowerosion(:,:)=0.
2012	fluxlat(:,:)=0.
2013	wfbils(:,:)=0. ; wfevap(:,:)=0. ;
2014	flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
2015	flux_qbs(:,:,:)=0.
2016	dflux_t(:)=0. ; dflux_q(:)=0.
2017	zxsnow(:)=0.
2018	zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0.
2019	qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
2020	runoff(:)=0. ; icesub_lic(:)=0.
2021	l_mixmin(:,:,:)=0.
2022	l_mix(:,:,:) = 0.
2023	wprime(:,:,:) = 0
2024	#ifdef ISO
2025	zxxtevap(:,:)=0.
2026	d_xt(:,:,:)=0.
2027	d_xt_x(:,:,:)=0.
2028	d_xt_w(:,:,:)=0.
2029	flux_xt(:,:,:,:)=0.
2030	! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow
2031	xtevap(:,:,:)=0.
2032	#endif
2033	IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
2034	zcoefh(:,:,:) = 0.0
2035	zcoefh(:,1,:) = 999999. ! zcoefh(:,k=1) should never be used
2036	zcoefm(:,:,:) = 0.0
2037	zcoefm(:,1,:) = 999999. !
2038	ELSE
2039	zcoefm(:,:,is_ave)=0.
2040	zcoefh(:,:,is_ave)=0.
2041	ENDIF
2042	!!
2043	! The components "is_ave" of tke_x and wake_deltke are "OUT" variables
2044	!jyg<
2045	!! tke(:,:,is_ave)=0.
2046	tke_x(:,:,is_ave)=0.
2047	eps_x(:,:,is_ave)=0.
2048
2049	wake_dltke(:,:,is_ave)=0.
2050	!>jyg
2051	!!! jyg le 23/02/2013
2052	t2m(:,:) = 999999. ! t2m and q2m are meaningfull only over sub-surfaces
2053	q2m(:,:) = 999999. ! actually present in the grid cell.
2054	!!!
2055	rh2m(:) = 0. ; qsat2m(:) = 0.
2056	!!!
2057	!!! jyg le 10/02/2012
2058	rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0.
2059
2060
2061	#ifdef ISO
2062	dflux_xt=0.0
2063	#endif
2064
2065	! 2c) Initialization of all local variables computed within the subsurface loop and used later on
2066	!****************************************************************************************
2067	d_t_diss_x(:,:) = 0. ; d_t_diss_w(:,:) = 0.
2068	d_u_x(:,:)=0. ; d_u_w(:,:)=0.
2069	d_v_x(:,:)=0. ; d_v_w(:,:)=0.
2070	flux_t_x(:,:,:)=0. ; flux_t_w(:,:,:)=0.
2071	flux_q_x(:,:,:)=0. ; flux_q_w(:,:,:)=0.
2072	!
2073	!jyg<
2074	flux_u_x(:,:,:)=0. ; flux_u_w(:,:,:)=0.
2075	flux_v_x(:,:,:)=0. ; flux_v_w(:,:,:)=0.
2076	fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0.
2077	!>jyg
2078	#ifdef ISO
2079	flux_xt_x(:,:,:,:)=0. ; flux_xt_w(:,:,:,:)=0.
2080	#endif
2081	!
2082	!jyg<
2083	! pblh,plcl,capCL,cteiCL ... are meaningfull only over sub-surfaces
2084	! actually present in the grid cell ==> value set to 999999.
2085	!
2086	!jyg<
2087	ustar(:,:) = 999999.
2088	wstar(:,:) = 999999.
2089	windsp(:,:) = SQRT(u10m(:,:)2 + v10m(:,:)2 )
2090	u10m(:,:) = 999999.
2091	v10m(:,:) = 999999.
2092	!>jyg
2093	!
2094	pblh(:,:) = 999999. ! Hauteur de couche limite
2095	plcl(:,:) = 999999. ! Niveau de condensation de la CLA
2096	capCL(:,:) = 999999. ! CAPE de couche limite
2097	oliqCL(:,:) = 999999. ! eau_liqu integree de couche limite
2098	cteiCL(:,:) = 999999. ! cloud top instab. crit. couche limite
2099	pblt(:,:) = 999999. ! T a la Hauteur de couche limite
2100	therm(:,:) = 999999.
2101	trmb1(:,:) = 999999. ! deep_cape
2102	trmb2(:,:) = 999999. ! inhibition
2103	trmb3(:,:) = 999999. ! Point Omega
2104	!
2105	t2m_x(:,:) = 999999.
2106	q2m_x(:,:) = 999999.
2107	ustar_x(:,:) = 999999.
2108	wstar_x(:,:) = 999999.
2109	u10m_x(:,:) = 999999.
2110	v10m_x(:,:) = 999999.
2111	!
2112	pblh_x(:,:) = 999999. ! Hauteur de couche limite
2113	plcl_x(:,:) = 999999. ! Niveau de condensation de la CLA
2114	capCL_x(:,:) = 999999. ! CAPE de couche limite
2115	oliqCL_x(:,:) = 999999. ! eau_liqu integree de couche limite
2116	cteiCL_x(:,:) = 999999. ! cloud top instab. crit. couche limite
2117	pblt_x(:,:) = 999999. ! T a la Hauteur de couche limite
2118	therm_x(:,:) = 999999.
2119	trmb1_x(:,:) = 999999. ! deep_cape
2120	trmb2_x(:,:) = 999999. ! inhibition
2121	trmb3_x(:,:) = 999999. ! Point Omega
2122	!
2123	t2m_w(:,:) = 999999.
2124	q2m_w(:,:) = 999999.
2125	ustar_w(:,:) = 999999.
2126	wstar_w(:,:) = 999999.
2127	u10m_w(:,:) = 999999.
2128	v10m_w(:,:) = 999999.
2129
2130	pblh_w(:,:) = 999999. ! Hauteur de couche limite
2131	plcl_w(:,:) = 999999. ! Niveau de condensation de la CLA
2132	capCL_w(:,:) = 999999. ! CAPE de couche limite
2133	oliqCL_w(:,:) = 999999. ! eau_liqu integree de couche limite
2134	cteiCL_w(:,:) = 999999. ! cloud top instab. crit. couche limite
2135	pblt_w(:,:) = 999999. ! T a la Hauteur de couche limite
2136	therm_w(:,:) = 999999.
2137	trmb1_w(:,:) = 999999. ! deep_cape
2138	trmb2_w(:,:) = 999999. ! inhibition
2139	trmb3_w(:,:) = 999999. ! Point Omega
2140	!!!
2141	!
2142	!!!
2143	!****************************************************************************************
2144	! 3) - Calculate pressure thickness of each layer
2145	! - Calculate the wind at first layer
2146	! - Mean calculations of albedo
2147	! - Calculate net radiance at sub-surface
2148	!****************************************************************************************
2149	DO k = 1, klev
2150	DO i = 1, klon
2151	delp(i,k) = paprs(i,k)-paprs(i,k+1)
2152	ENDDO
2153	ENDDO
2154
2155	!****************************************************************************************
2156	! Test for rugos........ from physiq.. A la fin plutot???
2157	!
2158	!****************************************************************************************
2159
2160	DO nsrf = 1, nbsrf
2161	DO i = 1, klon
2162	z0m(i,nsrf) = MAX(z0m(i,nsrf),z0min)
2163	z0h(i,nsrf) = MAX(z0h(i,nsrf),z0min)
2164	ENDDO
2165	ENDDO
2166
2167	! AM heterogeneous continental subsurfaces
2168	! compute time-independent effective surface parameters
2169	IF (iflag_hetero_surf .GT. 0) THEN
2170	CALL eff_surf_param(klon, nbtersrf, albedo_tersrf, frac_tersrf, 'ARI', albedo_eff)
2171	ENDIF
2172
2173	! Mean calculations of albedo
2174	!
2175	! * alb : mean albedo for whole SW interval
2176	!
2177	! Mean albedo for grid point
2178	! * alb_m : mean albedo at whole SW interval
2179
2180	alb_dir_m(:,:) = 0.0
2181	alb_dif_m(:,:) = 0.0
2182	DO k = 1, nsw
2183	DO nsrf = 1, nbsrf
2184	DO i = 1, klon
2185	! AM heterogeneous continental sub-surfaces
2186	IF (nsrf .EQ. is_ter .AND. iflag_hetero_surf .GT. 0) THEN
2187	alb_dir(i,k,nsrf) = albedo_eff(i)
2188	alb_dif(i,k,nsrf) = albedo_eff(i)
2189	ENDIF
2190	!
2191	alb_dir_m(i,k) = alb_dir_m(i,k) + alb_dir(i,k,nsrf) * pctsrf(i,nsrf)
2192	alb_dif_m(i,k) = alb_dif_m(i,k) + alb_dif(i,k,nsrf) * pctsrf(i,nsrf)
2193	ENDDO
2194	ENDDO
2195	ENDDO
2196
2197	! We here suppose the fraction f1 of incoming radiance of visible radiance
2198	! as a fraction of all shortwave radiance
2199	f1 = 0.5
2200	! f1 = 1 ! put f1=1 to recreate old calculations
2201
2202	!f1 is already included with SFRWL values in each surf files
2203	alb=0.0
2204	DO k=1,nsw
2205	DO nsrf = 1, nbsrf
2206	DO i = 1, klon
2207	alb(i,nsrf) = alb(i,nsrf) + alb_dir(i,k,nsrf)*SFRWL(k)
2208	ENDDO
2209	ENDDO
2210	ENDDO
2211
2212	alb_m=0.0
2213	DO k = 1,nsw
2214	DO i = 1, klon
2215	alb_m(i) = alb_m(i) + alb_dir_m(i,k)*SFRWL(k)
2216	ENDDO
2217	ENDDO
2218	!albedo SB <<<
2219
2220
2221
2222	! Calculation of mean temperature at surface grid points
2223	ztsol(:) = 0.0
2224	DO nsrf = 1, nbsrf
2225	DO i = 1, klon
2226	ztsol(i) = ztsol(i) + ts(i,nsrf)*pctsrf(i,nsrf)
2227	ENDDO
2228	ENDDO
2229
2230	! Linear distrubution on sub-surface of long- and shortwave net radiance
2231	DO nsrf = 1, nbsrf
2232	DO i = 1, klon
2233	sollw(i,nsrf) = sollw_m(i) + 4.0RSIGMAztsol(i)*3 (ztsol(i)-ts(i,nsrf))
2234	!--OB this line is not satisfactory because alb is the direct albedo not total albedo
2235	solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
2236	ENDDO
2237	ENDDO
2238	!
2239	!<al1: second order corrections
2240	!- net = dwn -up; up=sig( T4 + 4sum%T3T' + 6sum%T2T'2 +...)
2241	IF (iflag_order2_sollw == 1) THEN
2242	meansqT(:) = 0. ! as working buffer
2243	DO nsrf = 1, nbsrf
2244	DO i = 1, klon
2245	meansqT(i) = meansqT(i)+(ts(i,nsrf)-ztsol(i))*2 pctsrf(i,nsrf)
2246	ENDDO
2247	ENDDO
2248	DO nsrf = 1, nbsrf
2249	DO i = 1, klon
2250	sollw(i,nsrf) = sollw(i,nsrf) &
2251	+ 6.0RSIGMAztsol(i)*2 (meansqT(i)-(ztsol(i)-ts(i,nsrf))**2)
2252	ENDDO
2253	ENDDO
2254	ENDIF ! iflag_order2_sollw == 1
2255	!>al1
2256
2257	!--OB add diffuse fraction of SW down
2258	DO n=1,nbcf_out
2259	IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
2260	ENDDO
2261	! >> PC
2262	IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
2263	r_co2_ppm(1:klon) = co2_send(1:klon)
2264	DO n=1,nbcf_out
2265	IF (cfname_out(n) == "atmco2" ) fields_out(1:klon,n) = co2_send(1:klon)
2266	ENDDO
2267	ENDIF
2268
2269	IF ( .NOT. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
2270	r_co2_ppm(1:klon) = co2_ppm ! Constant field
2271	DO n=1,nbcf_out
2272	IF (cfname_out(n) == "atmco2" ) fields_out(1:klon,n) = co2_ppm
2273	ENDDO
2274	ENDIF
2275
2276	END SUBROUTINE pbl_surface_uncompress_pre
2277
2278	SUBROUTINE pbl_surface_subsrf( nsrf, knon, ni, &
2279	dtime, date0, itap, jour, &
2280	debut, lafin, &
2281	rlon, rlat, rugoro, rmu0, &
2282	lwdown_m, pphi, cldt, &
2283	rain_f, snow_f, bs_f, &
2284	gustiness, &
2285	t, q, qbs, u, v, &
2286	wake_dlt, wake_dlq, &
2287	wake_cstar, wake_s, &
2288	pplay, paprs, pctsrf, &
2289	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
2290	cdragh, cdragm, &
2291	beta, &
2292	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
2293	qsat2m, &
2294	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
2295	d_t_w, d_q_w, &
2296	d_t_x, d_q_x, &
2297	delta_tsurf,wake_dens,cdragh_x,cdragh_w, &
2298	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
2299	zcoefh, zcoefm, slab_wfbils, &
2300	qsol, s_pblh, &
2301	s_pblh_x, s_pblh_w, &
2302	delta_qsurf, &
2303	rh2m, &
2304	z0m, z0h, agesno, sollw, solsw, &
2305	d_ts, evap, fluxlat, t2m, &
2306	flux_t, flux_u, flux_v, &
2307	dflux_t, dflux_q, &
2308	q2m, flux_q, flux_qbs, tke_x, eps_x, &
2309	wake_dltke, &
2310	treedrg,hice ,tice, bilg_cumul, &
2311	fcds, fcdi, dh_basal_growth, dh_basal_melt, &
2312	dh_top_melt, dh_snow2sic, &
2313	dtice_melt, dtice_snow2sic , &
2314	tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
2315	cdragm_tersrf, cdragh_tersrf, &
2316	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
2317	#ifdef ISO
2318	& ,xtrain_f, xtsnow_f,xt, &
2319	& wake_dlxt,zxxtevap,xtevap, &
2320	& d_xt,d_xt_w,d_xt_x, &
2321	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
2322	& h1_diag,runoff_diag,xtrunoff_diag &
2323	#endif
2324	, n2mout, n2mout_x, n2mout_w, d_u_x, d_u_w, d_v_x, d_v_w, windsp, t2m_x, &
2325	q2m_x, rh2m_x, qsat2m_x, u10m_x, v10m_x, ustar_x, wstar_x, pblh_x, plcl_x, capCL_x, &
2326	oliqCL_x, cteiCL_x, pblt_x, therm_x, trmb1_x, trmb2_x, trmb3_x, t2m_w, q2m_w, rh2m_w, &
2327	qsat2m_w, u10m_w, v10m_w, ustar_w, wstar_w, pblh_w, plcl_w, capCL_w, oliqCL_w, cteiCL_w,&
2328	pblt_w, therm_w, trmb1_w, trmb2_w, trmb3_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, &
2329	therm, trmb1, trmb2, trmb3, alb, snowerosion, iflag_split_ref, &
2330	delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w,&
2331	flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w)
2332	!$gpum horizontal knon
2333
2334
2335	!****************************************************************************************
2336	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
2337	! Objet: interface de "couche limite" (diffusion verticale)
2338	!
2339	!AA REM:
2340	!AA-----
2341	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
2342	!AA pour l'instant le calcul de la couche limite pour les traceurs
2343	!AA se fait avec cltrac et ne tient pas compte de la differentiation
2344	!AA des sous-fraction de sol.
2345	!AA REM bis :
2346	!AA----------
2347	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
2348	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
2349	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
2350	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
2351	!AA si les informations des subsurfaces doivent etre prises en compte
2352	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
2353	!AA c'est a dire nbsrf (nbre de subsurface).
2354	!
2355	! Arguments:
2356	!
2357	! dtime----input-R- interval du temps (secondes)
2358	! itap-----input-I- numero du pas de temps
2359	! date0----input-R- jour initial
2360	! t--------input-R- temperature (K)
2361	! q--------input-R- vapeur d'eau (kg/kg)
2362	! u--------input-R- vitesse u
2363	! v--------input-R- vitesse v
2364	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
2365	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
2366	!wake_cstar-input-R- wake gust front speed (m/s)
2367	! wake_s---input-R- wake fractionnal area
2368	! ts-------input-R- temperature du sol (en Kelvin)
2369	! paprs----input-R- pression a intercouche (Pa)
2370	! pplay----input-R- pression au milieu de couche (Pa)
2371	! rlat-----input-R- latitude en degree
2372	! z0m, z0h ----input-R- longeur de rugosite (en m)
2373	! Martin
2374	! cldt-----input-R- total cloud fraction
2375	! Martin
2376	!GG
2377	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
2378	!GG
2379	!
2380	! d_t------output-R- le changement pour "t"
2381	! d_q------output-R- le changement pour "q"
2382	! d_u------output-R- le changement pour "u"
2383	! d_v------output-R- le changement pour "v"
2384	! d_ts-----output-R- le changement pour "ts"
2385	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
2386	! (orientation positive vers le bas)
2387	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
2388	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
2389	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
2390	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
2391	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
2392	! dflux_t--output-R- derive du flux sensible
2393	! dflux_q--output-R- derive du flux latent
2394	! zu1------output-R- le vent dans la premiere couche
2395	! zv1------output-R- le vent dans la premiere couche
2396	! trmb1----output-R- deep_cape
2397	! trmb2----output-R- inhibition
2398	! trmb3----output-R- Point Omega
2399	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
2400	! plcl-----output-R- Niveau de condensation
2401	! pblh-----output-R- HCL
2402	! pblT-----output-R- T au nveau HCL
2403	! treedrg--output-R- tree drag (m)
2404	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
2405	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
2406	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
2407	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
2408	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
2409	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
2410	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
2411	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
2412
2413	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
2414	USE carbon_cycle_mod, ONLY : co2_send, nbcf_out, fields_out, yfields_out
2415	use hbtm_mod, only: hbtm
2416	USE indice_sol_mod
2417	USE mod_grid_phy_lmdz, ONLY : grid1dto2d_glo
2418	USE print_control_mod, ONLY : prt_level,lunout
2419	#ifdef ISO
2420	USE isotopes_mod, ONLY: Rdefault,iso_eau
2421	#ifdef ISOVERIF
2422	USE isotopes_verif_mod
2423	#endif
2424	#ifdef ISOTRAC
2425	USE isotrac_mod, only: index_iso
2426	#endif
2427	#endif
2428	USE dimpft_mod_h
2429	USE flux_arp_mod_h
2430	USE compbl_mod_h
2431	USE yoethf_mod_h
2432	USE clesphys_mod_h
2433	USE ioipsl_getin_p_mod, ONLY : getin_p
2434	use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
2435	dser, dt_ds, zsig, zmea, &
2436	frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf !AM
2437	use phys_output_var_mod, only: tkt, tks, taur, sss
2438	use lmdz_blowing_snow_ini, only : zeta_bs
2439	USE dimsoil_mod_h, ONLY: nsoilmx
2440	USE surf_param_mod, ONLY: eff_surf_param !AM
2441	use wxios_mod, ONLY: missing_val_xios => missing_val, using_xios
2442	USE netcdf, only: missing_val_netcdf => nf90_fill_real
2443	USE yomcst_mod_h
2444	USE lmdz_checksum, ONLY : checksum
2445	USE mod_phys_lmdz_para, ONLY : is_master
2446	USE cdrag_mod, ONLY : cdrag
2447
2448	IMPLICIT NONE
2449
2450	INCLUDE "FCTTRE.h"
2451	!****************************************************************************************
2452	INTEGER, INTENT(IN) :: nsrf ! indice current subsurface
2453	INTEGER, INTENT(IN) :: knon ! number of compressed points for current subsurface
2454	INTEGER, INTENT(IN) :: ni(knon)! index for compressed current sub-surface
2455	REAL, INTENT(IN) :: dtime ! time interval (s)
2456	REAL, INTENT(IN) :: date0 ! initial day
2457	INTEGER, INTENT(IN) :: itap ! time step
2458	INTEGER, INTENT(IN) :: jour ! current day of the year
2459	LOGICAL, INTENT(IN) :: debut ! true if first run step
2460	LOGICAL, INTENT(IN) :: lafin ! true if last run step
2461	REAL, DIMENSION(klon), INTENT(IN) :: rlon ! longitudes in degrees
2462	REAL, DIMENSION(klon), INTENT(IN) :: rlat ! latitudes in degrees
2463	REAL, DIMENSION(klon), INTENT(IN) :: rugoro ! rugosity length
2464	REAL, DIMENSION(klon), INTENT(IN) :: rmu0 ! cosine of solar zenith angle
2465	REAL, DIMENSION(klon), INTENT(IN) :: rain_f ! rain fall
2466	REAL, DIMENSION(klon), INTENT(IN) :: snow_f ! snow fall
2467	REAL, DIMENSION(klon), INTENT(IN) :: bs_f ! blowing snow fall
2468	REAL, DIMENSION(klon,klev), INTENT(IN) :: t ! temperature (K)
2469	REAL, DIMENSION(klon,klev), INTENT(IN) :: q ! water vapour (kg/kg)
2470	REAL, DIMENSION(klon,klev), INTENT(IN) :: qbs ! blowing snow specific content (kg/kg)
2471	REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed
2472	REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed
2473	REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay ! mid-layer pression (Pa)
2474	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa)
2475	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
2476	REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downward longwave radiation at mean s
2477	REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness
2478	REAL, DIMENSION(klon,klev), INTENT(IN) :: pphi ! geopotential (m2/s2)
2479	REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud
2480
2481	#ifdef ISO
2482	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
2483	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
2484	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
2485	#endif
2486	REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlt !temperature difference between (w) and (x) (K)
2487	REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlq !humidity difference between (w) and (x) (K)
2488	REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides
2489	REAL, DIMENSION(klon), INTENT(IN) :: wake_cstar! Vitesse d'expansion des poches froides
2490	REAL, DIMENSION(klon), INTENT(IN) :: wake_dens
2491	#ifdef ISO
2492	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
2493	#endif
2494	! Input/Output variables
2495	!****************************************************************************************
2496	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: beta ! Aridity factor
2497	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
2498	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: delta_tsurf !surface temperature difference between
2499	REAL, DIMENSIOn(6),intent(in) :: SFRWL
2500	REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
2501	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
2502	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
2503	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
2504	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
2505	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
2506	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
2507
2508	! Output variables
2509	!****************************************************************************************
2510	REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: eps_x ! TKE dissipation rate
2511
2512	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q
2513	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind
2514	REAL, DIMENSION(klon), INTENT(OUT) :: alb3_lic
2515	REAL, DIMENSION(klon), INTENT(OUT) :: icesub_lic ! ice (no snow!) sublimation over ice sheet
2516	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_t_w ! !
2517	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_q_w ! ! Tendances dans les poches
2518	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_t_x ! !
2519	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_q_x ! ! Tendances hors des poches
2520	REAL, DIMENSION(klon), INTENT(INOUT) :: qsat2m
2521	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_t ! change in temperature
2522	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_t_diss ! change in temperature
2523	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_q ! change in water vapour
2524	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_u ! change in u speed
2525	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_v ! change in v speed
2526	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_qbs ! change in blowing snow specific content
2527
2528	REAL, INTENT(INOUT):: zcoefh(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
2529	! coef for turbulent diffusion of T and Q, mean for each grid point
2530
2531	REAL, INTENT(INOUT):: zcoefm(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
2532	! coef for turbulent diffusion of U and V (?), mean for each grid point
2533	#ifdef ISO
2534	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
2535	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
2536	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
2537	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
2538	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
2539	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
2540	#endif
2541	! Output only for diagnostics
2542	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragh_x
2543	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragh_w
2544	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragm_x
2545	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragm_w
2546	REAL, DIMENSION(klon), INTENT(INOUT) :: kh
2547	REAL, DIMENSION(klon), INTENT(INOUT) :: kh_x
2548	REAL, DIMENSION(klon), INTENT(INOUT) :: kh_w
2549	REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points
2550	REAL, DIMENSION(klon), INTENT(OUT) :: qsol ! water height in the soil (mm)
2551	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
2552	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
2553	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
2554	REAL, DIMENSION(klon), INTENT(OUT) :: delta_qsurf! humidity difference at surface, mean for each grid point
2555	REAL, DIMENSION(klon), INTENT(INOUT) :: rh2m ! relative humidity at 2m
2556	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
2557	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: agesno ! age of snow at surface
2558	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: solsw ! net shortwave radiation at surface
2559	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: sollw ! net longwave radiation at surface
2560	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface
2561	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
2562	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux
2563	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height
2564	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
2565	! positve orientation downwards
2566	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
2567	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
2568	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m)
2569	!AM heterogeneous continental sub-surfaces
2570	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_tersrf ! surface temperature of continental sub-surfaces (K)
2571	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: qsurf_tersrf ! surface specific humidity of continental sub-surfaces (kg/kg)
2572	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_new_tersrf ! surface temperature of continental sub-surfaces (K)
2573	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragm_tersrf ! momentum drag coefficient of continental sub-surfaces (-)
2574	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragh_tersrf ! heat drag coefficient of continental sub-surfaces (-)
2575	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: swnet_tersrf ! net shortwave radiation of continental sub-surfaces (W/m2)
2576	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: lwnet_tersrf ! net longwave radiation of continental sub-surfaces (W/m2)
2577	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxsens_tersrf ! sensible heat flux of continental sub-surfaces (W/m2)
2578	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxlat_tersrf ! latent heat flux of continental sub-surfaces (W/m2)
2579	REAL, DIMENSION(klon, nsoilmx, nbtersrf), INTENT(INOUT) :: tsoil_tersrf ! soil temperature of continental sub-surfaces (K)
2580	#ifdef ISO
2581	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
2582	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
2583	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
2584	#endif
2585
2586	! Output not needed
2587	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux
2588	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux
2589	REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height
2590	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
2591	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2
2592
2593	#ifdef ISO
2594	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
2595	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
2596	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
2597	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
2598	#endif
2599
2600	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow ! snow water content
2601	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt ! snow height
2602	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice ! snow passed to ice
2603	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow ! snow in snow model
2604	REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice
2605	REAL, DIMENSION(klon), INTENT(INOUT) :: hice ! hice
2606	REAL, DIMENSION(klon), INTENT(INOUT) :: tice ! tice
2607	REAL, DIMENSION(klon), INTENT(INOUT) :: bilg_cumul ! flux cumulated
2608	REAL, DIMENSION(klon), INTENT(INOUT) :: fcds
2609	REAL, DIMENSION(klon), INTENT(INOUT) :: fcdi
2610	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_growth
2611	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_melt
2612	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_top_melt
2613	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_snow2sic
2614	REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_melt
2615	REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_snow2sic
2616
2617	! variables temporaires en "klon" (nom compressée) passée en argument pour les sous-surface
2618
2619	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(OUT) :: n2mout
2620	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(OUT) :: n2mout_x
2621	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(OUT) :: n2mout_w
2622	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_x
2623	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_w
2624	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_x
2625	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_w
2626	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: windsp
2627	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_x
2628	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_x
2629	REAL, DIMENSION(klon), INTENT(INOUT) :: rh2m_x
2630	REAL, DIMENSION(klon), INTENT(INOUT) :: qsat2m_x
2631	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_x
2632	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_x
2633	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_x
2634	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_x
2635	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_x
2636	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_x
2637	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_x
2638	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_x
2639	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_x
2640	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_x
2641	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_x
2642	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_x
2643	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_x
2644	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_x
2645	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_w
2646	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_w
2647	REAL, DIMENSION(klon), INTENT(INOUT) :: rh2m_w
2648	REAL, DIMENSION(klon), INTENT(INOUT) :: qsat2m_w
2649	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_w
2650	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_w
2651	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_w
2652	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_w
2653	!
2654	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_w
2655	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_w
2656	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_w
2657	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_w
2658	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_w
2659	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_w
2660	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_w
2661	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_w
2662	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_w
2663	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_w
2664	!
2665	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblh ! height of the planetary boundary layer
2666	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: plcl ! condensation level
2667	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: capCL
2668	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: oliqCL
2669	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: cteiCL
2670	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblT
2671	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: therm
2672	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb1 ! deep cape
2673	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb2 ! inhibition
2674	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb3 ! point Omega
2675	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: alb ! mean albedo for whole SW interval
2676	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: snowerosion
2677	INTEGER, INTENT(INOUT) :: iflag_split_ref
2678
2679	!
2680	! Other local variables
2681	!****************************************************************************************
2682	INTEGER :: n
2683	INTEGER :: iflag_split
2684	INTEGER :: i, k
2685	INTEGER :: j
2686	REAL, DIMENSION(knon) :: r_co2_ppm ! taux CO2 atmosphere
2687	REAL :: yt1_new
2688	REAL, DIMENSION(knon) :: yts, yz0m, yz0h, ypct
2689	REAL, DIMENSION(knon) :: yz0h_old
2690	REAL, DIMENSION(knon) :: yalb,yalb_vis
2691	REAL, DIMENSION(knon) :: yt1, yq1, yu1, yv1, yqbs1
2692	REAL, DIMENSION(knon) :: yqa
2693	REAL, DIMENSION(knon) :: ysnow, yqsurf, yagesno, yqsol
2694	REAL, DIMENSION(knon) :: yrain_f, ysnow_f, ybs_f
2695	#ifdef ISO
2696	REAL, DIMENSION(ntraciso,knon) :: yxt1
2697	REAL, DIMENSION(niso,knon) :: yxtsnow, yxtsol
2698	REAL, DIMENSION(ntraciso,knon) :: yxtrain_f, yxtsnow_f
2699	REAL, DIMENSION(knon) :: yrunoff_diag
2700	REAL, DIMENSION(niso,knon) :: yxtrunoff_diag
2701	REAL, DIMENSION(niso,knon) :: yRland_ice
2702	#endif
2703	REAL, DIMENSION(knon) :: ysolsw, ysollw
2704	REAL, DIMENSION(knon) :: yfder
2705	REAL, DIMENSION(knon) :: yrugoro
2706	REAL, DIMENSION(knon) :: yfluxlat
2707	REAL, DIMENSION(knon) :: yfluxbs
2708	REAL, DIMENSION(knon) :: y_d_ts
2709	REAL, DIMENSION(knon) :: y_flux_t1, y_flux_q1
2710	REAL, DIMENSION(knon) :: y_dflux_t, y_dflux_q
2711	#ifdef ISO
2712	REAL, DIMENSION(ntraciso,knon) :: y_flux_xt1
2713	REAL, DIMENSION(ntraciso,knon) :: y_dflux_xt
2714	#endif
2715	REAL, DIMENSION(knon) :: y_flux_u1, y_flux_v1
2716	REAL, DIMENSION(knon) :: y_flux_bs, y_flux0
2717	REAL, DIMENSION(knon) :: yt2m, yq2m, yu10m
2718	INTEGER, DIMENSION(knon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
2719	REAL, DIMENSION(knon) :: yustar
2720	REAL, DIMENSION(knon) :: ywstar
2721	REAL, DIMENSION(knon) :: ywindsp
2722	REAL, DIMENSION(knon) :: yt10m, yq10m
2723	REAL, DIMENSION(knon) :: ypblh
2724	REAL, DIMENSION(knon) :: ylcl
2725	REAL, DIMENSION(knon) :: ycapCL
2726	REAL, DIMENSION(knon) :: yoliqCL
2727	REAL, DIMENSION(knon) :: ycteiCL
2728	REAL, DIMENSION(knon) :: ypblT
2729	REAL, DIMENSION(knon) :: ytherm
2730	REAL, DIMENSION(knon) :: ytrmb1
2731	REAL, DIMENSION(knon) :: ytrmb2
2732	REAL, DIMENSION(knon) :: ytrmb3
2733
2734	REAL, DIMENSION(knon) :: yt2m_x
2735	REAL, DIMENSION(knon) :: yq2m_x
2736	REAL, DIMENSION(knon) :: yt10m_x
2737	REAL, DIMENSION(knon) :: yq10m_x
2738	REAL, DIMENSION(knon) :: yu10m_x
2739	REAL, DIMENSION(knon) :: yustar_x
2740	REAL, DIMENSION(knon) :: ywstar_x
2741	!
2742	REAL, DIMENSION(knon) :: ypblh_x
2743	REAL, DIMENSION(knon) :: ylcl_x
2744	REAL, DIMENSION(knon) :: ycapCL_x
2745	REAL, DIMENSION(knon) :: yoliqCL_x
2746	REAL, DIMENSION(knon) :: ycteiCL_x
2747	REAL, DIMENSION(knon) :: ypblt_x
2748	REAL, DIMENSION(knon) :: ytherm_x
2749	REAL, DIMENSION(knon) :: ytrmb1_x
2750	REAL, DIMENSION(knon) :: ytrmb2_x
2751	REAL, DIMENSION(knon) :: ytrmb3_x
2752
2753	REAL, DIMENSION(knon) :: uzon, vmer
2754	REAL, DIMENSION(knon) :: tair1, qair1, tairsol
2755	REAL, DIMENSION(knon) :: psfce, patm
2756	REAL, DIMENSION(knon) :: qairsol, zgeo1, speed, zri1, pref !speed, zri1, pref, added by Fuxing WANG, 04/03/2015
2757	REAL, DIMENSION(knon) :: yz0h_oupas
2758	REAL, DIMENSION(knon) :: yfluxsens
2759	REAL, DIMENSION(knon) :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
2760	REAL, DIMENSION(knon) :: AcoefH, AcoefQ, BcoefH, BcoefQ
2761	#ifdef ISO
2762	REAL, DIMENSION(ntraciso,knon) :: AcoefXT, BcoefXT
2763	#endif
2764	REAL, DIMENSION(knon) :: AcoefU, AcoefV, BcoefU, BcoefV
2765	REAL, DIMENSION(knon) :: AcoefQBS, BcoefQBS
2766	REAL, DIMENSION(knon) :: ypsref
2767	REAL, DIMENSION(knon) :: yevap, yevap_pot, ytsurf_new, yalb3_new, yicesub_lic
2768	REAL, DIMENSION(knon,nsw) :: yalb_dir_new, yalb_dif_new
2769	REAL, DIMENSION(knon,klev) :: y_d_t, y_d_q, y_d_t_diss, y_d_qbs
2770	REAL, DIMENSION(knon,klev) :: y_d_u, y_d_v
2771	REAL, DIMENSION(knon,klev) :: y_flux_t, y_flux_q, y_flux_qbs
2772	REAL, DIMENSION(knon,klev) :: y_flux_u, y_flux_v
2773	REAL, DIMENSION(knon,klev) :: ycoefh,ycoefm,ycoefq,ycoefqbs
2774	REAL, DIMENSION(knon) :: ycdragh, ycdragq, ycdragm
2775	REAL, DIMENSION(knon,klev) :: yu, yv
2776	REAL, DIMENSION(knon,klev) :: yt, yq, yqbs
2777	#ifdef ISO
2778	REAL, DIMENSION(ntraciso,knon) :: yxtevap
2779	REAL, DIMENSION(ntraciso,knon,klev) :: y_d_xt
2780	REAL, DIMENSION(ntraciso,knon,klev) :: y_flux_xt
2781	REAL, DIMENSION(ntraciso,knon,klev) :: yxt
2782	#endif
2783	REAL, DIMENSION(knon,klev) :: ypplay, ydelp
2784	REAL, DIMENSION(klon,klev),INTENT(IN) :: delp
2785	REAL, DIMENSION(knon,klev+1) :: ypaprs
2786	REAL, DIMENSION(knon,klev+1) :: ytke, yeps
2787	REAL, DIMENSION(knon,nsoilmx) :: ytsoil
2788	REAL, DIMENSION(knon,nvm_lmdz) :: yveget
2789	REAL, DIMENSION(knon,nvm_lmdz) :: ylai
2790	REAL, DIMENSION(knon,nvm_lmdz) :: yheight
2791	REAL, DIMENSION(knon,klev) :: y_d_u_frein
2792	REAL, DIMENSION(knon,klev) :: y_d_v_frein
2793	REAL, DIMENSION(knon,klev) :: y_treedrg
2794
2795	CHARACTER(len=80) :: abort_message
2796	CHARACTER(len=20) :: modname = 'pbl_surface'
2797	LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
2798	LOGICAL, PARAMETER :: check=.FALSE.
2799
2800	REAL, DIMENSION(knon) :: ywake_s, ywake_cstar, ywake_dens
2801	REAL, DIMENSION(knon,klev+1) :: ytke_x, ytke_w, yeps_x, yeps_w
2802	REAL, DIMENSION(knon,klev+1) :: ywake_dltke
2803	REAL, DIMENSION(knon,klev) :: yu_x, yv_x, yu_w, yv_w
2804	REAL, DIMENSION(knon,klev) :: yt_x, yq_x, yt_w, yq_w
2805	REAL, DIMENSION(knon,klev) :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
2806	REAL, DIMENSION(knon,klev) :: ycoefq_x, ycoefq_w
2807	REAL, DIMENSION(knon) :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
2808	REAL, DIMENSION(knon) :: ycdragm_x, ycdragm_w
2809	REAL, DIMENSION(knon) :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
2810	REAL, DIMENSION(knon) :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
2811	REAL, DIMENSION(knon) :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x
2812	REAL, DIMENSION(knon) :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w
2813	REAL, DIMENSION(knon) :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w
2814	REAL, DIMENSION(knon) :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w
2815	REAL, DIMENSION(knon,klev) :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w
2816	REAL, DIMENSION(knon,klev) :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w
2817	REAL, DIMENSION(knon) :: yfluxlat_x, yfluxlat_w
2818	REAL, DIMENSION(knon,klev) :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w
2819	REAL, DIMENSION(knon,klev) :: y_d_t_diss_x, y_d_t_diss_w
2820	REAL, DIMENSION(knon,klev), INTENT(INOUT) :: d_t_diss_x, d_t_diss_w
2821	REAL, DIMENSION(knon,klev) :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w
2822	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
2823	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
2824	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: fluxlat_x, fluxlat_w
2825	REAL, DIMENSION(knon) :: ybeta
2826	REAL, DIMENSION(knon) :: ybeta_prev
2827	REAL, DIMENSION(knon,klev) :: CcoefH, CcoefQ, DcoefH, DcoefQ
2828	REAL, DIMENSION(knon,klev) :: CcoefU, CcoefV, DcoefU, DcoefV
2829	REAL, DIMENSION(knon,klev) :: CcoefQBS, DcoefQBS
2830	REAL, DIMENSION(knon,klev) :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x
2831	REAL, DIMENSION(knon,klev) :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w
2832	REAL, DIMENSION(knon,klev) :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x
2833	REAL, DIMENSION(knon,klev) :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w
2834	REAL, DIMENSION(knon,klev) :: Kcoef_hq, Kcoef_m, gama_h, gama_q
2835	REAL, DIMENSION(knon,klev) :: gama_qbs, Kcoef_qbs
2836	REAL, DIMENSION(knon,klev) :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x
2837	REAL, DIMENSION(knon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
2838	REAL, DIMENSION(knon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
2839	#ifdef ISO
2840	REAL, DIMENSION(ntraciso,knon,klev) :: yxt_x, yxt_w
2841	REAL, DIMENSION(ntraciso,knon) :: y_flux_xt1_x , y_flux_xt1_w
2842	REAL, DIMENSION(ntraciso,knon,klev) :: y_flux_xt_x,y_d_xt_x
2843	REAL, DIMENSION(ntraciso,knon,klev) :: y_flux_xt_w,y_d_xt_w
2844	REAL, DIMENSION(ntraciso,klon,klev),INTENT(INOUT) :: zxfluxxt_w, zxfluxxt_x
2845	REAL, DIMENSION(ntraciso,klon,klev,nbsrf), INTENT(INOUT) :: flux_xt_x, flux_xt_w
2846	REAL, DIMENSION(ntraciso,knon) :: AcoefXT_x, BcoefXT_x
2847	REAL, DIMENSION(ntraciso,knon) :: AcoefXT_w, BcoefXT_w
2848	REAL, DIMENSION(ntraciso,knon,klev) :: CcoefXT, DcoefXT
2849	REAL, DIMENSION(ntraciso,knon,klev) :: CcoefXT_x, DcoefXT_x
2850	REAL, DIMENSION(ntraciso,knon,klev) :: CcoefXT_w, DcoefXT_w
2851	REAL, DIMENSION(ntraciso,knon,klev) :: gama_xt,gama_xt_x,gama_xt_w
2852	#endif
2853
2854	REAL, DIMENSION(knon) :: yt2m_w
2855	REAL, DIMENSION(knon) :: yq2m_w
2856	REAL, DIMENSION(knon) :: yt10m_w
2857	REAL, DIMENSION(knon) :: yq10m_w
2858	REAL, DIMENSION(knon) :: yu10m_w
2859	REAL, DIMENSION(knon) :: yustar_w
2860	REAL, DIMENSION(knon) :: ywstar_w
2861	!
2862	REAL, DIMENSION(knon) :: ypblh_w
2863	REAL, DIMENSION(knon) :: ylcl_w
2864	REAL, DIMENSION(knon) :: ycapCL_w
2865	REAL, DIMENSION(knon) :: yoliqCL_w
2866	REAL, DIMENSION(knon) :: ycteiCL_w
2867	REAL, DIMENSION(knon) :: ypblt_w
2868	REAL, DIMENSION(knon) :: ytherm_w
2869	REAL, DIMENSION(knon) :: ytrmb1_w
2870	REAL, DIMENSION(knon) :: ytrmb2_w
2871	REAL, DIMENSION(knon) :: ytrmb3_w
2872	!
2873	REAL, DIMENSION(knon) :: uzon_x, vmer_x, speed_x, zri1_x, pref_x !speed_x, zri1_x, pref_x, added by Fuxing WANG, 04/03/2015
2874	REAL, DIMENSION(knon) :: zgeo1_x, tair1_x, qair1_x, tairsol_x
2875	!
2876	REAL, DIMENSION(knon) :: uzon_w, vmer_w, speed_w, zri1_w, pref_w !speed_w, zri1_w, pref_w, added by Fuxing WANG, 04/03/2015
2877	REAL, DIMENSION(knon) :: zgeo1_w, tair1_w, qair1_w, tairsol_w
2878	REAL, DIMENSION(knon) :: yus0, yvs0
2879	!
2880	REAL, DIMENSION(knon) :: y_delta_flux_t1
2881	REAL, DIMENSION(knon) :: y_delta_tsurf, y_delta_tsurf_new
2882	REAL, DIMENSION(knon) :: delta_coef, tau_eq
2883	REAL, DIMENSION(knon) :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
2884	REAL, DIMENSION(knon) :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
2885	REAL, DIMENSION(knon) :: y_delta_qsurf
2886	REAL, DIMENSION(knon) :: y_delta_qsats
2887	REAL, DIMENSION(knon) :: yg_T, yg_Q
2888	REAL, DIMENSION(knon) :: yGamma_dTs_phiT, yGamma_dQs_phiQ
2889	REAL, DIMENSION(knon) :: ydTs_ins, ydqs_ins
2890	!
2891	REAL, PARAMETER :: facteur = 2. / 1.772 ! ( == 2. / SQRT(3.14))
2892	REAL, PARAMETER :: inertia=2000.
2893	REAL, DIMENSION(knon) :: ydtsurf_th
2894	REAL, DIMENSION(knon) :: Kech_h ! Coefficient d'echange pour l'energie
2895	REAL, DIMENSION(knon) :: Kech_h_x, Kech_h_w
2896	REAL, DIMENSION(knon) :: yts_x, yts_w
2897	REAL, DIMENSION(knon) :: yqsurf_x, yqsurf_w
2898	REAL :: fact_cdrag
2899	REAL :: z1lay
2900	REAL :: vent
2901	REAL, DIMENSION(knon) :: ylwdown ! jg : temporary (ysollwdown)
2902	REAL, DIMENSION(knon) :: ygustiness ! jg : temporary (ysollwdown)
2903	REAL :: zx_qs1, zcor1, zdelta1
2904	REAL, DIMENSION(knon) :: ytoice
2905	REAL, DIMENSION(knon) :: ysnowhgt, yqsnow, ysissnow, yrunoff
2906	REAL, DIMENSION(knon) :: yzmea
2907	REAL, DIMENSION(knon) :: yzsig
2908	REAL, DIMENSION(knon) :: ycldt
2909	REAL, DIMENSION(knon) :: yrmu0
2910	REAL, DIMENSION(knon) :: yri0
2911
2912	REAL, DIMENSION(knon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, &
2913	ydser, ydt_ds, ytkt, ytks, ytaur, ysss
2914	! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser,
2915	! dt_ds, tkt, tks, taur, sss on ocean points
2916	REAL :: missing_val
2917
2918	REAL, DIMENSION(knon,klev) :: ytheta
2919	REAL, DIMENSION(knon,klev) :: ypphii
2920	REAL, DIMENSION(knon,klev) :: ypphi
2921	REAL, DIMENSION(knon,klev) :: ydthetadz
2922	REAL, DIMENSION(knon) :: ydthetadz300
2923	REAL, DIMENSION(knon) :: Ampl
2924	REAL, DIMENSION(knon, nbtersrf) :: yfrac_tersrf, yz0m_tersrf, yz0h_tersrf
2925	REAL, DIMENSION(knon) :: yzxtsol ! temperature at surface
2926	REAL, DIMENSION(knon) :: ypblh_tmp ! temporaire pblh compressed
2927	#ifdef ISO
2928	REAL, DIMENSION(knon) :: h1
2929	INTEGER :: ixt
2930	#endif
2931	IF (using_xios) THEN
2932	missing_val=missing_val_xios
2933	ELSE
2934	missing_val=missing_val_netcdf
2935	ENDIF
2936
2937	yus0(:)=0. ; yvs0(:)=0.
2938
2939	! loop_nbsrf: DO nsrf = 1, nbsrf !<<<<<<<<<<<<<
2940	!<<<<<<<<<<<<<
2941	IF (prt_level >=10) print *,' Loop nsrf ',nsrf
2942	!
2943	IF (iflag_split_ref == 3) THEN
2944	IF (nsrf == is_oce) THEN
2945	iflag_split = 1
2946	ELSE
2947	iflag_split=0
2948	ENDIF !! (nsrf == is_oce)
2949	ELSE
2950	iflag_split = iflag_split_ref
2951	ENDIF !! (iflag_split_ref == 3)
2952
2953	! Search for index(ni) and size(knon) of domaine to treat
2954	! ni(:) = 0
2955	! knon = 0
2956	! DO i = 1, klon
2957	! IF (pctsrf(i,nsrf) > 0.) THEN
2958	! knon = knon + 1
2959	! ni(knon) = i
2960	! ENDIF
2961	! ENDDO
2962
2963	!!! jyg le 19/08/2012
2964	! IF (knon <= 0) THEN
2965	! IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf
2966	! cycle loop_nbsrf
2967	! ENDIF
2968
2969	!!!
2970	! 2b) Initialization of all local variables that will be compressed later
2971	!****************************************************************************************
2972
2973	ypct = 0.0 ; yts = 0.0 ; ysnow = 0.0
2974	yqsurf = 0.0 ; yalb = 0.0 ; yalb_vis = 0.0
2975	yrain_f = 0.0 ; ysnow_f = 0.0 ; ybs_f=0.0 ; yfder = 0.0 ; ysolsw = 0.0
2976	ysollw = 0.0 ; yz0m = 0.0 ; yz0h = 0.0 ; yz0h_oupas = 0.0 ; yu1 = 0.0
2977	yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 ; yqbs1 = 0.0
2978	ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0
2979	yq = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0
2980	yqbs(:,:)=0.0
2981	yrugoro = 0.0 ; ywindsp = 0.0
2982	yfluxlat=0.0 ; y_flux0(:)=0.0
2983	yqsol = 0.0 ; yzxtsol = 0.0
2984
2985	ytke=0.
2986	yeps=0.
2987	yri0(:)=0.
2988	y_treedrg=0.
2989
2990	ysnowhgt = 0.0; yqsnow = 0.0 ; yrunoff = 0.0 ; ytoice =0.0
2991	yalb3_new = 0.0 ; ysissnow = 0.0
2992	ycldt = 0.0 ; yrmu0 = 0.0
2993	y_d_qbs(:,:)=0.0
2994
2995	ytke_x=0. ; ytke_w=0. ; ywake_dltke=0.
2996	yeps_x=0. ; yeps_w=0.
2997	y_d_t_x=0. ; y_d_t_w=0. ; y_d_q_x=0. ; y_d_q_w=0.
2998	yfluxlat_x=0. ; yfluxlat_w=0.
2999	ywake_s=0. ; ywake_cstar=0. ;ywake_dens=0.
3000
3001	tau_eq=0. ; delta_coef=0.
3002	y_delta_flux_t1=0.
3003	ydtsurf_th=0.
3004	yts_x(:)=0. ; yts_w(:)=0.
3005	y_delta_tsurf(:)=0. ; y_delta_qsurf(:)=0.
3006	yqsurf_x(:)=0. ; yqsurf_w(:)=0.
3007	yg_T(:) = 0. ; yg_Q(:) = 0.
3008	yGamma_dTs_phiT(:) = 0. ; yGamma_dQs_phiQ(:) = 0.
3009	ydTs_ins(:) = 0. ; ydqs_ins(:) = 0.
3010
3011	ytsoil = 999999.
3012	y_d_u_frein(:,:)=0.
3013	y_d_v_frein(:,:)=0.
3014
3015	#ifdef ISO
3016	yxtrain_f = 0.0 ; yxtsnow_f = 0.0
3017	yxtsnow = 0.0
3018	yxt = 0.0
3019	yxtsol = 0.0
3020	flux_xt = 0.0
3021	yRland_ice = 0.0
3022
3023	y_dflux_xt = 0.0
3024	y_d_xt_x=0. ; y_d_xt_w=0.
3025	#endif
3026
3027	! >> PC
3028	!the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
3029	!the ORCHIDEE grid and as such should be defined in yfields_out(knon,nbcf_out) but
3030	!the knon variable is not known at that level of pbl_surface_mod
3031
3032	!the yfields_in variable is defined in (klon,nbcf_in) even if it is used on the
3033	!ORCHIDEE grid and as such should be defined in yfields_in(knon,nbcf_in) but the
3034	!knon variable is not known at that level of pbl_surface_mod
3035	yfields_out(:,:) = 0.
3036
3037	ypphi = 0.0
3038
3039
3040
3041
3042	!****************************************************************************************
3043	! 5) Compress variables
3044	!
3045	!****************************************************************************************
3046
3047	! Provisional : set ybeta to standard values
3048	IF (nsrf .NE. is_ter) THEN
3049	ybeta(1:knon) = 1.
3050	ELSE
3051	IF (iflag_split .EQ. 0) THEN
3052	ybeta(1:knon) = 1.
3053	ELSE
3054	DO j = 1, knon
3055	i = ni(j)
3056	ybeta(j) = beta(i,nsrf)
3057	ENDDO
3058	ENDIF ! (iflag_split .LE.1)
3059	ENDIF ! (nsrf .NE. is_ter)
3060	!
3061	DO j = 1, knon
3062	i = ni(j)
3063	ypct(j) = pctsrf(i,nsrf)
3064	yts(j) = ts(i,nsrf)
3065	ysnow(j) = snow(i,nsrf)
3066	yqsurf(j) = qsurf(i,nsrf)
3067	yalb(j) = alb(i,nsrf)
3068	yalb_vis(j) = alb_dir(i,1,nsrf)
3069	IF (nsw==6) THEN
3070	yalb_vis(j)=(alb_dir(i,1,nsrf)SFRWL(1)+alb_dir(i,2,nsrf)SFRWL(2) &
3071	+alb_dir(i,3,nsrf)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
3072	ENDIF
3073	yrain_f(j) = rain_f(i)
3074	ysnow_f(j) = snow_f(i)
3075	ybs_f(j) = bs_f(i)
3076	yagesno(j) = agesno(i,nsrf)
3077	yfder(j) = fder(i)
3078	ylwdown(j) = lwdown_m(i)
3079	ygustiness(j) = gustiness(i)
3080	ysolsw(j) = solsw(i,nsrf)
3081	ysollw(j) = sollw(i,nsrf)
3082	yz0m(j) = z0m(i,nsrf)
3083	yz0h(j) = z0h(i,nsrf)
3084	yrugoro(j) = rugoro(i)
3085	yu1(j) = u(i,1)
3086	yv1(j) = v(i,1)
3087	yqbs1(j) = qbs(i,1)
3088	ypaprs(j,klev+1) = paprs(i,klev+1)
3089	ywindsp(j) = windsp(i,nsrf)
3090	yzmea(j) = zmea(i)
3091	yzsig(j) = zsig(i)
3092	ycldt(j) = cldt(i)
3093	yrmu0(j) = rmu0(i)
3094	y_delta_tsurf(j)=delta_tsurf(i,nsrf)
3095	yfluxbs(j)=0.0
3096	y_flux_bs(j) = 0.0
3097	!!!
3098	#ifdef ISO
3099	DO ixt=1,ntraciso
3100	yxtrain_f(ixt,j) = xtrain_f(ixt,i)
3101	yxtsnow_f(ixt,j) = xtsnow_f(ixt,i)
3102	ENDDO
3103	DO ixt=1,niso
3104	yxtsnow(ixt,j) = xtsnow(ixt,i,nsrf)
3105	ENDDO
3106	DO ixt=1,niso
3107	yRland_ice(ixt,j)= Rland_ice(ixt,i)
3108	ENDDO
3109	#ifdef ISOVERIF
3110	IF (iso_eau >= 0) THEN
3111	call iso_verif_egalite_choix(ysnow_f(j), &
3112	& yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', &
3113	& errmax,errmaxrel)
3114	call iso_verif_egalite_choix(ysnow(j), &
3115	& yxtsnow(iso_eau,j),'pbl_surf_mod 872', &
3116	& errmax,errmaxrel)
3117	ENDIF
3118	#endif
3119	#ifdef ISOVERIF
3120	DO ixt=1,ntraciso
3121	call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921')
3122	ENDDO
3123	#endif
3124	#endif
3125	ENDDO
3126	!--compressing fields_out onto ORCHIDEE grid
3127	!--these fields are shared and used directly surf_land_orchidee_mod
3128	DO n = 1, nbcf_out
3129	DO j = 1, knon
3130	i = ni(j)
3131	yfields_out(j,n) = fields_out(i,n)
3132	ENDDO
3133	ENDDO
3134
3135	DO k = 1, klev
3136	DO j = 1, knon
3137	i = ni(j)
3138	ypaprs(j,k) = paprs(i,k)
3139	ypplay(j,k) = pplay(i,k)
3140	ydelp(j,k) = delp(i,k)
3141	ENDDO
3142	ENDDO
3143
3144	DO k = 1, klev+1
3145	DO j = 1, knon
3146	i = ni(j)
3147	ytke(j,k) = tke_x(i,k,nsrf)
3148	ENDDO
3149	ENDDO
3150
3151	DO k = 1, klev
3152	DO j = 1, knon
3153	i = ni(j)
3154	y_treedrg(j,k) = treedrg(i,k,nsrf)
3155	yu(j,k) = u(i,k)
3156	yv(j,k) = v(i,k)
3157	yt(j,k) = t(i,k)
3158	yq(j,k) = q(i,k)
3159	yqbs(j,k)=qbs(i,k)
3160	ypphi(j,k) = pphi(i,k)
3161
3162	#ifdef ISO
3163	DO ixt=1,ntraciso
3164	yxt(ixt,j,k) = xt(ixt,i,k)
3165	ENDDO !DO ixt=1,ntraciso
3166	#endif
3167	ENDDO
3168	ENDDO
3169	!
3170	IF (iflag_split.GE.1) THEN
3171
3172	DO k = 1, klev
3173	DO j = 1, knon
3174	i = ni(j)
3175	yu_x(j,k) = u(i,k)
3176	yv_x(j,k) = v(i,k)
3177	yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k)
3178	yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k)
3179	yu_w(j,k) = u(i,k)
3180	yv_w(j,k) = v(i,k)
3181	yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k)
3182	yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
3183	#ifdef ISO
3184	DO ixt=1,ntraciso
3185	yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k)
3186	yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k)
3187	ENDDO
3188	#endif
3189	ENDDO
3190	ENDDO
3191
3192	IF (prt_level .ge. 10) THEN
3193	print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)
3194	print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)
3195	ENDIF
3196
3197	DO k = 1, klev+1
3198	DO j = 1, knon
3199	i = ni(j)
3200	ytke_x(j,k) = tke_x(i,k,nsrf)
3201	ytke(j,k) = tke_x(i,k,nsrf)+wake_s(i)*wake_dltke(i,k,nsrf)
3202	ytke_w(j,k) = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
3203	ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
3204	ENDDO
3205	ENDDO
3206
3207	DO j = 1, knon
3208	i = ni(j)
3209	ywake_s(j)=wake_s(i)
3210	ywake_cstar(j)=wake_cstar(i)
3211	ywake_dens(j)=wake_dens(i)
3212	ENDDO
3213
3214	DO j=1,knon
3215	yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j)
3216	yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j)
3217	ENDDO
3218
3219	ENDIF ! (iflag_split .ge.1)
3220
3221	DO k = 1, nsoilmx
3222	DO j = 1, knon
3223	i = ni(j)
3224	ytsoil(j,k) = ftsoil(i,k,nsrf)
3225	ENDDO
3226	ENDDO
3227
3228	! qsol(water height in soil) only for bucket continental model
3229	IF ( nsrf .EQ. is_ter .AND. .NOT. ok_veget ) THEN
3230	DO j = 1, knon
3231	i = ni(j)
3232	yqsol(j) = qsol(i)
3233	#ifdef ISO
3234	DO ixt=1,niso
3235	yxtsol(ixt,j) = xtsol(ixt,i)
3236	ENDDO
3237	#endif
3238	ENDDO
3239	ENDIF
3240
3241	if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
3242	if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
3243	ydelta_sal(:knon) = delta_sal(ni(:knon))
3244	ydelta_sst(:knon) = delta_sst(ni(:knon))
3245	ydter(:knon) = dter(ni(:knon))
3246	ydser(:knon) = dser(ni(:knon))
3247	ydt_ds(:knon) = dt_ds(ni(:knon))
3248	end if
3249
3250	yds_ns(:knon) = ds_ns(ni(:knon))
3251	ydt_ns(:knon) = dt_ns(ni(:knon))
3252	end if
3253
3254	!****************************************************************************************
3255	! 6a) Calculate coefficients for turbulent diffusion at surface, cdragh et cdragm.
3256	!
3257	!****************************************************************************************
3258
3259
3260	IF (iflag_split .eq.0) THEN
3261
3262	DO i = 1, knon
3263	zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3264	* (ypaprs(i,1)-ypplay(i,1))
3265	speed(i) = SQRT(yu(i,1)2+yv(i,1)2)
3266	ENDDO
3267
3268	!!! AM heterogeneous continental subsurfaces
3269	IF (nsrf .EQ. is_ter) THEN
3270	! compute time-dependent effective surface parameters (function of zgeo1) !! AM
3271	IF (iflag_hetero_surf .GT. 0) THEN
3272	DO n=1,nbtersrf
3273	DO j=1,knon
3274	i = ni(j)
3275	yfrac_tersrf(j,n) = frac_tersrf(i,n)
3276	yz0m_tersrf(j,n) = z0m_tersrf(i,n)
3277	IF (ratio_z0m_z0h_tersrf(i,n) .NE. 0.) THEN
3278	yz0h_tersrf(j,n) = z0m_tersrf(i,n) / ratio_z0m_z0h_tersrf(i,n)
3279	ELSE
3280	yz0h_tersrf(j,n) = 0.
3281	ENDIF
3282	ENDDO
3283	ENDDO
3284	!
3285
3286	CALL eff_surf_param(knon, nbtersrf, yz0m_tersrf, yfrac_tersrf, 'CDN', yz0m, zgeo1/RG)
3287	CALL eff_surf_param(knon, nbtersrf, yz0h_tersrf, yfrac_tersrf, 'CDN', yz0h, zgeo1/RG)
3288	!
3289	ENDIF
3290	ENDIF
3291
3292	!
3293	ypblh_tmp(:)=s_pblh(ni(:))
3294
3295	CALL cdrag(knon, nsrf, &
3296	speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), ypblh_tmp, &
3297	yts, yqsurf, yz0m, yz0h, yri0, 0, &
3298	ycdragm, ycdragh, zri1, pref, rain_f, yzxtsol, ypplay(:,1))
3299	s_pblh(ni(:)) = ypblh_tmp(:)
3300	! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
3301	IF (ok_prescr_ust) THEN
3302	DO i = 1, knon
3303	print *,'ycdragm avant=',ycdragm(i)
3304	vent= sqrt(yu(i,1)yu(i,1)+yv(i,1)yv(i,1))
3305	ycdragm(i) = ust*ust/(1.+vent)/vent
3306	ENDDO
3307	ENDIF
3308
3309	IF (prt_level >=10) print *,'cdrag -> ycdragh ', ycdragh(1:knon)
3310	ELSE !(iflag_split .eq.0)
3311
3312	DO i = 1, knon
3313	zgeo1_x(i) = RD * yt_x(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3314	* (ypaprs(i,1)-ypplay(i,1))
3315	speed_x(i) = SQRT(yu_x(i,1)2+yv_x(i,1)2)
3316	ENDDO
3317
3318	ypblh_tmp(:)=s_pblh_x(ni(:))
3319
3320	CALL cdrag(knon, nsrf, &
3321	speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),ypblh,&
3322	yts_x, yqsurf_x, yz0m, yz0h, yri0, 0, &
3323	ycdragm_x, ycdragh_x, zri1_x, pref_x, rain_f, yzxtsol, ypplay(:,1) )
3324
3325	s_pblh_x(ni(:)) = ypblh_tmp(:)
3326	! --- special Dice. JYG+MPL 25112013
3327	IF (ok_prescr_ust) THEN
3328	DO i = 1, knon
3329	vent= sqrt(yu_x(i,1)yu_x(i,1)+yv_x(i,1)yv_x(i,1))
3330	ycdragm_x(i) = ust*ust/(1.+vent)/vent
3331	ENDDO
3332	ENDIF
3333	IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x(1:knon)
3334
3335	DO i = 1, knon
3336	zgeo1_w(i) = RD * yt_w(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3337	* (ypaprs(i,1)-ypplay(i,1))
3338	speed_w(i) = SQRT(yu_w(i,1)2+yv_w(i,1)2)
3339	ENDDO
3340
3341	ypblh_tmp(:)=s_pblh_w(ni(:))
3342
3343	CALL cdrag(knon, nsrf, &
3344	speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),s_pblh_w,&
3345	yts_w, yqsurf_w, yz0m, yz0h, yri0, 0, &
3346	ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, yzxtsol, ypplay(:,1) )
3347
3348	s_pblh_w(ni(:)) = ypblh_tmp(:)
3349	!
3350	IF(ok_bug_zg_wk_pbl) THEN
3351	zgeo1(1:knon) = wake_s(1:knon)zgeo1_w(1:knon) + (1.-wake_s(1:knon))zgeo1_x(1:knon)
3352	ELSE
3353	zgeo1(1:knon) = ywake_s(1:knon)zgeo1_w(1:knon) + (1.-ywake_s(1:knon))zgeo1_x(1:knon)
3354	ENDIF
3355
3356	! --- special Dice. JYG+MPL 25112013 puis BOMEX
3357	IF (ok_prescr_ust) THEN
3358	DO i = 1, knon
3359	vent= sqrt(yu_w(i,1)yu_w(i,1)+yv_w(i,1)yv_w(i,1))
3360	ycdragm_w(i) = ust*ust/(1.+vent)/vent
3361	ENDDO
3362	ENDIF
3363	IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w(1:knon)
3364	ENDIF ! (iflag_split .eq.0)
3365
3366
3367	!****************************************************************************************
3368	! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm.
3369	!
3370	!****************************************************************************************
3371
3372	IF (iflag_split .eq.0) THEN
3373
3374	IF (prt_level >=10) THEN
3375	print *,' args coef_diff_turb: yu ', yu(1:knon,:)
3376	print *,' args coef_diff_turb: yv ', yv(1:knon,:)
3377	print *,' args coef_diff_turb: yq ', yq(1:knon,:)
3378	print *,' args coef_diff_turb: yt ', yt(1:knon,:)
3379	print *,' args coef_diff_turb: yts ', yts(1:knon)
3380	print *,' args coef_diff_turb: yz0m ', yz0m(1:knon)
3381	print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)
3382	print *,' args coef_diff_turb: ycdragm ', ycdragm(1:knon)
3383	print *,' args coef_diff_turb: ycdragh ', ycdragh(1:knon)
3384	print *,' args coef_diff_turb: ytke ', ytke(1:knon,:)
3385	ENDIF
3386
3387	IF (iflag_pbl>=50) THEN
3388
3389	CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm, ycdragh,yus0,yvs0,yts, &
3390	yu, yv,yt,yq,ypplay,ypaprs, &
3391	ytke,yeps, ycoefm, ycoefh)
3392
3393	ELSE
3394
3395
3396	CALL coef_diff_turb(dtime, nsrf, knon, ni, &
3397	ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
3398	ycoefm, ycoefh, ytke, yeps, y_treedrg)
3399
3400	IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
3401	! In this case, coef_diff_turb is called for the Cd only
3402	DO k = 2, klev
3403	DO j = 1, knon
3404	i = ni(j)
3405	ycoefh(j,k) = zcoefh(i,k,nsrf)
3406	ycoefm(j,k) = zcoefm(i,k,nsrf)
3407	ENDDO
3408	ENDDO
3409	ENDIF
3410
3411	ENDIF ! iflag_pbl >= 50
3412
3413	IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh(1:knon,:)
3414
3415
3416	ELSE !(iflag_split .eq.0)
3417
3418
3419	IF (prt_level >=10) THEN
3420	print *,' args coef_diff_turb: yu_x ', yu_x(1:knon,:)
3421	print *,' args coef_diff_turb: yv_x ', yv_x(1:knon,:)
3422	print *,' args coef_diff_turb: yq_x ', yq_x(1:knon,:)
3423	print *,' args coef_diff_turb: yt_x ', yt_x(1:knon,:)
3424	print *,' args coef_diff_turb: yts_x ', yts_x(1:knon)
3425	print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)
3426	print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x(1:knon)
3427	print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x(1:knon)
3428	print *,' args coef_diff_turb: ytke_x ', ytke_x(1:knon,:)
3429	ENDIF
3430
3431
3432	IF (iflag_pbl>=50) THEN
3433
3434	CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon), &
3435	yu_x(1:knon,:),yv_x(1:knon,:),yt_x(1:knon,:),yq_x(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:), &
3436	ytke_x(1:knon,:),yeps_x(1:knon,:),ycoefm_x(1:knon,:), ycoefh_x(1:knon,:))
3437
3438	ELSE
3439
3440
3441	CALL coef_diff_turb(dtime, nsrf, knon, ni, &
3442	ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf_x, ycdragm_x, &
3443	ycoefm_x, ycoefh_x, ytke_x,yeps_x,y_treedrg)
3444
3445	!FC doit on le mettre ( on ne l utilise pas si il y a du spliting)
3446	IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
3447	! In this case, coef_diff_turb is called for the Cd only
3448	DO k = 2, klev
3449	DO j = 1, knon
3450	i = ni(j)
3451	ycoefh_x(j,k) = zcoefh(i,k,nsrf)
3452	ycoefm_x(j,k) = zcoefm(i,k,nsrf)
3453	ENDDO
3454	ENDDO
3455	ENDIF
3456
3457	ENDIF ! iflag_pbl >= 50
3458
3459	IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x(1:knon,:)
3460	!
3461	IF (prt_level >=10) THEN
3462	print *,' args coef_diff_turb: yu_w ', yu_w(1:knon,:)
3463	print *,' args coef_diff_turb: yv_w ', yv_w(1:knon,:)
3464	print *,' args coef_diff_turb: yq_w ', yq_w(1:knon,:)
3465	print *,' args coef_diff_turb: yt_w ', yt_w(1:knon,:)
3466	print *,' args coef_diff_turb: yts_w ', yts_w(1:knon)
3467	print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)
3468	print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w(1:knon)
3469	print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w(1:knon)
3470	print *,' args coef_diff_turb: ytke_w ', ytke_w(1:knon,:)
3471	ENDIF
3472
3473	IF (iflag_pbl>=50) THEN
3474
3475
3476	CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_w,ycdragh_w,yus0,yvs0,yts_w, &
3477	yu_w, yv_w, yt_w, yq_w, ypplay, ypaprs, &
3478	ytke_w, yeps_w, ycoefm_w, ycoefh_w)
3479
3480	ELSE
3481
3482	CALL coef_diff_turb(dtime, nsrf, knon, ni, &
3483	ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf_w, ycdragm_w, &
3484	ycoefm_w, ycoefh_w, ytke_w,yeps_w,y_treedrg)
3485
3486	IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
3487	! In this case, coef_diff_turb is called for the Cd only
3488	DO k = 2, klev
3489	DO j = 1, knon
3490	i = ni(j)
3491	ycoefh_w(j,k) = zcoefh(i,k,nsrf)
3492	ycoefm_w(j,k) = zcoefm(i,k,nsrf)
3493	ENDDO
3494	ENDDO
3495	ENDIF
3496
3497	ENDIF ! iflag_pbl >= 50
3498
3499
3500	IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w(1:knon,:)
3501
3502	!!!jyg le 10/04/2013
3503	!! En attendant de traiter le transport des traceurs dans les poches froides, formule
3504	!! arbitraire pour ycoefh et ycoefm
3505	DO k = 2,klev
3506	DO j = 1,knon
3507	ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k))
3508	ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k))
3509	ENDDO
3510	ENDDO
3511
3512
3513	ENDIF ! (iflag_split .eq.0)
3514
3515
3516	!****************************************************************************************
3517	!
3518	! 8) "La descente" - "The downhill"
3519	!
3520	! climb_hq_down and climb_wind_down calculate the coefficients
3521	! Ccoef_X et Dcoef_X for X=[H, Q, U, V].
3522	! Only the coefficients at surface for H and Q are returned.
3523	!
3524	!****************************************************************************************
3525
3526	! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q
3527	IF (iflag_split .eq.0) THEN
3528
3529	CALL climb_hq_down(knon, ni, ycoefh, ypaprs, ypplay, &
3530	ydelp, yt, yq, dtime, &
3531	CcoefH, CcoefQ, DcoefH, DcoefQ, &
3532	Kcoef_hq, gama_q, gama_h, &
3533	AcoefH, AcoefQ, BcoefH, BcoefQ &
3534	#ifdef ISO
3535	& ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT &
3536	#endif
3537	& )
3538	ELSE !(iflag_split .eq.0)
3539
3540	CALL climb_hq_down(knon, ni, ycoefh_x, ypaprs, ypplay, &
3541	ydelp, yt_x, yq_x, dtime, &
3542	CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
3543	Kcoef_hq_x, gama_q_x, gama_h_x, &
3544	AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x &
3545	#ifdef ISO
3546	& ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x &
3547	#endif
3548	& )
3549
3550	IF (prt_level >=10) THEN
3551	PRINT *,'pbl_surface (climb_hq_down.x->) AcoefH_x ',AcoefH_x
3552	PRINT *,'pbl_surface (climb_hq_down.x->) AcoefQ_x ',AcoefQ_x
3553	PRINT *,'pbl_surface (climb_hq_down.x->) BcoefH_x ',BcoefH_x
3554	PRINT *,'pbl_surface (climb_hq_down.x->) BcoefQ_x ',BcoefQ_x
3555	ENDIF
3556
3557
3558	CALL climb_hq_down(knon, ni, ycoefh_w, ypaprs, ypplay, &
3559	ydelp, yt_w, yq_w, dtime, &
3560	CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
3561	Kcoef_hq_w, gama_q_w, gama_h_w, &
3562	AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w &
3563	#ifdef ISO
3564	& ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w &
3565	#endif
3566	& )
3567
3568	IF (prt_level >=10) THEN
3569	PRINT *,'pbl_surface (climb_hq_down.w->) AcoefH_w ',AcoefH_w
3570	PRINT *,'pbl_surface (climb_hq_down.w->) AcoefQ_w ',AcoefQ_w
3571	PRINT *,'pbl_surface (climb_hq_down.w->) BcoefH_w ',BcoefH_w
3572	PRINT *,'pbl_surface (climb_hq_down.w->) BcoefQ_w ',BcoefQ_w
3573	ENDIF
3574
3575	ENDIF ! (iflag_split .eq.0)
3576
3577
3578	! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
3579	IF (iflag_split .eq.0) THEN
3580
3581	CALL climb_wind_down(knon, ni, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
3582	CcoefU, CcoefV, DcoefU, DcoefV, &
3583	Kcoef_m, alf_1, alf_2, &
3584	AcoefU, AcoefV, BcoefU, BcoefV)
3585	ELSE ! (iflag_split .eq.0)
3586
3587	CALL climb_wind_down(knon, ni, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
3588	CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
3589	Kcoef_m_x, alf_1_x, alf_2_x, &
3590	AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x)
3591
3592	CALL climb_wind_down(knon, ni, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, &
3593	CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
3594	Kcoef_m_w, alf_1_w, alf_2_w, &
3595	AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w)
3596	ENDIF ! (iflag_split .eq.0)
3597
3598	! For blowing snow:
3599	IF (ok_bs) THEN
3600	! following Bintanja et al 2000, part II and Vionnet V PhD thesis
3601	! we assume that the eddy diffsivity coefficient for
3602	! suspended particles is a fraction of Kh
3603	do k=1,klev
3604	do j=1,knon
3605	ycoefqbs(j,k)=ycoefh(j,k)*zeta_bs
3606	enddo
3607	enddo
3608
3609	CALL climb_qbs_down(knon, ni, ycoefqbs, ypaprs, ypplay, &
3610	ydelp, yt, yqbs, dtime, &
3611	CcoefQBS, DcoefQBS, &
3612	Kcoef_qbs, gama_qbs, &
3613	AcoefQBS, BcoefQBS)
3614	ENDIF
3615
3616	!****************************************************************************************
3617	! 9) Small calculations
3618	!
3619	!****************************************************************************************
3620
3621	! - Reference pressure is given the values at surface level
3622	ypsref(:) = ypaprs(:,1)
3623
3624	! - CO2 field on 2D grid to be sent to ORCHIDEE
3625	! Transform to compressed field
3626	IF (carbon_cycle_cpl) THEN
3627	DO i=1,knon
3628	r_co2_ppm(i) = co2_send(ni(i))
3629	ENDDO
3630	ELSE
3631	r_co2_ppm(:) = co2_ppm ! Constant field
3632	ENDIF
3633
3634	!!! nrlmd le 02/05/2011 -----------------------On raccorde les 2 colonnes dans la couche 1
3635
3636	IF (iflag_split .eq. 0) THEN
3637	yt1(:) = yt(:,1)
3638	yq1(:) = yq(:,1)
3639	#ifdef ISO
3640	yxt1(:,:) = yxt(:,:,1)
3641	#endif
3642
3643	ELSE IF (iflag_split .ge. 1) THEN
3644	#ifdef ISO
3645	call abort_physic('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1)
3646	#endif
3647
3648	!
3649	! Cdragq computation
3650	! ------------------
3651	!******************************************************************************
3652	! Cdragq computed from cdrag
3653	! The difference comes only from a factor (f_z0qh_oce) on z0, so that
3654	! it can be computed inside wx_pbl0_merge
3655	! More complicated appraches may require the propagation through
3656	! pbl_surface of an independant cdragq variable.
3657	!******************************************************************************
3658	!
3659	IF ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce) THEN
3660	! Si on suit les formulations par exemple de Tessel, on
3661	! a z0h=0.4nu/u, z0q=0.62nu/u, d'ou f_z0qh_oce=0.62/0.4=1.55
3662	!! ycdragq_x(1:knon)=ycdragh_x(1:knon)* &
3663	!! log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
3664	!! ycdragq_w(1:knon)=ycdragh_w(1:knon)* &
3665	!! log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
3666	!
3667	DO j = 1,knon
3668	z1lay = zgeo1(j)/RG
3669	fact_cdrag = log(z1lay/yz0h(j))/log(z1lay/(f_z0qh_oce*yz0h(j)))
3670	ycdragq_x(j)=ycdragh_x(j)*fact_cdrag
3671	ycdragq_w(j)=ycdragh_w(j)*fact_cdrag
3672	ENDDO ! j = 1,knon
3673
3674	ELSE
3675	ycdragq_x(1:knon)=ycdragh_x(1:knon)
3676	ycdragq_w(1:knon)=ycdragh_w(1:knon)
3677	ENDIF ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
3678	!
3679
3680	CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s, &
3681	yts, y_delta_tsurf, ygustiness, &
3682	yt_x, yt_w, yq_x, yq_w, &
3683	yu_x, yu_w, yv_x, yv_w, &
3684	ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
3685	ycdragm_x, ycdragm_w, &
3686	AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
3687	AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
3688	BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
3689	BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
3690	Kech_h_x, Kech_h_w, Kech_h &
3691	)
3692	CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta, &
3693	BcoefQ_x, BcoefQ_w &
3694	)
3695
3696	CALL wx_pbl0_merge(knon, ypplay, ypaprs, &
3697	ywake_s, ydTs0, ydqs0, &
3698	yt_x, yt_w, yq_x, yq_w, &
3699	yu_x, yu_w, yv_x, yv_w, &
3700	ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
3701	ycdragm_x, ycdragm_w, &
3702	AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
3703	AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
3704	BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
3705	BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
3706	AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
3707	BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
3708	ycdragh, ycdragq, ycdragm, &
3709	yt1, yq1, yu1, yv1 &
3710	)
3711	IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
3712
3713	CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
3714	ywake_s, ybeta, ywake_cstar, ywake_dens, &
3715	AcoefH_x, AcoefH_w, &
3716	BcoefH_x, BcoefH_w, &
3717	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
3718	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3719	HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
3720	phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
3721	yg_T, yg_Q, &
3722	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
3723	ydTs_ins, ydqs_ins &
3724	)
3725	ELSE !
3726	AcoefH(:) = AcoefH_0(:)
3727	AcoefQ(:) = AcoefQ_0(:)
3728	BcoefH(:) = BcoefH_0(:)
3729	BcoefQ(:) = BcoefQ_0(:)
3730	yg_T(:) = 0.
3731	yg_Q(:) = 0.
3732	yGamma_dTs_phiT(:) = 0.
3733	yGamma_dQs_phiQ(:) = 0.
3734	ydTs_ins(:) = 0.
3735	ydqs_ins(:) = 0.
3736	ENDIF ! (iflag_split .eq. 2)
3737	ENDIF ! (iflag_split .eq.0)
3738
3739	IF (prt_level >=10) THEN
3740	DO i = 1, min(1,knon)
3741	PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(i,:)
3742	PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(i,:)
3743	PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(i,:)
3744	PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(i,:)
3745	PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
3746	AcoefH(i), AcoefQ(i), AcoefU(i), AcoefV(i)
3747	PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
3748	BcoefH(i), BcoefQ(i), BcoefU(i), BcoefV(i)
3749	ENDDO
3750
3751	ENDIF
3752
3753	! Save initial value of z0h for use in evappot (z0h wiil be computed again in the surface models)
3754	yz0h_old(1:knon) = yz0h(1:knon)
3755	!
3756	!****************************************************************************************
3757	!
3758	! Calulate t2m and q2m for the case of calculation at land grid points
3759	! t2m and q2m are needed as input to ORCHIDEE
3760	!
3761	!****************************************************************************************
3762	IF (nsrf == is_ter) THEN
3763
3764	DO i = 1, knon
3765	zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3766	* (ypaprs(i,1)-ypplay(i,1))
3767	ENDDO
3768
3769	! Calculate the temperature et relative humidity at 2m and the wind at 10m
3770	IF (iflag_new_t2mq2m==1) THEN
3771
3772	CALL stdlevvarn(knon, knon, is_ter, zxli, &
3773	yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
3774	yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
3775	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
3776	yn2mout)
3777	ELSE
3778
3779	CALL stdlevvar(knon, knon, is_ter, zxli, &
3780	yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
3781	yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
3782	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, yzxtsol)
3783	ENDIF
3784
3785	ENDIF
3786
3787	!****************************************************************************************
3788	!
3789	! 10) Switch according to current surface
3790	! It is necessary to start with the continental surfaces because the ocean
3791	! needs their run-off.
3792	!
3793	!****************************************************************************************
3794	SELECT CASE(nsrf)
3795
3796	CASE(is_ter)
3797
3798	CALL surf_land(itap, dtime, date0, jour, knon, ni,&
3799	rlon, rlat, yrmu0, &
3800	debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
3801	yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
3802	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3803	AcoefU, AcoefV, BcoefU, BcoefV, &
3804	ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
3805	ylwdown, yq2m, yt2m, &
3806	ysnow, yqsol, yagesno, ytsoil, &
3807	yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,yfluxbs,&
3808	yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
3809	y_flux_u1, y_flux_v1, &
3810	yveget,ylai,yheight, tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
3811	cdragm_tersrf, cdragh_tersrf, &
3812	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
3813	#ifdef ISO
3814	& ,yxtrain_f, yxtsnow_f,yxt1, &
3815	& yxtsnow,yxtsol,yxtevap,h1, &
3816	& yrunoff_diag,yxtrunoff_diag,yRland_ice &
3817	#endif
3818	& )
3819
3820	tsurf_tersrf(:,:) = tsurf_new_tersrf(:,:) ! for next time step
3821
3822	IF (ifl_pbltree .ge. 1) THEN
3823
3824	CALL freinage(knon, knon, yu, yv, yt, &
3825	yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
3826	ENDIF
3827
3828
3829	! Special DICE MPL 05082013 puis BOMEX
3830	IF (ok_prescr_ust) THEN
3831	DO j=1,knon
3832	y_flux_u1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yu(j,1)*ypplay(j,1)/RD/yt(j,1)
3833	y_flux_v1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yv(j,1)*ypplay(j,1)/RD/yt(j,1)
3834	ENDDO
3835	ENDIF
3836
3837	#ifdef ISOVERIF
3838	DO j=1,knon
3839	DO ixt=1,ntraciso
3840	CALL iso_verif_noNaN(yxtevap(ixt,j), &
3841	& 'pbl_surface 1056a: apres surf_land')
3842	ENDDO
3843	DO ixt=1,niso
3844	CALL iso_verif_noNaN(yxtsol(ixt,j), &
3845	& 'pbl_surface 1056b: apres surf_land')
3846	ENDDO
3847	ENDDO
3848	#endif
3849	#ifdef ISOVERIF
3850
3851	DO j=1,knon
3852	IF (iso_eau >= 0) THEN
3853	CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
3854	& ysnow(j),'pbl_surf_mod 1043')
3855	ENDIF !if (iso_eau.gt.0) then
3856	ENDDO !DO i=1,klon
3857	#endif
3858
3859	CASE(is_lic)
3860	IF (landice_opt .LT. 2) THEN
3861	! Land ice is treated by LMDZ and not by ORCHIDEE
3862
3863	CALL surf_landice(itap, dtime, knon, ni, &
3864	rlon, rlat, debut, lafin, &
3865	yrmu0, ylwdown, yalb, zgeo1, &
3866	ysolsw, ysollw, yts, ypplay(:,1), &
3867	ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
3868	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3869	AcoefU, AcoefV, BcoefU, BcoefV, &
3870	AcoefQBS, BcoefQBS, &
3871	ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
3872	ysnow, yqsurf, yqsol,yqbs1, yagesno, &
3873	ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yicesub_lic, yfluxsens,yfluxlat, &
3874	yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, &
3875	yzmea, yzsig, ycldt, &
3876	ysnowhgt, yqsnow, ytoice, ysissnow, &
3877	yalb3_new, yrunoff, &
3878	y_flux_u1, y_flux_v1 &
3879	#ifdef ISO
3880	& ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
3881	& ,yxtsnow,yxtsol,yxtevap &
3882	#endif
3883	& )
3884
3885	DO j = 1, knon
3886	i = ni(j)
3887	alb3_lic(i) = yalb3_new(j)
3888	snowhgt(i) = ysnowhgt(j)
3889	qsnow(i) = yqsnow(j)
3890	to_ice(i) = ytoice(j)
3891	sissnow(i) = ysissnow(j)
3892	runoff(i) = yrunoff(j)
3893	icesub_lic(i) = yicesub_lic(j)*ypct(j)
3894	ENDDO
3895	! Martin
3896	! Special DICE MPL 05082013 puis BOMEX MPL 20150410
3897	IF (ok_prescr_ust) THEN
3898	DO j=1,knon
3899	y_flux_u1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yu(j,1)*ypplay(j,1)/RD/yt(j,1)
3900	y_flux_v1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yv(j,1)*ypplay(j,1)/RD/yt(j,1)
3901	ENDDO
3902	ENDIF
3903
3904	#ifdef ISOVERIF
3905	DO j=1,knon
3906	DO ixt=1,ntraciso
3907	CALL iso_verif_noNaN(yxtevap(ixt,j), &
3908	& 'pbl_surface 1095a: apres surf_landice')
3909	ENDDO
3910	do ixt=1,niso
3911	call iso_verif_noNaN(yxtsol(ixt,j), &
3912	& 'pbl_surface 1095b: apres surf_landice')
3913	enddo
3914	enddo
3915	#endif
3916	#ifdef ISOVERIF
3917
3918	do j=1,knon
3919	IF (iso_eau >= 0) THEN
3920	CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
3921	& ysnow(j),'pbl_surf_mod 1064')
3922	ENDIF !if (iso_eau >= 0) THEN
3923	ENDDO !DO i=1,klon
3924	#endif
3925
3926	END IF
3927
3928	CASE(is_oce)
3929	! calculate length scale PBL
3930
3931	if (iflag_leads == 1) then
3932	ydthetadz = 999999.
3933	ypphii = 999999.
3934	ytheta = 999999.
3935
3936	DO k = 1, klev
3937	DO j = 1, knon
3938	ytheta(j,k) = yt(j,k)(ypplay(j,k)/1.e5)*(RD/RCPD)
3939	ENDDO
3940	ENDDO
3941
3942	DO k = 2, klev
3943	DO j = 1, knon
3944	ydthetadz(j,k) = RG*( ytheta(j,k) - ytheta(j,k-1) ) / ( ypphi(j,k) - ypphi(j,k-1) )
3945	ypphii(j,k) = (ypphi(j,k)+ypphi(j,k-1))/(RG*2.)
3946	ENDDO
3947	ENDDO
3948
3949	!ym minloc does't work on GPU (nvfortran + openacc)
3950	! DO j = 1, knon
3951	! k= minloc(abs(ypphii(j,:)-300),1)
3952	! ydthetadz300(j)=ydthetadz(j,k)
3953	! ENDDO
3954
3955	ydthetadz300(1:knon) = ydthetadz(1:knon,1)
3956	DO k=2, klev
3957	DO j=1,knon
3958	IF (abs(ypphii(j,k)-300) < ydthetadz300(j)) ydthetadz300(j) = abs(ypphii(j,k)-300)
3959	ENDDO
3960	ENDDO
3961
3962	end if
3963
3964	CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
3965	ywindsp, yrmu0, yfder, yts, &
3966	itap, dtime, jour, knon, ni, &
3967	ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt(:,1), yq(:,1),& ! ym missing init
3968	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3969	AcoefU, AcoefV, BcoefU, BcoefV, &
3970	ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
3971	ysnow, yqsurf, yagesno, &
3972	yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
3973	ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
3974	y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
3975	yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
3976	ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss, &
3977	ydthetadz300,Ampl &
3978
3979	#ifdef ISO
3980	& ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
3981	& yxtsnow,yxtevap,h1 &
3982	#endif
3983	& )
3984	!$gpum nocall
3985	CALL checksum("yalb_dir_new_ocean",yalb_dir_new(1:knon,:))
3986	IF (prt_level >=10) THEN
3987	print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon)
3988	print *,'arg de surf_ocean: ycdragm ',ycdragm(1:knon)
3989	print *,'arg de surf_ocean: yt ', yt(1:knon,:)
3990	print *,'arg de surf_ocean: yq ', yq(1:knon,:)
3991	print *,'arg de surf_ocean: yts ', yts(1:knon)
3992	print *,'arg de surf_ocean: AcoefH ',AcoefH(1:knon)
3993	print *,'arg de surf_ocean: AcoefQ ',AcoefQ(1:knon)
3994	print *,'arg de surf_ocean: BcoefH ',BcoefH(1:knon)
3995	print *,'arg de surf_ocean: BcoefQ ',BcoefQ(1:knon)
3996	print *,'arg de surf_ocean: yevap ',yevap(1:knon)
3997	print *,'arg de surf_ocean: yfluxsens ',yfluxsens(1:knon)
3998	print *,'arg de surf_ocean: yfluxlat ',yfluxlat(1:knon)
3999	print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new(1:knon)
4000	ENDIF
4001	! Special DICE MPL 05082013 puis BOMEX MPL 20150410
4002	IF (ok_prescr_ust) THEN
4003	DO j=1,knon
4004	y_flux_u1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yu(j,1)*ypplay(j,1)/RD/yt(j,1)
4005	y_flux_v1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yv(j,1)*ypplay(j,1)/RD/yt(j,1)
4006	ENDDO
4007	ENDIF
4008
4009	CASE(is_sic)
4010
4011	CALL surf_seaice( &
4012	rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
4013	itap, dtime, jour, knon, ni, &
4014	lafin, &
4015	yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
4016	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4017	AcoefU, AcoefV, BcoefU, BcoefV, &
4018	ypsref, yu1, yv1, ygustiness, pctsrf, &
4019	ysnow, yqsurf, yqsol, yagesno, ytsoil, &
4020	yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
4021	ytsurf_new, y_dflux_t, y_dflux_q, &
4022	y_flux_u1, y_flux_v1, &
4023	hice,tice,bilg_cumul, &
4024	fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, &
4025	dtice_melt, dtice_snow2sic &
4026	#ifdef ISO
4027	& ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
4028	& yxtsnow,yxtsol,yxtevap,Rland_ice &
4029	#endif
4030	& )
4031
4032	! Special DICE MPL 05082013 puis BOMEX MPL 20150410
4033	IF (ok_prescr_ust) THEN
4034	DO j=1,knon
4035	y_flux_u1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yu(j,1)*ypplay(j,1)/RD/yt(j,1)
4036	y_flux_v1(j)=ycdragm(j)(1.+sqrt(yu(j,1)yu(j,1)+yv(j,1)yv(j,1)))yv(j,1)*ypplay(j,1)/RD/yt(j,1)
4037	ENDDO
4038	ENDIF
4039
4040	#ifdef ISOVERIF
4041	DO j=1,knon
4042	DO ixt=1,ntraciso
4043	CALL iso_verif_noNaN(yxtevap(ixt,j), &
4044	& 'pbl_surface 1165a: apres surf_seaice')
4045	ENDDO
4046	DO ixt=1,niso
4047	CALL iso_verif_noNaN(yxtsol(ixt,j), &
4048	& 'pbl_surface 1165b: apres surf_seaice')
4049	ENDDO
4050	ENDDO
4051	#endif
4052	#ifdef ISOVERIF
4053	DO j=1,knon
4054	IF (iso_eau >= 0) THEN
4055	CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
4056	& ysnow(j),'pbl_surf_mod 1106')
4057	ENDIF !IF (iso_eau >= 0) THEN
4058	ENDDO !DO i=1,klon
4059	#endif
4060
4061	CASE DEFAULT
4062	WRITE(lunout,*) 'Surface index = ', nsrf
4063	abort_message = 'Surface index not valid'
4064	!ym CALL abort_physic(modname,abort_message,1)
4065	END SELECT
4066
4067
4068	!****************************************************************************************
4069	! 11) - Calcul the increment of surface temperature
4070	!
4071	!****************************************************************************************
4072
4073	IF (evap0>=0.) THEN
4074	yevap(1:knon)=evap0
4075	yevap(1:knon)=RLVTT*evap0
4076	ENDIF
4077
4078	y_d_ts(1:knon) = ytsurf_new(1:knon) - yts(1:knon)
4079
4080	!****************************************************************************************
4081	!
4082	! 12) "La remontee" - "The uphill"
4083	!
4084	! The fluxes (y_flux_X) and tendancy (y_d_X) are calculated
4085	! for X=H, Q, U and V, for all vertical levels.
4086	!
4087	!****************************************************************************************
4088
4089	IF (ok_forc_tsurf) THEN
4090	DO j=1,knon
4091	ytsurf_new(j)=tg
4092	y_d_ts(j) = ytsurf_new(j) - yts(j)
4093	ENDDO
4094	ENDIF ! ok_forc_tsurf
4095
4096	IF (ok_flux_surf) THEN
4097	IF (prt_level >=10) THEN
4098	PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
4099	ENDIF
4100	y_flux_t1(:) = fsens
4101	y_flux_q1(:) = flat/RLVTT
4102	yfluxlat(:) = flat
4103	!
4104	!! Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
4105	!! IF (iflag_split .eq.0) THEN
4106	DO j=1,knon
4107	Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)2+yv(j,1)2)) * &
4108	ypplay(j,1)/(RD*yt(j,1))
4109	ENDDO
4110	!! ENDIF ! (iflag_split .eq.0)
4111
4112	DO j = 1, knon
4113	yt1_new=(1./RCPD)(AcoefH(j)+BcoefH(j)y_flux_t1(j)*dtime)
4114	ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD)
4115	! for cases forced in flux and for which forcing in Ts is needed
4116	! to prevent the latter to reach unrealistic value (even if not used,
4117	! Ts is calculated and hgardfou can appear during the calculation
4118	! of surface saturation humidity for example
4119	if (ok_forc_tsurf) ytsurf_new(j)=tg
4120	ENDDO
4121
4122	DO j=1,knon
4123	y_d_ts(j) = ytsurf_new(j) - yts(j)
4124	ENDDO
4125
4126	ELSE ! (ok_flux_surf)
4127	DO j=1,knon
4128	y_flux_t1(j) = yfluxsens(j)
4129	y_flux_q1(j) = -yevap(j)
4130	#ifdef ISO
4131	y_flux_xt1(:,:) = -yxtevap(:,:)
4132	#endif
4133	ENDDO
4134	ENDIF ! (ok_flux_surf)
4135
4136	! flux of blowing snow at the first level
4137	IF (ok_bs) THEN
4138	DO j=1,knon
4139	y_flux_bs(j)=yfluxbs(j)
4140	ENDDO
4141	ENDIF
4142	!
4143	! ------------------------------------------------------------------------------
4144	! 12a) Splitting
4145	! ------------------------------------------------------------------------------
4146
4147	IF (iflag_split .GE. 1) THEN
4148	#ifdef ISO
4149	call abort_physic('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1)
4150	#endif
4151
4152	IF (nsrf .ne. is_oce) THEN
4153
4154	! Compute potential evaporation and aridity factor (jyg, 20200328)
4155	ybeta_prev(:) = ybeta(:)
4156	DO j = 1, knon
4157	yqa(j) = AcoefQ(j) - BcoefQ(j)yevap(j)dtime
4158	ENDDO
4159
4160	CALL wx_evappot(knon, yqa, yTsurf_new, yevap_pot)
4161
4162	ybeta(1:knon) = min(yevap(1:knon)/yevap_pot(1:knon), 1.)
4163
4164	IF (prt_level >=10) THEN
4165	DO j=1,knon
4166	print*,'y_flux_t1,yfluxlat,wakes' &
4167	& , y_flux_t1(j), yfluxlat(j), ywake_s(j)
4168	print*,'beta_prev, beta, ytsurf_new', ybeta_prev(j), ybeta(j), ytsurf_new(j)
4169	print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
4170	ENDDO
4171	ENDIF ! (prt_level >=10)
4172	!
4173	! Second call to wx_pbl0_merge and wx_pbl_dts_merge in order to take into account
4174	! the update of the aridity coeficient beta.
4175	!
4176	CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta, &
4177	BcoefQ_x, BcoefQ_w &
4178	)
4179
4180	CALL wx_pbl0_merge(knon, ypplay, ypaprs, &
4181	ywake_s, ydTs0, ydqs0, &
4182	yt_x, yt_w, yq_x, yq_w, &
4183	yu_x, yu_w, yv_x, yv_w, &
4184	ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
4185	ycdragm_x, ycdragm_w, &
4186	AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
4187	AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
4188	BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
4189	BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
4190	AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
4191	BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
4192	ycdragh, ycdragq, ycdragm, &
4193	yt1, yq1, yu1, yv1 &
4194	)
4195	IF (iflag_split .eq. 2) THEN
4196
4197	CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
4198	ywake_s, ybeta, ywake_cstar, ywake_dens, &
4199	AcoefH_x, AcoefH_w, &
4200	BcoefH_x, BcoefH_w, &
4201	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
4202	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4203	HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
4204	phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
4205	yg_T, yg_Q, &
4206	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
4207	ydTs_ins, ydqs_ins &
4208	)
4209	ELSE !
4210	AcoefH(:) = AcoefH_0(:)
4211	AcoefQ(:) = AcoefQ_0(:)
4212	BcoefH(:) = BcoefH_0(:)
4213	BcoefQ(:) = BcoefQ_0(:)
4214	yg_T(:) = 0.
4215	yg_Q(:) = 0.
4216	yGamma_dTs_phiT(:) = 0.
4217	yGamma_dQs_phiQ(:) = 0.
4218	ydTs_ins(:) = 0.
4219	ydqs_ins(:) = 0.
4220	ENDIF ! (iflag_split .eq. 2)
4221	!
4222	ELSE ! (nsrf .ne. is_oce)
4223	ybeta(1:knon) = 1.
4224	yevap_pot(1:knon) = yevap(1:knon)
4225	AcoefH(:) = AcoefH_0(:)
4226	AcoefQ(:) = AcoefQ_0(:)
4227	BcoefH(:) = BcoefH_0(:)
4228	BcoefQ(:) = BcoefQ_0(:)
4229	yg_T(:) = 0.
4230	yg_Q(:) = 0.
4231	yGamma_dTs_phiT(:) = 0.
4232	yGamma_dQs_phiQ(:) = 0.
4233	ydTs_ins(:) = 0.
4234	ydqs_ins(:) = 0.
4235	ENDIF ! (nsrf .ne. is_oce)
4236
4237	CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
4238	yg_T, yg_Q, &
4239	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
4240	ydTs_ins, ydqs_ins, &
4241	y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
4242	phiQ0_b, phiT0_b, &
4243	y_flux_t1_x, y_flux_t1_w, &
4244	y_flux_q1_x, y_flux_q1_w, &
4245	y_flux_u1_x, y_flux_u1_w, &
4246	y_flux_v1_x, y_flux_v1_w, &
4247	yfluxlat_x, yfluxlat_w, &
4248	y_delta_qsats, &
4249	y_delta_tsurf_new, y_delta_qsurf &
4250	)
4251
4252	CALL wx_pbl_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
4253	yTs, y_delta_tsurf, &
4254	yqsurf, yTsurf_new, &
4255	y_delta_tsurf_new, y_delta_qsats, &
4256	AcoefH_x, AcoefH_w, &
4257	BcoefH_x, BcoefH_w, &
4258	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
4259	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4260	y_flux_t1, y_flux_q1, &
4261	y_flux_t1_x, y_flux_t1_w, &
4262	y_flux_q1_x, y_flux_q1_w)
4263
4264	IF (nsrf .ne. is_oce) THEN
4265
4266	CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
4267	yTs, y_delta_tsurf, &
4268	yqsurf, yTsurf_new, &
4269	y_delta_qsats, y_delta_tsurf_new, y_delta_qsurf, &
4270	AcoefH_x, AcoefH_w, &
4271	BcoefH_x, BcoefH_w, &
4272	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
4273	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4274	HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
4275	phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
4276	yg_T, yg_Q, &
4277	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
4278	ydTs_ins, ydqs_ins, &
4279	y_flux_t1, y_flux_q1, &
4280	y_flux_t1_x, y_flux_t1_w, &
4281	y_flux_q1_x, y_flux_q1_w )
4282	ENDIF ! (nsrf .ne. is_oce)
4283
4284	ELSE ! (iflag_split .ge. 1)
4285	ybeta(1:knon) = 1.
4286	yevap_pot(1:knon) = yevap(1:knon)
4287	ENDIF ! (iflag_split .ge. 1)
4288
4289	IF (prt_level >= 10) THEN
4290	print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
4291	ybeta(1:knon) , yevap(1:knon), yevap_pot(1:knon)
4292	ENDIF ! (prt_level >= 10)
4293
4294	IF (iflag_split .ge. 1) THEN
4295	IF (prt_level >=10) THEN
4296	DO j = 1, knon
4297	print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j)
4298	print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j)
4299	print*,'t1x, t1w, t1, t1_ancien', &
4300	& yt_x(j,1), yt_w(j,1), yt(j,1), t(j,1)
4301	print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j)
4302	ENDDO
4303
4304	DO j=1,knon
4305	print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' &
4306	& , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)RLVTT, y_flux_q1_w(j)RLVTT, yfluxlat(j), ywake_s(j)
4307	print*,'beta, ytsurf_new ', ybeta(j), ytsurf_new(j)
4308	print*,'inertia, facteur, cstar', inertia, facteur,wake_cstar(j)
4309	ENDDO
4310	ENDIF ! (prt_level >=10)
4311
4312	ENDIF ! (iflag_split .ge.1)
4313
4314	IF (iflag_split .eq.0) THEN
4315
4316	CALL climb_hq_up(knon, ni, dtime, yt, yq, &
4317	y_flux_q1, y_flux_t1, ypaprs, ypplay, &
4318	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4319	CcoefH, CcoefQ, DcoefH, DcoefQ, &
4320	Kcoef_hq, gama_q, gama_h, &
4321	y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) &
4322	#ifdef ISO
4323	& ,yxt,y_flux_xt1 &
4324	& ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt &
4325	& ,y_flux_xt(:,:,:),y_d_xt(:,:,:) &
4326	#endif
4327	& )
4328	ELSE !(iflag_split .eq.0)
4329
4330	CALL climb_hq_up(knon, ni, dtime, yt_x, yq_x, &
4331	y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
4332	AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, &
4333	CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
4334	Kcoef_hq_x, gama_q_x, gama_h_x, &
4335	y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) &
4336	#ifdef ISO
4337	& ,yxt_x,y_flux_xt1_x &
4338	& ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x &
4339	& ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) &
4340	#endif
4341	& )
4342	!
4343
4344	CALL climb_hq_up(knon, ni, dtime, yt_w, yq_w, &
4345	y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, &
4346	AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, &
4347	CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
4348	Kcoef_hq_w, gama_q_w, gama_h_w, &
4349	y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) &
4350	#ifdef ISO
4351	& ,yxt_w,y_flux_xt1_w &
4352	& ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w &
4353	& ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) &
4354	#endif
4355	& )
4356	ENDIF ! (iflag_split .eq.0)
4357
4358	IF (iflag_split .eq.0) THEN
4359	IF (is_master) WRITE(lunout,) "*** CHECKSUM IN ==> climb_wind_up ***"
4360	CALL checksum("knon", knon)
4361	CALL checksum("dtime", dtime)
4362	CALL checksum("yu", yu(1:knon,:))
4363	CALL checksum("yv", yv(1:knon,:))
4364	CALL checksum("y_flux_u1", y_flux_u1(1:knon))
4365	CALL checksum("y_flux_v1", y_flux_v1(1:knon))
4366	CALL checksum("AcoefU", AcoefU(1:knon))
4367	CALL checksum("AcoefV", AcoefV(1:knon))
4368	CALL checksum("BcoefU", BcoefU(1:knon))
4369	CALL checksum("BcoefV", BcoefV(1:knon))
4370	CALL checksum("CcoefU", CcoefU(1:knon,:))
4371	CALL checksum("CcoefV", CcoefV(1:knon,:))
4372	CALL checksum("DcoefU", DcoefU(1:knon,:))
4373	CALL checksum("DcoefV", DcoefV(1:knon,:))
4374	CALL checksum("Kcoef_m", Kcoef_m(1:knon,:))
4375	CALL checksum("y_flux_u", y_flux_u(1:knon,:))
4376	CALL checksum("y_flux_v", y_flux_v(1:knon,:))
4377	CALL checksum("y_d_u", y_d_u(1:knon,:))
4378	CALL checksum("y_d_v", y_d_v(1:knon,:))
4379
4380	CALL climb_wind_up(knon, ni, dtime, yu, yv, y_flux_u1, y_flux_v1, &
4381	AcoefU, AcoefV, BcoefU, BcoefV, &
4382	CcoefU, CcoefV, DcoefU, DcoefV, &
4383	Kcoef_m, &
4384	y_flux_u, y_flux_v, y_d_u, y_d_v)
4385
4386	IF (is_master) WRITE(lunout,) "*** CHECKSUM OUT ==> climb_wind_up ***"
4387	CALL checksum("knon", knon)
4388	CALL checksum("dtime", dtime)
4389	CALL checksum("yu", yu(1:knon,:))
4390	CALL checksum("yv", yv(1:knon,:))
4391	CALL checksum("y_flux_u1", y_flux_u1(1:knon))
4392	CALL checksum("y_flux_v1", y_flux_v1(1:knon))
4393	CALL checksum("AcoefU", AcoefU(1:knon))
4394	CALL checksum("AcoefV", AcoefV(1:knon))
4395	CALL checksum("BcoefU", BcoefU(1:knon))
4396	CALL checksum("BcoefV", BcoefV(1:knon))
4397	CALL checksum("CcoefU", CcoefU(1:knon,:))
4398	CALL checksum("CcoefV", CcoefV(1:knon,:))
4399	CALL checksum("DcoefU", DcoefU(1:knon,:))
4400	CALL checksum("DcoefV", DcoefV(1:knon,:))
4401	CALL checksum("Kcoef_m", Kcoef_m(1:knon,:))
4402	CALL checksum("y_flux_u", y_flux_u(1:knon,:))
4403	CALL checksum("y_flux_v", y_flux_v(1:knon,:))
4404	CALL checksum("y_d_u", y_d_u(1:knon,:))
4405	CALL checksum("y_d_v", y_d_v(1:knon,:))
4406	IF (is_master) WRITE(lunout,) "** CHECKSUM *****************************"
4407
4408	y_d_t_diss(:,:)=0.
4409	IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
4410
4411	CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
4412	& ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
4413	& ,iflag_pbl)
4414	ENDIF
4415
4416	ELSE !(iflag_split .eq.0)
4417
4418	CALL climb_wind_up(knon, ni, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
4419	AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, &
4420	CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
4421	Kcoef_m_x, &
4422	y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x)
4423
4424	y_d_t_diss_x(:,:)=0.
4425	IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
4426
4427	CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
4428	& ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x &
4429	,ycoefq_x,y_d_t_diss_x,yustar_x &
4430	& ,iflag_pbl)
4431	ENDIF
4432
4433	CALL climb_wind_up(knon, ni, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, &
4434	AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, &
4435	CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
4436	Kcoef_m_w, &
4437	y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w)
4438
4439	y_d_t_diss_w(:,:)=0.
4440	IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
4441
4442	CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
4443	& ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w &
4444	,ycoefq_w,y_d_t_diss_w,yustar_w &
4445	& ,iflag_pbl)
4446	ENDIF
4447
4448	IF (prt_level >=10) THEN
4449	print *, 'After climbing up, lfuxlat_x, fluxlat_w ', &
4450	yfluxlat_x(1:knon), yfluxlat_w(1:knon)
4451	ENDIF
4452	!
4453	ENDIF ! (iflag_split .eq.0)
4454
4455	IF (ok_bs) THEN
4456
4457	CALL climb_qbs_up(knon, ni, dtime, yqbs, &
4458	y_flux_bs, ypaprs, ypplay, &
4459	AcoefQBS, BcoefQBS, &
4460	CcoefQBS, DcoefQBS, &
4461	Kcoef_qbs, gama_qbs, &
4462	y_flux_qbs(:,:), y_d_qbs(:,:))
4463	ENDIF
4464
4465
4466	!****************************************************************************************
4467	! 13) Transform variables for output format :
4468	! - Decompress
4469	! - Multiply with pourcentage of current surface
4470	! - Cumulate in global variable
4471	!
4472	!****************************************************************************************
4473
4474
4475	IF (iflag_split.EQ.0) THEN
4476
4477	DO k = 1, klev
4478	DO j = 1, knon
4479	i = ni(j)
4480	y_d_t_diss(j,k) = y_d_t_diss(j,k) * ypct(j)
4481	y_d_t(j,k) = y_d_t(j,k) * ypct(j)
4482	y_d_q(j,k) = y_d_q(j,k) * ypct(j)
4483	y_d_u(j,k) = y_d_u(j,k) * ypct(j)
4484	y_d_v(j,k) = y_d_v(j,k) * ypct(j)
4485
4486	IF (nsrf .EQ. is_ter .and. ifl_pbltree .GE. 1) THEN
4487
4488	y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
4489	y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
4490	treedrg(i,k,nsrf)=y_treedrg(j,k)
4491	ELSE
4492	treedrg(i,k,nsrf)=0.
4493	ENDIF
4494
4495	flux_t(i,k,nsrf) = y_flux_t(j,k)
4496	flux_q(i,k,nsrf) = y_flux_q(j,k)
4497	flux_u(i,k,nsrf) = y_flux_u(j,k)
4498	flux_v(i,k,nsrf) = y_flux_v(j,k)
4499
4500	#ifdef ISO
4501	DO ixt=1,ntraciso
4502	y_d_xt(ixt,j,k) = y_d_xt(ixt,j,k) * ypct(j)
4503	flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k)
4504	ENDDO ! DO ixt=1,ntraciso
4505	h1_diag(i)=h1(j)
4506	#endif
4507
4508	ENDDO
4509	ENDDO
4510
4511	#ifdef ISO
4512	#ifdef ISOVERIF
4513	if (iso_eau.gt.0) then
4514	call iso_verif_egalite_vect2D( &
4515	y_d_xt,y_d_q, &
4516	'pbl_surface_mod 2600',ntraciso,klon,klev)
4517	endif
4518	#endif
4519	#endif
4520
4521	ELSE !(iflag_split .eq.0)
4522
4523	! Tendances hors poches
4524	DO k = 1, klev
4525	DO j = 1, knon
4526	i = ni(j)
4527	y_d_t_diss_x(j,k) = y_d_t_diss_x(j,k) * ypct(j)
4528	y_d_t_x(j,k) = y_d_t_x(j,k) * ypct(j)
4529	y_d_q_x(j,k) = y_d_q_x(j,k) * ypct(j)
4530	y_d_u_x(j,k) = y_d_u_x(j,k) * ypct(j)
4531	y_d_v_x(j,k) = y_d_v_x(j,k) * ypct(j)
4532
4533	flux_t_x(i,k,nsrf) = y_flux_t_x(j,k)
4534	flux_q_x(i,k,nsrf) = y_flux_q_x(j,k)
4535	flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
4536	flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
4537
4538	#ifdef ISO
4539	DO ixt=1,ntraciso
4540	y_d_xt_x(ixt,j,k) = y_d_xt_x(ixt,j,k) * ypct(j)
4541	flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k)
4542	ENDDO ! DO ixt=1,ntraciso
4543	#endif
4544	ENDDO
4545	ENDDO
4546
4547	! Tendances dans les poches
4548	DO k = 1, klev
4549	DO j = 1, knon
4550	i = ni(j)
4551	y_d_t_diss_w(j,k) = y_d_t_diss_w(j,k) * ypct(j)
4552	y_d_t_w(j,k) = y_d_t_w(j,k) * ypct(j)
4553	y_d_q_w(j,k) = y_d_q_w(j,k) * ypct(j)
4554	y_d_u_w(j,k) = y_d_u_w(j,k) * ypct(j)
4555	y_d_v_w(j,k) = y_d_v_w(j,k) * ypct(j)
4556
4557	flux_t_w(i,k,nsrf) = y_flux_t_w(j,k)
4558	flux_q_w(i,k,nsrf) = y_flux_q_w(j,k)
4559	flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
4560	flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
4561
4562	#ifdef ISO
4563	DO ixt=1,ntraciso
4564	y_d_xt_w(ixt,j,k) = y_d_xt_w(ixt,j,k) * ypct(j)
4565	flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k)
4566	ENDDO ! do ixt=1,ntraciso
4567	#endif
4568
4569	ENDDO
4570	ENDDO
4571
4572	! Flux, tendances et Tke moyenne dans la maille
4573	DO k = 1, klev
4574	DO j = 1, knon
4575	i = ni(j)
4576	flux_t(i,k,nsrf) = flux_t_x(i,k,nsrf)+ywake_s(j)*(flux_t_w(i,k,nsrf)-flux_t_x(i,k,nsrf))
4577	flux_q(i,k,nsrf) = flux_q_x(i,k,nsrf)+ywake_s(j)*(flux_q_w(i,k,nsrf)-flux_q_x(i,k,nsrf))
4578	flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf))
4579	flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf))
4580	#ifdef ISO
4581	DO ixt=1,ntraciso
4582	flux_xt(ixt,i,k,nsrf) = flux_xt_x(ixt,i,k,nsrf)+ywake_s(j)*(flux_xt_w(ixt,i,k,nsrf)-flux_xt_x(ixt,i,k,nsrf))
4583	ENDDO ! do ixt=1,ntraciso
4584	#endif
4585	ENDDO
4586	ENDDO
4587	DO j=1,knon
4588	yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j))
4589	ENDDO
4590	IF (prt_level >=10) THEN
4591	print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', &
4592	nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf)
4593	ENDIF
4594
4595	DO k = 1, klev
4596	DO j = 1, knon
4597	y_d_t_diss(j,k) = y_d_t_diss_x(j,k)+ywake_s(j)*(y_d_t_diss_w(j,k) -y_d_t_diss_x(j,k))
4598	y_d_t(j,k) = y_d_t_x(j,k)+ywake_s(j)*(y_d_t_w(j,k) -y_d_t_x(j,k))
4599	y_d_q(j,k) = y_d_q_x(j,k)+ywake_s(j)*(y_d_q_w(j,k) -y_d_q_x(j,k))
4600	y_d_u(j,k) = y_d_u_x(j,k)+ywake_s(j)*(y_d_u_w(j,k) -y_d_u_x(j,k))
4601	y_d_v(j,k) = y_d_v_x(j,k)+ywake_s(j)*(y_d_v_w(j,k) -y_d_v_x(j,k))
4602	ENDDO
4603	ENDDO
4604
4605	ENDIF ! (iflag_split .eq.0)
4606
4607
4608	! tendencies of blowing snow
4609	IF (ok_bs) THEN
4610	DO k = 1, klev
4611	DO j = 1, knon
4612	i = ni(j)
4613	y_d_qbs(j,k)=y_d_qbs(j,k) * ypct(j)
4614	flux_qbs(i,k,nsrf) = y_flux_qbs(j,k)
4615	ENDDO
4616	ENDDO
4617	ENDIF
4618
4619
4620	DO j = 1, knon
4621	i = ni(j)
4622	evap(i,nsrf) = - flux_q(i,1,nsrf) !jyg
4623	if (ok_bs) then ; snowerosion(i,nsrf)=flux_qbs(i,1,nsrf); endif
4624	beta(i,nsrf) = ybeta(j) !jyg
4625	d_ts(i,nsrf) = y_d_ts(j)
4626	!albedo SB >>>
4627	DO k=1,nsw
4628	alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
4629	alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
4630	ENDDO
4631	!albedo SB <<<
4632	snow(i,nsrf) = ysnow(j)
4633	qsurf(i,nsrf) = yqsurf(j)
4634	z0m(i,nsrf) = yz0m(j)
4635	z0h(i,nsrf) = yz0h(j)
4636	fluxlat(i,nsrf) = yfluxlat(j)
4637	agesno(i,nsrf) = yagesno(j)
4638	cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
4639	cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
4640	dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
4641	dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
4642	#ifdef ISO
4643	DO ixt=1,niso
4644	xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j)
4645	ENDDO
4646	DO ixt=1,ntraciso
4647	xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf)
4648	dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j)
4649	ENDDO
4650	IF (nsrf == is_lic) THEN
4651	DO ixt=1,niso
4652	Rland_ice(ixt,i) = yRland_ice(ixt,j)
4653	ENDDO
4654	ENDIF !IF (nsrf == is_lic) THEN
4655	#ifdef ISOVERIF
4656	IF (iso_eau.gt.0) THEN
4657	call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
4658	& 'pbl_surf_mod 1230',errmax,errmaxrel)
4659	ENDIF !if (iso_eau.gt.0) then
4660	#endif
4661	#endif
4662	ENDDO
4663
4664	IF (iflag_split .ge.1) THEN
4665
4666	DO j = 1, knon
4667	i = ni(j)
4668	fluxlat_x(i,nsrf) = yfluxlat_x(j)
4669	fluxlat_w(i,nsrf) = yfluxlat_w(j)
4670	delta_tsurf(i,nsrf)=y_delta_tsurf_new(j)
4671	delta_qsurf(i) = delta_qsurf(i) + y_delta_qsurf(j)*ypct(j)
4672	cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
4673	cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j)
4674	cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j)
4675	cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j)
4676	kh(i) = kh(i) + Kech_h(j)*ypct(j)
4677	kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j)
4678	kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j)
4679	ENDDO
4680	ENDIF ! (iflag_split .ge.1)
4681
4682	IF (iflag_split .eq.0) THEN
4683	wake_dltke(:,:,nsrf) = 0.
4684	DO k = 1, klev+1
4685	DO j = 1, knon
4686	i = ni(j)
4687	tke_x(i,k,nsrf) = ytke(j,k)
4688	tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
4689	eps_x(i,k,nsrf) = yeps(j,k)
4690	eps_x(i,k,is_ave) = eps_x(i,k,is_ave) + yeps(j,k)*ypct(j)
4691	ENDDO
4692	ENDDO
4693
4694	ELSE ! (iflag_split .eq.0)
4695	DO k = 1, klev+1
4696	DO j = 1, knon
4697	i = ni(j)
4698	wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
4699	tke_x(i,k,nsrf) = ytke_x(j,k)
4700	tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
4701	eps_x(i,k,nsrf) = yeps_x(j,k)
4702	eps_x(i,k,is_ave) = eps_x(i,k,is_ave) + eps_x(i,k,nsrf)*ypct(j)
4703	wake_dltke(i,k,is_ave) = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
4704	ENDDO
4705	ENDDO
4706	ENDIF ! (iflag_split .eq.0)
4707
4708	DO k = 2, klev
4709	DO j = 1, knon
4710	i = ni(j)
4711	zcoefh(i,k,nsrf) = ycoefh(j,k)
4712	zcoefm(i,k,nsrf) = ycoefm(j,k)
4713	zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
4714	zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
4715	ENDDO
4716	ENDDO
4717
4718	IF ( nsrf .EQ. is_ter ) THEN
4719	DO j = 1, knon
4720	i = ni(j)
4721	qsol(i) = yqsol(j)
4722	#ifdef ISO
4723	runoff_diag(i)=yrunoff_diag(j)
4724	DO ixt=1,niso
4725	xtsol(ixt,i) = yxtsol(ixt,j)
4726	xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j)
4727	ENDDO
4728	#endif
4729	ENDDO
4730	ENDIF
4731
4732	DO k = 1, nsoilmx
4733	DO j = 1, knon
4734	i = ni(j)
4735	ftsoil(i, k, nsrf) = ytsoil(j,k)
4736	ENDDO
4737	ENDDO
4738
4739	#ifdef ISO
4740	#ifdef ISOVERIF
4741	DO i = 1, klon
4742	DO ixt=1,niso
4743	call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405')
4744	ENDDO
4745	ENDDO
4746	#endif
4747	#ifdef ISOVERIF
4748	IF (iso_eau.gt.0) THEN
4749	call iso_verif_egalite_vect2D( &
4750	y_d_xt,y_d_q, &
4751	'pbl_surface_mod 1261',ntraciso,klon,klev)
4752	ENDIF !if (iso_eau.gt.0) then
4753	#endif
4754	#endif
4755
4756	IF (iflag_split .ge.1) THEN
4757
4758	DO k = 1, klev
4759	DO j = 1, knon
4760	i = ni(j)
4761	d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k)
4762	d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k)
4763	d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k)
4764	d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k)
4765	d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k)
4766	!
4767	d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k)
4768	d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k)
4769	d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k)
4770	d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
4771	d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
4772	#ifdef ISO
4773	DO ixt=1,ntraciso
4774	d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k)
4775	d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k)
4776	ENDDO ! DO ixt=1,ntraciso
4777	#endif
4778
4779	ENDDO
4780	ENDDO
4781	ENDIF ! (iflag_split .ge.1)
4782
4783	DO k = 1, klev
4784	DO j = 1, knon
4785	i = ni(j)
4786	d_t_diss(i,k) = d_t_diss(i,k) + y_d_t_diss(j,k)
4787	d_t(i,k) = d_t(i,k) + y_d_t(j,k)
4788	d_q(i,k) = d_q(i,k) + y_d_q(j,k)
4789	#ifdef ISO
4790	DO ixt=1,ntraciso
4791	d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k)
4792	ENDDO !DO ixt=1,ntraciso
4793	#endif
4794	d_u(i,k) = d_u(i,k) + y_d_u(j,k)
4795	d_v(i,k) = d_v(i,k) + y_d_v(j,k)
4796	ENDDO
4797	ENDDO
4798
4799
4800	IF (ok_bs) THEN
4801	DO k = 1, klev
4802	DO j = 1, knon
4803	i = ni(j)
4804	d_qbs(i,k) = d_qbs(i,k) + y_d_qbs(j,k)
4805	ENDDO
4806	ENDDO
4807	ENDIF
4808
4809	#ifdef ISO
4810	#ifdef ISOVERIF
4811	call iso_verif_noNaN_vect2D( &
4812	& d_xt, &
4813	& 'pbl_surface 1385',ntraciso,klon,klev)
4814	IF (iso_eau >= 0) THEN
4815	call iso_verif_egalite_vect2D( &
4816	y_d_xt,y_d_q, &
4817	'pbl_surface_mod 2945',ntraciso,klon,klev)
4818	call iso_verif_egalite_vect2D( &
4819	d_xt,d_q, &
4820	'pbl_surface_mod 1276',ntraciso,klon,klev)
4821	ENDIF !IF (iso_eau >= 0) THEN
4822	#endif
4823	#endif
4824
4825	IF (prt_level >=10) THEN
4826	print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', &
4827	d_t_w(1:knon,1), d_t_x(1:knon,1), d_t(1:knon,1)
4828	ENDIF
4829
4830	if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
4831	delta_sal = missing_val
4832	ds_ns = missing_val
4833	dt_ns = missing_val
4834	delta_sst = missing_val
4835	dter = missing_val
4836	dser = missing_val
4837	tkt = missing_val
4838	tks = missing_val
4839	taur = missing_val
4840	sss = missing_val
4841
4842	delta_sal(ni(:knon)) = ydelta_sal(:knon)
4843	ds_ns(ni(:knon)) = yds_ns(:knon)
4844	dt_ns(ni(:knon)) = ydt_ns(:knon)
4845	delta_sst(ni(:knon)) = ydelta_sst(:knon)
4846	dter(ni(:knon)) = ydter(:knon)
4847	dser(ni(:knon)) = ydser(:knon)
4848	tkt(ni(:knon)) = ytkt(:knon)
4849	tks(ni(:knon)) = ytks(:knon)
4850	taur(ni(:knon)) = ytaur(:knon)
4851	sss(ni(:knon)) = ysss(:knon)
4852
4853	if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
4854	dt_ds = missing_val
4855	dt_ds(ni(:knon)) = ydt_ds(:knon)
4856	end if
4857	end if
4858
4859
4860	!****************************************************************************************
4861	! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m
4862	! Call HBTM
4863	!
4864	!****************************************************************************************
4865	!!!
4866	!
4867	#undef T2m
4868	#define T2m
4869	#ifdef T2m
4870	! Calculations of diagnostic t,q at 2m and u, v at 10m
4871
4872	IF (iflag_split .eq.0) THEN
4873	DO j=1, knon
4874	uzon(j) = yu(j,1) + y_d_u(j,1)
4875	vmer(j) = yv(j,1) + y_d_v(j,1)
4876	tair1(j) = yt(j,1) + y_d_t(j,1) + y_d_t_diss(j,1)
4877	qair1(j) = yq(j,1) + y_d_q(j,1)
4878	zgeo1(j) = RD * tair1(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
4879	* (ypaprs(j,1)-ypplay(j,1))
4880	tairsol(j) = yts(j) + y_d_ts(j)
4881	qairsol(j) = yqsurf(j)
4882	ENDDO
4883	ELSE ! (iflag_split .eq.0)
4884	DO j=1, knon
4885	uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1)
4886	vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1)
4887	tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1)
4888	qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1)
4889	zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
4890	* (ypaprs(j,1)-ypplay(j,1))
4891	tairsol(j) = yts(j) + y_d_ts(j)
4892	tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf_new(j)
4893	qairsol(j) = yqsurf(j)
4894	ENDDO
4895	DO j=1, knon
4896	uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1)
4897	vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1)
4898	tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1)
4899	qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1)
4900	zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
4901	* (ypaprs(j,1)-ypplay(j,1))
4902	tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j)
4903	qairsol(j) = yqsurf(j)
4904	ENDDO
4905	ENDIF ! (iflag_split .eq.0)
4906
4907	DO j=1, knon
4908	psfce(j)=ypaprs(j,1)
4909	patm(j)=ypplay(j,1)
4910	ENDDO
4911
4912	IF (iflag_pbl_surface_t2m_bug==1) THEN
4913	yz0h_oupas(1:knon)=yz0m(1:knon)
4914	ELSE
4915	yz0h_oupas(1:knon)=yz0h(1:knon)
4916	ENDIF
4917
4918
4919	! Calculate the temperature and relative humidity at 2m and the wind at 10m
4920	IF (iflag_split .eq.0) THEN
4921	IF (iflag_new_t2mq2m==1) THEN
4922	CALL checksum("yq2m_bis", yq2m(1:knon))
4923
4924	CALL stdlevvarn(knon, knon, nsrf, zxli, &
4925	uzon, vmer, tair1, qair1, zgeo1, &
4926	tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4927	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
4928	yn2mout(:, :, :))
4929	CALL checksum("yq2m_bis", yq2m(1:knon))
4930	ELSE
4931
4932	CALL stdlevvar(knon, knon, nsrf, zxli, &
4933	uzon, vmer, tair1, qair1, zgeo1, &
4934	tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4935	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, yzxtsol)
4936	ENDIF
4937	ELSE !(iflag_split .eq.0)
4938	IF (iflag_new_t2mq2m==1) THEN
4939
4940	CALL stdlevvarn(knon, knon, nsrf, zxli, &
4941	uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
4942	tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4943	yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
4944	yn2mout_x(:, :, :))
4945
4946	CALL stdlevvarn(knon, knon, nsrf, zxli, &
4947	uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
4948	tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4949	yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, &
4950	yn2mout_w(:, :, :))
4951	ELSE
4952
4953	CALL stdlevvar(knon, knon, nsrf, zxli, &
4954	uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
4955	tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4956	yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, ypblh_x, rain_f, yzxtsol)
4957
4958	CALL stdlevvar(knon, knon, nsrf, zxli, &
4959	uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
4960	tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4961	yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, ypblh_w, rain_f, yzxtsol)
4962	ENDIF
4963
4964	ENDIF ! (iflag_split .eq.0)
4965
4966	IF (iflag_split .eq.0) THEN
4967	DO j=1, knon
4968	i = ni(j)
4969	t2m(i,nsrf)=yt2m(j)
4970	q2m(i,nsrf)=yq2m(j)
4971	! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
4972	ustar(i,nsrf)=yustar(j)
4973	u10m(i,nsrf)=(yu10m(j) * uzon(j))/max(SQRT(uzon(j)2+vmer(j)2), smallestreal)
4974	v10m(i,nsrf)=(yu10m(j) * vmer(j))/max(SQRT(uzon(j)2+vmer(j)2), smallestreal)
4975
4976	DO k = 1, 6
4977	n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
4978	END DO
4979
4980	ENDDO
4981	ELSE !(iflag_split .eq.0)
4982	DO j=1, knon
4983	i = ni(j)
4984	t2m_x(i,nsrf)=yt2m_x(j)
4985	q2m_x(i,nsrf)=yq2m_x(j)
4986	! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
4987	ustar_x(i,nsrf)=yustar_x(j)
4988	u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/max(SQRT(uzon_x(j)2+vmer_x(j)2), smallestreal)
4989	v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/max(SQRT(uzon_x(j)2+vmer_x(j)2), smallestreal)
4990
4991	DO k = 1, 6
4992	n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
4993	END DO
4994
4995	ENDDO
4996	DO j=1, knon
4997	i = ni(j)
4998	t2m_w(i,nsrf)=yt2m_w(j)
4999	q2m_w(i,nsrf)=yq2m_w(j)
5000	! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
5001	ustar_w(i,nsrf)=yustar_w(j)
5002	u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/max(SQRT(uzon_w(j)2+vmer_w(j)2), smallestreal)
5003	v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/max(SQRT(uzon_w(j)2+vmer_w(j)2), smallestreal)
5004
5005	ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf))
5006	u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
5007	v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
5008
5009	DO k = 1, 6
5010	n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
5011	END DO
5012
5013	ENDDO
5014
5015	ENDIF ! (iflag_split .eq.0)
5016
5017
5018	!IM Calcule de l'humidite relative a 2m (rh2m) pour diagnostique
5019	!IM Ajoute dependance type surface
5020	IF (thermcep) THEN
5021
5022	IF (iflag_split .eq.0) THEN
5023	DO j = 1, knon
5024	i=ni(j)
5025	zdelta1 = MAX(0.,SIGN(1., rtt-yt2m(j) ))
5026	zx_qs1 = r2es * FOEEW(yt2m(j),zdelta1)/paprs(i,1)
5027	zx_qs1 = MIN(0.5,zx_qs1)
5028	zcor1 = 1./(1.-RETV*zx_qs1)
5029	zx_qs1 = zx_qs1*zcor1
5030
5031	rh2m(i) = rh2m(i) + yq2m(j)/zx_qs1 * pctsrf(i,nsrf)
5032	qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i,nsrf)
5033	ENDDO
5034	ELSE ! (iflag_split .eq.0)
5035	DO j = 1, knon
5036	i=ni(j)
5037	zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) ))
5038	zx_qs1 = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1)
5039	zx_qs1 = MIN(0.5,zx_qs1)
5040	zcor1 = 1./(1.-RETV*zx_qs1)
5041	zx_qs1 = zx_qs1*zcor1
5042
5043	rh2m_x(i) = rh2m_x(i) + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf)
5044	qsat2m_x(i) = qsat2m_x(i) + zx_qs1 * pctsrf(i,nsrf)
5045	ENDDO
5046	DO j = 1, knon
5047	i=ni(j)
5048	zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) ))
5049	zx_qs1 = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1)
5050	zx_qs1 = MIN(0.5,zx_qs1)
5051	zcor1 = 1./(1.-RETV*zx_qs1)
5052	zx_qs1 = zx_qs1*zcor1
5053
5054	rh2m_w(i) = rh2m_w(i) + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf)
5055	qsat2m_w(i) = qsat2m_w(i) + zx_qs1 * pctsrf(i,nsrf)
5056	ENDDO
5057
5058	ENDIF ! (iflag_split .eq.0)
5059
5060	ENDIF
5061	!
5062	IF (prt_level >=10) THEN
5063	print *, 'T2m, q2m, RH2m ', &
5064	t2m(1:knon,:), q2m(1:knon,:), rh2m(1:knon)
5065	ENDIF
5066
5067
5068	IF (iflag_split .eq.0) THEN
5069
5070	CALL hbtm(knon, ypaprs, ypplay, &
5071	yt2m,yt10m,yq2m,yq10m,yustar,ywstar, &
5072	y_flux_t,y_flux_q,yu,yv,yt,yq, &
5073	ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, &
5074	ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl)
5075	IF (prt_level >=10) THEN
5076	print *,' Arg. de HBTM: yt2m ',yt2m(1:knon)
5077	print *,' Arg. de HBTM: yt10m ',yt10m(1:knon)
5078	print *,' Arg. de HBTM: yq2m ',yq2m(1:knon)
5079	print *,' Arg. de HBTM: yq10m ',yq10m(1:knon)
5080	print *,' Arg. de HBTM: yustar ',yustar(1:knon)
5081	print *,' Arg. de HBTM: y_flux_t ',y_flux_t(1:knon,:)
5082	print *,' Arg. de HBTM: y_flux_q ',y_flux_q(1:knon,:)
5083	print *,' Arg. de HBTM: yu ',yu(1:knon,:)
5084	print *,' Arg. de HBTM: yv ',yv(1:knon,:)
5085	print *,' Arg. de HBTM: yt ',yt(1:knon,:)
5086	print *,' Arg. de HBTM: yq ',yq(1:knon,:)
5087	ENDIF
5088	ELSE ! (iflag_split .eq.0)
5089
5090	CALL HBTM(knon, ypaprs, ypplay, &
5091	yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, &
5092	y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, &
5093	ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, &
5094	ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x)
5095	IF (prt_level >=10) THEN
5096	print *,' Arg. de HBTM: yt2m_x ',yt2m_x(1:knon)
5097	print *,' Arg. de HBTM: yt10m_x ',yt10m_x(1:knon)
5098	print *,' Arg. de HBTM: yq2m_x ',yq2m_x(1:knon)
5099	print *,' Arg. de HBTM: yq10m_x ',yq10m_x(1:knon)
5100	print *,' Arg. de HBTM: yustar_x ',yustar_x(1:knon)
5101	print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x(1:knon,:)
5102	print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x(1:knon,:)
5103	print *,' Arg. de HBTM: yu_x ',yu_x(1:knon,:)
5104	print *,' Arg. de HBTM: yv_x ',yv_x(1:knon,:)
5105	print *,' Arg. de HBTM: yt_x ',yt_x(1:knon,:)
5106	print *,' Arg. de HBTM: yq_x ',yq_x(1:knon,:)
5107	ENDIF
5108
5109	CALL HBTM(knon, ypaprs, ypplay, &
5110	yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, &
5111	y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, &
5112	ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, &
5113	ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w)
5114
5115	ENDIF ! (iflag_split .eq.0)
5116
5117	IF (iflag_split .eq.0) THEN
5118
5119	DO j=1, knon
5120	i = ni(j)
5121	pblh(i,nsrf) = ypblh(j)
5122	wstar(i,nsrf) = ywstar(j)
5123	plcl(i,nsrf) = ylcl(j)
5124	capCL(i,nsrf) = ycapCL(j)
5125	oliqCL(i,nsrf) = yoliqCL(j)
5126	cteiCL(i,nsrf) = ycteiCL(j)
5127	pblT(i,nsrf) = ypblT(j)
5128	therm(i,nsrf) = ytherm(j)
5129	trmb1(i,nsrf) = ytrmb1(j)
5130	trmb2(i,nsrf) = ytrmb2(j)
5131	trmb3(i,nsrf) = ytrmb3(j)
5132	ENDDO
5133	IF (prt_level >=10) THEN
5134	print *, 'After HBTM: pblh ', pblh(1:knon,:)
5135	print *, 'After HBTM: plcl ', plcl(1:knon,:)
5136	print *, 'After HBTM: cteiCL ', cteiCL(1:knon,:)
5137	ENDIF
5138	ELSE !(iflag_split .eq.0)
5139	DO j=1, knon
5140	i = ni(j)
5141	pblh_x(i,nsrf) = ypblh_x(j)
5142	wstar_x(i,nsrf) = ywstar_x(j)
5143	plcl_x(i,nsrf) = ylcl_x(j)
5144	capCL_x(i,nsrf) = ycapCL_x(j)
5145	oliqCL_x(i,nsrf) = yoliqCL_x(j)
5146	cteiCL_x(i,nsrf) = ycteiCL_x(j)
5147	pblT_x(i,nsrf) = ypblT_x(j)
5148	therm_x(i,nsrf) = ytherm_x(j)
5149	trmb1_x(i,nsrf) = ytrmb1_x(j)
5150	trmb2_x(i,nsrf) = ytrmb2_x(j)
5151	trmb3_x(i,nsrf) = ytrmb3_x(j)
5152	ENDDO
5153	IF (prt_level >=10) THEN
5154	print *, 'After HBTM: pblh_x ', pblh_x(1:knon,:)
5155	print *, 'After HBTM: plcl_x ', plcl_x(1:knon,:)
5156	print *, 'After HBTM: cteiCL_x ', cteiCL_x(1:knon,:)
5157	ENDIF
5158	DO j=1, knon
5159	i = ni(j)
5160	pblh_w(i,nsrf) = ypblh_w(j)
5161	wstar_w(i,nsrf) = ywstar_w(j)
5162	plcl_w(i,nsrf) = ylcl_w(j)
5163	capCL_w(i,nsrf) = ycapCL_w(j)
5164	oliqCL_w(i,nsrf) = yoliqCL_w(j)
5165	cteiCL_w(i,nsrf) = ycteiCL_w(j)
5166	pblT_w(i,nsrf) = ypblT_w(j)
5167	therm_w(i,nsrf) = ytherm_w(j)
5168	trmb1_w(i,nsrf) = ytrmb1_w(j)
5169	trmb2_w(i,nsrf) = ytrmb2_w(j)
5170	trmb3_w(i,nsrf) = ytrmb3_w(j)
5171	ENDDO
5172	IF (prt_level >=10) THEN
5173	print *, 'After HBTM: pblh_w ', pblh_w(1:knon,:)
5174	print *, 'After HBTM: plcl_w ', plcl_w(1:knon,:)
5175	print *, 'After HBTM: cteiCL_w ', cteiCL_w(1:knon,:)
5176	ENDIF
5177
5178	ENDIF ! (iflag_split .eq.0)
5179
5180	#else
5181	! T2m not defined
5182	! No calculation
5183	PRINT*,' Warning !!! No T2m calculation. Output is set to zero.'
5184	#endif
5185
5186	!****************************************************************************************
5187	! 15) End of loop over different surfaces
5188	!
5189	!****************************************************************************************
5190	! ENDDO loop_nbsrf
5191	CALL checksum("yeps",yeps)
5192	CALL checksum("yq2m",yq2m)
5193	END SUBROUTINE pbl_surface_subsrf
5194
5195
5196	SUBROUTINE pbl_surface_uncompressed_post( &
5197	itap, dtime, &
5198	u, v, &
5199	wake_s, &
5200	pctsrf, &
5201	ts,ustar, u10m, v10m,wstar, &
5202	zu1, zv1, &
5203	zxsens, zxevap, zxsnowerosion, &
5204	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
5205	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
5206	zq2m, s_pblh, s_plcl, &
5207	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
5208	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
5209	s_therm, s_trmb1, s_trmb2, s_trmb3, &
5210	zustar,zu10m, zv10m, fder_print, &
5211	zxqsurf, &
5212	zxfluxu, zxfluxv, &
5213	z0m, z0h, sollw, solsw, &
5214	d_ts, evap, fluxlat, t2m, &
5215	wfbils, wfevap, &
5216	flux_t, flux_u, flux_v, &
5217	dflux_t, dflux_q, zxsnow, &
5218	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, bilg_cumul, iflag_split_ref, &
5219	& n2mout, n2mout_x, flux_t_x, flux_q_x, flux_t_w, flux_q_w, flux_u_x, flux_v_x, flux_u_w, flux_v_w, &
5220	fluxlat_x, fluxlat_w, t2m_x, q2m_x, qsat2m_x, u10m_x, v10m_x, ustar_x, wstar_x, pblh_x, plcl_x, &
5221	capCL_x, oliqCL_x, cteiCL_x, pblt_x, therm_x, trmb1_x, trmb2_x, trmb3_x, t2m_w, qsat2m_w, &
5222	pblh_w, plcl_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3 &
5223	#ifdef ISO
5224	& ,xtrain_f, xtsnow_f,xt, &
5225	& wake_dlxt,zxxtevap,xtevap, &
5226	& d_xt,d_xt_w,d_xt_x, &
5227	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
5228	& h1_diag,runoff_diag,xtrunoff_diag &
5229	#endif
5230	& )
5231	!$gpum horizontal klon
5232
5233	!****************************************************************************************
5234	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
5235	! Objet: interface de "couche limite" (diffusion verticale)
5236	!
5237	!AA REM:
5238	!AA-----
5239	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
5240	!AA pour l'instant le calcul de la couche limite pour les traceurs
5241	!AA se fait avec cltrac et ne tient pas compte de la differentiation
5242	!AA des sous-fraction de sol.
5243	!AA REM bis :
5244	!AA----------
5245	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
5246	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
5247	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
5248	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
5249	!AA si les informations des subsurfaces doivent etre prises en compte
5250	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
5251	!AA c'est a dire nbsrf (nbre de subsurface).
5252	!
5253	! Arguments:
5254	!
5255	! dtime----input-R- interval du temps (secondes)
5256	! itap-----input-I- numero du pas de temps
5257	! date0----input-R- jour initial
5258	! t--------input-R- temperature (K)
5259	! q--------input-R- vapeur d'eau (kg/kg)
5260	! u--------input-R- vitesse u
5261	! v--------input-R- vitesse v
5262	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
5263	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
5264	!wake_cstar-input-R- wake gust front speed (m/s)
5265	! wake_s---input-R- wake fractionnal area
5266	! ts-------input-R- temperature du sol (en Kelvin)
5267	! paprs----input-R- pression a intercouche (Pa)
5268	! pplay----input-R- pression au milieu de couche (Pa)
5269	! rlat-----input-R- latitude en degree
5270	! z0m, z0h ----input-R- longeur de rugosite (en m)
5271	! Martin
5272	! cldt-----input-R- total cloud fraction
5273	! Martin
5274	!GG
5275	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
5276	!GG
5277	!
5278	! d_t------output-R- le changement pour "t"
5279	! d_q------output-R- le changement pour "q"
5280	! d_u------output-R- le changement pour "u"
5281	! d_v------output-R- le changement pour "v"
5282	! d_ts-----output-R- le changement pour "ts"
5283	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
5284	! (orientation positive vers le bas)
5285	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
5286	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
5287	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
5288	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
5289	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
5290	! dflux_t--output-R- derive du flux sensible
5291	! dflux_q--output-R- derive du flux latent
5292	! zu1------output-R- le vent dans la premiere couche
5293	! zv1------output-R- le vent dans la premiere couche
5294	! trmb1----output-R- deep_cape
5295	! trmb2----output-R- inhibition
5296	! trmb3----output-R- Point Omega
5297	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
5298	! plcl-----output-R- Niveau de condensation
5299	! pblh-----output-R- HCL
5300	! pblT-----output-R- T au nveau HCL
5301	! treedrg--output-R- tree drag (m)
5302	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
5303	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
5304	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
5305	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
5306	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
5307	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
5308	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
5309	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
5310
5311	use hbtm_mod, only: hbtm
5312	USE indice_sol_mod
5313	USE mod_grid_phy_lmdz, ONLY : grid1dto2d_glo
5314	#ifdef ISO
5315	USE isotopes_mod, ONLY: Rdefault,iso_eau
5316	#ifdef ISOVERIF
5317	USE isotopes_verif_mod
5318	#endif
5319	#ifdef ISOTRAC
5320	USE isotrac_mod, only: index_iso
5321	#endif
5322	#endif
5323	USE dimpft_mod_h
5324	USE flux_arp_mod_h
5325	USE compbl_mod_h
5326	USE yoethf_mod_h
5327	USE clesphys_mod_h
5328	USE ioipsl_getin_p_mod, ONLY : getin_p
5329	USE dimsoil_mod_h, ONLY: nsoilmx
5330	USE surf_param_mod, ONLY: eff_surf_param !AM
5331	USE yomcst_mod_h
5332	USE ocean_forced_mod,ONLY : ocean_forced_ice_reset_bilg_cumul
5333	USE lmdz_checksum, ONLY : checksum
5334	IMPLICIT NONE
5335
5336	INCLUDE "FCTTRE.h"
5337
5338	!****************************************************************************************
5339	INTEGER, INTENT(IN) :: itap ! time step
5340	REAL, INTENT(IN) :: dtime ! interval du temps (secondes)
5341	REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed
5342	REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed
5343	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
5344	#ifdef ISO
5345	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
5346	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
5347	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
5348	#endif
5349	REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides
5350
5351	#ifdef ISO
5352	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
5353	#endif
5354
5355	! Input/Output variables
5356	!****************************************************************************************
5357	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
5358	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
5359	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
5360	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
5361	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
5362
5363	! Output variables
5364	!****************************************************************************************
5365	REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer
5366	REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer
5367	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign
5368	! (=> positive sign upwards)
5369	REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards
5370	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface
5371	REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point
5372	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point
5373	REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point
5374	INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: zn2mout ! number of times the 2m temperature is out of the [tsol,temp]
5375	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m
5376	#ifdef ISO
5377	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
5378	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
5379	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
5380	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
5381	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
5382	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
5383	#endif
5384	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche
5385	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche
5386	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche
5387	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche
5388
5389	! Output only for diagnostics
5390	REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point
5391	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
5392	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
5393	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
5394	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level
5395	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region
5396	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region
5397	REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL
5398	REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL
5399	REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL
5400	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH
5401	REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess
5402	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point
5403	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point
5404	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point
5405	REAL, DIMENSION(klon), INTENT(OUT) :: zustar ! u*
5406	REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point
5407	REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point
5408	REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
5409	REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point
5410	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point
5411	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point
5412	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
5413	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: solsw ! net shortwave radiation at surface
5414	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: sollw ! net longwave radiation at surface
5415	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: d_ts ! change in temperature at surface
5416	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
5417	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: fluxlat ! latent flux
5418	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m ! temperature at 2 meter height
5419	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface
5420	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfevap ! water balance (evap) at surface weighted by srf
5421	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
5422	! positve orientation downwards
5423	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
5424	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
5425	#ifdef ISO
5426	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
5427	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
5428	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
5429	#endif
5430
5431	! Output not needed
5432	REAL, DIMENSION(klon), INTENT(IN) :: dflux_t ! change of sensible heat flux
5433	REAL, DIMENSION(klon), INTENT(IN) :: dflux_q ! change of water vapour flux
5434	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point
5435	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point
5436	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point
5437	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxqbs ! blowing snow flux, mean for each grid point
5438	REAL, DIMENSION(klon, nbsrf),INTENT(IN) :: q2m ! water vapour at 2 meter height
5439	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
5440	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_qbs ! blowind snow vertical flux (kg/m**2
5441	REAL, DIMENSION(klon), INTENT(INOUT) :: bilg_cumul ! flux cumulated
5442	INTEGER, INTENT(INOUT) :: iflag_split_ref
5443
5444	#ifdef ISO
5445	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
5446	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
5447	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
5448	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
5449	#endif
5450
5451	! Other local variables
5452	!****************************************************************************************
5453	INTEGER :: iflag_split
5454	INTEGER :: i, k, nsrf
5455	REAL :: amn, amx
5456	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(IN) :: n2mout, n2mout_x
5457	REAL, DIMENSION(klon) :: meansqT ! mean square deviation of subsurface temperatures
5458	LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
5459	LOGICAL, PARAMETER :: check=.FALSE.
5460
5461	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
5462	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
5463	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: fluxlat_x, fluxlat_w
5464	REAL, DIMENSION(klon, klev) :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w
5465	REAL, DIMENSION(klon, klev) :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w
5466	#ifdef ISO
5467	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: zxfluxxt_x
5468	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: zxfluxxt_w
5469	REAL, DIMENSION(ntraciso,klon,klev,nbsrf), INTENT(IN) :: flux_xt_x, flux_xt_w
5470	#endif
5471	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m_x
5472	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: q2m_x
5473	REAL, DIMENSION(klon), INTENT(IN) :: qsat2m_x
5474	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: u10m_x
5475	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: v10m_x
5476	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: ustar_x
5477	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: wstar_x
5478	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pblh_x
5479	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: plcl_x
5480	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: capCL_x
5481	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: oliqCL_x
5482	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: cteiCL_x
5483	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pblt_x
5484	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: therm_x
5485	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: trmb1_x
5486	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: trmb2_x
5487	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: trmb3_x
5488	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m_w
5489	REAL, DIMENSION(klon), INTENT(IN) :: qsat2m_w
5490	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pblh_w
5491	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: plcl_w
5492	REAL, PARAMETER :: facteur = 2. / 1.772 ! ( == 2. / SQRT(3.14))
5493	REAL, PARAMETER :: inertia=2000.
5494
5495	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pblh ! height of the planetary boundary layer
5496	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: plcl ! condensation level
5497	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: capCL
5498	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: oliqCL
5499	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: cteiCL
5500	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pblT
5501	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: therm
5502	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: trmb1 ! deep cape
5503	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: trmb2 ! inhibition
5504	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: trmb3 ! point Omega
5505	#ifdef ISO
5506	INTEGER :: ixt
5507	#endif
5508
5509	!
5510	!----------------------------------------------------------------------------------------
5511	! Reset iflag_split
5512	!
5513	iflag_split=iflag_split_ref
5514
5515	#ifdef ISO
5516	#ifdef ISOVERIF
5517
5518	IF (iso_eau >= 0) THEN
5519	call iso_verif_egalite_vect2D( &
5520	d_xt,d_q, &
5521	'pbl_surface_mod 1276',ntraciso,klon,klev)
5522	ENDIF !IF (iso_eau >= 0) THEN
5523	#endif
5524	#endif
5525
5526	!YM something bad to check
5527	CALL ocean_forced_ice_reset_bilg_cumul(itap, dtime, bilg_cumul)
5528	!****************************************************************************************
5529	! 16) Calculate the mean value over all sub-surfaces for some variables
5530	!
5531	!****************************************************************************************
5532
5533	z0m(:,nbsrf+1) = 0.0
5534	z0h(:,nbsrf+1) = 0.0
5535	DO nsrf = 1, nbsrf
5536	DO i = 1, klon
5537	z0m(i,nbsrf+1) = z0m(i,nbsrf+1) + z0m(i,nsrf)*pctsrf(i,nsrf)
5538	z0h(i,nbsrf+1) = z0h(i,nbsrf+1) + z0h(i,nsrf)*pctsrf(i,nsrf)
5539	ENDDO
5540	ENDDO
5541
5542	zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
5543	zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
5544	zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0
5545	zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0
5546	zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
5547	zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
5548	#ifdef ISO
5549	zxfluxxt(:,:,:) = 0.0
5550	zxfluxxt_x(:,:,:) = 0.0
5551	zxfluxxt_w(:,:,:) = 0.0
5552	#endif
5553
5554
5555	IF (iflag_split .ge.1) THEN
5556
5557	DO nsrf = 1, nbsrf
5558	DO k = 1, klev
5559	DO i = 1, klon
5560	zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf)
5561	zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf)
5562	zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf)
5563	zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf)
5564	zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf)
5565	zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf)
5566	zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
5567	zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
5568	#ifdef ISO
5569	DO ixt=1,ntraciso
5570	zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf)
5571	zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf)
5572	ENDDO ! DO ixt=1,ntraciso
5573	#endif
5574	ENDDO
5575	ENDDO
5576	ENDDO
5577
5578	DO i = 1, klon
5579	zxsens_x(i) = - zxfluxt_x(i,1)
5580	zxsens_w(i) = - zxfluxt_w(i,1)
5581	ENDDO
5582	!!!
5583	ENDIF ! (iflag_split .ge.1)
5584	!!!
5585
5586	DO nsrf = 1, nbsrf
5587	DO k = 1, klev
5588	DO i = 1, klon
5589	zxfluxt(i,k) = zxfluxt(i,k) + flux_t(i,k,nsrf) * pctsrf(i,nsrf)
5590	zxfluxq(i,k) = zxfluxq(i,k) + flux_q(i,k,nsrf) * pctsrf(i,nsrf)
5591	zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
5592	zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
5593	#ifdef ISO
5594	DO ixt=1,niso
5595	zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf)
5596	ENDDO ! DO ixt=1,niso
5597	#endif
5598	ENDDO
5599	ENDDO
5600	ENDDO
5601
5602	DO i = 1, klon
5603	zxsens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
5604	zxevap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
5605	fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
5606	ENDDO
5607
5608	! if blowing snow
5609	if (ok_bs) then
5610	DO nsrf = 1, nbsrf
5611	DO k = 1, klev
5612	DO i = 1, klon
5613	zxfluxqbs(i,k) = zxfluxqbs(i,k) + flux_qbs(i,k,nsrf) * pctsrf(i,nsrf)
5614	ENDDO
5615	ENDDO
5616	ENDDO
5617
5618	DO i = 1, klon
5619	zxsnowerosion(i) = zxfluxqbs(i,1) ! blowings snow flux at the surface
5620	END DO
5621	endif
5622
5623	#ifdef ISO
5624	DO i = 1, klon
5625	DO ixt=1,ntraciso
5626	zxxtevap(ixt,i) = - zxfluxxt(ixt,i,1)
5627	ENDDO
5628	ENDDO
5629	#endif
5630
5631	!
5632	! Incrementer la temperature du sol
5633	!
5634	zxtsol(:) = 0.0 ; zxfluxlat(:) = 0.0
5635	zt2m(:) = 0.0 ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
5636	zustar(:)=0.0 ; zu10m(:) = 0.0 ; zv10m(:) = 0.0
5637	s_pblh(:) = 0.0 ; s_plcl(:) = 0.0
5638
5639	s_pblh_x(:) = 0.0 ; s_plcl_x(:) = 0.0
5640	s_pblh_w(:) = 0.0 ; s_plcl_w(:) = 0.0
5641
5642	s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
5643	s_cteiCL(:) = 0.0; s_pblT(:) = 0.0
5644	s_therm(:) = 0.0 ; s_trmb1(:) = 0.0
5645	s_trmb2(:) = 0.0 ; s_trmb3(:) = 0.0
5646	wstar(:,is_ave)=0.
5647
5648	zxfluxlat_x(:) = 0.0 ; zxfluxlat_w(:) = 0.0
5649
5650	DO nsrf = 1, nbsrf
5651	DO i = 1, klon
5652	ts(i,nsrf) = ts(i,nsrf) + d_ts(i,nsrf)
5653
5654	wfbils(i,nsrf) = ( solsw(i,nsrf) + sollw(i,nsrf) &
5655	+ flux_t(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
5656
5657	wfevap(i,nsrf) = evap(i,nsrf)*pctsrf(i,nsrf)
5658
5659	zxtsol(i) = zxtsol(i) + ts(i,nsrf) * pctsrf(i,nsrf)
5660	zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
5661	ENDDO
5662	ENDDO
5663	!
5664	!<al1 order 2 correction to zxtsol, for radiation computations (main atm effect of Ts)
5665	IF (iflag_order2_sollw == 1) THEN
5666	meansqT(:) = 0. ! as working buffer
5667	DO nsrf = 1, nbsrf
5668	DO i = 1, klon
5669	meansqT(i) = meansqT(i)+(ts(i,nsrf)-zxtsol(i))*2 pctsrf(i,nsrf)
5670	ENDDO
5671	ENDDO
5672	zxtsol(:) = zxtsol(:)+1.5*meansqT(:)/zxtsol(:)
5673	ENDIF ! iflag_order2_sollw == 1
5674
5675	!$gpum nocall
5676	CALL checksum("n2mout", n2mout)
5677	CALL checksum("n2mout_x", n2mout_x)
5678
5679	IF (iflag_split .eq.0) THEN
5680	DO nsrf = 1, nbsrf
5681	DO i = 1, klon
5682	zt2m(i) = zt2m(i) + t2m(i,nsrf) * pctsrf(i,nsrf)
5683	zq2m(i) = zq2m(i) + q2m(i,nsrf) * pctsrf(i,nsrf)
5684	!
5685	DO k = 1, 6
5686	zn2mout(i,k) = zn2mout(i,k) + n2mout(i,nsrf,k) * pctsrf(i,nsrf)
5687	ENDDO
5688	!
5689	zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
5690	wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
5691	zu10m(i) = zu10m(i) + u10m(i,nsrf) * pctsrf(i,nsrf)
5692	zv10m(i) = zv10m(i) + v10m(i,nsrf) * pctsrf(i,nsrf)
5693
5694	s_pblh(i) = s_pblh(i) + pblh(i,nsrf) * pctsrf(i,nsrf)
5695	s_plcl(i) = s_plcl(i) + plcl(i,nsrf) * pctsrf(i,nsrf)
5696	s_capCL(i) = s_capCL(i) + capCL(i,nsrf) * pctsrf(i,nsrf)
5697	s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf)* pctsrf(i,nsrf)
5698	s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf)* pctsrf(i,nsrf)
5699	s_pblT(i) = s_pblT(i) + pblT(i,nsrf) * pctsrf(i,nsrf)
5700	s_therm(i) = s_therm(i) + therm(i,nsrf) * pctsrf(i,nsrf)
5701	s_trmb1(i) = s_trmb1(i) + trmb1(i,nsrf) * pctsrf(i,nsrf)
5702	s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) * pctsrf(i,nsrf)
5703	s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) * pctsrf(i,nsrf)
5704	ENDDO
5705	ENDDO
5706	ELSE !(iflag_split .eq.0)
5707	DO nsrf = 1, nbsrf
5708	DO i = 1, klon
5709	zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf)
5710	zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf)
5711	!!!
5712	!!! jyg le 08/02/2012
5713	!! Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ;
5714	!! pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ;
5715	!! pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ;
5716	!! pour les autres variables, on sort les valeurs de la region (x).
5717	zt2m(i) = zt2m(i) + (t2m_x(i,nsrf)+wake_s(i)(t2m_w(i,nsrf)-t2m_x(i,nsrf))) pctsrf(i,nsrf)
5718	zq2m(i) = zq2m(i) + q2m_x(i,nsrf) * pctsrf(i,nsrf)
5719	!
5720	DO k = 1, 6
5721	zn2mout(i,k) = zn2mout(i,k) + n2mout_x(i,nsrf,k) * pctsrf(i,nsrf)
5722	ENDDO
5723	!
5724	zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
5725	wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
5726	zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf)
5727	zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf)
5728	!
5729	s_pblh(i) = s_pblh(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf)
5730	s_pblh_x(i) = s_pblh_x(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf)
5731	s_pblh_w(i) = s_pblh_w(i) + pblh_w(i,nsrf) * pctsrf(i,nsrf)
5732	!
5733	s_plcl(i) = s_plcl(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf)
5734	s_plcl_x(i) = s_plcl_x(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf)
5735	s_plcl_w(i) = s_plcl_w(i) + plcl_w(i,nsrf) * pctsrf(i,nsrf)
5736	!
5737	s_capCL(i) = s_capCL(i) + capCL_x(i,nsrf) * pctsrf(i,nsrf)
5738	s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf)
5739	s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf)
5740	s_pblT(i) = s_pblT(i) + pblT_x(i,nsrf) * pctsrf(i,nsrf)
5741	s_therm(i) = s_therm(i) + therm_x(i,nsrf) * pctsrf(i,nsrf)
5742	s_trmb1(i) = s_trmb1(i) + trmb1_x(i,nsrf) * pctsrf(i,nsrf)
5743	s_trmb2(i) = s_trmb2(i) + trmb2_x(i,nsrf) * pctsrf(i,nsrf)
5744	s_trmb3(i) = s_trmb3(i) + trmb3_x(i,nsrf) * pctsrf(i,nsrf)
5745	ENDDO
5746	ENDDO
5747	DO i = 1, klon
5748	qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i))
5749	ENDDO
5750	!!!
5751	ENDIF ! (iflag_split .eq.0)
5752	!!!
5753
5754	IF (check) THEN
5755	amn=MIN(ts(1,is_ter),1000.)
5756	amx=MAX(ts(1,is_ter),-1000.)
5757	DO i=2, klon
5758	amn=MIN(ts(i,is_ter),amn)
5759	amx=MAX(ts(i,is_ter),amx)
5760	ENDDO
5761	PRINT*,' debut apres d_ts min max ftsol(ts)',itap,amn,amx
5762	ENDIF
5763
5764	DO i = 1, klon
5765	fder(i) = - 4.0RSIGMAzxtsol(i)**3
5766	ENDDO
5767
5768	zxqsurf(:) = 0.0
5769	zxsnow(:) = 0.0
5770	#ifdef ISO
5771	zxxtsnow(:,:) = 0.0
5772	#endif
5773
5774	DO nsrf = 1, nbsrf
5775	DO i = 1, klon
5776	zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
5777	zxsnow(i) = zxsnow(i) + snow(i,nsrf) * pctsrf(i,nsrf)
5778	#ifdef ISO
5779	DO ixt=1,niso
5780	zxxtsnow(ixt,i) = zxxtsnow(ixt,i) + xtsnow(ixt,i,nsrf) * pctsrf(i,nsrf)
5781	ENDDO ! DO ixt=1,niso
5782	#endif
5783	ENDDO
5784	ENDDO
5785
5786	! Premier niveau de vent sortie dans physiq.F
5787	zu1(:) = u(:,1)
5788	zv1(:) = v(:,1)
5789
5790	END SUBROUTINE pbl_surface_uncompressed_post
5791	!
5792	!****************************************************************************************
5793	!
5794	END MODULE pbl_surface_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format