Context Navigation

pbl_surface_mod.F90 @ 5869

Last change on this file since 5869 was 5869, checked in by yann meurdesoif, 5 days ago
cleaning : remove old pbl_surface subroutine source that was inhibited by preprocessing key. YM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 254.8 KB

Line
1	!
2	! $Id: pbl_surface_mod.F90 5869 2025-11-17 15:01:45Z 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
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
1497	SUBROUTINE pbl_surface_uncompress_pre( &
1498	itap, &
1499	solsw_m, solswfdiff_m, sollw_m, &
1500	paprs, pctsrf, &
1501	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
1502	cdragh, cdragm, zu1, zv1, &
1503	alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, &
1504	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
1505	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
1506	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
1507	d_t_w, d_q_w, &
1508	d_t_x, d_q_x, &
1509	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
1510	cdragh_x,cdragh_w, &
1511	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
1512	zcoefh, zcoefm, slab_wfbils, &
1513	qsol, zq2m, s_pblh, s_plcl, &
1514	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
1515	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
1516	s_therm, s_trmb1, s_trmb2, s_trmb3, &
1517	zustar,zu10m, zv10m, fder_print, &
1518	zxqsurf, delta_qsurf, &
1519	rh2m, zxfluxu, zxfluxv, &
1520	z0m, z0h, sollw, solsw, &
1521	d_ts, evap, fluxlat, t2m, &
1522	wfbils, wfevap, &
1523	flux_t, flux_u, flux_v, &
1524	dflux_t, dflux_q, zxsnow, &
1525	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, tke_x, eps_x, &
1526	wake_dltke, iflag_split_ref, &
1527	& delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w, &
1528	flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w, d_u_x, &
1529	d_u_w, d_v_x, d_v_w, windsp, t2m_x, q2m_x, rh2m_x, qsat2m_x, u10m_x, v10m_x, &
1530	ustar_x, wstar_x, pblh_x, plcl_x, capCL_x, oliqCL_x, cteiCL_x, pblt_x, therm_x, &
1531	trmb1_x, trmb2_x, trmb3_x, t2m_w, q2m_w, rh2m_w, qsat2m_w, u10m_w, v10m_w, &
1532	ustar_w, wstar_w , pblh_w, plcl_w, capCL_w, oliqCL_w, cteiCL_w, pblt_w, therm_w, &
1533	trmb1_w, trmb2_w, trmb3_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, therm, &
1534	trmb1, trmb2, trmb3, snowerosion, alb &
1535	#ifdef ISO
1536	& ,xtrain_f, xtsnow_f,xt, &
1537	& wake_dlxt,zxxtevap,xtevap, &
1538	& d_xt,d_xt_w,d_xt_x, &
1539	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
1540	& h1_diag,runoff_diag,xtrunoff_diag &
1541	#endif
1542	& )
1543	!****************************************************************************************
1544	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
1545	! Objet: interface de "couche limite" (diffusion verticale)
1546	!
1547	!AA REM:
1548	!AA-----
1549	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
1550	!AA pour l'instant le calcul de la couche limite pour les traceurs
1551	!AA se fait avec cltrac et ne tient pas compte de la differentiation
1552	!AA des sous-fraction de sol.
1553	!AA REM bis :
1554	!AA----------
1555	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
1556	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
1557	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
1558	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
1559	!AA si les informations des subsurfaces doivent etre prises en compte
1560	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
1561	!AA c'est a dire nbsrf (nbre de subsurface).
1562	!
1563	! Arguments:
1564	!
1565	! dtime----input-R- interval du temps (secondes)
1566	! itap-----input-I- numero du pas de temps
1567	! date0----input-R- jour initial
1568	! t--------input-R- temperature (K)
1569	! q--------input-R- vapeur d'eau (kg/kg)
1570	! u--------input-R- vitesse u
1571	! v--------input-R- vitesse v
1572	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
1573	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
1574	!wake_cstar-input-R- wake gust front speed (m/s)
1575	! wake_s---input-R- wake fractionnal area
1576	! ts-------input-R- temperature du sol (en Kelvin)
1577	! paprs----input-R- pression a intercouche (Pa)
1578	! pplay----input-R- pression au milieu de couche (Pa)
1579	! rlat-----input-R- latitude en degree
1580	! z0m, z0h ----input-R- longeur de rugosite (en m)
1581	! Martin
1582	! cldt-----input-R- total cloud fraction
1583	! Martin
1584	!GG
1585	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
1586	!GG
1587	!
1588	! d_t------output-R- le changement pour "t"
1589	! d_q------output-R- le changement pour "q"
1590	! d_u------output-R- le changement pour "u"
1591	! d_v------output-R- le changement pour "v"
1592	! d_ts-----output-R- le changement pour "ts"
1593	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
1594	! (orientation positive vers le bas)
1595	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
1596	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
1597	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
1598	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
1599	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
1600	! dflux_t--output-R- derive du flux sensible
1601	! dflux_q--output-R- derive du flux latent
1602	! zu1------output-R- le vent dans la premiere couche
1603	! zv1------output-R- le vent dans la premiere couche
1604	! trmb1----output-R- deep_cape
1605	! trmb2----output-R- inhibition
1606	! trmb3----output-R- Point Omega
1607	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
1608	! plcl-----output-R- Niveau de condensation
1609	! pblh-----output-R- HCL
1610	! pblT-----output-R- T au nveau HCL
1611	! treedrg--output-R- tree drag (m)
1612	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
1613	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
1614	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
1615	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
1616	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
1617	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
1618	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
1619	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
1620
1621	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, carbon_cycle_tr
1622	USE carbon_cycle_mod, ONLY : co2_send, nbcf_out, fields_out, cfname_out
1623	use hbtm_mod, only: hbtm
1624	USE indice_sol_mod
1625	USE time_phylmdz_mod, ONLY :
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 phys_output_var_mod, only:
1645	use lmdz_blowing_snow_ini, only :
1646	USE dimsoil_mod_h, ONLY: nsoilmx
1647	USE surf_param_mod, ONLY: eff_surf_param !AM
1648	USE yomcst_mod_h
1649	USE phys_local_var_mod, only: l_mixmin, l_mix
1650	IMPLICIT NONE
1651
1652	INCLUDE "FCTTRE.h"
1653	!FC
1654
1655	!****************************************************************************************
1656	INTEGER, INTENT(IN) :: itap ! time step
1657	REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! net shortwave radiation at mean surface
1658	REAL, DIMENSION(klon), INTENT(IN) :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
1659	REAL, DIMENSION(klon), INTENT(IN) :: sollw_m ! net longwave radiation at mean surface
1660	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa)
1661	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
1662	#ifdef ISO
1663	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
1664	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
1665	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
1666	#endif
1667	#ifdef ISO
1668	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
1669	#endif
1670	! Input/Output variables
1671	!****************************************************************************************
1672	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
1673	REAL, DIMENSIOn(6),intent(in) :: SFRWL
1674	REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
1675	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
1676	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
1677	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
1678	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
1679	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
1680	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
1681
1682	! Output variables
1683	!****************************************************************************************
1684	REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(OUT) :: eps_x ! TKE dissipation rate
1685
1686	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q
1687	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind
1688	REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer
1689	REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer
1690	REAL, DIMENSION(klon, nsw), INTENT(OUT) :: alb_dir_m,alb_dif_m
1691	REAL, DIMENSION(klon), INTENT(OUT) :: alb3_lic
1692	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign
1693	! (=> positive sign upwards)
1694	REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards
1695	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface
1696	REAL, DIMENSION(klon), INTENT(OUT) :: icesub_lic ! ice (no snow!) sublimation over ice sheet
1697	REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point
1698	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_w ! !
1699	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_w ! ! Tendances dans les poches
1700	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_x ! !
1701	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_x ! ! Tendances hors des poches
1702	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point
1703	REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point
1704	INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: zn2mout ! number of times the 2m temperature is out of the [tsol,temp]
1705	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m
1706	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t ! change in temperature
1707	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_diss ! change in temperature
1708	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_q ! change in water vapour
1709	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u ! change in u speed
1710	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v ! change in v speed
1711	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_qbs ! change in blowing snow specific content
1712	REAL, INTENT(OUT):: zcoefh(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
1713	! coef for turbulent diffusion of T and Q, mean for each grid point
1714	REAL, INTENT(OUT):: zcoefm(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
1715	! coef for turbulent diffusion of U and V (?), mean for each grid point
1716	#ifdef ISO
1717	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
1718	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
1719	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
1720	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
1721	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
1722	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
1723	#endif
1724	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche
1725	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche
1726	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche
1727	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche
1728	! Output only for diagnostics
1729	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_x
1730	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_w
1731	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_x
1732	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_w
1733	REAL, DIMENSION(klon), INTENT(OUT) :: kh
1734	REAL, DIMENSION(klon), INTENT(OUT) :: kh_x
1735	REAL, DIMENSION(klon), INTENT(OUT) :: kh_w
1736	REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points
1737	REAL, DIMENSION(klon), INTENT(OUT) :: qsol ! water height in the soil (mm)
1738	REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point
1739	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
1740	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
1741	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
1742	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level
1743	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region
1744	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region
1745	REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL
1746	REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL
1747	REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL
1748	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH
1749	REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess
1750	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point
1751	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point
1752	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point
1753	REAL, DIMENSION(klon), INTENT(OUT) :: zustar ! u*
1754	REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point
1755	REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point
1756	REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
1757	REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point
1758	REAL, DIMENSION(klon), INTENT(OUT) :: delta_qsurf! humidity difference at surface, mean for each grid point
1759	REAL, DIMENSION(klon), INTENT(OUT) :: rh2m ! relative humidity at 2m
1760	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point
1761	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point
1762	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
1763	! REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: agesno ! age of snow at surface
1764	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: solsw ! net shortwave radiation at surface
1765	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw ! net longwave radiation at surface
1766	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface
1767	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
1768	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux
1769	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height
1770	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface
1771	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfevap ! water balance (evap) at surface weighted by srf
1772	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
1773	! positve orientation downwards
1774	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
1775	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
1776	#ifdef ISO
1777	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
1778	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
1779	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
1780	#endif
1781
1782	! Output not needed
1783	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux
1784	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux
1785	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point
1786	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point
1787	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point
1788	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxqbs ! blowing snow flux, mean for each grid point
1789	REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height
1790	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
1791	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2
1792
1793	#ifdef ISO
1794	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
1795	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
1796	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
1797	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
1798	#endif
1799
1800	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow ! snow water content
1801	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt ! snow height
1802	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice ! snow passed to ice
1803	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow ! snow in snow model
1804	REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice
1805	INTEGER, INTENT(INOUT) :: iflag_split_ref
1806	! Other local variables
1807	!****************************************************************************************
1808	INTEGER :: n
1809	INTEGER :: iflag_split
1810	INTEGER :: i, k, nsrf
1811	REAL :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
1812	REAL, DIMENSION(klon) :: r_co2_ppm ! taux CO2 atmosphere
1813	REAL, DIMENSION(klon) :: ztsol
1814	REAL, DIMENSION(klon) :: meansqT ! mean square deviation of subsurface temperatures
1815	REAL, DIMENSION(klon) :: alb_m ! mean albedo for whole SW interval
1816	REAL, DIMENSION(klon,klev), INTENT(OUT) :: delp
1817	LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
1818	LOGICAL, PARAMETER :: check=.FALSE.
1819	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_diss_x, d_t_diss_w
1820	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
1821	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
1822	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat_x, fluxlat_w
1823	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_x
1824	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_w
1825	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_x
1826	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_w
1827	#ifdef ISO
1828	REAL, DIMENSION(ntraciso,klon,klev,nbsrf), INTENT(OUT) :: flux_xt_x, flux_xt_w
1829	#endif
1830	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: windsp
1831	!
1832	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_x
1833	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_x
1834	REAL, DIMENSION(klon), INTENT(OUT) :: rh2m_x
1835	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m_x
1836	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_x
1837	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_x
1838	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_x
1839	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_x
1840	!
1841	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_x
1842	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_x
1843	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_x
1844	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_x
1845	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_x
1846	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_x
1847	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_x
1848	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_x
1849	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_x
1850	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_x
1851	!
1852	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_w
1853	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_w
1854	REAL, DIMENSION(klon) , INTENT(OUT) :: rh2m_w
1855	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m_w
1856	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_w
1857	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_w
1858	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_w
1859	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_w
1860	!
1861	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_w
1862	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_w
1863	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_w
1864	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_w
1865	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_w
1866	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_w
1867	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_w
1868	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_w
1869	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_w
1870	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_w
1871
1872	REAL, PARAMETER :: facteur=2./sqrt(3.14)
1873	REAL, PARAMETER :: inertia=2000.
1874	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblh ! height of the planetary boundary layer
1875	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: plcl ! condensation level
1876	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: capCL
1877	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: oliqCL
1878	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: cteiCL
1879	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblT
1880	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: therm
1881	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb1 ! deep cape
1882	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb2 ! inhibition
1883	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb3 ! point Omega
1884	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: alb ! mean albedo for whole SW interval
1885	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: snowerosion
1886	REAL, DIMENSION(klon) :: albedo_eff
1887	#ifdef ISO
1888	INTEGER :: ixt
1889	#endif
1890
1891	!****************************************************************************************
1892	! End of declarations
1893	!****************************************************************************************
1894
1895	IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
1896	!
1897	!!jyg iflag_split = mod(iflag_pbl_split,2)
1898	!!jyg iflag_split = mod(iflag_pbl_split,10)
1899	!
1900	! Flags controlling the splitting of the turbulent boundary layer:
1901	! iflag_split_ref = 0 ==> no splitting
1902	! = 1 ==> splitting without coupling with surface temperature
1903	! = 2 ==> splitting with coupling with surface temperature over land
1904	! = 3 ==> splitting over ocean; no splitting over land
1905	! iflag_split: actual flag controlling the splitting.
1906	! iflag_split = iflag_split_ref outside the sub-surface loop
1907	! = iflag_split_ref if iflag_split_ref = 0, 1, or 2
1908	! = 0 over land if iflga_split_ref = 3
1909	! = 1 over ocean if iflga_split_ref = 3
1910
1911	iflag_split_ref = mod(iflag_pbl_split,10)
1912	iflag_split = iflag_split_ref
1913
1914	#ifdef ISO
1915	#ifdef ISOVERIF
1916	DO i=1,klon
1917	DO ixt=1,niso
1918	CALL iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608')
1919	ENDDO
1920	ENDDO
1921	#endif
1922	#ifdef ISOVERIF
1923	DO i=1,klon
1924	IF (iso_eau >= 0) THEN
1925	CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
1926	& 'pbl_surf_mod 585',errmax,errmaxrel)
1927	CALL iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), &
1928	& 'pbl_surf_mod 594',errmax,errmaxrel)
1929	IF (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), &
1930	& 'pbl_surf_mod 596',errmax,errmaxrel) == 1) THEN
1931	WRITE(,) 'i=',i
1932	STOP
1933	ENDIF
1934	DO nsrf=1,nbsrf
1935	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
1936	& 'pbl_surf_mod 598',errmax,errmaxrel)
1937	ENDDO
1938	ENDIF !IF (iso_eau >= 0) THEN
1939	ENDDO !DO i=1,knon
1940	DO k=1,klev
1941	DO i=1,klon
1942	IF (iso_eau >= 0) THEN
1943	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1944	& 'pbl_surf_mod 595',errmax,errmaxrel)
1945	ENDIF !IF (iso_eau >= 0) THEN
1946	ENDDO !DO i=1,knon
1947	ENDDO !DO k=1,klev
1948	#endif
1949	#endif
1950
1951
1952
1953	!****************************************************************************************
1954	! Force soil water content to qsol0 if qsol0>0 and VEGET=F (use bucket
1955	! instead of ORCHIDEE)
1956	IF (qsol0>=0.) THEN
1957	PRINT*,'WARNING : On impose qsol=',qsol0
1958	qsol(:)=qsol0
1959	#ifdef ISO
1960	DO ixt=1,niso
1961	xtsol(ixt,:)=qsol0*Rdefault(ixt)
1962	ENDDO
1963	#ifdef ISOTRAC
1964	DO ixt=1+niso,ntraciso
1965	xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt))
1966	ENDDO
1967	#endif
1968	#endif
1969	ENDIF
1970	!****************************************************************************************
1971
1972	!****************************************************************************************
1973	! 2) Initialization to zero
1974	!****************************************************************************************
1975	!
1976	! 2a) Initialization of all argument variables with INTENT(OUT)
1977	!****************************************************************************************
1978	cdragh(:)=0. ; cdragm(:)=0.
1979	zu1(:)=0. ; zv1(:)=0.
1980	!albedo SB >>>
1981	alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
1982	!albedo SB <<<
1983	zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. ; zxsnowerosion(:)=0.
1984	d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
1985	zxfluxlat(:)=0.
1986	zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
1987	zn2mout(:,:)=0 ;
1988	d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_qbs(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
1989	zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
1990	zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
1991	cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
1992	kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
1993	slab_wfbils(:)=0.
1994	s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
1995	s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
1996	s_capCL(:)=0. ; s_oliqCL(:)=0. ; s_cteiCL(:)=0. ; s_pblT(:)=0.
1997	s_therm(:)=0.
1998	s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
1999	zustar(:)=0.
2000	zu10m(:)=0. ; zv10m(:)=0.
2001	fder_print(:)=0.
2002	zxqsurf(:)=0.
2003	delta_qsurf(:) = 0.
2004	zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
2005	solsw(:,:)=0. ; sollw(:,:)=0.
2006	d_ts(:,:)=0.
2007	evap(:,:)=0.
2008	snowerosion(:,:)=0.
2009	fluxlat(:,:)=0.
2010	wfbils(:,:)=0. ; wfevap(:,:)=0. ;
2011	flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
2012	flux_qbs(:,:,:)=0.
2013	dflux_t(:)=0. ; dflux_q(:)=0.
2014	zxsnow(:)=0.
2015	zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0.
2016	qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
2017	runoff(:)=0. ; icesub_lic(:)=0.
2018	l_mixmin(:,:,:)=0.
2019	l_mix(:,:,:)=0.
2020	#ifdef ISO
2021	zxxtevap(:,:)=0.
2022	d_xt(:,:,:)=0.
2023	d_xt_x(:,:,:)=0.
2024	d_xt_w(:,:,:)=0.
2025	flux_xt(:,:,:,:)=0.
2026	! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow
2027	xtevap(:,:,:)=0.
2028	#endif
2029	IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
2030	zcoefh(:,:,:) = 0.0
2031	zcoefh(:,1,:) = 999999. ! zcoefh(:,k=1) should never be used
2032	zcoefm(:,:,:) = 0.0
2033	zcoefm(:,1,:) = 999999. !
2034	ELSE
2035	zcoefm(:,:,is_ave)=0.
2036	zcoefh(:,:,is_ave)=0.
2037	ENDIF
2038	!!
2039	! The components "is_ave" of tke_x and wake_deltke are "OUT" variables
2040	!jyg<
2041	!! tke(:,:,is_ave)=0.
2042	tke_x(:,:,is_ave)=0.
2043	eps_x(:,:,is_ave)=0.
2044
2045	wake_dltke(:,:,is_ave)=0.
2046	!>jyg
2047	!!! jyg le 23/02/2013
2048	t2m(:,:) = 999999. ! t2m and q2m are meaningfull only over sub-surfaces
2049	q2m(:,:) = 999999. ! actually present in the grid cell.
2050	!!!
2051	rh2m(:) = 0. ; qsat2m(:) = 0.
2052	!!!
2053	!!! jyg le 10/02/2012
2054	rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0.
2055
2056
2057	#ifdef ISO
2058	dflux_xt=0.0
2059	#endif
2060
2061	! 2c) Initialization of all local variables computed within the subsurface loop and used later on
2062	!****************************************************************************************
2063	d_t_diss_x(:,:) = 0. ; d_t_diss_w(:,:) = 0.
2064	d_u_x(:,:)=0. ; d_u_w(:,:)=0.
2065	d_v_x(:,:)=0. ; d_v_w(:,:)=0.
2066	flux_t_x(:,:,:)=0. ; flux_t_w(:,:,:)=0.
2067	flux_q_x(:,:,:)=0. ; flux_q_w(:,:,:)=0.
2068	!
2069	!jyg<
2070	flux_u_x(:,:,:)=0. ; flux_u_w(:,:,:)=0.
2071	flux_v_x(:,:,:)=0. ; flux_v_w(:,:,:)=0.
2072	fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0.
2073	!>jyg
2074	#ifdef ISO
2075	flux_xt_x(:,:,:,:)=0. ; flux_xt_w(:,:,:,:)=0.
2076	#endif
2077	!
2078	!jyg<
2079	! pblh,plcl,capCL,cteiCL ... are meaningfull only over sub-surfaces
2080	! actually present in the grid cell ==> value set to 999999.
2081	!
2082	!jyg<
2083	ustar(:,:) = 999999.
2084	wstar(:,:) = 999999.
2085	windsp(:,:) = SQRT(u10m(:,:)2 + v10m(:,:)2 )
2086	u10m(:,:) = 999999.
2087	v10m(:,:) = 999999.
2088	!>jyg
2089	!
2090	pblh(:,:) = 999999. ! Hauteur de couche limite
2091	plcl(:,:) = 999999. ! Niveau de condensation de la CLA
2092	capCL(:,:) = 999999. ! CAPE de couche limite
2093	oliqCL(:,:) = 999999. ! eau_liqu integree de couche limite
2094	cteiCL(:,:) = 999999. ! cloud top instab. crit. couche limite
2095	pblt(:,:) = 999999. ! T a la Hauteur de couche limite
2096	therm(:,:) = 999999.
2097	trmb1(:,:) = 999999. ! deep_cape
2098	trmb2(:,:) = 999999. ! inhibition
2099	trmb3(:,:) = 999999. ! Point Omega
2100	!
2101	t2m_x(:,:) = 999999.
2102	q2m_x(:,:) = 999999.
2103	ustar_x(:,:) = 999999.
2104	wstar_x(:,:) = 999999.
2105	u10m_x(:,:) = 999999.
2106	v10m_x(:,:) = 999999.
2107	!
2108	pblh_x(:,:) = 999999. ! Hauteur de couche limite
2109	plcl_x(:,:) = 999999. ! Niveau de condensation de la CLA
2110	capCL_x(:,:) = 999999. ! CAPE de couche limite
2111	oliqCL_x(:,:) = 999999. ! eau_liqu integree de couche limite
2112	cteiCL_x(:,:) = 999999. ! cloud top instab. crit. couche limite
2113	pblt_x(:,:) = 999999. ! T a la Hauteur de couche limite
2114	therm_x(:,:) = 999999.
2115	trmb1_x(:,:) = 999999. ! deep_cape
2116	trmb2_x(:,:) = 999999. ! inhibition
2117	trmb3_x(:,:) = 999999. ! Point Omega
2118	!
2119	t2m_w(:,:) = 999999.
2120	q2m_w(:,:) = 999999.
2121	ustar_w(:,:) = 999999.
2122	wstar_w(:,:) = 999999.
2123	u10m_w(:,:) = 999999.
2124	v10m_w(:,:) = 999999.
2125
2126	pblh_w(:,:) = 999999. ! Hauteur de couche limite
2127	plcl_w(:,:) = 999999. ! Niveau de condensation de la CLA
2128	capCL_w(:,:) = 999999. ! CAPE de couche limite
2129	oliqCL_w(:,:) = 999999. ! eau_liqu integree de couche limite
2130	cteiCL_w(:,:) = 999999. ! cloud top instab. crit. couche limite
2131	pblt_w(:,:) = 999999. ! T a la Hauteur de couche limite
2132	therm_w(:,:) = 999999.
2133	trmb1_w(:,:) = 999999. ! deep_cape
2134	trmb2_w(:,:) = 999999. ! inhibition
2135	trmb3_w(:,:) = 999999. ! Point Omega
2136	!!!
2137	!
2138	!!!
2139	!****************************************************************************************
2140	! 3) - Calculate pressure thickness of each layer
2141	! - Calculate the wind at first layer
2142	! - Mean calculations of albedo
2143	! - Calculate net radiance at sub-surface
2144	!****************************************************************************************
2145	DO k = 1, klev
2146	DO i = 1, klon
2147	delp(i,k) = paprs(i,k)-paprs(i,k+1)
2148	ENDDO
2149	ENDDO
2150
2151	!****************************************************************************************
2152	! Test for rugos........ from physiq.. A la fin plutot???
2153	!
2154	!****************************************************************************************
2155
2156	DO nsrf = 1, nbsrf
2157	DO i = 1, klon
2158	z0m(i,nsrf) = MAX(z0m(i,nsrf),z0min)
2159	z0h(i,nsrf) = MAX(z0h(i,nsrf),z0min)
2160	ENDDO
2161	ENDDO
2162
2163	! AM heterogeneous continental subsurfaces
2164	! compute time-independent effective surface parameters
2165	IF (iflag_hetero_surf .GT. 0) THEN
2166	CALL eff_surf_param(klon, nbtersrf, albedo_tersrf, frac_tersrf, 'ARI', albedo_eff)
2167	ENDIF
2168
2169	! Mean calculations of albedo
2170	!
2171	! * alb : mean albedo for whole SW interval
2172	!
2173	! Mean albedo for grid point
2174	! * alb_m : mean albedo at whole SW interval
2175
2176	alb_dir_m(:,:) = 0.0
2177	alb_dif_m(:,:) = 0.0
2178	DO k = 1, nsw
2179	DO nsrf = 1, nbsrf
2180	DO i = 1, klon
2181	! AM heterogeneous continental sub-surfaces
2182	IF (nsrf .EQ. is_ter .AND. iflag_hetero_surf .GT. 0) THEN
2183	alb_dir(i,k,nsrf) = albedo_eff(i)
2184	alb_dif(i,k,nsrf) = albedo_eff(i)
2185	ENDIF
2186	!
2187	alb_dir_m(i,k) = alb_dir_m(i,k) + alb_dir(i,k,nsrf) * pctsrf(i,nsrf)
2188	alb_dif_m(i,k) = alb_dif_m(i,k) + alb_dif(i,k,nsrf) * pctsrf(i,nsrf)
2189	ENDDO
2190	ENDDO
2191	ENDDO
2192
2193	! We here suppose the fraction f1 of incoming radiance of visible radiance
2194	! as a fraction of all shortwave radiance
2195	f1 = 0.5
2196	! f1 = 1 ! put f1=1 to recreate old calculations
2197
2198	!f1 is already included with SFRWL values in each surf files
2199	alb=0.0
2200	DO k=1,nsw
2201	DO nsrf = 1, nbsrf
2202	DO i = 1, klon
2203	alb(i,nsrf) = alb(i,nsrf) + alb_dir(i,k,nsrf)*SFRWL(k)
2204	ENDDO
2205	ENDDO
2206	ENDDO
2207
2208	alb_m=0.0
2209	DO k = 1,nsw
2210	DO i = 1, klon
2211	alb_m(i) = alb_m(i) + alb_dir_m(i,k)*SFRWL(k)
2212	ENDDO
2213	ENDDO
2214	!albedo SB <<<
2215
2216
2217
2218	! Calculation of mean temperature at surface grid points
2219	ztsol(:) = 0.0
2220	DO nsrf = 1, nbsrf
2221	DO i = 1, klon
2222	ztsol(i) = ztsol(i) + ts(i,nsrf)*pctsrf(i,nsrf)
2223	ENDDO
2224	ENDDO
2225
2226	! Linear distrubution on sub-surface of long- and shortwave net radiance
2227	DO nsrf = 1, nbsrf
2228	DO i = 1, klon
2229	sollw(i,nsrf) = sollw_m(i) + 4.0RSIGMAztsol(i)*3 (ztsol(i)-ts(i,nsrf))
2230	!--OB this line is not satisfactory because alb is the direct albedo not total albedo
2231	solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
2232	ENDDO
2233	ENDDO
2234	!
2235	!<al1: second order corrections
2236	!- net = dwn -up; up=sig( T4 + 4sum%T3T' + 6sum%T2T'2 +...)
2237	IF (iflag_order2_sollw == 1) THEN
2238	meansqT(:) = 0. ! as working buffer
2239	DO nsrf = 1, nbsrf
2240	DO i = 1, klon
2241	meansqT(i) = meansqT(i)+(ts(i,nsrf)-ztsol(i))*2 pctsrf(i,nsrf)
2242	ENDDO
2243	ENDDO
2244	DO nsrf = 1, nbsrf
2245	DO i = 1, klon
2246	sollw(i,nsrf) = sollw(i,nsrf) &
2247	+ 6.0RSIGMAztsol(i)*2 (meansqT(i)-(ztsol(i)-ts(i,nsrf))**2)
2248	ENDDO
2249	ENDDO
2250	ENDIF ! iflag_order2_sollw == 1
2251	!>al1
2252
2253	!--OB add diffuse fraction of SW down
2254	DO n=1,nbcf_out
2255	IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
2256	ENDDO
2257	! >> PC
2258	IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
2259	r_co2_ppm(:) = co2_send(:)
2260	DO n=1,nbcf_out
2261	IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_send(:)
2262	ENDDO
2263	ENDIF
2264
2265	IF ( .NOT. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
2266	r_co2_ppm(:) = co2_ppm ! Constant field
2267	DO n=1,nbcf_out
2268	IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_ppm
2269	ENDDO
2270	ENDIF
2271
2272	END SUBROUTINE pbl_surface_uncompress_pre
2273
2274	SUBROUTINE pbl_surface_subsrf( nsrf, knon, ni, &
2275	dtime, date0, itap, jour, &
2276	debut, lafin, &
2277	rlon, rlat, rugoro, rmu0, &
2278	lwdown_m, pphi, cldt, &
2279	rain_f, snow_f, bs_f, &
2280	gustiness, &
2281	t, q, qbs, u, v, &
2282	wake_dlt, wake_dlq, &
2283	wake_cstar, wake_s, &
2284	pplay, paprs, pctsrf, &
2285	ts,SFRWL, alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
2286	cdragh, cdragm, &
2287	beta, &
2288	icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &
2289	qsat2m, &
2290	d_t, d_q, d_qbs, d_u, d_v, d_t_diss, &
2291	d_t_w, d_q_w, &
2292	d_t_x, d_q_x, &
2293	delta_tsurf,wake_dens,cdragh_x,cdragh_w, &
2294	cdragm_x,cdragm_w,kh,kh_x,kh_w, &
2295	zcoefh, zcoefm, slab_wfbils, &
2296	qsol, s_pblh, &
2297	s_pblh_x, s_pblh_w, &
2298	delta_qsurf, &
2299	rh2m, &
2300	z0m, z0h, agesno, sollw, solsw, &
2301	d_ts, evap, fluxlat, t2m, &
2302	flux_t, flux_u, flux_v, &
2303	dflux_t, dflux_q, &
2304	q2m, flux_q, flux_qbs, tke_x, eps_x, &
2305	wake_dltke, &
2306	treedrg,hice ,tice, bilg_cumul, &
2307	fcds, fcdi, dh_basal_growth, dh_basal_melt, &
2308	dh_top_melt, dh_snow2sic, &
2309	dtice_melt, dtice_snow2sic , &
2310	tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
2311	cdragm_tersrf, cdragh_tersrf, &
2312	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
2313	#ifdef ISO
2314	& ,xtrain_f, xtsnow_f,xt, &
2315	& wake_dlxt,zxxtevap,xtevap, &
2316	& d_xt,d_xt_w,d_xt_x, &
2317	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
2318	& h1_diag,runoff_diag,xtrunoff_diag &
2319	#endif
2320	, n2mout, n2mout_x, n2mout_w, d_u_x, d_u_w, d_v_x, d_v_w, windsp, t2m_x, &
2321	q2m_x, rh2m_x, qsat2m_x, u10m_x, v10m_x, ustar_x, wstar_x, pblh_x, plcl_x, capCL_x, &
2322	oliqCL_x, cteiCL_x, pblt_x, therm_x, trmb1_x, trmb2_x, trmb3_x, t2m_w, q2m_w, rh2m_w, &
2323	qsat2m_w, u10m_w, v10m_w, ustar_w, wstar_w, pblh_w, plcl_w, capCL_w, oliqCL_w, cteiCL_w,&
2324	pblt_w, therm_w, trmb1_w, trmb2_w, trmb3_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, &
2325	therm, trmb1, trmb2, trmb3, alb, snowerosion, iflag_split_ref, &
2326	delp, d_t_diss_x, d_t_diss_w, flux_t_x, flux_q_x, flux_t_w, flux_q_w,&
2327	flux_u_x, flux_v_x, flux_u_w, flux_v_w, fluxlat_x, fluxlat_w)
2328	!****************************************************************************************
2329	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
2330	! Objet: interface de "couche limite" (diffusion verticale)
2331	!
2332	!AA REM:
2333	!AA-----
2334	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
2335	!AA pour l'instant le calcul de la couche limite pour les traceurs
2336	!AA se fait avec cltrac et ne tient pas compte de la differentiation
2337	!AA des sous-fraction de sol.
2338	!AA REM bis :
2339	!AA----------
2340	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
2341	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
2342	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
2343	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
2344	!AA si les informations des subsurfaces doivent etre prises en compte
2345	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
2346	!AA c'est a dire nbsrf (nbre de subsurface).
2347	!
2348	! Arguments:
2349	!
2350	! dtime----input-R- interval du temps (secondes)
2351	! itap-----input-I- numero du pas de temps
2352	! date0----input-R- jour initial
2353	! t--------input-R- temperature (K)
2354	! q--------input-R- vapeur d'eau (kg/kg)
2355	! u--------input-R- vitesse u
2356	! v--------input-R- vitesse v
2357	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
2358	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
2359	!wake_cstar-input-R- wake gust front speed (m/s)
2360	! wake_s---input-R- wake fractionnal area
2361	! ts-------input-R- temperature du sol (en Kelvin)
2362	! paprs----input-R- pression a intercouche (Pa)
2363	! pplay----input-R- pression au milieu de couche (Pa)
2364	! rlat-----input-R- latitude en degree
2365	! z0m, z0h ----input-R- longeur de rugosite (en m)
2366	! Martin
2367	! cldt-----input-R- total cloud fraction
2368	! Martin
2369	!GG
2370	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
2371	!GG
2372	!
2373	! d_t------output-R- le changement pour "t"
2374	! d_q------output-R- le changement pour "q"
2375	! d_u------output-R- le changement pour "u"
2376	! d_v------output-R- le changement pour "v"
2377	! d_ts-----output-R- le changement pour "ts"
2378	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
2379	! (orientation positive vers le bas)
2380	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
2381	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
2382	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
2383	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
2384	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
2385	! dflux_t--output-R- derive du flux sensible
2386	! dflux_q--output-R- derive du flux latent
2387	! zu1------output-R- le vent dans la premiere couche
2388	! zv1------output-R- le vent dans la premiere couche
2389	! trmb1----output-R- deep_cape
2390	! trmb2----output-R- inhibition
2391	! trmb3----output-R- Point Omega
2392	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
2393	! plcl-----output-R- Niveau de condensation
2394	! pblh-----output-R- HCL
2395	! pblT-----output-R- T au nveau HCL
2396	! treedrg--output-R- tree drag (m)
2397	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
2398	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
2399	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
2400	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
2401	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
2402	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
2403	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
2404	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
2405
2406	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
2407	USE carbon_cycle_mod, ONLY : co2_send, nbcf_out, fields_out, yfields_out
2408	use hbtm_mod, only: hbtm
2409	USE indice_sol_mod
2410	USE mod_grid_phy_lmdz, ONLY : grid1dto2d_glo
2411	USE print_control_mod, ONLY : prt_level,lunout
2412	#ifdef ISO
2413	USE isotopes_mod, ONLY: Rdefault,iso_eau
2414	#ifdef ISOVERIF
2415	USE isotopes_verif_mod
2416	#endif
2417	#ifdef ISOTRAC
2418	USE isotrac_mod, only: index_iso
2419	#endif
2420	#endif
2421	USE dimpft_mod_h
2422	USE flux_arp_mod_h
2423	USE compbl_mod_h
2424	USE yoethf_mod_h
2425	USE clesphys_mod_h
2426	USE ioipsl_getin_p_mod, ONLY : getin_p
2427	use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
2428	dser, dt_ds, zsig, zmea, &
2429	frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf !AM
2430	use phys_output_var_mod, only: tkt, tks, taur, sss
2431	use lmdz_blowing_snow_ini, only : zeta_bs
2432	USE dimsoil_mod_h, ONLY: nsoilmx
2433	USE surf_param_mod, ONLY: eff_surf_param !AM
2434	use wxios_mod, ONLY: missing_val_xios => missing_val, using_xios
2435	USE netcdf, only: missing_val_netcdf => nf90_fill_real
2436	USE yomcst_mod_h
2437	USE lmdz_checksum, ONLY : checksum
2438	USE mod_phys_lmdz_para, ONLY : is_master
2439	IMPLICIT NONE
2440
2441	INCLUDE "FCTTRE.h"
2442	!****************************************************************************************
2443	INTEGER, INTENT(IN) :: nsrf ! indice current subsurface
2444	INTEGER, INTENT(IN) :: knon ! number of compressed points for current subsurface
2445	INTEGER, INTENT(IN) :: ni(knon)! index for compressed current sub-surface
2446	REAL, INTENT(IN) :: dtime ! time interval (s)
2447	REAL, INTENT(IN) :: date0 ! initial day
2448	INTEGER, INTENT(IN) :: itap ! time step
2449	INTEGER, INTENT(IN) :: jour ! current day of the year
2450	LOGICAL, INTENT(IN) :: debut ! true if first run step
2451	LOGICAL, INTENT(IN) :: lafin ! true if last run step
2452	REAL, DIMENSION(klon), INTENT(IN) :: rlon ! longitudes in degrees
2453	REAL, DIMENSION(klon), INTENT(IN) :: rlat ! latitudes in degrees
2454	REAL, DIMENSION(klon), INTENT(IN) :: rugoro ! rugosity length
2455	REAL, DIMENSION(klon), INTENT(IN) :: rmu0 ! cosine of solar zenith angle
2456	REAL, DIMENSION(klon), INTENT(IN) :: rain_f ! rain fall
2457	REAL, DIMENSION(klon), INTENT(IN) :: snow_f ! snow fall
2458	REAL, DIMENSION(klon), INTENT(IN) :: bs_f ! blowing snow fall
2459	REAL, DIMENSION(klon,klev), INTENT(IN) :: t ! temperature (K)
2460	REAL, DIMENSION(klon,klev), INTENT(IN) :: q ! water vapour (kg/kg)
2461	REAL, DIMENSION(klon,klev), INTENT(IN) :: qbs ! blowing snow specific content (kg/kg)
2462	REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed
2463	REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed
2464	REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay ! mid-layer pression (Pa)
2465	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! pression between layers (Pa)
2466	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
2467	REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downward longwave radiation at mean s
2468	REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness
2469	REAL, DIMENSION(klon,klev), INTENT(IN) :: pphi ! geopotential (m2/s2)
2470	REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud
2471
2472	#ifdef ISO
2473	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
2474	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
2475	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
2476	#endif
2477	REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlt !temperature difference between (w) and (x) (K)
2478	REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlq !humidity difference between (w) and (x) (K)
2479	REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides
2480	REAL, DIMENSION(klon), INTENT(IN) :: wake_cstar! Vitesse d'expansion des poches froides
2481	REAL, DIMENSION(klon), INTENT(IN) :: wake_dens
2482	#ifdef ISO
2483	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
2484	#endif
2485	! Input/Output variables
2486	!****************************************************************************************
2487	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: beta ! Aridity factor
2488	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
2489	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: delta_tsurf !surface temperature difference between
2490	REAL, DIMENSIOn(6),intent(in) :: SFRWL
2491	REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
2492	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
2493	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
2494	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
2495	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
2496	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
2497	REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
2498
2499	! Output variables
2500	!****************************************************************************************
2501	REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: eps_x ! TKE dissipation rate
2502
2503	REAL, DIMENSION(klon), INTENT(OUT) :: cdragh ! drag coefficient for T and Q
2504	REAL, DIMENSION(klon), INTENT(OUT) :: cdragm ! drag coefficient for wind
2505	REAL, DIMENSION(klon), INTENT(OUT) :: alb3_lic
2506	REAL, DIMENSION(klon), INTENT(OUT) :: icesub_lic ! ice (no snow!) sublimation over ice sheet
2507	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_t_w ! !
2508	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_q_w ! ! Tendances dans les poches
2509	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_t_x ! !
2510	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: d_q_x ! ! Tendances hors des poches
2511	REAL, DIMENSION(klon), INTENT(INOUT) :: qsat2m
2512	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_t ! change in temperature
2513	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_t_diss ! change in temperature
2514	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_q ! change in water vapour
2515	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_u ! change in u speed
2516	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_v ! change in v speed
2517	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_qbs ! change in blowing snow specific content
2518
2519	REAL, INTENT(INOUT):: zcoefh(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
2520	! coef for turbulent diffusion of T and Q, mean for each grid point
2521
2522	REAL, INTENT(INOUT):: zcoefm(klon, klev+1, nbsrf + 1) ! (klon, klev, nbsrf + 1) => only use (klon, klev, nbsrf+1)
2523	! coef for turbulent diffusion of U and V (?), mean for each grid point
2524	#ifdef ISO
2525	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
2526	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
2527	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
2528	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
2529	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
2530	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
2531	#endif
2532	! Output only for diagnostics
2533	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragh_x
2534	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragh_w
2535	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragm_x
2536	REAL, DIMENSION(klon), INTENT(INOUT) :: cdragm_w
2537	REAL, DIMENSION(klon), INTENT(INOUT) :: kh
2538	REAL, DIMENSION(klon), INTENT(INOUT) :: kh_x
2539	REAL, DIMENSION(klon), INTENT(INOUT) :: kh_w
2540	REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points
2541	REAL, DIMENSION(klon), INTENT(OUT) :: qsol ! water height in the soil (mm)
2542	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
2543	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
2544	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
2545	REAL, DIMENSION(klon), INTENT(OUT) :: delta_qsurf! humidity difference at surface, mean for each grid point
2546	REAL, DIMENSION(klon), INTENT(INOUT) :: rh2m ! relative humidity at 2m
2547	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
2548	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: agesno ! age of snow at surface
2549	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: solsw ! net shortwave radiation at surface
2550	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: sollw ! net longwave radiation at surface
2551	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface
2552	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
2553	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux
2554	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height
2555	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
2556	! positve orientation downwards
2557	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
2558	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
2559	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m)
2560	!AM heterogeneous continental sub-surfaces
2561	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_tersrf ! surface temperature of continental sub-surfaces (K)
2562	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: qsurf_tersrf ! surface specific humidity of continental sub-surfaces (kg/kg)
2563	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_new_tersrf ! surface temperature of continental sub-surfaces (K)
2564	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragm_tersrf ! momentum drag coefficient of continental sub-surfaces (-)
2565	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragh_tersrf ! heat drag coefficient of continental sub-surfaces (-)
2566	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: swnet_tersrf ! net shortwave radiation of continental sub-surfaces (W/m2)
2567	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: lwnet_tersrf ! net longwave radiation of continental sub-surfaces (W/m2)
2568	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxsens_tersrf ! sensible heat flux of continental sub-surfaces (W/m2)
2569	REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxlat_tersrf ! latent heat flux of continental sub-surfaces (W/m2)
2570	REAL, DIMENSION(klon, nsoilmx, nbtersrf), INTENT(INOUT) :: tsoil_tersrf ! soil temperature of continental sub-surfaces (K)
2571	#ifdef ISO
2572	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
2573	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
2574	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
2575	#endif
2576
2577	! Output not needed
2578	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_t ! change of sensible heat flux
2579	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_q ! change of water vapour flux
2580	REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height
2581	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
2582	REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2
2583
2584	#ifdef ISO
2585	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
2586	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
2587	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
2588	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
2589	#endif
2590
2591	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow ! snow water content
2592	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt ! snow height
2593	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice ! snow passed to ice
2594	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow ! snow in snow model
2595	REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice
2596	REAL, DIMENSION(klon), INTENT(INOUT) :: hice ! hice
2597	REAL, DIMENSION(klon), INTENT(INOUT) :: tice ! tice
2598	REAL, DIMENSION(klon), INTENT(INOUT) :: bilg_cumul ! flux cumulated
2599	REAL, DIMENSION(klon), INTENT(INOUT) :: fcds
2600	REAL, DIMENSION(klon), INTENT(INOUT) :: fcdi
2601	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_growth
2602	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_melt
2603	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_top_melt
2604	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_snow2sic
2605	REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_melt
2606	REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_snow2sic
2607
2608	! variables temporaires en "klon" (nom compressée) passée en argument pour les sous-surface
2609
2610	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(OUT) :: n2mout
2611	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(OUT) :: n2mout_x
2612	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(OUT) :: n2mout_w
2613	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_x
2614	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_w
2615	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_x
2616	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_w
2617	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: windsp
2618	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_x
2619	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_x
2620	REAL, DIMENSION(klon), INTENT(INOUT) :: rh2m_x
2621	REAL, DIMENSION(klon), INTENT(INOUT) :: qsat2m_x
2622	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_x
2623	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_x
2624	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_x
2625	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_x
2626	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_x
2627	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_x
2628	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_x
2629	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_x
2630	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_x
2631	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_x
2632	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_x
2633	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_x
2634	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_x
2635	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_x
2636	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m_w
2637	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: q2m_w
2638	REAL, DIMENSION(klon), INTENT(INOUT) :: rh2m_w
2639	REAL, DIMENSION(klon), INTENT(INOUT) :: qsat2m_w
2640	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: u10m_w
2641	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: v10m_w
2642	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: ustar_w
2643	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wstar_w
2644	!
2645	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblh_w
2646	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: plcl_w
2647	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: capCL_w
2648	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: oliqCL_w
2649	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: cteiCL_w
2650	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pblt_w
2651	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: therm_w
2652	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb1_w
2653	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb2_w
2654	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: trmb3_w
2655	!
2656	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblh ! height of the planetary boundary layer
2657	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: plcl ! condensation level
2658	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: capCL
2659	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: oliqCL
2660	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: cteiCL
2661	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pblT
2662	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: therm
2663	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb1 ! deep cape
2664	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb2 ! inhibition
2665	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: trmb3 ! point Omega
2666	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: alb ! mean albedo for whole SW interval
2667	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: snowerosion
2668	INTEGER, INTENT(INOUT) :: iflag_split_ref
2669
2670	!
2671	! Other local variables
2672	!****************************************************************************************
2673	INTEGER :: n
2674	INTEGER :: iflag_split
2675	INTEGER :: i, k
2676	INTEGER :: j
2677	REAL, DIMENSION(knon) :: r_co2_ppm ! taux CO2 atmosphere
2678	REAL :: yt1_new
2679	REAL, DIMENSION(knon) :: yts, yz0m, yz0h, ypct
2680	REAL, DIMENSION(knon) :: yz0h_old
2681	REAL, DIMENSION(knon) :: yalb,yalb_vis
2682	REAL, DIMENSION(knon) :: yt1, yq1, yu1, yv1, yqbs1
2683	REAL, DIMENSION(knon) :: yqa
2684	REAL, DIMENSION(knon) :: ysnow, yqsurf, yagesno, yqsol
2685	REAL, DIMENSION(knon) :: yrain_f, ysnow_f, ybs_f
2686	#ifdef ISO
2687	REAL, DIMENSION(ntraciso,knon) :: yxt1
2688	REAL, DIMENSION(niso,knon) :: yxtsnow, yxtsol
2689	REAL, DIMENSION(ntraciso,knon) :: yxtrain_f, yxtsnow_f
2690	REAL, DIMENSION(knon) :: yrunoff_diag
2691	REAL, DIMENSION(niso,knon) :: yxtrunoff_diag
2692	REAL, DIMENSION(niso,knon) :: yRland_ice
2693	#endif
2694	REAL, DIMENSION(knon) :: ysolsw, ysollw
2695	REAL, DIMENSION(knon) :: yfder
2696	REAL, DIMENSION(knon) :: yrugoro
2697	REAL, DIMENSION(knon) :: yfluxlat
2698	REAL, DIMENSION(knon) :: yfluxbs
2699	REAL, DIMENSION(knon) :: y_d_ts
2700	REAL, DIMENSION(knon) :: y_flux_t1, y_flux_q1
2701	REAL, DIMENSION(knon) :: y_dflux_t, y_dflux_q
2702	#ifdef ISO
2703	REAL, DIMENSION(ntraciso,knon) :: y_flux_xt1
2704	REAL, DIMENSION(ntraciso,knon) :: y_dflux_xt
2705	#endif
2706	REAL, DIMENSION(knon) :: y_flux_u1, y_flux_v1
2707	REAL, DIMENSION(knon) :: y_flux_bs, y_flux0
2708	REAL, DIMENSION(knon) :: yt2m, yq2m, yu10m
2709	INTEGER, DIMENSION(knon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
2710	REAL, DIMENSION(knon) :: yustar
2711	REAL, DIMENSION(knon) :: ywstar
2712	REAL, DIMENSION(knon) :: ywindsp
2713	REAL, DIMENSION(knon) :: yt10m, yq10m
2714	REAL, DIMENSION(knon) :: ypblh
2715	REAL, DIMENSION(knon) :: ylcl
2716	REAL, DIMENSION(knon) :: ycapCL
2717	REAL, DIMENSION(knon) :: yoliqCL
2718	REAL, DIMENSION(knon) :: ycteiCL
2719	REAL, DIMENSION(knon) :: ypblT
2720	REAL, DIMENSION(knon) :: ytherm
2721	REAL, DIMENSION(knon) :: ytrmb1
2722	REAL, DIMENSION(knon) :: ytrmb2
2723	REAL, DIMENSION(knon) :: ytrmb3
2724
2725	REAL, DIMENSION(knon) :: yt2m_x
2726	REAL, DIMENSION(knon) :: yq2m_x
2727	REAL, DIMENSION(knon) :: yt10m_x
2728	REAL, DIMENSION(knon) :: yq10m_x
2729	REAL, DIMENSION(knon) :: yu10m_x
2730	REAL, DIMENSION(knon) :: yustar_x
2731	REAL, DIMENSION(knon) :: ywstar_x
2732	!
2733	REAL, DIMENSION(knon) :: ypblh_x
2734	REAL, DIMENSION(knon) :: ylcl_x
2735	REAL, DIMENSION(knon) :: ycapCL_x
2736	REAL, DIMENSION(knon) :: yoliqCL_x
2737	REAL, DIMENSION(knon) :: ycteiCL_x
2738	REAL, DIMENSION(knon) :: ypblt_x
2739	REAL, DIMENSION(knon) :: ytherm_x
2740	REAL, DIMENSION(knon) :: ytrmb1_x
2741	REAL, DIMENSION(knon) :: ytrmb2_x
2742	REAL, DIMENSION(knon) :: ytrmb3_x
2743
2744	REAL, DIMENSION(knon) :: uzon, vmer
2745	REAL, DIMENSION(knon) :: tair1, qair1, tairsol
2746	REAL, DIMENSION(knon) :: psfce, patm
2747	REAL, DIMENSION(knon) :: qairsol, zgeo1, speed, zri1, pref !speed, zri1, pref, added by Fuxing WANG, 04/03/2015
2748	REAL, DIMENSION(knon) :: yz0h_oupas
2749	REAL, DIMENSION(knon) :: yfluxsens
2750	REAL, DIMENSION(knon) :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
2751	REAL, DIMENSION(knon) :: AcoefH, AcoefQ, BcoefH, BcoefQ
2752	#ifdef ISO
2753	REAL, DIMENSION(ntraciso,knon) :: AcoefXT, BcoefXT
2754	#endif
2755	REAL, DIMENSION(knon) :: AcoefU, AcoefV, BcoefU, BcoefV
2756	REAL, DIMENSION(knon) :: AcoefQBS, BcoefQBS
2757	REAL, DIMENSION(knon) :: ypsref
2758	REAL, DIMENSION(knon) :: yevap, yevap_pot, ytsurf_new, yalb3_new, yicesub_lic
2759	REAL, DIMENSION(knon,nsw) :: yalb_dir_new, yalb_dif_new
2760	REAL, DIMENSION(knon,klev) :: y_d_t, y_d_q, y_d_t_diss, y_d_qbs
2761	REAL, DIMENSION(knon,klev) :: y_d_u, y_d_v
2762	REAL, DIMENSION(knon,klev) :: y_flux_t, y_flux_q, y_flux_qbs
2763	REAL, DIMENSION(knon,klev) :: y_flux_u, y_flux_v
2764	REAL, DIMENSION(knon,klev) :: ycoefh,ycoefm,ycoefq,ycoefqbs
2765	REAL, DIMENSION(knon) :: ycdragh, ycdragq, ycdragm
2766	REAL, DIMENSION(knon,klev) :: yu, yv
2767	REAL, DIMENSION(knon,klev) :: yt, yq, yqbs
2768	#ifdef ISO
2769	REAL, DIMENSION(ntraciso,knon) :: yxtevap
2770	REAL, DIMENSION(ntraciso,knon,klev) :: y_d_xt
2771	REAL, DIMENSION(ntraciso,knon,klev) :: y_flux_xt
2772	REAL, DIMENSION(ntraciso,knon,klev) :: yxt
2773	#endif
2774	REAL, DIMENSION(knon,klev) :: ypplay, ydelp
2775	REAL, DIMENSION(klon,klev),INTENT(IN) :: delp
2776	REAL, DIMENSION(knon,klev+1) :: ypaprs
2777	REAL, DIMENSION(knon,klev+1) :: ytke, yeps
2778	REAL, DIMENSION(knon,nsoilmx) :: ytsoil
2779	REAL, DIMENSION(knon,nvm_lmdz) :: yveget
2780	REAL, DIMENSION(knon,nvm_lmdz) :: ylai
2781	REAL, DIMENSION(knon,nvm_lmdz) :: yheight
2782	REAL, DIMENSION(knon,klev) :: y_d_u_frein
2783	REAL, DIMENSION(knon,klev) :: y_d_v_frein
2784	REAL, DIMENSION(knon,klev) :: y_treedrg
2785
2786	CHARACTER(len=80) :: abort_message
2787	CHARACTER(len=20) :: modname = 'pbl_surface'
2788	LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
2789	LOGICAL, PARAMETER :: check=.FALSE.
2790
2791	REAL, DIMENSION(knon) :: ywake_s, ywake_cstar, ywake_dens
2792	REAL, DIMENSION(knon,klev+1) :: ytke_x, ytke_w, yeps_x, yeps_w
2793	REAL, DIMENSION(knon,klev+1) :: ywake_dltke
2794	REAL, DIMENSION(knon,klev) :: yu_x, yv_x, yu_w, yv_w
2795	REAL, DIMENSION(knon,klev) :: yt_x, yq_x, yt_w, yq_w
2796	REAL, DIMENSION(knon,klev) :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
2797	REAL, DIMENSION(knon,klev) :: ycoefq_x, ycoefq_w
2798	REAL, DIMENSION(knon) :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
2799	REAL, DIMENSION(knon) :: ycdragm_x, ycdragm_w
2800	REAL, DIMENSION(knon) :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
2801	REAL, DIMENSION(knon) :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
2802	REAL, DIMENSION(knon) :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x
2803	REAL, DIMENSION(knon) :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w
2804	REAL, DIMENSION(knon) :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w
2805	REAL, DIMENSION(knon) :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w
2806	REAL, DIMENSION(knon,klev) :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w
2807	REAL, DIMENSION(knon,klev) :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w
2808	REAL, DIMENSION(knon) :: yfluxlat_x, yfluxlat_w
2809	REAL, DIMENSION(knon,klev) :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w
2810	REAL, DIMENSION(knon,klev) :: y_d_t_diss_x, y_d_t_diss_w
2811	REAL, DIMENSION(knon,klev), INTENT(INOUT) :: d_t_diss_x, d_t_diss_w
2812	REAL, DIMENSION(knon,klev) :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w
2813	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
2814	REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
2815	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: fluxlat_x, fluxlat_w
2816	REAL, DIMENSION(knon) :: ybeta
2817	REAL, DIMENSION(knon) :: ybeta_prev
2818	REAL, DIMENSION(knon,klev) :: CcoefH, CcoefQ, DcoefH, DcoefQ
2819	REAL, DIMENSION(knon,klev) :: CcoefU, CcoefV, DcoefU, DcoefV
2820	REAL, DIMENSION(knon,klev) :: CcoefQBS, DcoefQBS
2821	REAL, DIMENSION(knon,klev) :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x
2822	REAL, DIMENSION(knon,klev) :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w
2823	REAL, DIMENSION(knon,klev) :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x
2824	REAL, DIMENSION(knon,klev) :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w
2825	REAL, DIMENSION(knon,klev) :: Kcoef_hq, Kcoef_m, gama_h, gama_q
2826	REAL, DIMENSION(knon,klev) :: gama_qbs, Kcoef_qbs
2827	REAL, DIMENSION(knon,klev) :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x
2828	REAL, DIMENSION(knon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
2829	REAL, DIMENSION(knon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
2830	#ifdef ISO
2831	REAL, DIMENSION(ntraciso,knon,klev) :: yxt_x, yxt_w
2832	REAL, DIMENSION(ntraciso,knon) :: y_flux_xt1_x , y_flux_xt1_w
2833	REAL, DIMENSION(ntraciso,knon,klev) :: y_flux_xt_x,y_d_xt_x
2834	REAL, DIMENSION(ntraciso,knon,klev) :: y_flux_xt_w,y_d_xt_w
2835	REAL, DIMENSION(ntraciso,klon,klev),INTENT(INOUT) :: zxfluxxt_w, zxfluxxt_x
2836	REAL, DIMENSION(ntraciso,klon,klev,nbsrf), INTENT(INOUT) :: flux_xt_x, flux_xt_w
2837	REAL, DIMENSION(ntraciso,knon) :: AcoefXT_x, BcoefXT_x
2838	REAL, DIMENSION(ntraciso,knon) :: AcoefXT_w, BcoefXT_w
2839	REAL, DIMENSION(ntraciso,knon,klev) :: CcoefXT, DcoefXT
2840	REAL, DIMENSION(ntraciso,knon,klev) :: CcoefXT_x, DcoefXT_x
2841	REAL, DIMENSION(ntraciso,knon,klev) :: CcoefXT_w, DcoefXT_w
2842	REAL, DIMENSION(ntraciso,knon,klev) :: gama_xt,gama_xt_x,gama_xt_w
2843	#endif
2844
2845	REAL, DIMENSION(knon) :: yt2m_w
2846	REAL, DIMENSION(knon) :: yq2m_w
2847	REAL, DIMENSION(knon) :: yt10m_w
2848	REAL, DIMENSION(knon) :: yq10m_w
2849	REAL, DIMENSION(knon) :: yu10m_w
2850	REAL, DIMENSION(knon) :: yustar_w
2851	REAL, DIMENSION(knon) :: ywstar_w
2852	!
2853	REAL, DIMENSION(knon) :: ypblh_w
2854	REAL, DIMENSION(knon) :: ylcl_w
2855	REAL, DIMENSION(knon) :: ycapCL_w
2856	REAL, DIMENSION(knon) :: yoliqCL_w
2857	REAL, DIMENSION(knon) :: ycteiCL_w
2858	REAL, DIMENSION(knon) :: ypblt_w
2859	REAL, DIMENSION(knon) :: ytherm_w
2860	REAL, DIMENSION(knon) :: ytrmb1_w
2861	REAL, DIMENSION(knon) :: ytrmb2_w
2862	REAL, DIMENSION(knon) :: ytrmb3_w
2863	!
2864	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
2865	REAL, DIMENSION(knon) :: zgeo1_x, tair1_x, qair1_x, tairsol_x
2866	!
2867	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
2868	REAL, DIMENSION(knon) :: zgeo1_w, tair1_w, qair1_w, tairsol_w
2869	REAL, DIMENSION(knon) :: yus0, yvs0
2870	!
2871	REAL, DIMENSION(knon) :: y_delta_flux_t1
2872	REAL, DIMENSION(knon) :: y_delta_tsurf, y_delta_tsurf_new
2873	REAL, DIMENSION(knon) :: delta_coef, tau_eq
2874	REAL, DIMENSION(knon) :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
2875	REAL, DIMENSION(knon) :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
2876	REAL, DIMENSION(knon) :: y_delta_qsurf
2877	REAL, DIMENSION(knon) :: y_delta_qsats
2878	REAL, DIMENSION(knon) :: yg_T, yg_Q
2879	REAL, DIMENSION(knon) :: yGamma_dTs_phiT, yGamma_dQs_phiQ
2880	REAL, DIMENSION(knon) :: ydTs_ins, ydqs_ins
2881	!
2882	REAL, PARAMETER :: facteur=2./sqrt(3.14)
2883	REAL, PARAMETER :: inertia=2000.
2884	REAL, DIMENSION(knon) :: ydtsurf_th
2885	REAL, DIMENSION(knon) :: Kech_h ! Coefficient d'echange pour l'energie
2886	REAL, DIMENSION(knon) :: Kech_h_x, Kech_h_w
2887	REAL, DIMENSION(knon) :: yts_x, yts_w
2888	REAL, DIMENSION(knon) :: yqsurf_x, yqsurf_w
2889	REAL :: fact_cdrag
2890	REAL :: z1lay
2891	REAL :: vent
2892	REAL, DIMENSION(knon) :: ylwdown ! jg : temporary (ysollwdown)
2893	REAL, DIMENSION(knon) :: ygustiness ! jg : temporary (ysollwdown)
2894	REAL :: zx_qs1, zcor1, zdelta1
2895	REAL, DIMENSION(knon) :: ytoice
2896	REAL, DIMENSION(knon) :: ysnowhgt, yqsnow, ysissnow, yrunoff
2897	REAL, DIMENSION(knon) :: yzmea
2898	REAL, DIMENSION(knon) :: yzsig
2899	REAL, DIMENSION(knon) :: ycldt
2900	REAL, DIMENSION(knon) :: yrmu0
2901	REAL, DIMENSION(knon) :: yri0
2902
2903	REAL, DIMENSION(knon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, &
2904	ydser, ydt_ds, ytkt, ytks, ytaur, ysss
2905	! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser,
2906	! dt_ds, tkt, tks, taur, sss on ocean points
2907	REAL :: missing_val
2908
2909	REAL, DIMENSION(knon,klev) :: ytheta
2910	REAL, DIMENSION(knon,klev) :: ypphii
2911	REAL, DIMENSION(knon,klev) :: ypphi
2912	REAL, DIMENSION(knon,klev) :: ydthetadz
2913	REAL, DIMENSION(knon) :: ydthetadz300
2914	REAL, DIMENSION(knon) :: Ampl
2915	REAL, DIMENSION(knon, nbtersrf) :: yfrac_tersrf, yz0m_tersrf, yz0h_tersrf
2916	REAL, DIMENSION(knon) :: yzxtsol ! temperature at surface
2917	REAL, DIMENSION(knon) :: ypblh_tmp ! temporaire pblh compressed
2918	#ifdef ISO
2919	REAL, DIMENSION(knon) :: h1
2920	INTEGER :: ixt
2921	#endif
2922	IF (using_xios) THEN
2923	missing_val=missing_val_xios
2924	ELSE
2925	missing_val=missing_val_netcdf
2926	ENDIF
2927
2928	yus0(:)=0. ; yvs0(:)=0.
2929
2930	! loop_nbsrf: DO nsrf = 1, nbsrf !<<<<<<<<<<<<<
2931	!<<<<<<<<<<<<<
2932	IF (prt_level >=10) print *,' Loop nsrf ',nsrf
2933	!
2934	IF (iflag_split_ref == 3) THEN
2935	IF (nsrf == is_oce) THEN
2936	iflag_split = 1
2937	ELSE
2938	iflag_split=0
2939	ENDIF !! (nsrf == is_oce)
2940	ELSE
2941	iflag_split = iflag_split_ref
2942	ENDIF !! (iflag_split_ref == 3)
2943
2944	! Search for index(ni) and size(knon) of domaine to treat
2945	! ni(:) = 0
2946	! knon = 0
2947	! DO i = 1, klon
2948	! IF (pctsrf(i,nsrf) > 0.) THEN
2949	! knon = knon + 1
2950	! ni(knon) = i
2951	! ENDIF
2952	! ENDDO
2953
2954	!!! jyg le 19/08/2012
2955	! IF (knon <= 0) THEN
2956	! IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf
2957	! cycle loop_nbsrf
2958	! ENDIF
2959
2960	!!!
2961	! 2b) Initialization of all local variables that will be compressed later
2962	!****************************************************************************************
2963
2964	ypct = 0.0 ; yts = 0.0 ; ysnow = 0.0
2965	yqsurf = 0.0 ; yalb = 0.0 ; yalb_vis = 0.0
2966	yrain_f = 0.0 ; ysnow_f = 0.0 ; ybs_f=0.0 ; yfder = 0.0 ; ysolsw = 0.0
2967	ysollw = 0.0 ; yz0m = 0.0 ; yz0h = 0.0 ; yz0h_oupas = 0.0 ; yu1 = 0.0
2968	yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 ; yqbs1 = 0.0
2969	ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0
2970	yq = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0
2971	yqbs(:,:)=0.0
2972	yrugoro = 0.0 ; ywindsp = 0.0
2973	yfluxlat=0.0 ; y_flux0(:)=0.0
2974	yqsol = 0.0 ; yzxtsol = 0.0
2975
2976	ytke=0.
2977	yeps=0.
2978	yri0(:)=0.
2979	y_treedrg=0.
2980
2981	ysnowhgt = 0.0; yqsnow = 0.0 ; yrunoff = 0.0 ; ytoice =0.0
2982	yalb3_new = 0.0 ; ysissnow = 0.0
2983	ycldt = 0.0 ; yrmu0 = 0.0
2984	y_d_qbs(:,:)=0.0
2985
2986	ytke_x=0. ; ytke_w=0. ; ywake_dltke=0.
2987	yeps_x=0. ; yeps_w=0.
2988	y_d_t_x=0. ; y_d_t_w=0. ; y_d_q_x=0. ; y_d_q_w=0.
2989	yfluxlat_x=0. ; yfluxlat_w=0.
2990	ywake_s=0. ; ywake_cstar=0. ;ywake_dens=0.
2991
2992	tau_eq=0. ; delta_coef=0.
2993	y_delta_flux_t1=0.
2994	ydtsurf_th=0.
2995	yts_x(:)=0. ; yts_w(:)=0.
2996	y_delta_tsurf(:)=0. ; y_delta_qsurf(:)=0.
2997	yqsurf_x(:)=0. ; yqsurf_w(:)=0.
2998	yg_T(:) = 0. ; yg_Q(:) = 0.
2999	yGamma_dTs_phiT(:) = 0. ; yGamma_dQs_phiQ(:) = 0.
3000	ydTs_ins(:) = 0. ; ydqs_ins(:) = 0.
3001
3002	ytsoil = 999999.
3003	y_d_u_frein(:,:)=0.
3004	y_d_v_frein(:,:)=0.
3005
3006	#ifdef ISO
3007	yxtrain_f = 0.0 ; yxtsnow_f = 0.0
3008	yxtsnow = 0.0
3009	yxt = 0.0
3010	yxtsol = 0.0
3011	flux_xt = 0.0
3012	yRland_ice = 0.0
3013
3014	y_dflux_xt = 0.0
3015	y_d_xt_x=0. ; y_d_xt_w=0.
3016	#endif
3017
3018	! >> PC
3019	!the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
3020	!the ORCHIDEE grid and as such should be defined in yfields_out(knon,nbcf_out) but
3021	!the knon variable is not known at that level of pbl_surface_mod
3022
3023	!the yfields_in variable is defined in (klon,nbcf_in) even if it is used on the
3024	!ORCHIDEE grid and as such should be defined in yfields_in(knon,nbcf_in) but the
3025	!knon variable is not known at that level of pbl_surface_mod
3026	yfields_out(:,:) = 0.
3027
3028	ypphi = 0.0
3029
3030
3031
3032
3033	!****************************************************************************************
3034	! 5) Compress variables
3035	!
3036	!****************************************************************************************
3037
3038	! Provisional : set ybeta to standard values
3039	IF (nsrf .NE. is_ter) THEN
3040	ybeta(1:knon) = 1.
3041	ELSE
3042	IF (iflag_split .EQ. 0) THEN
3043	ybeta(1:knon) = 1.
3044	ELSE
3045	DO j = 1, knon
3046	i = ni(j)
3047	ybeta(j) = beta(i,nsrf)
3048	ENDDO
3049	ENDIF ! (iflag_split .LE.1)
3050	ENDIF ! (nsrf .NE. is_ter)
3051	!
3052	DO j = 1, knon
3053	i = ni(j)
3054	ypct(j) = pctsrf(i,nsrf)
3055	yts(j) = ts(i,nsrf)
3056	ysnow(j) = snow(i,nsrf)
3057	yqsurf(j) = qsurf(i,nsrf)
3058	yalb(j) = alb(i,nsrf)
3059	yalb_vis(j) = alb_dir(i,1,nsrf)
3060	IF (nsw==6) THEN
3061	yalb_vis(j)=(alb_dir(i,1,nsrf)SFRWL(1)+alb_dir(i,2,nsrf)SFRWL(2) &
3062	+alb_dir(i,3,nsrf)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
3063	ENDIF
3064	yrain_f(j) = rain_f(i)
3065	ysnow_f(j) = snow_f(i)
3066	ybs_f(j) = bs_f(i)
3067	yagesno(j) = agesno(i,nsrf)
3068	yfder(j) = fder(i)
3069	ylwdown(j) = lwdown_m(i)
3070	ygustiness(j) = gustiness(i)
3071	ysolsw(j) = solsw(i,nsrf)
3072	ysollw(j) = sollw(i,nsrf)
3073	yz0m(j) = z0m(i,nsrf)
3074	yz0h(j) = z0h(i,nsrf)
3075	yrugoro(j) = rugoro(i)
3076	yu1(j) = u(i,1)
3077	yv1(j) = v(i,1)
3078	yqbs1(j) = qbs(i,1)
3079	ypaprs(j,klev+1) = paprs(i,klev+1)
3080	ywindsp(j) = windsp(i,nsrf)
3081	yzmea(j) = zmea(i)
3082	yzsig(j) = zsig(i)
3083	ycldt(j) = cldt(i)
3084	yrmu0(j) = rmu0(i)
3085	y_delta_tsurf(j)=delta_tsurf(i,nsrf)
3086	yfluxbs(j)=0.0
3087	y_flux_bs(j) = 0.0
3088	!!!
3089	#ifdef ISO
3090	DO ixt=1,ntraciso
3091	yxtrain_f(ixt,j) = xtrain_f(ixt,i)
3092	yxtsnow_f(ixt,j) = xtsnow_f(ixt,i)
3093	ENDDO
3094	DO ixt=1,niso
3095	yxtsnow(ixt,j) = xtsnow(ixt,i,nsrf)
3096	ENDDO
3097	DO ixt=1,niso
3098	yRland_ice(ixt,j)= Rland_ice(ixt,i)
3099	ENDDO
3100	#ifdef ISOVERIF
3101	IF (iso_eau >= 0) THEN
3102	call iso_verif_egalite_choix(ysnow_f(j), &
3103	& yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', &
3104	& errmax,errmaxrel)
3105	call iso_verif_egalite_choix(ysnow(j), &
3106	& yxtsnow(iso_eau,j),'pbl_surf_mod 872', &
3107	& errmax,errmaxrel)
3108	ENDIF
3109	#endif
3110	#ifdef ISOVERIF
3111	DO ixt=1,ntraciso
3112	call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921')
3113	ENDDO
3114	#endif
3115	#endif
3116	ENDDO
3117	!--compressing fields_out onto ORCHIDEE grid
3118	!--these fields are shared and used directly surf_land_orchidee_mod
3119	DO n = 1, nbcf_out
3120	DO j = 1, knon
3121	i = ni(j)
3122	yfields_out(j,n) = fields_out(i,n)
3123	ENDDO
3124	ENDDO
3125
3126	DO k = 1, klev
3127	DO j = 1, knon
3128	i = ni(j)
3129	ypaprs(j,k) = paprs(i,k)
3130	ypplay(j,k) = pplay(i,k)
3131	ydelp(j,k) = delp(i,k)
3132	ENDDO
3133	ENDDO
3134
3135	DO k = 1, klev+1
3136	DO j = 1, knon
3137	i = ni(j)
3138	ytke(j,k) = tke_x(i,k,nsrf)
3139	ENDDO
3140	ENDDO
3141
3142	DO k = 1, klev
3143	DO j = 1, knon
3144	i = ni(j)
3145	y_treedrg(j,k) = treedrg(i,k,nsrf)
3146	yu(j,k) = u(i,k)
3147	yv(j,k) = v(i,k)
3148	yt(j,k) = t(i,k)
3149	yq(j,k) = q(i,k)
3150	yqbs(j,k)=qbs(i,k)
3151	ypphi(j,k) = pphi(i,k)
3152
3153	#ifdef ISO
3154	DO ixt=1,ntraciso
3155	yxt(ixt,j,k) = xt(ixt,i,k)
3156	ENDDO !DO ixt=1,ntraciso
3157	#endif
3158	ENDDO
3159	ENDDO
3160	!
3161	IF (iflag_split.GE.1) THEN
3162
3163	DO k = 1, klev
3164	DO j = 1, knon
3165	i = ni(j)
3166	yu_x(j,k) = u(i,k)
3167	yv_x(j,k) = v(i,k)
3168	yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k)
3169	yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k)
3170	yu_w(j,k) = u(i,k)
3171	yv_w(j,k) = v(i,k)
3172	yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k)
3173	yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
3174	#ifdef ISO
3175	DO ixt=1,ntraciso
3176	yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k)
3177	yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k)
3178	ENDDO
3179	#endif
3180	ENDDO
3181	ENDDO
3182
3183	IF (prt_level .ge. 10) THEN
3184	print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)
3185	print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)
3186	ENDIF
3187
3188	DO k = 1, klev+1
3189	DO j = 1, knon
3190	i = ni(j)
3191	ytke_x(j,k) = tke_x(i,k,nsrf)
3192	ytke(j,k) = tke_x(i,k,nsrf)+wake_s(i)*wake_dltke(i,k,nsrf)
3193	ytke_w(j,k) = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
3194	ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
3195	ENDDO
3196	ENDDO
3197
3198	DO j = 1, knon
3199	i = ni(j)
3200	ywake_s(j)=wake_s(i)
3201	ywake_cstar(j)=wake_cstar(i)
3202	ywake_dens(j)=wake_dens(i)
3203	ENDDO
3204
3205	DO j=1,knon
3206	yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j)
3207	yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j)
3208	ENDDO
3209
3210	ENDIF ! (iflag_split .ge.1)
3211
3212	DO k = 1, nsoilmx
3213	DO j = 1, knon
3214	i = ni(j)
3215	ytsoil(j,k) = ftsoil(i,k,nsrf)
3216	ENDDO
3217	ENDDO
3218
3219	! qsol(water height in soil) only for bucket continental model
3220	IF ( nsrf .EQ. is_ter .AND. .NOT. ok_veget ) THEN
3221	DO j = 1, knon
3222	i = ni(j)
3223	yqsol(j) = qsol(i)
3224	#ifdef ISO
3225	DO ixt=1,niso
3226	yxtsol(ixt,j) = xtsol(ixt,i)
3227	ENDDO
3228	#endif
3229	ENDDO
3230	ENDIF
3231
3232	if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
3233	if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
3234	ydelta_sal(:knon) = delta_sal(ni(:knon))
3235	ydelta_sst(:knon) = delta_sst(ni(:knon))
3236	ydter(:knon) = dter(ni(:knon))
3237	ydser(:knon) = dser(ni(:knon))
3238	ydt_ds(:knon) = dt_ds(ni(:knon))
3239	end if
3240
3241	yds_ns(:knon) = ds_ns(ni(:knon))
3242	ydt_ns(:knon) = dt_ns(ni(:knon))
3243	end if
3244
3245	!****************************************************************************************
3246	! 6a) Calculate coefficients for turbulent diffusion at surface, cdragh et cdragm.
3247	!
3248	!****************************************************************************************
3249
3250
3251	IF (iflag_split .eq.0) THEN
3252
3253	DO i = 1, knon
3254	zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3255	* (ypaprs(i,1)-ypplay(i,1))
3256	speed(i) = SQRT(yu(i,1)2+yv(i,1)2)
3257	ENDDO
3258
3259	!!! AM heterogeneous continental subsurfaces
3260	IF (nsrf .EQ. is_ter) THEN
3261	! compute time-dependent effective surface parameters (function of zgeo1) !! AM
3262	IF (iflag_hetero_surf .GT. 0) THEN
3263	DO n=1,nbtersrf
3264	DO j=1,knon
3265	i = ni(j)
3266	yfrac_tersrf(j,n) = frac_tersrf(i,n)
3267	yz0m_tersrf(j,n) = z0m_tersrf(i,n)
3268	IF (ratio_z0m_z0h_tersrf(i,n) .NE. 0.) THEN
3269	yz0h_tersrf(j,n) = z0m_tersrf(i,n) / ratio_z0m_z0h_tersrf(i,n)
3270	ELSE
3271	yz0h_tersrf(j,n) = 0.
3272	ENDIF
3273	ENDDO
3274	ENDDO
3275	!
3276	CALL eff_surf_param(knon, nbtersrf, yz0m_tersrf, yfrac_tersrf, 'CDN', yz0m, zgeo1/RG)
3277	CALL eff_surf_param(knon, nbtersrf, yz0h_tersrf, yfrac_tersrf, 'CDN', yz0h, zgeo1/RG)
3278	!
3279	ENDIF
3280	ENDIF
3281
3282	!
3283	ypblh_tmp(:)=s_pblh(ni(:))
3284	CALL cdrag(knon, nsrf, &
3285	speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), ypblh_tmp, &
3286	yts, yqsurf, yz0m, yz0h, yri0, 0, &
3287	ycdragm, ycdragh, zri1, pref, rain_f, yzxtsol, ypplay(:,1))
3288	s_pblh(ni(:)) = ypblh_tmp(:)
3289	! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
3290	IF (ok_prescr_ust) THEN
3291	DO i = 1, knon
3292	print *,'ycdragm avant=',ycdragm(i)
3293	vent= sqrt(yu(i,1)yu(i,1)+yv(i,1)yv(i,1))
3294	ycdragm(i) = ust*ust/(1.+vent)/vent
3295	ENDDO
3296	ENDIF
3297
3298	IF (prt_level >=10) print *,'cdrag -> ycdragh ', ycdragh(1:knon)
3299	ELSE !(iflag_split .eq.0)
3300
3301	DO i = 1, knon
3302	zgeo1_x(i) = RD * yt_x(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3303	* (ypaprs(i,1)-ypplay(i,1))
3304	speed_x(i) = SQRT(yu_x(i,1)2+yv_x(i,1)2)
3305	ENDDO
3306
3307	ypblh_tmp(:)=s_pblh_x(ni(:))
3308
3309	CALL cdrag(knon, nsrf, &
3310	speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),ypblh,&
3311	yts_x, yqsurf_x, yz0m, yz0h, yri0, 0, &
3312	ycdragm_x, ycdragh_x, zri1_x, pref_x, rain_f, yzxtsol, ypplay(:,1) )
3313
3314	s_pblh_x(ni(:)) = ypblh_tmp(:)
3315	! --- special Dice. JYG+MPL 25112013
3316	IF (ok_prescr_ust) THEN
3317	DO i = 1, knon
3318	vent= sqrt(yu_x(i,1)yu_x(i,1)+yv_x(i,1)yv_x(i,1))
3319	ycdragm_x(i) = ust*ust/(1.+vent)/vent
3320	ENDDO
3321	ENDIF
3322	IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x(1:knon)
3323
3324	DO i = 1, knon
3325	zgeo1_w(i) = RD * yt_w(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3326	* (ypaprs(i,1)-ypplay(i,1))
3327	speed_w(i) = SQRT(yu_w(i,1)2+yv_w(i,1)2)
3328	ENDDO
3329
3330	ypblh_tmp(:)=s_pblh_w(ni(:))
3331	CALL cdrag(knon, nsrf, &
3332	speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),s_pblh_w,&
3333	yts_w, yqsurf_w, yz0m, yz0h, yri0, 0, &
3334	ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, yzxtsol, ypplay(:,1) )
3335
3336	s_pblh_w(ni(:)) = ypblh_tmp(:)
3337	!
3338	IF(ok_bug_zg_wk_pbl) THEN
3339	zgeo1(1:knon) = wake_s(1:knon)zgeo1_w(1:knon) + (1.-wake_s(1:knon))zgeo1_x(1:knon)
3340	ELSE
3341	zgeo1(1:knon) = ywake_s(1:knon)zgeo1_w(1:knon) + (1.-ywake_s(1:knon))zgeo1_x(1:knon)
3342	ENDIF
3343
3344	! --- special Dice. JYG+MPL 25112013 puis BOMEX
3345	IF (ok_prescr_ust) THEN
3346	DO i = 1, knon
3347	vent= sqrt(yu_w(i,1)yu_w(i,1)+yv_w(i,1)yv_w(i,1))
3348	ycdragm_w(i) = ust*ust/(1.+vent)/vent
3349	ENDDO
3350	ENDIF
3351	IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w(1:knon)
3352	ENDIF ! (iflag_split .eq.0)
3353
3354
3355	!****************************************************************************************
3356	! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm.
3357	!
3358	!****************************************************************************************
3359
3360	IF (iflag_split .eq.0) THEN
3361
3362	IF (prt_level >=10) THEN
3363	print *,' args coef_diff_turb: yu ', yu(1:knon,:)
3364	print *,' args coef_diff_turb: yv ', yv(1:knon,:)
3365	print *,' args coef_diff_turb: yq ', yq(1:knon,:)
3366	print *,' args coef_diff_turb: yt ', yt(1:knon,:)
3367	print *,' args coef_diff_turb: yts ', yts(1:knon)
3368	print *,' args coef_diff_turb: yz0m ', yz0m(1:knon)
3369	print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)
3370	print *,' args coef_diff_turb: ycdragm ', ycdragm(1:knon)
3371	print *,' args coef_diff_turb: ycdragh ', ycdragh(1:knon)
3372	print *,' args coef_diff_turb: ytke ', ytke(1:knon,:)
3373	ENDIF
3374
3375	IF (iflag_pbl>=50) THEN
3376	CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm, ycdragh,yus0,yvs0,yts, &
3377	yu, yv,yt,yq,ypplay,ypaprs, &
3378	ytke,yeps, ycoefm, ycoefh)
3379
3380	ELSE
3381
3382	CALL coef_diff_turb(dtime, nsrf, knon, ni, &
3383	ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
3384	ycoefm, ycoefh, ytke, yeps, y_treedrg)
3385
3386	IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
3387	! In this case, coef_diff_turb is called for the Cd only
3388	DO k = 2, klev
3389	DO j = 1, knon
3390	i = ni(j)
3391	ycoefh(j,k) = zcoefh(i,k,nsrf)
3392	ycoefm(j,k) = zcoefm(i,k,nsrf)
3393	ENDDO
3394	ENDDO
3395	ENDIF
3396
3397	ENDIF ! iflag_pbl >= 50
3398
3399	IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh(1:knon,:)
3400
3401
3402	ELSE !(iflag_split .eq.0)
3403
3404
3405	IF (prt_level >=10) THEN
3406	print *,' args coef_diff_turb: yu_x ', yu_x(1:knon,:)
3407	print *,' args coef_diff_turb: yv_x ', yv_x(1:knon,:)
3408	print *,' args coef_diff_turb: yq_x ', yq_x(1:knon,:)
3409	print *,' args coef_diff_turb: yt_x ', yt_x(1:knon,:)
3410	print *,' args coef_diff_turb: yts_x ', yts_x(1:knon)
3411	print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)
3412	print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x(1:knon)
3413	print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x(1:knon)
3414	print *,' args coef_diff_turb: ytke_x ', ytke_x(1:knon,:)
3415	ENDIF
3416
3417
3418	IF (iflag_pbl>=50) THEN
3419
3420	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), &
3421	yu_x(1:knon,:),yv_x(1:knon,:),yt_x(1:knon,:),yq_x(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:), &
3422	ytke_x(1:knon,:),yeps_x(1:knon,:),ycoefm_x(1:knon,:), ycoefh_x(1:knon,:))
3423
3424	ELSE
3425
3426	CALL coef_diff_turb(dtime, nsrf, knon, ni, &
3427	ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf_x, ycdragm_x, &
3428	ycoefm_x, ycoefh_x, ytke_x,yeps_x,y_treedrg)
3429
3430	!FC doit on le mettre ( on ne l utilise pas si il y a du spliting)
3431	IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
3432	! In this case, coef_diff_turb is called for the Cd only
3433	DO k = 2, klev
3434	DO j = 1, knon
3435	i = ni(j)
3436	ycoefh_x(j,k) = zcoefh(i,k,nsrf)
3437	ycoefm_x(j,k) = zcoefm(i,k,nsrf)
3438	ENDDO
3439	ENDDO
3440	ENDIF
3441
3442	ENDIF ! iflag_pbl >= 50
3443
3444	IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x(1:knon,:)
3445	!
3446	IF (prt_level >=10) THEN
3447	print *,' args coef_diff_turb: yu_w ', yu_w(1:knon,:)
3448	print *,' args coef_diff_turb: yv_w ', yv_w(1:knon,:)
3449	print *,' args coef_diff_turb: yq_w ', yq_w(1:knon,:)
3450	print *,' args coef_diff_turb: yt_w ', yt_w(1:knon,:)
3451	print *,' args coef_diff_turb: yts_w ', yts_w(1:knon)
3452	print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)
3453	print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w(1:knon)
3454	print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w(1:knon)
3455	print *,' args coef_diff_turb: ytke_w ', ytke_w(1:knon,:)
3456	ENDIF
3457
3458	IF (iflag_pbl>=50) THEN
3459
3460	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), &
3461	yu_w(1:knon,:),yv_w(1:knon,:),yt_w(1:knon,:),yq_w(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:), &
3462	ytke_w(1:knon,:),yeps_w(1:knon,:),ycoefm_w(1:knon,:),ycoefh_w(1:knon,:))
3463
3464	ELSE
3465
3466	CALL coef_diff_turb(dtime, nsrf, knon, ni, &
3467	ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf_w, ycdragm_w, &
3468	ycoefm_w, ycoefh_w, ytke_w,yeps_w,y_treedrg)
3469
3470	IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
3471	! In this case, coef_diff_turb is called for the Cd only
3472	DO k = 2, klev
3473	DO j = 1, knon
3474	i = ni(j)
3475	ycoefh_w(j,k) = zcoefh(i,k,nsrf)
3476	ycoefm_w(j,k) = zcoefm(i,k,nsrf)
3477	ENDDO
3478	ENDDO
3479	ENDIF
3480
3481	ENDIF ! iflag_pbl >= 50
3482
3483
3484	IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w(1:knon,:)
3485
3486	!!!jyg le 10/04/2013
3487	!! En attendant de traiter le transport des traceurs dans les poches froides, formule
3488	!! arbitraire pour ycoefh et ycoefm
3489	DO k = 2,klev
3490	DO j = 1,knon
3491	ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k))
3492	ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k))
3493	ENDDO
3494	ENDDO
3495
3496
3497	ENDIF ! (iflag_split .eq.0)
3498
3499
3500	!****************************************************************************************
3501	!
3502	! 8) "La descente" - "The downhill"
3503	!
3504	! climb_hq_down and climb_wind_down calculate the coefficients
3505	! Ccoef_X et Dcoef_X for X=[H, Q, U, V].
3506	! Only the coefficients at surface for H and Q are returned.
3507	!
3508	!****************************************************************************************
3509
3510	! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q
3511	IF (iflag_split .eq.0) THEN
3512
3513	CALL climb_hq_down(knon, ni, ycoefh, ypaprs, ypplay, &
3514	ydelp, yt, yq, dtime, &
3515	CcoefH, CcoefQ, DcoefH, DcoefQ, &
3516	Kcoef_hq, gama_q, gama_h, &
3517	AcoefH, AcoefQ, BcoefH, BcoefQ &
3518	#ifdef ISO
3519	& ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT &
3520	#endif
3521	& )
3522	ELSE !(iflag_split .eq.0)
3523	CALL climb_hq_down(knon, ni, ycoefh_x, ypaprs, ypplay, &
3524	ydelp, yt_x, yq_x, dtime, &
3525	CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
3526	Kcoef_hq_x, gama_q_x, gama_h_x, &
3527	AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x &
3528	#ifdef ISO
3529	& ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x &
3530	#endif
3531	& )
3532
3533	IF (prt_level >=10) THEN
3534	PRINT *,'pbl_surface (climb_hq_down.x->) AcoefH_x ',AcoefH_x
3535	PRINT *,'pbl_surface (climb_hq_down.x->) AcoefQ_x ',AcoefQ_x
3536	PRINT *,'pbl_surface (climb_hq_down.x->) BcoefH_x ',BcoefH_x
3537	PRINT *,'pbl_surface (climb_hq_down.x->) BcoefQ_x ',BcoefQ_x
3538	ENDIF
3539
3540	CALL climb_hq_down(knon, ni, ycoefh_w, ypaprs, ypplay, &
3541	ydelp, yt_w, yq_w, dtime, &
3542	CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
3543	Kcoef_hq_w, gama_q_w, gama_h_w, &
3544	AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w &
3545	#ifdef ISO
3546	& ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w &
3547	#endif
3548	& )
3549
3550	IF (prt_level >=10) THEN
3551	PRINT *,'pbl_surface (climb_hq_down.w->) AcoefH_w ',AcoefH_w
3552	PRINT *,'pbl_surface (climb_hq_down.w->) AcoefQ_w ',AcoefQ_w
3553	PRINT *,'pbl_surface (climb_hq_down.w->) BcoefH_w ',BcoefH_w
3554	PRINT *,'pbl_surface (climb_hq_down.w->) BcoefQ_w ',BcoefQ_w
3555	ENDIF
3556
3557	ENDIF ! (iflag_split .eq.0)
3558
3559
3560	! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
3561	IF (iflag_split .eq.0) THEN
3562	CALL climb_wind_down(knon, ni, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
3563	CcoefU, CcoefV, DcoefU, DcoefV, &
3564	Kcoef_m, alf_1, alf_2, &
3565	AcoefU, AcoefV, BcoefU, BcoefV)
3566	ELSE ! (iflag_split .eq.0)
3567	CALL climb_wind_down(knon, ni, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
3568	CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
3569	Kcoef_m_x, alf_1_x, alf_2_x, &
3570	AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x)
3571
3572	CALL climb_wind_down(knon, ni, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, &
3573	CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
3574	Kcoef_m_w, alf_1_w, alf_2_w, &
3575	AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w)
3576	ENDIF ! (iflag_split .eq.0)
3577
3578	! For blowing snow:
3579	IF (ok_bs) THEN
3580	! following Bintanja et al 2000, part II and Vionnet V PhD thesis
3581	! we assume that the eddy diffsivity coefficient for
3582	! suspended particles is a fraction of Kh
3583	do k=1,klev
3584	do j=1,knon
3585	ycoefqbs(j,k)=ycoefh(j,k)*zeta_bs
3586	enddo
3587	enddo
3588	CALL climb_qbs_down(knon, ni, ycoefqbs, ypaprs, ypplay, &
3589	ydelp, yt, yqbs, dtime, &
3590	CcoefQBS, DcoefQBS, &
3591	Kcoef_qbs, gama_qbs, &
3592	AcoefQBS, BcoefQBS)
3593	ENDIF
3594
3595	!****************************************************************************************
3596	! 9) Small calculations
3597	!
3598	!****************************************************************************************
3599
3600	! - Reference pressure is given the values at surface level
3601	ypsref(:) = ypaprs(:,1)
3602
3603	! - CO2 field on 2D grid to be sent to ORCHIDEE
3604	! Transform to compressed field
3605	IF (carbon_cycle_cpl) THEN
3606	DO i=1,knon
3607	r_co2_ppm(i) = co2_send(ni(i))
3608	ENDDO
3609	ELSE
3610	r_co2_ppm(:) = co2_ppm ! Constant field
3611	ENDIF
3612
3613	!!! nrlmd le 02/05/2011 -----------------------On raccorde les 2 colonnes dans la couche 1
3614
3615	IF (iflag_split .eq. 0) THEN
3616	yt1(:) = yt(:,1)
3617	yq1(:) = yq(:,1)
3618	#ifdef ISO
3619	yxt1(:,:) = yxt(:,:,1)
3620	#endif
3621
3622	ELSE IF (iflag_split .ge. 1) THEN
3623	#ifdef ISO
3624	call abort_physic('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1)
3625	#endif
3626
3627	!
3628	! Cdragq computation
3629	! ------------------
3630	!******************************************************************************
3631	! Cdragq computed from cdrag
3632	! The difference comes only from a factor (f_z0qh_oce) on z0, so that
3633	! it can be computed inside wx_pbl0_merge
3634	! More complicated appraches may require the propagation through
3635	! pbl_surface of an independant cdragq variable.
3636	!******************************************************************************
3637	!
3638	IF ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce) THEN
3639	! Si on suit les formulations par exemple de Tessel, on
3640	! a z0h=0.4nu/u, z0q=0.62nu/u, d'ou f_z0qh_oce=0.62/0.4=1.55
3641	!! ycdragq_x(1:knon)=ycdragh_x(1:knon)* &
3642	!! log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
3643	!! ycdragq_w(1:knon)=ycdragh_w(1:knon)* &
3644	!! log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
3645	!
3646	DO j = 1,knon
3647	z1lay = zgeo1(j)/RG
3648	fact_cdrag = log(z1lay/yz0h(j))/log(z1lay/(f_z0qh_oce*yz0h(j)))
3649	ycdragq_x(j)=ycdragh_x(j)*fact_cdrag
3650	ycdragq_w(j)=ycdragh_w(j)*fact_cdrag
3651	ENDDO ! j = 1,knon
3652
3653	ELSE
3654	ycdragq_x(1:knon)=ycdragh_x(1:knon)
3655	ycdragq_w(1:knon)=ycdragh_w(1:knon)
3656	ENDIF ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
3657	!
3658	CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s, &
3659	yts, y_delta_tsurf, ygustiness, &
3660	yt_x, yt_w, yq_x, yq_w, &
3661	yu_x, yu_w, yv_x, yv_w, &
3662	ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
3663	ycdragm_x, ycdragm_w, &
3664	AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
3665	AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
3666	BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
3667	BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
3668	Kech_h_x, Kech_h_w, Kech_h &
3669	)
3670	CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta, &
3671	BcoefQ_x, BcoefQ_w &
3672	)
3673	CALL wx_pbl0_merge(knon, ypplay, ypaprs, &
3674	ywake_s, ydTs0, ydqs0, &
3675	yt_x, yt_w, yq_x, yq_w, &
3676	yu_x, yu_w, yv_x, yv_w, &
3677	ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
3678	ycdragm_x, ycdragm_w, &
3679	AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
3680	AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
3681	BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
3682	BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
3683	AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
3684	BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
3685	ycdragh, ycdragq, ycdragm, &
3686	yt1, yq1, yu1, yv1 &
3687	)
3688	IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
3689	CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
3690	ywake_s, ybeta, ywake_cstar, ywake_dens, &
3691	AcoefH_x, AcoefH_w, &
3692	BcoefH_x, BcoefH_w, &
3693	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
3694	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3695	HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
3696	phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
3697	yg_T, yg_Q, &
3698	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
3699	ydTs_ins, ydqs_ins &
3700	)
3701	ELSE !
3702	AcoefH(:) = AcoefH_0(:)
3703	AcoefQ(:) = AcoefQ_0(:)
3704	BcoefH(:) = BcoefH_0(:)
3705	BcoefQ(:) = BcoefQ_0(:)
3706	yg_T(:) = 0.
3707	yg_Q(:) = 0.
3708	yGamma_dTs_phiT(:) = 0.
3709	yGamma_dQs_phiQ(:) = 0.
3710	ydTs_ins(:) = 0.
3711	ydqs_ins(:) = 0.
3712	ENDIF ! (iflag_split .eq. 2)
3713	ENDIF ! (iflag_split .eq.0)
3714
3715	IF (prt_level >=10) THEN
3716	DO i = 1, min(1,knon)
3717	PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(i,:)
3718	PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(i,:)
3719	PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(i,:)
3720	PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(i,:)
3721	PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
3722	AcoefH(i), AcoefQ(i), AcoefU(i), AcoefV(i)
3723	PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
3724	BcoefH(i), BcoefQ(i), BcoefU(i), BcoefV(i)
3725	ENDDO
3726
3727	ENDIF
3728
3729	! Save initial value of z0h for use in evappot (z0h wiil be computed again in the surface models)
3730	yz0h_old(1:knon) = yz0h(1:knon)
3731	!
3732	!****************************************************************************************
3733	!
3734	! Calulate t2m and q2m for the case of calculation at land grid points
3735	! t2m and q2m are needed as input to ORCHIDEE
3736	!
3737	!****************************************************************************************
3738	IF (nsrf == is_ter) THEN
3739
3740	DO i = 1, knon
3741	zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
3742	* (ypaprs(i,1)-ypplay(i,1))
3743	ENDDO
3744
3745	! Calculate the temperature et relative humidity at 2m and the wind at 10m
3746	IF (iflag_new_t2mq2m==1) THEN
3747	CALL stdlevvarn(knon, knon, is_ter, zxli, &
3748	yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
3749	yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
3750	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
3751	yn2mout)
3752	ELSE
3753	CALL stdlevvar(knon, knon, is_ter, zxli, &
3754	yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
3755	yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
3756	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, yzxtsol)
3757	ENDIF
3758
3759	ENDIF
3760
3761	!****************************************************************************************
3762	!
3763	! 10) Switch according to current surface
3764	! It is necessary to start with the continental surfaces because the ocean
3765	! needs their run-off.
3766	!
3767	!****************************************************************************************
3768	SELECT CASE(nsrf)
3769
3770	CASE(is_ter)
3771	CALL surf_land(itap, dtime, date0, jour, knon, ni,&
3772	rlon, rlat, yrmu0, &
3773	debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
3774	yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
3775	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3776	AcoefU, AcoefV, BcoefU, BcoefV, &
3777	ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
3778	ylwdown, yq2m, yt2m, &
3779	ysnow, yqsol, yagesno, ytsoil, &
3780	yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,yfluxbs,&
3781	yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
3782	y_flux_u1, y_flux_v1, &
3783	yveget,ylai,yheight, tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
3784	cdragm_tersrf, cdragh_tersrf, &
3785	swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
3786	#ifdef ISO
3787	& ,yxtrain_f, yxtsnow_f,yxt1, &
3788	& yxtsnow,yxtsol,yxtevap,h1, &
3789	& yrunoff_diag,yxtrunoff_diag,yRland_ice &
3790	#endif
3791	& )
3792
3793	tsurf_tersrf(:,:) = tsurf_new_tersrf(:,:) ! for next time step
3794
3795	IF (ifl_pbltree .ge. 1) THEN
3796	CALL freinage(knon, knon, yu, yv, yt, &
3797	yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
3798	ENDIF
3799
3800
3801	! Special DICE MPL 05082013 puis BOMEX
3802	IF (ok_prescr_ust) THEN
3803	DO j=1,knon
3804	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)
3805	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)
3806	ENDDO
3807	ENDIF
3808
3809	#ifdef ISOVERIF
3810	DO j=1,knon
3811	DO ixt=1,ntraciso
3812	CALL iso_verif_noNaN(yxtevap(ixt,j), &
3813	& 'pbl_surface 1056a: apres surf_land')
3814	ENDDO
3815	DO ixt=1,niso
3816	CALL iso_verif_noNaN(yxtsol(ixt,j), &
3817	& 'pbl_surface 1056b: apres surf_land')
3818	ENDDO
3819	ENDDO
3820	#endif
3821	#ifdef ISOVERIF
3822
3823	DO j=1,knon
3824	IF (iso_eau >= 0) THEN
3825	CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
3826	& ysnow(j),'pbl_surf_mod 1043')
3827	ENDIF !if (iso_eau.gt.0) then
3828	ENDDO !DO i=1,klon
3829	#endif
3830
3831	CASE(is_lic)
3832	IF (landice_opt .LT. 2) THEN
3833	! Land ice is treated by LMDZ and not by ORCHIDEE
3834	CALL surf_landice(itap, dtime, knon, ni, &
3835	rlon, rlat, debut, lafin, &
3836	yrmu0, ylwdown, yalb, zgeo1, &
3837	ysolsw, ysollw, yts, ypplay(:,1), &
3838	ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
3839	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3840	AcoefU, AcoefV, BcoefU, BcoefV, &
3841	AcoefQBS, BcoefQBS, &
3842	ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
3843	ysnow, yqsurf, yqsol,yqbs1, yagesno, &
3844	ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yicesub_lic, yfluxsens,yfluxlat, &
3845	yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, &
3846	yzmea, yzsig, ycldt, &
3847	ysnowhgt, yqsnow, ytoice, ysissnow, &
3848	yalb3_new, yrunoff, &
3849	y_flux_u1, y_flux_v1 &
3850	#ifdef ISO
3851	& ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
3852	& ,yxtsnow,yxtsol,yxtevap &
3853	#endif
3854	& )
3855
3856	DO j = 1, knon
3857	i = ni(j)
3858	alb3_lic(i) = yalb3_new(j)
3859	snowhgt(i) = ysnowhgt(j)
3860	qsnow(i) = yqsnow(j)
3861	to_ice(i) = ytoice(j)
3862	sissnow(i) = ysissnow(j)
3863	runoff(i) = yrunoff(j)
3864	icesub_lic(i) = yicesub_lic(j)*ypct(j)
3865	ENDDO
3866	! Martin
3867	! Special DICE MPL 05082013 puis BOMEX MPL 20150410
3868	IF (ok_prescr_ust) THEN
3869	DO j=1,knon
3870	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)
3871	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)
3872	ENDDO
3873	ENDIF
3874
3875	#ifdef ISOVERIF
3876	DO j=1,knon
3877	DO ixt=1,ntraciso
3878	CALL iso_verif_noNaN(yxtevap(ixt,j), &
3879	& 'pbl_surface 1095a: apres surf_landice')
3880	ENDDO
3881	do ixt=1,niso
3882	call iso_verif_noNaN(yxtsol(ixt,j), &
3883	& 'pbl_surface 1095b: apres surf_landice')
3884	enddo
3885	enddo
3886	#endif
3887	#ifdef ISOVERIF
3888
3889	do j=1,knon
3890	IF (iso_eau >= 0) THEN
3891	CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
3892	& ysnow(j),'pbl_surf_mod 1064')
3893	ENDIF !if (iso_eau >= 0) THEN
3894	ENDDO !DO i=1,klon
3895	#endif
3896
3897	END IF
3898
3899	CASE(is_oce)
3900	! calculate length scale PBL
3901
3902	if (iflag_leads == 1) then
3903	ydthetadz = 999999.
3904	ypphii = 999999.
3905	ytheta = 999999.
3906
3907	DO k = 1, klev
3908	DO j = 1, knon
3909	ytheta(j,k) = yt(j,k)(ypplay(j,k)/1.e5)*(RD/RCPD)
3910	ENDDO
3911	ENDDO
3912
3913	DO k = 2, klev
3914	DO j = 1, knon
3915	ydthetadz(j,k) = RG*( ytheta(j,k) - ytheta(j,k-1) ) / ( ypphi(j,k) - ypphi(j,k-1) )
3916	ypphii(j,k) = (ypphi(j,k)+ypphi(j,k-1))/(RG*2.)
3917	ENDDO
3918	ENDDO
3919
3920	DO j = 1, knon
3921	k= minloc(abs(ypphii(j,:)-300),1)
3922	ydthetadz300(j)=ydthetadz(j,k)
3923	ENDDO
3924	end if
3925
3926	CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
3927	ywindsp, yrmu0, yfder, yts, &
3928	itap, dtime, jour, knon, ni, &
3929	ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt(:,1), yq(:,1),& ! ym missing init
3930	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3931	AcoefU, AcoefV, BcoefU, BcoefV, &
3932	ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
3933	ysnow, yqsurf, yagesno, &
3934	yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
3935	ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
3936	y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
3937	yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
3938	ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss, &
3939	ydthetadz300,Ampl &
3940
3941	#ifdef ISO
3942	& ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
3943	& yxtsnow,yxtevap,h1 &
3944	#endif
3945	& )
3946	CALL checksum("yalb_dir_new_ocean",yalb_dir_new(1:knon,:))
3947	IF (prt_level >=10) THEN
3948	print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon)
3949	print *,'arg de surf_ocean: ycdragm ',ycdragm(1:knon)
3950	print *,'arg de surf_ocean: yt ', yt(1:knon,:)
3951	print *,'arg de surf_ocean: yq ', yq(1:knon,:)
3952	print *,'arg de surf_ocean: yts ', yts(1:knon)
3953	print *,'arg de surf_ocean: AcoefH ',AcoefH(1:knon)
3954	print *,'arg de surf_ocean: AcoefQ ',AcoefQ(1:knon)
3955	print *,'arg de surf_ocean: BcoefH ',BcoefH(1:knon)
3956	print *,'arg de surf_ocean: BcoefQ ',BcoefQ(1:knon)
3957	print *,'arg de surf_ocean: yevap ',yevap(1:knon)
3958	print *,'arg de surf_ocean: yfluxsens ',yfluxsens(1:knon)
3959	print *,'arg de surf_ocean: yfluxlat ',yfluxlat(1:knon)
3960	print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new(1:knon)
3961	ENDIF
3962	! Special DICE MPL 05082013 puis BOMEX MPL 20150410
3963	IF (ok_prescr_ust) THEN
3964	DO j=1,knon
3965	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)
3966	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)
3967	ENDDO
3968	ENDIF
3969
3970	CASE(is_sic)
3971	CALL surf_seaice( &
3972	rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
3973	itap, dtime, jour, knon, ni, &
3974	lafin, &
3975	yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
3976	AcoefH, AcoefQ, BcoefH, BcoefQ, &
3977	AcoefU, AcoefV, BcoefU, BcoefV, &
3978	ypsref, yu1, yv1, ygustiness, pctsrf, &
3979	ysnow, yqsurf, yqsol, yagesno, ytsoil, &
3980	yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
3981	ytsurf_new, y_dflux_t, y_dflux_q, &
3982	y_flux_u1, y_flux_v1, &
3983	hice,tice,bilg_cumul, &
3984	fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, &
3985	dtice_melt, dtice_snow2sic &
3986	#ifdef ISO
3987	& ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
3988	& yxtsnow,yxtsol,yxtevap,Rland_ice &
3989	#endif
3990	& )
3991
3992	! Special DICE MPL 05082013 puis BOMEX MPL 20150410
3993	IF (ok_prescr_ust) THEN
3994	DO j=1,knon
3995	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)
3996	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)
3997	ENDDO
3998	ENDIF
3999
4000	#ifdef ISOVERIF
4001	DO j=1,knon
4002	DO ixt=1,ntraciso
4003	CALL iso_verif_noNaN(yxtevap(ixt,j), &
4004	& 'pbl_surface 1165a: apres surf_seaice')
4005	ENDDO
4006	DO ixt=1,niso
4007	CALL iso_verif_noNaN(yxtsol(ixt,j), &
4008	& 'pbl_surface 1165b: apres surf_seaice')
4009	ENDDO
4010	ENDDO
4011	#endif
4012	#ifdef ISOVERIF
4013	DO j=1,knon
4014	IF (iso_eau >= 0) THEN
4015	CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
4016	& ysnow(j),'pbl_surf_mod 1106')
4017	ENDIF !IF (iso_eau >= 0) THEN
4018	ENDDO !DO i=1,klon
4019	#endif
4020
4021	CASE DEFAULT
4022	WRITE(lunout,*) 'Surface index = ', nsrf
4023	abort_message = 'Surface index not valid'
4024	!ym CALL abort_physic(modname,abort_message,1)
4025	END SELECT
4026
4027
4028	!****************************************************************************************
4029	! 11) - Calcul the increment of surface temperature
4030	!
4031	!****************************************************************************************
4032
4033	IF (evap0>=0.) THEN
4034	yevap(1:knon)=evap0
4035	yevap(1:knon)=RLVTT*evap0
4036	ENDIF
4037
4038	y_d_ts(1:knon) = ytsurf_new(1:knon) - yts(1:knon)
4039
4040	!****************************************************************************************
4041	!
4042	! 12) "La remontee" - "The uphill"
4043	!
4044	! The fluxes (y_flux_X) and tendancy (y_d_X) are calculated
4045	! for X=H, Q, U and V, for all vertical levels.
4046	!
4047	!****************************************************************************************
4048
4049	IF (ok_forc_tsurf) THEN
4050	DO j=1,knon
4051	ytsurf_new(j)=tg
4052	y_d_ts(j) = ytsurf_new(j) - yts(j)
4053	ENDDO
4054	ENDIF ! ok_forc_tsurf
4055
4056	IF (ok_flux_surf) THEN
4057	IF (prt_level >=10) THEN
4058	PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
4059	ENDIF
4060	y_flux_t1(:) = fsens
4061	y_flux_q1(:) = flat/RLVTT
4062	yfluxlat(:) = flat
4063	!
4064	!! Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
4065	!! IF (iflag_split .eq.0) THEN
4066	DO j=1,knon
4067	Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)2+yv(j,1)2)) * &
4068	ypplay(j,1)/(RD*yt(j,1))
4069	ENDDO
4070	!! ENDIF ! (iflag_split .eq.0)
4071
4072	DO j = 1, knon
4073	yt1_new=(1./RCPD)(AcoefH(j)+BcoefH(j)y_flux_t1(j)*dtime)
4074	ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD)
4075	! for cases forced in flux and for which forcing in Ts is needed
4076	! to prevent the latter to reach unrealistic value (even if not used,
4077	! Ts is calculated and hgardfou can appear during the calculation
4078	! of surface saturation humidity for example
4079	if (ok_forc_tsurf) ytsurf_new(j)=tg
4080	ENDDO
4081
4082	DO j=1,knon
4083	y_d_ts(j) = ytsurf_new(j) - yts(j)
4084	ENDDO
4085
4086	ELSE ! (ok_flux_surf)
4087	DO j=1,knon
4088	y_flux_t1(j) = yfluxsens(j)
4089	y_flux_q1(j) = -yevap(j)
4090	#ifdef ISO
4091	y_flux_xt1(:,:) = -yxtevap(:,:)
4092	#endif
4093	ENDDO
4094	ENDIF ! (ok_flux_surf)
4095
4096	! flux of blowing snow at the first level
4097	IF (ok_bs) THEN
4098	DO j=1,knon
4099	y_flux_bs(j)=yfluxbs(j)
4100	ENDDO
4101	ENDIF
4102	!
4103	! ------------------------------------------------------------------------------
4104	! 12a) Splitting
4105	! ------------------------------------------------------------------------------
4106
4107	IF (iflag_split .GE. 1) THEN
4108	#ifdef ISO
4109	call abort_physic('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1)
4110	#endif
4111
4112	IF (nsrf .ne. is_oce) THEN
4113
4114	! Compute potential evaporation and aridity factor (jyg, 20200328)
4115	ybeta_prev(:) = ybeta(:)
4116	DO j = 1, knon
4117	yqa(j) = AcoefQ(j) - BcoefQ(j)yevap(j)dtime
4118	ENDDO
4119
4120	CALL wx_evappot(knon, yqa, yTsurf_new, yevap_pot)
4121
4122	ybeta(1:knon) = min(yevap(1:knon)/yevap_pot(1:knon), 1.)
4123
4124	IF (prt_level >=10) THEN
4125	DO j=1,knon
4126	print*,'y_flux_t1,yfluxlat,wakes' &
4127	& , y_flux_t1(j), yfluxlat(j), ywake_s(j)
4128	print*,'beta_prev, beta, ytsurf_new', ybeta_prev(j), ybeta(j), ytsurf_new(j)
4129	print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
4130	ENDDO
4131	ENDIF ! (prt_level >=10)
4132	!
4133	! Second call to wx_pbl0_merge and wx_pbl_dts_merge in order to take into account
4134	! the update of the aridity coeficient beta.
4135	!
4136	CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta, &
4137	BcoefQ_x, BcoefQ_w &
4138	)
4139	CALL wx_pbl0_merge(knon, ypplay, ypaprs, &
4140	ywake_s, ydTs0, ydqs0, &
4141	yt_x, yt_w, yq_x, yq_w, &
4142	yu_x, yu_w, yv_x, yv_w, &
4143	ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
4144	ycdragm_x, ycdragm_w, &
4145	AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
4146	AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
4147	BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
4148	BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
4149	AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
4150	BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
4151	ycdragh, ycdragq, ycdragm, &
4152	yt1, yq1, yu1, yv1 &
4153	)
4154	IF (iflag_split .eq. 2) THEN
4155	CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
4156	ywake_s, ybeta, ywake_cstar, ywake_dens, &
4157	AcoefH_x, AcoefH_w, &
4158	BcoefH_x, BcoefH_w, &
4159	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
4160	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4161	HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
4162	phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
4163	yg_T, yg_Q, &
4164	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
4165	ydTs_ins, ydqs_ins &
4166	)
4167	ELSE !
4168	AcoefH(:) = AcoefH_0(:)
4169	AcoefQ(:) = AcoefQ_0(:)
4170	BcoefH(:) = BcoefH_0(:)
4171	BcoefQ(:) = BcoefQ_0(:)
4172	yg_T(:) = 0.
4173	yg_Q(:) = 0.
4174	yGamma_dTs_phiT(:) = 0.
4175	yGamma_dQs_phiQ(:) = 0.
4176	ydTs_ins(:) = 0.
4177	ydqs_ins(:) = 0.
4178	ENDIF ! (iflag_split .eq. 2)
4179	!
4180	ELSE ! (nsrf .ne. is_oce)
4181	ybeta(1:knon) = 1.
4182	yevap_pot(1:knon) = yevap(1:knon)
4183	AcoefH(:) = AcoefH_0(:)
4184	AcoefQ(:) = AcoefQ_0(:)
4185	BcoefH(:) = BcoefH_0(:)
4186	BcoefQ(:) = BcoefQ_0(:)
4187	yg_T(:) = 0.
4188	yg_Q(:) = 0.
4189	yGamma_dTs_phiT(:) = 0.
4190	yGamma_dQs_phiQ(:) = 0.
4191	ydTs_ins(:) = 0.
4192	ydqs_ins(:) = 0.
4193	ENDIF ! (nsrf .ne. is_oce)
4194
4195	CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
4196	yg_T, yg_Q, &
4197	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
4198	ydTs_ins, ydqs_ins, &
4199	y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
4200	phiQ0_b, phiT0_b, &
4201	y_flux_t1_x, y_flux_t1_w, &
4202	y_flux_q1_x, y_flux_q1_w, &
4203	y_flux_u1_x, y_flux_u1_w, &
4204	y_flux_v1_x, y_flux_v1_w, &
4205	yfluxlat_x, yfluxlat_w, &
4206	y_delta_qsats, &
4207	y_delta_tsurf_new, y_delta_qsurf &
4208	)
4209
4210	CALL wx_pbl_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
4211	yTs, y_delta_tsurf, &
4212	yqsurf, yTsurf_new, &
4213	y_delta_tsurf_new, y_delta_qsats, &
4214	AcoefH_x, AcoefH_w, &
4215	BcoefH_x, BcoefH_w, &
4216	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
4217	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4218	y_flux_t1, y_flux_q1, &
4219	y_flux_t1_x, y_flux_t1_w, &
4220	y_flux_q1_x, y_flux_q1_w)
4221
4222	IF (nsrf .ne. is_oce) THEN
4223	CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
4224	yTs, y_delta_tsurf, &
4225	yqsurf, yTsurf_new, &
4226	y_delta_qsats, y_delta_tsurf_new, y_delta_qsurf, &
4227	AcoefH_x, AcoefH_w, &
4228	BcoefH_x, BcoefH_w, &
4229	AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0, &
4230	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4231	HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
4232	phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
4233	yg_T, yg_Q, &
4234	yGamma_dTs_phiT, yGamma_dQs_phiQ, &
4235	ydTs_ins, ydqs_ins, &
4236	y_flux_t1, y_flux_q1, &
4237	y_flux_t1_x, y_flux_t1_w, &
4238	y_flux_q1_x, y_flux_q1_w )
4239	ENDIF ! (nsrf .ne. is_oce)
4240
4241	ELSE ! (iflag_split .ge. 1)
4242	ybeta(1:knon) = 1.
4243	yevap_pot(1:knon) = yevap(1:knon)
4244	ENDIF ! (iflag_split .ge. 1)
4245
4246	IF (prt_level >= 10) THEN
4247	print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
4248	ybeta(1:knon) , yevap(1:knon), yevap_pot(1:knon)
4249	ENDIF ! (prt_level >= 10)
4250
4251	IF (iflag_split .ge. 1) THEN
4252	IF (prt_level >=10) THEN
4253	DO j = 1, knon
4254	print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j)
4255	print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j)
4256	print*,'t1x, t1w, t1, t1_ancien', &
4257	& yt_x(j,1), yt_w(j,1), yt(j,1), t(j,1)
4258	print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j)
4259	ENDDO
4260
4261	DO j=1,knon
4262	print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' &
4263	& , 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)
4264	print*,'beta, ytsurf_new ', ybeta(j), ytsurf_new(j)
4265	print*,'inertia, facteur, cstar', inertia, facteur,wake_cstar(j)
4266	ENDDO
4267	ENDIF ! (prt_level >=10)
4268
4269	ENDIF ! (iflag_split .ge.1)
4270
4271	IF (iflag_split .eq.0) THEN
4272
4273	CALL climb_hq_up(knon, ni, dtime, yt, yq, &
4274	y_flux_q1, y_flux_t1, ypaprs, ypplay, &
4275	AcoefH, AcoefQ, BcoefH, BcoefQ, &
4276	CcoefH, CcoefQ, DcoefH, DcoefQ, &
4277	Kcoef_hq, gama_q, gama_h, &
4278	y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) &
4279	#ifdef ISO
4280	& ,yxt,y_flux_xt1 &
4281	& ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt &
4282	& ,y_flux_xt(:,:,:),y_d_xt(:,:,:) &
4283	#endif
4284	& )
4285	ELSE !(iflag_split .eq.0)
4286	CALL climb_hq_up(knon, ni, dtime, yt_x, yq_x, &
4287	y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
4288	AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, &
4289	CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
4290	Kcoef_hq_x, gama_q_x, gama_h_x, &
4291	y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) &
4292	#ifdef ISO
4293	& ,yxt_x,y_flux_xt1_x &
4294	& ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x &
4295	& ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) &
4296	#endif
4297	& )
4298	!
4299	CALL climb_hq_up(knon, ni, dtime, yt_w, yq_w, &
4300	y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, &
4301	AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, &
4302	CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
4303	Kcoef_hq_w, gama_q_w, gama_h_w, &
4304	y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) &
4305	#ifdef ISO
4306	& ,yxt_w,y_flux_xt1_w &
4307	& ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w &
4308	& ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) &
4309	#endif
4310	& )
4311	ENDIF ! (iflag_split .eq.0)
4312
4313	IF (iflag_split .eq.0) THEN
4314	IF (is_master) WRITE(lunout,) "*** CHECKSUM IN ==> climb_wind_up ***"
4315	CALL checksum("knon", knon)
4316	CALL checksum("dtime", dtime)
4317	CALL checksum("yu", yu(1:knon,:))
4318	CALL checksum("yv", yv(1:knon,:))
4319	CALL checksum("y_flux_u1", y_flux_u1(1:knon))
4320	CALL checksum("y_flux_v1", y_flux_v1(1:knon))
4321	CALL checksum("AcoefU", AcoefU(1:knon))
4322	CALL checksum("AcoefV", AcoefV(1:knon))
4323	CALL checksum("BcoefU", BcoefU(1:knon))
4324	CALL checksum("BcoefV", BcoefV(1:knon))
4325	CALL checksum("CcoefU", CcoefU(1:knon,:))
4326	CALL checksum("CcoefV", CcoefV(1:knon,:))
4327	CALL checksum("DcoefU", DcoefU(1:knon,:))
4328	CALL checksum("DcoefV", DcoefV(1:knon,:))
4329	CALL checksum("Kcoef_m", Kcoef_m(1:knon,:))
4330	CALL checksum("y_flux_u", y_flux_u(1:knon,:))
4331	CALL checksum("y_flux_v", y_flux_v(1:knon,:))
4332	CALL checksum("y_d_u", y_d_u(1:knon,:))
4333	CALL checksum("y_d_v", y_d_v(1:knon,:))
4334
4335	CALL climb_wind_up(knon, ni, dtime, yu, yv, y_flux_u1, y_flux_v1, &
4336	AcoefU, AcoefV, BcoefU, BcoefV, &
4337	CcoefU, CcoefV, DcoefU, DcoefV, &
4338	Kcoef_m, &
4339	y_flux_u, y_flux_v, y_d_u, y_d_v)
4340
4341	IF (is_master) WRITE(lunout,) "*** CHECKSUM OUT ==> climb_wind_up ***"
4342	CALL checksum("knon", knon)
4343	CALL checksum("dtime", dtime)
4344	CALL checksum("yu", yu(1:knon,:))
4345	CALL checksum("yv", yv(1:knon,:))
4346	CALL checksum("y_flux_u1", y_flux_u1(1:knon))
4347	CALL checksum("y_flux_v1", y_flux_v1(1:knon))
4348	CALL checksum("AcoefU", AcoefU(1:knon))
4349	CALL checksum("AcoefV", AcoefV(1:knon))
4350	CALL checksum("BcoefU", BcoefU(1:knon))
4351	CALL checksum("BcoefV", BcoefV(1:knon))
4352	CALL checksum("CcoefU", CcoefU(1:knon,:))
4353	CALL checksum("CcoefV", CcoefV(1:knon,:))
4354	CALL checksum("DcoefU", DcoefU(1:knon,:))
4355	CALL checksum("DcoefV", DcoefV(1:knon,:))
4356	CALL checksum("Kcoef_m", Kcoef_m(1:knon,:))
4357	CALL checksum("y_flux_u", y_flux_u(1:knon,:))
4358	CALL checksum("y_flux_v", y_flux_v(1:knon,:))
4359	CALL checksum("y_d_u", y_d_u(1:knon,:))
4360	CALL checksum("y_d_v", y_d_v(1:knon,:))
4361	IF (is_master) WRITE(lunout,) "** CHECKSUM *****************************"
4362
4363	y_d_t_diss(:,:)=0.
4364	IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
4365	CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
4366	& ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
4367	& ,iflag_pbl)
4368	ENDIF
4369
4370	ELSE !(iflag_split .eq.0)
4371	CALL climb_wind_up(knon, ni, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
4372	AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, &
4373	CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
4374	Kcoef_m_x, &
4375	y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x)
4376
4377	y_d_t_diss_x(:,:)=0.
4378	IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
4379	CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
4380	& ,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 &
4381	,ycoefq_x,y_d_t_diss_x,yustar_x &
4382	& ,iflag_pbl)
4383	ENDIF
4384
4385	CALL climb_wind_up(knon, ni, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, &
4386	AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, &
4387	CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
4388	Kcoef_m_w, &
4389	y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w)
4390
4391	y_d_t_diss_w(:,:)=0.
4392	IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
4393	CALL yamada_c(knon, knon,dtime,ypaprs,ypplay &
4394	& ,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 &
4395	,ycoefq_w,y_d_t_diss_w,yustar_w &
4396	& ,iflag_pbl)
4397	ENDIF
4398
4399	IF (prt_level >=10) THEN
4400	print *, 'After climbing up, lfuxlat_x, fluxlat_w ', &
4401	yfluxlat_x(1:knon), yfluxlat_w(1:knon)
4402	ENDIF
4403	!
4404	ENDIF ! (iflag_split .eq.0)
4405
4406	IF (ok_bs) THEN
4407	CALL climb_qbs_up(knon, ni, dtime, yqbs, &
4408	y_flux_bs, ypaprs, ypplay, &
4409	AcoefQBS, BcoefQBS, &
4410	CcoefQBS, DcoefQBS, &
4411	Kcoef_qbs, gama_qbs, &
4412	y_flux_qbs(:,:), y_d_qbs(:,:))
4413	ENDIF
4414
4415
4416	!****************************************************************************************
4417	! 13) Transform variables for output format :
4418	! - Decompress
4419	! - Multiply with pourcentage of current surface
4420	! - Cumulate in global variable
4421	!
4422	!****************************************************************************************
4423
4424
4425	IF (iflag_split.EQ.0) THEN
4426
4427	DO k = 1, klev
4428	DO j = 1, knon
4429	i = ni(j)
4430	y_d_t_diss(j,k) = y_d_t_diss(j,k) * ypct(j)
4431	y_d_t(j,k) = y_d_t(j,k) * ypct(j)
4432	y_d_q(j,k) = y_d_q(j,k) * ypct(j)
4433	y_d_u(j,k) = y_d_u(j,k) * ypct(j)
4434	y_d_v(j,k) = y_d_v(j,k) * ypct(j)
4435
4436	IF (nsrf .EQ. is_ter .and. ifl_pbltree .GE. 1) THEN
4437
4438	y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
4439	y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
4440	treedrg(i,k,nsrf)=y_treedrg(j,k)
4441	ELSE
4442	treedrg(i,k,nsrf)=0.
4443	ENDIF
4444
4445	flux_t(i,k,nsrf) = y_flux_t(j,k)
4446	flux_q(i,k,nsrf) = y_flux_q(j,k)
4447	flux_u(i,k,nsrf) = y_flux_u(j,k)
4448	flux_v(i,k,nsrf) = y_flux_v(j,k)
4449
4450	#ifdef ISO
4451	DO ixt=1,ntraciso
4452	y_d_xt(ixt,j,k) = y_d_xt(ixt,j,k) * ypct(j)
4453	flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k)
4454	ENDDO ! DO ixt=1,ntraciso
4455	h1_diag(i)=h1(j)
4456	#endif
4457
4458	ENDDO
4459	ENDDO
4460
4461	#ifdef ISO
4462	#ifdef ISOVERIF
4463	if (iso_eau.gt.0) then
4464	call iso_verif_egalite_vect2D( &
4465	y_d_xt,y_d_q, &
4466	'pbl_surface_mod 2600',ntraciso,klon,klev)
4467	endif
4468	#endif
4469	#endif
4470
4471	ELSE !(iflag_split .eq.0)
4472
4473	! Tendances hors poches
4474	DO k = 1, klev
4475	DO j = 1, knon
4476	i = ni(j)
4477	y_d_t_diss_x(j,k) = y_d_t_diss_x(j,k) * ypct(j)
4478	y_d_t_x(j,k) = y_d_t_x(j,k) * ypct(j)
4479	y_d_q_x(j,k) = y_d_q_x(j,k) * ypct(j)
4480	y_d_u_x(j,k) = y_d_u_x(j,k) * ypct(j)
4481	y_d_v_x(j,k) = y_d_v_x(j,k) * ypct(j)
4482
4483	flux_t_x(i,k,nsrf) = y_flux_t_x(j,k)
4484	flux_q_x(i,k,nsrf) = y_flux_q_x(j,k)
4485	flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
4486	flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
4487
4488	#ifdef ISO
4489	DO ixt=1,ntraciso
4490	y_d_xt_x(ixt,j,k) = y_d_xt_x(ixt,j,k) * ypct(j)
4491	flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k)
4492	ENDDO ! DO ixt=1,ntraciso
4493	#endif
4494	ENDDO
4495	ENDDO
4496
4497	! Tendances dans les poches
4498	DO k = 1, klev
4499	DO j = 1, knon
4500	i = ni(j)
4501	y_d_t_diss_w(j,k) = y_d_t_diss_w(j,k) * ypct(j)
4502	y_d_t_w(j,k) = y_d_t_w(j,k) * ypct(j)
4503	y_d_q_w(j,k) = y_d_q_w(j,k) * ypct(j)
4504	y_d_u_w(j,k) = y_d_u_w(j,k) * ypct(j)
4505	y_d_v_w(j,k) = y_d_v_w(j,k) * ypct(j)
4506
4507	flux_t_w(i,k,nsrf) = y_flux_t_w(j,k)
4508	flux_q_w(i,k,nsrf) = y_flux_q_w(j,k)
4509	flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
4510	flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
4511
4512	#ifdef ISO
4513	DO ixt=1,ntraciso
4514	y_d_xt_w(ixt,j,k) = y_d_xt_w(ixt,j,k) * ypct(j)
4515	flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k)
4516	ENDDO ! do ixt=1,ntraciso
4517	#endif
4518
4519	ENDDO
4520	ENDDO
4521
4522	! Flux, tendances et Tke moyenne dans la maille
4523	DO k = 1, klev
4524	DO j = 1, knon
4525	i = ni(j)
4526	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))
4527	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))
4528	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))
4529	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))
4530	#ifdef ISO
4531	DO ixt=1,ntraciso
4532	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))
4533	ENDDO ! do ixt=1,ntraciso
4534	#endif
4535	ENDDO
4536	ENDDO
4537	DO j=1,knon
4538	yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j))
4539	ENDDO
4540	IF (prt_level >=10) THEN
4541	print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', &
4542	nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf)
4543	ENDIF
4544
4545	DO k = 1, klev
4546	DO j = 1, knon
4547	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))
4548	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))
4549	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))
4550	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))
4551	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))
4552	ENDDO
4553	ENDDO
4554
4555	ENDIF ! (iflag_split .eq.0)
4556
4557
4558	! tendencies of blowing snow
4559	IF (ok_bs) THEN
4560	DO k = 1, klev
4561	DO j = 1, knon
4562	i = ni(j)
4563	y_d_qbs(j,k)=y_d_qbs(j,k) * ypct(j)
4564	flux_qbs(i,k,nsrf) = y_flux_qbs(j,k)
4565	ENDDO
4566	ENDDO
4567	ENDIF
4568
4569
4570	DO j = 1, knon
4571	i = ni(j)
4572	evap(i,nsrf) = - flux_q(i,1,nsrf) !jyg
4573	if (ok_bs) then ; snowerosion(i,nsrf)=flux_qbs(i,1,nsrf); endif
4574	beta(i,nsrf) = ybeta(j) !jyg
4575	d_ts(i,nsrf) = y_d_ts(j)
4576	!albedo SB >>>
4577	DO k=1,nsw
4578	alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
4579	alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
4580	ENDDO
4581	!albedo SB <<<
4582	snow(i,nsrf) = ysnow(j)
4583	qsurf(i,nsrf) = yqsurf(j)
4584	z0m(i,nsrf) = yz0m(j)
4585	z0h(i,nsrf) = yz0h(j)
4586	fluxlat(i,nsrf) = yfluxlat(j)
4587	agesno(i,nsrf) = yagesno(j)
4588	cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
4589	cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
4590	dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
4591	dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
4592	#ifdef ISO
4593	DO ixt=1,niso
4594	xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j)
4595	ENDDO
4596	DO ixt=1,ntraciso
4597	xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf)
4598	dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j)
4599	ENDDO
4600	IF (nsrf == is_lic) THEN
4601	DO ixt=1,niso
4602	Rland_ice(ixt,i) = yRland_ice(ixt,j)
4603	ENDDO
4604	ENDIF !IF (nsrf == is_lic) THEN
4605	#ifdef ISOVERIF
4606	IF (iso_eau.gt.0) THEN
4607	call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
4608	& 'pbl_surf_mod 1230',errmax,errmaxrel)
4609	ENDIF !if (iso_eau.gt.0) then
4610	#endif
4611	#endif
4612	ENDDO
4613
4614	IF (iflag_split .ge.1) THEN
4615
4616	DO j = 1, knon
4617	i = ni(j)
4618	fluxlat_x(i,nsrf) = yfluxlat_x(j)
4619	fluxlat_w(i,nsrf) = yfluxlat_w(j)
4620	delta_tsurf(i,nsrf)=y_delta_tsurf_new(j)
4621	delta_qsurf(i) = delta_qsurf(i) + y_delta_qsurf(j)*ypct(j)
4622	cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
4623	cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j)
4624	cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j)
4625	cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j)
4626	kh(i) = kh(i) + Kech_h(j)*ypct(j)
4627	kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j)
4628	kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j)
4629	ENDDO
4630	ENDIF ! (iflag_split .ge.1)
4631
4632	IF (iflag_split .eq.0) THEN
4633	wake_dltke(:,:,nsrf) = 0.
4634	DO k = 1, klev+1
4635	DO j = 1, knon
4636	i = ni(j)
4637	tke_x(i,k,nsrf) = ytke(j,k)
4638	tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
4639	eps_x(i,k,nsrf) = yeps(j,k)
4640	eps_x(i,k,is_ave) = eps_x(i,k,is_ave) + yeps(j,k)*ypct(j)
4641	ENDDO
4642	ENDDO
4643
4644	ELSE ! (iflag_split .eq.0)
4645	DO k = 1, klev+1
4646	DO j = 1, knon
4647	i = ni(j)
4648	wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
4649	tke_x(i,k,nsrf) = ytke_x(j,k)
4650	tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
4651	eps_x(i,k,nsrf) = yeps_x(j,k)
4652	eps_x(i,k,is_ave) = eps_x(i,k,is_ave) + eps_x(i,k,nsrf)*ypct(j)
4653	wake_dltke(i,k,is_ave) = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
4654	ENDDO
4655	ENDDO
4656	ENDIF ! (iflag_split .eq.0)
4657
4658	DO k = 2, klev
4659	DO j = 1, knon
4660	i = ni(j)
4661	zcoefh(i,k,nsrf) = ycoefh(j,k)
4662	zcoefm(i,k,nsrf) = ycoefm(j,k)
4663	zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
4664	zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
4665	ENDDO
4666	ENDDO
4667
4668	IF ( nsrf .EQ. is_ter ) THEN
4669	DO j = 1, knon
4670	i = ni(j)
4671	qsol(i) = yqsol(j)
4672	#ifdef ISO
4673	runoff_diag(i)=yrunoff_diag(j)
4674	DO ixt=1,niso
4675	xtsol(ixt,i) = yxtsol(ixt,j)
4676	xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j)
4677	ENDDO
4678	#endif
4679	ENDDO
4680	ENDIF
4681
4682	DO k = 1, nsoilmx
4683	DO j = 1, knon
4684	i = ni(j)
4685	ftsoil(i, k, nsrf) = ytsoil(j,k)
4686	ENDDO
4687	ENDDO
4688
4689	#ifdef ISO
4690	#ifdef ISOVERIF
4691	DO i = 1, klon
4692	DO ixt=1,niso
4693	call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405')
4694	ENDDO
4695	ENDDO
4696	#endif
4697	#ifdef ISOVERIF
4698	IF (iso_eau.gt.0) THEN
4699	call iso_verif_egalite_vect2D( &
4700	y_d_xt,y_d_q, &
4701	'pbl_surface_mod 1261',ntraciso,klon,klev)
4702	ENDIF !if (iso_eau.gt.0) then
4703	#endif
4704	#endif
4705
4706	IF (iflag_split .ge.1) THEN
4707
4708	DO k = 1, klev
4709	DO j = 1, knon
4710	i = ni(j)
4711	d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k)
4712	d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k)
4713	d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k)
4714	d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k)
4715	d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k)
4716	!
4717	d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k)
4718	d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k)
4719	d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k)
4720	d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
4721	d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
4722	#ifdef ISO
4723	DO ixt=1,ntraciso
4724	d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k)
4725	d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k)
4726	ENDDO ! DO ixt=1,ntraciso
4727	#endif
4728
4729	ENDDO
4730	ENDDO
4731	ENDIF ! (iflag_split .ge.1)
4732
4733	DO k = 1, klev
4734	DO j = 1, knon
4735	i = ni(j)
4736	d_t_diss(i,k) = d_t_diss(i,k) + y_d_t_diss(j,k)
4737	d_t(i,k) = d_t(i,k) + y_d_t(j,k)
4738	d_q(i,k) = d_q(i,k) + y_d_q(j,k)
4739	#ifdef ISO
4740	DO ixt=1,ntraciso
4741	d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k)
4742	ENDDO !DO ixt=1,ntraciso
4743	#endif
4744	d_u(i,k) = d_u(i,k) + y_d_u(j,k)
4745	d_v(i,k) = d_v(i,k) + y_d_v(j,k)
4746	ENDDO
4747	ENDDO
4748
4749
4750	IF (ok_bs) THEN
4751	DO k = 1, klev
4752	DO j = 1, knon
4753	i = ni(j)
4754	d_qbs(i,k) = d_qbs(i,k) + y_d_qbs(j,k)
4755	ENDDO
4756	ENDDO
4757	ENDIF
4758
4759	#ifdef ISO
4760	#ifdef ISOVERIF
4761	call iso_verif_noNaN_vect2D( &
4762	& d_xt, &
4763	& 'pbl_surface 1385',ntraciso,klon,klev)
4764	IF (iso_eau >= 0) THEN
4765	call iso_verif_egalite_vect2D( &
4766	y_d_xt,y_d_q, &
4767	'pbl_surface_mod 2945',ntraciso,klon,klev)
4768	call iso_verif_egalite_vect2D( &
4769	d_xt,d_q, &
4770	'pbl_surface_mod 1276',ntraciso,klon,klev)
4771	ENDIF !IF (iso_eau >= 0) THEN
4772	#endif
4773	#endif
4774
4775	IF (prt_level >=10) THEN
4776	print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', &
4777	d_t_w(1:knon,1), d_t_x(1:knon,1), d_t(1:knon,1)
4778	ENDIF
4779
4780	if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
4781	delta_sal = missing_val
4782	ds_ns = missing_val
4783	dt_ns = missing_val
4784	delta_sst = missing_val
4785	dter = missing_val
4786	dser = missing_val
4787	tkt = missing_val
4788	tks = missing_val
4789	taur = missing_val
4790	sss = missing_val
4791
4792	delta_sal(ni(:knon)) = ydelta_sal(:knon)
4793	ds_ns(ni(:knon)) = yds_ns(:knon)
4794	dt_ns(ni(:knon)) = ydt_ns(:knon)
4795	delta_sst(ni(:knon)) = ydelta_sst(:knon)
4796	dter(ni(:knon)) = ydter(:knon)
4797	dser(ni(:knon)) = ydser(:knon)
4798	tkt(ni(:knon)) = ytkt(:knon)
4799	tks(ni(:knon)) = ytks(:knon)
4800	taur(ni(:knon)) = ytaur(:knon)
4801	sss(ni(:knon)) = ysss(:knon)
4802
4803	if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
4804	dt_ds = missing_val
4805	dt_ds(ni(:knon)) = ydt_ds(:knon)
4806	end if
4807	end if
4808
4809
4810	!****************************************************************************************
4811	! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m
4812	! Call HBTM
4813	!
4814	!****************************************************************************************
4815	!!!
4816	!
4817	#undef T2m
4818	#define T2m
4819	#ifdef T2m
4820	! Calculations of diagnostic t,q at 2m and u, v at 10m
4821
4822	IF (iflag_split .eq.0) THEN
4823	DO j=1, knon
4824	uzon(j) = yu(j,1) + y_d_u(j,1)
4825	vmer(j) = yv(j,1) + y_d_v(j,1)
4826	tair1(j) = yt(j,1) + y_d_t(j,1) + y_d_t_diss(j,1)
4827	qair1(j) = yq(j,1) + y_d_q(j,1)
4828	zgeo1(j) = RD * tair1(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
4829	* (ypaprs(j,1)-ypplay(j,1))
4830	tairsol(j) = yts(j) + y_d_ts(j)
4831	qairsol(j) = yqsurf(j)
4832	ENDDO
4833	ELSE ! (iflag_split .eq.0)
4834	DO j=1, knon
4835	uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1)
4836	vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1)
4837	tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1)
4838	qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1)
4839	zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
4840	* (ypaprs(j,1)-ypplay(j,1))
4841	tairsol(j) = yts(j) + y_d_ts(j)
4842	tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf_new(j)
4843	qairsol(j) = yqsurf(j)
4844	ENDDO
4845	DO j=1, knon
4846	uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1)
4847	vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1)
4848	tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1)
4849	qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1)
4850	zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
4851	* (ypaprs(j,1)-ypplay(j,1))
4852	tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j)
4853	qairsol(j) = yqsurf(j)
4854	ENDDO
4855	ENDIF ! (iflag_split .eq.0)
4856
4857	DO j=1, knon
4858	psfce(j)=ypaprs(j,1)
4859	patm(j)=ypplay(j,1)
4860	ENDDO
4861
4862	IF (iflag_pbl_surface_t2m_bug==1) THEN
4863	yz0h_oupas(1:knon)=yz0m(1:knon)
4864	ELSE
4865	yz0h_oupas(1:knon)=yz0h(1:knon)
4866	ENDIF
4867
4868
4869	! Calculate the temperature and relative humidity at 2m and the wind at 10m
4870	IF (iflag_split .eq.0) THEN
4871	IF (iflag_new_t2mq2m==1) THEN
4872	CALL checksum("yq2m_bis", yq2m(1:knon))
4873
4874	CALL stdlevvarn(knon, knon, nsrf, zxli, &
4875	uzon, vmer, tair1, qair1, zgeo1, &
4876	tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4877	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
4878	yn2mout(:, :, :))
4879	CALL checksum("yq2m_bis", yq2m(1:knon))
4880	ELSE
4881	CALL stdlevvar(knon, knon, nsrf, zxli, &
4882	uzon, vmer, tair1, qair1, zgeo1, &
4883	tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4884	yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, yzxtsol)
4885	ENDIF
4886	ELSE !(iflag_split .eq.0)
4887	IF (iflag_new_t2mq2m==1) THEN
4888	CALL stdlevvarn(knon, knon, nsrf, zxli, &
4889	uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
4890	tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4891	yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
4892	yn2mout_x(:, :, :))
4893	CALL stdlevvarn(knon, knon, nsrf, zxli, &
4894	uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
4895	tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4896	yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, &
4897	yn2mout_w(:, :, :))
4898	ELSE
4899	CALL stdlevvar(knon, knon, nsrf, zxli, &
4900	uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
4901	tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4902	yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, ypblh_x, rain_f, yzxtsol)
4903	CALL stdlevvar(knon, knon, nsrf, zxli, &
4904	uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
4905	tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
4906	yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, ypblh_w, rain_f, yzxtsol)
4907	ENDIF
4908
4909	ENDIF ! (iflag_split .eq.0)
4910
4911	IF (iflag_split .eq.0) THEN
4912	DO j=1, knon
4913	i = ni(j)
4914	t2m(i,nsrf)=yt2m(j)
4915	q2m(i,nsrf)=yq2m(j)
4916	! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
4917	ustar(i,nsrf)=yustar(j)
4918	u10m(i,nsrf)=(yu10m(j) * uzon(j))/max(SQRT(uzon(j)2+vmer(j)2), smallestreal)
4919	v10m(i,nsrf)=(yu10m(j) * vmer(j))/max(SQRT(uzon(j)2+vmer(j)2), smallestreal)
4920
4921	DO k = 1, 6
4922	n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
4923	END DO
4924
4925	ENDDO
4926	ELSE !(iflag_split .eq.0)
4927	DO j=1, knon
4928	i = ni(j)
4929	t2m_x(i,nsrf)=yt2m_x(j)
4930	q2m_x(i,nsrf)=yq2m_x(j)
4931	! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
4932	ustar_x(i,nsrf)=yustar_x(j)
4933	u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/max(SQRT(uzon_x(j)2+vmer_x(j)2), smallestreal)
4934	v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/max(SQRT(uzon_x(j)2+vmer_x(j)2), smallestreal)
4935
4936	DO k = 1, 6
4937	n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
4938	END DO
4939
4940	ENDDO
4941	DO j=1, knon
4942	i = ni(j)
4943	t2m_w(i,nsrf)=yt2m_w(j)
4944	q2m_w(i,nsrf)=yq2m_w(j)
4945	! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
4946	ustar_w(i,nsrf)=yustar_w(j)
4947	u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/max(SQRT(uzon_w(j)2+vmer_w(j)2), smallestreal)
4948	v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/max(SQRT(uzon_w(j)2+vmer_w(j)2), smallestreal)
4949
4950	ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf))
4951	u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
4952	v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
4953
4954	DO k = 1, 6
4955	n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
4956	END DO
4957
4958	ENDDO
4959
4960	ENDIF ! (iflag_split .eq.0)
4961
4962
4963	!IM Calcule de l'humidite relative a 2m (rh2m) pour diagnostique
4964	!IM Ajoute dependance type surface
4965	IF (thermcep) THEN
4966
4967	IF (iflag_split .eq.0) THEN
4968	DO j = 1, knon
4969	i=ni(j)
4970	zdelta1 = MAX(0.,SIGN(1., rtt-yt2m(j) ))
4971	zx_qs1 = r2es * FOEEW(yt2m(j),zdelta1)/paprs(i,1)
4972	zx_qs1 = MIN(0.5,zx_qs1)
4973	zcor1 = 1./(1.-RETV*zx_qs1)
4974	zx_qs1 = zx_qs1*zcor1
4975
4976	rh2m(i) = rh2m(i) + yq2m(j)/zx_qs1 * pctsrf(i,nsrf)
4977	qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i,nsrf)
4978	ENDDO
4979	ELSE ! (iflag_split .eq.0)
4980	DO j = 1, knon
4981	i=ni(j)
4982	zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) ))
4983	zx_qs1 = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1)
4984	zx_qs1 = MIN(0.5,zx_qs1)
4985	zcor1 = 1./(1.-RETV*zx_qs1)
4986	zx_qs1 = zx_qs1*zcor1
4987
4988	rh2m_x(i) = rh2m_x(i) + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf)
4989	qsat2m_x(i) = qsat2m_x(i) + zx_qs1 * pctsrf(i,nsrf)
4990	ENDDO
4991	DO j = 1, knon
4992	i=ni(j)
4993	zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) ))
4994	zx_qs1 = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1)
4995	zx_qs1 = MIN(0.5,zx_qs1)
4996	zcor1 = 1./(1.-RETV*zx_qs1)
4997	zx_qs1 = zx_qs1*zcor1
4998
4999	rh2m_w(i) = rh2m_w(i) + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf)
5000	qsat2m_w(i) = qsat2m_w(i) + zx_qs1 * pctsrf(i,nsrf)
5001	ENDDO
5002
5003	ENDIF ! (iflag_split .eq.0)
5004
5005	ENDIF
5006	!
5007	IF (prt_level >=10) THEN
5008	print *, 'T2m, q2m, RH2m ', &
5009	t2m(1:knon,:), q2m(1:knon,:), rh2m(1:knon)
5010	ENDIF
5011
5012
5013	IF (iflag_split .eq.0) THEN
5014	CALL hbtm(knon, ypaprs, ypplay, &
5015	yt2m,yt10m,yq2m,yq10m,yustar,ywstar, &
5016	y_flux_t,y_flux_q,yu,yv,yt,yq, &
5017	ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, &
5018	ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl)
5019	IF (prt_level >=10) THEN
5020	print *,' Arg. de HBTM: yt2m ',yt2m(1:knon)
5021	print *,' Arg. de HBTM: yt10m ',yt10m(1:knon)
5022	print *,' Arg. de HBTM: yq2m ',yq2m(1:knon)
5023	print *,' Arg. de HBTM: yq10m ',yq10m(1:knon)
5024	print *,' Arg. de HBTM: yustar ',yustar(1:knon)
5025	print *,' Arg. de HBTM: y_flux_t ',y_flux_t(1:knon,:)
5026	print *,' Arg. de HBTM: y_flux_q ',y_flux_q(1:knon,:)
5027	print *,' Arg. de HBTM: yu ',yu(1:knon,:)
5028	print *,' Arg. de HBTM: yv ',yv(1:knon,:)
5029	print *,' Arg. de HBTM: yt ',yt(1:knon,:)
5030	print *,' Arg. de HBTM: yq ',yq(1:knon,:)
5031	ENDIF
5032	ELSE ! (iflag_split .eq.0)
5033	CALL HBTM(knon, ypaprs, ypplay, &
5034	yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, &
5035	y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, &
5036	ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, &
5037	ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x)
5038	IF (prt_level >=10) THEN
5039	print *,' Arg. de HBTM: yt2m_x ',yt2m_x(1:knon)
5040	print *,' Arg. de HBTM: yt10m_x ',yt10m_x(1:knon)
5041	print *,' Arg. de HBTM: yq2m_x ',yq2m_x(1:knon)
5042	print *,' Arg. de HBTM: yq10m_x ',yq10m_x(1:knon)
5043	print *,' Arg. de HBTM: yustar_x ',yustar_x(1:knon)
5044	print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x(1:knon,:)
5045	print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x(1:knon,:)
5046	print *,' Arg. de HBTM: yu_x ',yu_x(1:knon,:)
5047	print *,' Arg. de HBTM: yv_x ',yv_x(1:knon,:)
5048	print *,' Arg. de HBTM: yt_x ',yt_x(1:knon,:)
5049	print *,' Arg. de HBTM: yq_x ',yq_x(1:knon,:)
5050	ENDIF
5051	CALL HBTM(knon, ypaprs, ypplay, &
5052	yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, &
5053	y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, &
5054	ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, &
5055	ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w)
5056
5057	ENDIF ! (iflag_split .eq.0)
5058
5059	IF (iflag_split .eq.0) THEN
5060
5061	DO j=1, knon
5062	i = ni(j)
5063	pblh(i,nsrf) = ypblh(j)
5064	wstar(i,nsrf) = ywstar(j)
5065	plcl(i,nsrf) = ylcl(j)
5066	capCL(i,nsrf) = ycapCL(j)
5067	oliqCL(i,nsrf) = yoliqCL(j)
5068	cteiCL(i,nsrf) = ycteiCL(j)
5069	pblT(i,nsrf) = ypblT(j)
5070	therm(i,nsrf) = ytherm(j)
5071	trmb1(i,nsrf) = ytrmb1(j)
5072	trmb2(i,nsrf) = ytrmb2(j)
5073	trmb3(i,nsrf) = ytrmb3(j)
5074	ENDDO
5075	IF (prt_level >=10) THEN
5076	print *, 'After HBTM: pblh ', pblh(1:knon,:)
5077	print *, 'After HBTM: plcl ', plcl(1:knon,:)
5078	print *, 'After HBTM: cteiCL ', cteiCL(1:knon,:)
5079	ENDIF
5080	ELSE !(iflag_split .eq.0)
5081	DO j=1, knon
5082	i = ni(j)
5083	pblh_x(i,nsrf) = ypblh_x(j)
5084	wstar_x(i,nsrf) = ywstar_x(j)
5085	plcl_x(i,nsrf) = ylcl_x(j)
5086	capCL_x(i,nsrf) = ycapCL_x(j)
5087	oliqCL_x(i,nsrf) = yoliqCL_x(j)
5088	cteiCL_x(i,nsrf) = ycteiCL_x(j)
5089	pblT_x(i,nsrf) = ypblT_x(j)
5090	therm_x(i,nsrf) = ytherm_x(j)
5091	trmb1_x(i,nsrf) = ytrmb1_x(j)
5092	trmb2_x(i,nsrf) = ytrmb2_x(j)
5093	trmb3_x(i,nsrf) = ytrmb3_x(j)
5094	ENDDO
5095	IF (prt_level >=10) THEN
5096	print *, 'After HBTM: pblh_x ', pblh_x(1:knon,:)
5097	print *, 'After HBTM: plcl_x ', plcl_x(1:knon,:)
5098	print *, 'After HBTM: cteiCL_x ', cteiCL_x(1:knon,:)
5099	ENDIF
5100	DO j=1, knon
5101	i = ni(j)
5102	pblh_w(i,nsrf) = ypblh_w(j)
5103	wstar_w(i,nsrf) = ywstar_w(j)
5104	plcl_w(i,nsrf) = ylcl_w(j)
5105	capCL_w(i,nsrf) = ycapCL_w(j)
5106	oliqCL_w(i,nsrf) = yoliqCL_w(j)
5107	cteiCL_w(i,nsrf) = ycteiCL_w(j)
5108	pblT_w(i,nsrf) = ypblT_w(j)
5109	therm_w(i,nsrf) = ytherm_w(j)
5110	trmb1_w(i,nsrf) = ytrmb1_w(j)
5111	trmb2_w(i,nsrf) = ytrmb2_w(j)
5112	trmb3_w(i,nsrf) = ytrmb3_w(j)
5113	ENDDO
5114	IF (prt_level >=10) THEN
5115	print *, 'After HBTM: pblh_w ', pblh_w(1:knon,:)
5116	print *, 'After HBTM: plcl_w ', plcl_w(1:knon,:)
5117	print *, 'After HBTM: cteiCL_w ', cteiCL_w(1:knon,:)
5118	ENDIF
5119
5120	ENDIF ! (iflag_split .eq.0)
5121
5122	#else
5123	! T2m not defined
5124	! No calculation
5125	PRINT*,' Warning !!! No T2m calculation. Output is set to zero.'
5126	#endif
5127
5128	!****************************************************************************************
5129	! 15) End of loop over different surfaces
5130	!
5131	!****************************************************************************************
5132	! ENDDO loop_nbsrf
5133	CALL checksum("yeps",yeps)
5134	CALL checksum("yq2m",yq2m)
5135	END SUBROUTINE pbl_surface_subsrf
5136
5137
5138	SUBROUTINE pbl_surface_uncompressed_post( &
5139	itap, dtime, &
5140	u, v, &
5141	wake_s, &
5142	pctsrf, &
5143	ts,ustar, u10m, v10m,wstar, &
5144	zu1, zv1, &
5145	zxsens, zxevap, zxsnowerosion, &
5146	zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, &
5147	zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, &
5148	zq2m, s_pblh, s_plcl, &
5149	s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, &
5150	s_capCL, s_oliqCL, s_cteiCL, s_pblT, &
5151	s_therm, s_trmb1, s_trmb2, s_trmb3, &
5152	zustar,zu10m, zv10m, fder_print, &
5153	zxqsurf, &
5154	zxfluxu, zxfluxv, &
5155	z0m, z0h, sollw, solsw, &
5156	d_ts, evap, fluxlat, t2m, &
5157	wfbils, wfevap, &
5158	flux_t, flux_u, flux_v, &
5159	dflux_t, dflux_q, zxsnow, &
5160	zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, bilg_cumul, iflag_split_ref, &
5161	& 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, &
5162	fluxlat_x, fluxlat_w, t2m_x, q2m_x, qsat2m_x, u10m_x, v10m_x, ustar_x, wstar_x, pblh_x, plcl_x, &
5163	capCL_x, oliqCL_x, cteiCL_x, pblt_x, therm_x, trmb1_x, trmb2_x, trmb3_x, t2m_w, qsat2m_w, &
5164	pblh_w, plcl_w, pblh, plcl, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3 &
5165	#ifdef ISO
5166	& ,xtrain_f, xtsnow_f,xt, &
5167	& wake_dlxt,zxxtevap,xtevap, &
5168	& d_xt,d_xt_w,d_xt_x, &
5169	& xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
5170	& h1_diag,runoff_diag,xtrunoff_diag &
5171	#endif
5172	& )
5173	!****************************************************************************************
5174	! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
5175	! Objet: interface de "couche limite" (diffusion verticale)
5176	!
5177	!AA REM:
5178	!AA-----
5179	!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
5180	!AA pour l'instant le calcul de la couche limite pour les traceurs
5181	!AA se fait avec cltrac et ne tient pas compte de la differentiation
5182	!AA des sous-fraction de sol.
5183	!AA REM bis :
5184	!AA----------
5185	!AA Pour pouvoir extraire les coefficient d'echanges et le vent
5186	!AA dans la premiere couche, 3 champs supplementaires ont ete crees
5187	!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
5188	!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir
5189	!AA si les informations des subsurfaces doivent etre prises en compte
5190	!AA il faudra sortir ces memes champs en leur ajoutant une dimension,
5191	!AA c'est a dire nbsrf (nbre de subsurface).
5192	!
5193	! Arguments:
5194	!
5195	! dtime----input-R- interval du temps (secondes)
5196	! itap-----input-I- numero du pas de temps
5197	! date0----input-R- jour initial
5198	! t--------input-R- temperature (K)
5199	! q--------input-R- vapeur d'eau (kg/kg)
5200	! u--------input-R- vitesse u
5201	! v--------input-R- vitesse v
5202	! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
5203	! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
5204	!wake_cstar-input-R- wake gust front speed (m/s)
5205	! wake_s---input-R- wake fractionnal area
5206	! ts-------input-R- temperature du sol (en Kelvin)
5207	! paprs----input-R- pression a intercouche (Pa)
5208	! pplay----input-R- pression au milieu de couche (Pa)
5209	! rlat-----input-R- latitude en degree
5210	! z0m, z0h ----input-R- longeur de rugosite (en m)
5211	! Martin
5212	! cldt-----input-R- total cloud fraction
5213	! Martin
5214	!GG
5215	! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
5216	!GG
5217	!
5218	! d_t------output-R- le changement pour "t"
5219	! d_q------output-R- le changement pour "q"
5220	! d_u------output-R- le changement pour "u"
5221	! d_v------output-R- le changement pour "v"
5222	! d_ts-----output-R- le changement pour "ts"
5223	! flux_t---output-R- flux de chaleur sensible (CpT) J/m2/s (W/m2)
5224	! (orientation positive vers le bas)
5225	! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
5226	! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
5227	! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
5228	! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
5229	! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
5230	! dflux_t--output-R- derive du flux sensible
5231	! dflux_q--output-R- derive du flux latent
5232	! zu1------output-R- le vent dans la premiere couche
5233	! zv1------output-R- le vent dans la premiere couche
5234	! trmb1----output-R- deep_cape
5235	! trmb2----output-R- inhibition
5236	! trmb3----output-R- Point Omega
5237	! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
5238	! plcl-----output-R- Niveau de condensation
5239	! pblh-----output-R- HCL
5240	! pblT-----output-R- T au nveau HCL
5241	! treedrg--output-R- tree drag (m)
5242	! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
5243	! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
5244	! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
5245	! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
5246	! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
5247	! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
5248	! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
5249	! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
5250
5251	use hbtm_mod, only: hbtm
5252	USE indice_sol_mod
5253	USE mod_grid_phy_lmdz, ONLY : grid1dto2d_glo
5254	#ifdef ISO
5255	USE isotopes_mod, ONLY: Rdefault,iso_eau
5256	#ifdef ISOVERIF
5257	USE isotopes_verif_mod
5258	#endif
5259	#ifdef ISOTRAC
5260	USE isotrac_mod, only: index_iso
5261	#endif
5262	#endif
5263	USE dimpft_mod_h
5264	USE flux_arp_mod_h
5265	USE compbl_mod_h
5266	USE yoethf_mod_h
5267	USE clesphys_mod_h
5268	USE ioipsl_getin_p_mod, ONLY : getin_p
5269	USE dimsoil_mod_h, ONLY: nsoilmx
5270	USE surf_param_mod, ONLY: eff_surf_param !AM
5271	USE yomcst_mod_h
5272	USE ocean_forced_mod,ONLY : ocean_forced_ice_reset_bilg_cumul
5273	USE lmdz_checksum, ONLY : checksum
5274	IMPLICIT NONE
5275
5276	INCLUDE "FCTTRE.h"
5277
5278	!****************************************************************************************
5279	INTEGER, INTENT(IN) :: itap ! time step
5280	REAL, INTENT(IN) :: dtime ! interval du temps (secondes)
5281	REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed
5282	REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed
5283	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! sub-surface fraction
5284	#ifdef ISO
5285	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg)
5286	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall
5287	REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall
5288	#endif
5289	REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides
5290
5291	#ifdef ISO
5292	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt
5293	#endif
5294
5295	! Input/Output variables
5296	!****************************************************************************************
5297	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K)
5298	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s)
5299	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s)
5300	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m
5301	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m
5302
5303	! Output variables
5304	!****************************************************************************************
5305	REAL, DIMENSION(klon), INTENT(OUT) :: zu1 ! u wind speed in first layer
5306	REAL, DIMENSION(klon), INTENT(OUT) :: zv1 ! v wind speed in first layer
5307	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens ! sensible heat flux at surface with inversed sign
5308	! (=> positive sign upwards)
5309	REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards
5310	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface
5311	REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point
5312	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point
5313	REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point
5314	INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: zn2mout ! number of times the 2m temperature is out of the [tsol,temp]
5315	REAL, DIMENSION(klon), INTENT(OUT) :: qsat2m
5316	#ifdef ISO
5317	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards
5318	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour
5319	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
5320	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
5321	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w
5322	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x
5323	#endif
5324	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche
5325	REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche
5326	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche
5327	REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche
5328
5329	! Output only for diagnostics
5330	REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point
5331	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL)
5332	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region
5333	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region
5334	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level
5335	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region
5336	REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region
5337	REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL
5338	REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL
5339	REAL, DIMENSION(klon), INTENT(OUT) :: s_cteiCL ! cloud top instab. crit. of PBL
5340	REAL, DIMENSION(klon), INTENT(OUT) :: s_pblT ! temperature at PBLH
5341	REAL, DIMENSION(klon), INTENT(OUT) :: s_therm ! thermal virtual temperature excess
5342	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb1 ! deep cape, mean for each grid point
5343	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb2 ! inhibition, mean for each grid point
5344	REAL, DIMENSION(klon), INTENT(OUT) :: s_trmb3 ! point Omega, mean for each grid point
5345	REAL, DIMENSION(klon), INTENT(OUT) :: zustar ! u*
5346	REAL, DIMENSION(klon), INTENT(OUT) :: zu10m ! u speed at 10m, mean for each grid point
5347	REAL, DIMENSION(klon), INTENT(OUT) :: zv10m ! v speed at 10m, mean for each grid point
5348	REAL, DIMENSION(klon), INTENT(OUT) :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
5349	REAL, DIMENSION(klon), INTENT(OUT) :: zxqsurf ! humidity at surface, mean for each grid point
5350	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxu ! u wind tension, mean for each grid point
5351	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxv ! v wind tension, mean for each grid point
5352	REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: z0m,z0h ! rugosity length (m)
5353	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: solsw ! net shortwave radiation at surface
5354	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: sollw ! net longwave radiation at surface
5355	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: d_ts ! change in temperature at surface
5356	REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface
5357	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: fluxlat ! latent flux
5358	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m ! temperature at 2 meter height
5359	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfbils ! heat balance at surface
5360	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: wfevap ! water balance (evap) at surface weighted by srf
5361	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_t ! sensible heat flux (CpT) J/m2/s (W/m2)
5362	! positve orientation downwards
5363	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_u ! u wind tension (kg m/s)/(m**2 s) or Pascal
5364	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal
5365	#ifdef ISO
5366	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm)
5367	REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface
5368	REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful
5369	#endif
5370
5371	! Output not needed
5372	REAL, DIMENSION(klon), INTENT(IN) :: dflux_t ! change of sensible heat flux
5373	REAL, DIMENSION(klon), INTENT(IN) :: dflux_q ! change of water vapour flux
5374	REAL, DIMENSION(klon), INTENT(OUT) :: zxsnow ! snow at surface, mean for each grid point
5375	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point
5376	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point
5377	REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxqbs ! blowing snow flux, mean for each grid point
5378	REAL, DIMENSION(klon, nbsrf),INTENT(IN) :: q2m ! water vapour at 2 meter height
5379	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s)
5380	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_qbs ! blowind snow vertical flux (kg/m**2
5381	REAL, DIMENSION(klon), INTENT(INOUT) :: bilg_cumul ! flux cumulated
5382	INTEGER, INTENT(INOUT) :: iflag_split_ref
5383
5384	#ifdef ISO
5385	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux
5386	REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point
5387	REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point
5388	REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s)
5389	#endif
5390
5391	! Other local variables
5392	!****************************************************************************************
5393	INTEGER :: iflag_split
5394	INTEGER :: i, k, nsrf
5395	REAL :: amn, amx
5396	INTEGER, DIMENSION(klon, nbsrf, 6), INTENT(IN) :: n2mout, n2mout_x
5397	REAL, DIMENSION(klon) :: meansqT ! mean square deviation of subsurface temperatures
5398	LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
5399	LOGICAL, PARAMETER :: check=.FALSE.
5400
5401	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
5402	REAL, DIMENSION(klon, klev, nbsrf), INTENT(IN) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
5403	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: fluxlat_x, fluxlat_w
5404	REAL, DIMENSION(klon, klev) :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w
5405	REAL, DIMENSION(klon, klev) :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w
5406	#ifdef ISO
5407	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: zxfluxxt_x
5408	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: zxfluxxt_w
5409	REAL, DIMENSION(ntraciso,klon,klev,nbsrf), INTENT(IN) :: flux_xt_x, flux_xt_w
5410	#endif
5411	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m_x
5412	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: q2m_x
5413	REAL, DIMENSION(klon), INTENT(IN) :: qsat2m_x
5414	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: u10m_x
5415	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: v10m_x
5416	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: ustar_x
5417	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: wstar_x
5418	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pblh_x
5419	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: plcl_x
5420	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: capCL_x
5421	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: oliqCL_x
5422	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: cteiCL_x
5423	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pblt_x
5424	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: therm_x
5425	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: trmb1_x
5426	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: trmb2_x
5427	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: trmb3_x
5428	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m_w
5429	REAL, DIMENSION(klon), INTENT(IN) :: qsat2m_w
5430	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pblh_w
5431	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: plcl_w
5432	REAL, PARAMETER :: facteur=2./sqrt(3.14)
5433	REAL, PARAMETER :: inertia=2000.
5434
5435	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pblh ! height of the planetary boundary layer
5436	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: plcl ! condensation level
5437	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: capCL
5438	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: oliqCL
5439	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: cteiCL
5440	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pblT
5441	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: therm
5442	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: trmb1 ! deep cape
5443	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: trmb2 ! inhibition
5444	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: trmb3 ! point Omega
5445	#ifdef ISO
5446	INTEGER :: ixt
5447	#endif
5448
5449	!
5450	!----------------------------------------------------------------------------------------
5451	! Reset iflag_split
5452	!
5453	iflag_split=iflag_split_ref
5454
5455	#ifdef ISO
5456	#ifdef ISOVERIF
5457
5458	IF (iso_eau >= 0) THEN
5459	call iso_verif_egalite_vect2D( &
5460	d_xt,d_q, &
5461	'pbl_surface_mod 1276',ntraciso,klon,klev)
5462	ENDIF !IF (iso_eau >= 0) THEN
5463	#endif
5464	#endif
5465
5466	!YM something bad to check
5467	CALL ocean_forced_ice_reset_bilg_cumul(itap, dtime, bilg_cumul)
5468	!****************************************************************************************
5469	! 16) Calculate the mean value over all sub-surfaces for some variables
5470	!
5471	!****************************************************************************************
5472
5473	z0m(:,nbsrf+1) = 0.0
5474	z0h(:,nbsrf+1) = 0.0
5475	DO nsrf = 1, nbsrf
5476	DO i = 1, klon
5477	z0m(i,nbsrf+1) = z0m(i,nbsrf+1) + z0m(i,nsrf)*pctsrf(i,nsrf)
5478	z0h(i,nbsrf+1) = z0h(i,nbsrf+1) + z0h(i,nsrf)*pctsrf(i,nsrf)
5479	ENDDO
5480	ENDDO
5481
5482	zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
5483	zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
5484	zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0
5485	zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0
5486	zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
5487	zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
5488	#ifdef ISO
5489	zxfluxxt(:,:,:) = 0.0
5490	zxfluxxt_x(:,:,:) = 0.0
5491	zxfluxxt_w(:,:,:) = 0.0
5492	#endif
5493
5494
5495	IF (iflag_split .ge.1) THEN
5496
5497	DO nsrf = 1, nbsrf
5498	DO k = 1, klev
5499	DO i = 1, klon
5500	zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf)
5501	zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf)
5502	zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf)
5503	zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf)
5504	zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf)
5505	zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf)
5506	zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
5507	zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
5508	#ifdef ISO
5509	DO ixt=1,ntraciso
5510	zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf)
5511	zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf)
5512	ENDDO ! DO ixt=1,ntraciso
5513	#endif
5514	ENDDO
5515	ENDDO
5516	ENDDO
5517
5518	DO i = 1, klon
5519	zxsens_x(i) = - zxfluxt_x(i,1)
5520	zxsens_w(i) = - zxfluxt_w(i,1)
5521	ENDDO
5522	!!!
5523	ENDIF ! (iflag_split .ge.1)
5524	!!!
5525
5526	DO nsrf = 1, nbsrf
5527	DO k = 1, klev
5528	DO i = 1, klon
5529	zxfluxt(i,k) = zxfluxt(i,k) + flux_t(i,k,nsrf) * pctsrf(i,nsrf)
5530	zxfluxq(i,k) = zxfluxq(i,k) + flux_q(i,k,nsrf) * pctsrf(i,nsrf)
5531	zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
5532	zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
5533	#ifdef ISO
5534	DO ixt=1,niso
5535	zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf)
5536	ENDDO ! DO ixt=1,niso
5537	#endif
5538	ENDDO
5539	ENDDO
5540	ENDDO
5541
5542	DO i = 1, klon
5543	zxsens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
5544	zxevap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
5545	fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
5546	ENDDO
5547
5548	! if blowing snow
5549	if (ok_bs) then
5550	DO nsrf = 1, nbsrf
5551	DO k = 1, klev
5552	DO i = 1, klon
5553	zxfluxqbs(i,k) = zxfluxqbs(i,k) + flux_qbs(i,k,nsrf) * pctsrf(i,nsrf)
5554	ENDDO
5555	ENDDO
5556	ENDDO
5557
5558	DO i = 1, klon
5559	zxsnowerosion(i) = zxfluxqbs(i,1) ! blowings snow flux at the surface
5560	END DO
5561	endif
5562
5563	#ifdef ISO
5564	DO i = 1, klon
5565	DO ixt=1,ntraciso
5566	zxxtevap(ixt,i) = - zxfluxxt(ixt,i,1)
5567	ENDDO
5568	ENDDO
5569	#endif
5570
5571	!
5572	! Incrementer la temperature du sol
5573	!
5574	zxtsol(:) = 0.0 ; zxfluxlat(:) = 0.0
5575	zt2m(:) = 0.0 ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
5576	zustar(:)=0.0 ; zu10m(:) = 0.0 ; zv10m(:) = 0.0
5577	s_pblh(:) = 0.0 ; s_plcl(:) = 0.0
5578
5579	s_pblh_x(:) = 0.0 ; s_plcl_x(:) = 0.0
5580	s_pblh_w(:) = 0.0 ; s_plcl_w(:) = 0.0
5581
5582	s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
5583	s_cteiCL(:) = 0.0; s_pblT(:) = 0.0
5584	s_therm(:) = 0.0 ; s_trmb1(:) = 0.0
5585	s_trmb2(:) = 0.0 ; s_trmb3(:) = 0.0
5586	wstar(:,is_ave)=0.
5587
5588	zxfluxlat_x(:) = 0.0 ; zxfluxlat_w(:) = 0.0
5589
5590	DO nsrf = 1, nbsrf
5591	DO i = 1, klon
5592	ts(i,nsrf) = ts(i,nsrf) + d_ts(i,nsrf)
5593
5594	wfbils(i,nsrf) = ( solsw(i,nsrf) + sollw(i,nsrf) &
5595	+ flux_t(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
5596
5597	wfevap(i,nsrf) = evap(i,nsrf)*pctsrf(i,nsrf)
5598
5599	zxtsol(i) = zxtsol(i) + ts(i,nsrf) * pctsrf(i,nsrf)
5600	zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
5601	ENDDO
5602	ENDDO
5603	!
5604	!<al1 order 2 correction to zxtsol, for radiation computations (main atm effect of Ts)
5605	IF (iflag_order2_sollw == 1) THEN
5606	meansqT(:) = 0. ! as working buffer
5607	DO nsrf = 1, nbsrf
5608	DO i = 1, klon
5609	meansqT(i) = meansqT(i)+(ts(i,nsrf)-zxtsol(i))*2 pctsrf(i,nsrf)
5610	ENDDO
5611	ENDDO
5612	zxtsol(:) = zxtsol(:)+1.5*meansqT(:)/zxtsol(:)
5613	ENDIF ! iflag_order2_sollw == 1
5614
5615	CALL checksum("n2mout", n2mout)
5616	CALL checksum("n2mout_x", n2mout_x)
5617
5618	IF (iflag_split .eq.0) THEN
5619	DO nsrf = 1, nbsrf
5620	DO i = 1, klon
5621	zt2m(i) = zt2m(i) + t2m(i,nsrf) * pctsrf(i,nsrf)
5622	zq2m(i) = zq2m(i) + q2m(i,nsrf) * pctsrf(i,nsrf)
5623	!
5624	DO k = 1, 6
5625	zn2mout(i,k) = zn2mout(i,k) + n2mout(i,nsrf,k) * pctsrf(i,nsrf)
5626	ENDDO
5627	!
5628	zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
5629	wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
5630	zu10m(i) = zu10m(i) + u10m(i,nsrf) * pctsrf(i,nsrf)
5631	zv10m(i) = zv10m(i) + v10m(i,nsrf) * pctsrf(i,nsrf)
5632
5633	s_pblh(i) = s_pblh(i) + pblh(i,nsrf) * pctsrf(i,nsrf)
5634	s_plcl(i) = s_plcl(i) + plcl(i,nsrf) * pctsrf(i,nsrf)
5635	s_capCL(i) = s_capCL(i) + capCL(i,nsrf) * pctsrf(i,nsrf)
5636	s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf)* pctsrf(i,nsrf)
5637	s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf)* pctsrf(i,nsrf)
5638	s_pblT(i) = s_pblT(i) + pblT(i,nsrf) * pctsrf(i,nsrf)
5639	s_therm(i) = s_therm(i) + therm(i,nsrf) * pctsrf(i,nsrf)
5640	s_trmb1(i) = s_trmb1(i) + trmb1(i,nsrf) * pctsrf(i,nsrf)
5641	s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) * pctsrf(i,nsrf)
5642	s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) * pctsrf(i,nsrf)
5643	ENDDO
5644	ENDDO
5645	ELSE !(iflag_split .eq.0)
5646	DO nsrf = 1, nbsrf
5647	DO i = 1, klon
5648	zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf)
5649	zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf)
5650	!!!
5651	!!! jyg le 08/02/2012
5652	!! Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ;
5653	!! pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ;
5654	!! pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ;
5655	!! pour les autres variables, on sort les valeurs de la region (x).
5656	zt2m(i) = zt2m(i) + (t2m_x(i,nsrf)+wake_s(i)(t2m_w(i,nsrf)-t2m_x(i,nsrf))) pctsrf(i,nsrf)
5657	zq2m(i) = zq2m(i) + q2m_x(i,nsrf) * pctsrf(i,nsrf)
5658	!
5659	DO k = 1, 6
5660	zn2mout(i,k) = zn2mout(i,k) + n2mout_x(i,nsrf,k) * pctsrf(i,nsrf)
5661	ENDDO
5662	!
5663	zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
5664	wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
5665	zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf)
5666	zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf)
5667	!
5668	s_pblh(i) = s_pblh(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf)
5669	s_pblh_x(i) = s_pblh_x(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf)
5670	s_pblh_w(i) = s_pblh_w(i) + pblh_w(i,nsrf) * pctsrf(i,nsrf)
5671	!
5672	s_plcl(i) = s_plcl(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf)
5673	s_plcl_x(i) = s_plcl_x(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf)
5674	s_plcl_w(i) = s_plcl_w(i) + plcl_w(i,nsrf) * pctsrf(i,nsrf)
5675	!
5676	s_capCL(i) = s_capCL(i) + capCL_x(i,nsrf) * pctsrf(i,nsrf)
5677	s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf)
5678	s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf)
5679	s_pblT(i) = s_pblT(i) + pblT_x(i,nsrf) * pctsrf(i,nsrf)
5680	s_therm(i) = s_therm(i) + therm_x(i,nsrf) * pctsrf(i,nsrf)
5681	s_trmb1(i) = s_trmb1(i) + trmb1_x(i,nsrf) * pctsrf(i,nsrf)
5682	s_trmb2(i) = s_trmb2(i) + trmb2_x(i,nsrf) * pctsrf(i,nsrf)
5683	s_trmb3(i) = s_trmb3(i) + trmb3_x(i,nsrf) * pctsrf(i,nsrf)
5684	ENDDO
5685	ENDDO
5686	DO i = 1, klon
5687	qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i))
5688	ENDDO
5689	!!!
5690	ENDIF ! (iflag_split .eq.0)
5691	!!!
5692
5693	IF (check) THEN
5694	amn=MIN(ts(1,is_ter),1000.)
5695	amx=MAX(ts(1,is_ter),-1000.)
5696	DO i=2, klon
5697	amn=MIN(ts(i,is_ter),amn)
5698	amx=MAX(ts(i,is_ter),amx)
5699	ENDDO
5700	PRINT*,' debut apres d_ts min max ftsol(ts)',itap,amn,amx
5701	ENDIF
5702
5703	DO i = 1, klon
5704	fder(i) = - 4.0RSIGMAzxtsol(i)**3
5705	ENDDO
5706
5707	zxqsurf(:) = 0.0
5708	zxsnow(:) = 0.0
5709	#ifdef ISO
5710	zxxtsnow(:,:) = 0.0
5711	#endif
5712
5713	DO nsrf = 1, nbsrf
5714	DO i = 1, klon
5715	zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
5716	zxsnow(i) = zxsnow(i) + snow(i,nsrf) * pctsrf(i,nsrf)
5717	#ifdef ISO
5718	DO ixt=1,niso
5719	zxxtsnow(ixt,i) = zxxtsnow(ixt,i) + xtsnow(ixt,i,nsrf) * pctsrf(i,nsrf)
5720	ENDDO ! DO ixt=1,niso
5721	#endif
5722	ENDDO
5723	ENDDO
5724
5725	! Premier niveau de vent sortie dans physiq.F
5726	zu1(:) = u(:,1)
5727	zv1(:) = v(:,1)
5728
5729	END SUBROUTINE pbl_surface_uncompressed_post
5730	!
5731	!****************************************************************************************
5732	!
5733	END MODULE pbl_surface_mod

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

Download in other formats:

Original Format