Context Navigation

pbl_surface_mod.F90 @ 5874

Last change on this file since 5874 was 5874, checked in by yann meurdesoif, 2 days ago

GPU port of pbl_surface_uncompress_pre

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: 254.8 KB

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

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

Download in other formats:

Original Format