Context Navigation

surf_land_bucket_mod.F90 @ 5218

Last change on this file since 5218 was 5144, checked in by abarral, 5 months ago
Put YOMCST.h into modules
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: 11.9 KB

Line
1
2	MODULE surf_land_bucket_mod
3
4	! Surface land bucket module
5
6	! This module is used when no external land model is choosen.
7
8	IMPLICIT NONE
9
10	CONTAINS
11
12	SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
13	tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
14	spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
15	u1, v1, gustiness, rugoro, swnet, lwnet, &
16	snow, qsol, agesno, tsoil, &
17	qsurf, z0_new, alb1_new, alb2_new, evap, &
18	fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
19	#ifdef ISO
20	,xtprecip_rain, xtprecip_snow,xtspechum, &
21	xtsnow, xtsol,xtevap,h1, &
22	runoff_diag,xtrunoff_diag,Rland_ice &
23	#endif
24	)
25
26	USE limit_read_mod
27	USE surface_data
28	USE fonte_neige_mod
29	USE calcul_fluxs_mod
30	USE cpl_mod
31	USE dimphy
32	USE lmdz_geometry, ONLY: longitude,latitude
33	USE lmdz_grid_phy
34	USE lmdz_phys_para
35	USE indice_sol_mod
36	USE lmdz_clesphys
37	USE lmdz_yomcst
38
39	#ifdef ISO
40	USE infotrac_phy, ONLY: ntiso,niso
41	USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
42	ridicule_qsol
43	USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
44	#ifdef ISOVERIF
45	USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
46	iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
47	#endif
48	#endif
49	!****************************************************************************************
50	! Bucket calculations for surface.
51
52	INCLUDE "dimsoil.h"
53
54	! Input variables
55	!****************************************************************************************
56	INTEGER, INTENT(IN) :: itime, jour, knon
57	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
58	LOGICAL, INTENT(IN) :: debut
59	REAL, INTENT(IN) :: dtime
60	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
61	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
62	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
63	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
64	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
65	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
66	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
67	REAL, DIMENSION(klon), INTENT(IN) :: pref
68	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
69	REAL, DIMENSION(klon), INTENT(IN) :: rugoro
70	REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet
71	#ifdef ISO
72	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
73	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
74	#endif
75
76	! In/Output variables
77	!****************************************************************************************
78	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
79	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
80	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
81	#ifdef ISO
82	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow,xtsol
83	#endif
84
85	! Output variables
86	!****************************************************************************************
87	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
88	REAL, DIMENSION(klon), INTENT(OUT) :: z0_new
89	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
90	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
91	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
92	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
93	#ifdef ISO
94	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
95	REAL, DIMENSION(klon), INTENT(OUT) :: h1
96	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
97	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
98	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
99	#endif
100
101	! Local variables
102	!****************************************************************************************
103	REAL, DIMENSION(klon) :: soilcap, soilflux
104	REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
105	REAL, DIMENSION(klon) :: alb_neig, alb_lim
106	REAL, DIMENSION(klon) :: zfra
107	REAL, DIMENSION(klon) :: radsol ! total net radiance at surface
108	REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
109	REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
110	INTEGER :: i
111	#ifdef ISO
112	INTEGER :: ixt
113	REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
114	REAL, DIMENSION(klon) :: snow_prec,qsol_prec
115	REAL, PARAMETER :: t_coup = 273.15
116	REAL, DIMENSION(klon) :: fq_fonte_diag
117	REAL, DIMENSION(klon) :: fqfonte_diag
118	REAL, DIMENSION(klon) :: snow_evap_diag
119	REAL, DIMENSION(klon) :: fqcalving_diag
120	REAL :: max_eau_sol_diag
121	REAL, DIMENSION(klon) :: run_off_lic_diag
122	REAL :: coeff_rel_diag
123	#endif
124
125	!****************************************************************************************
126
127	#ifdef ISO
128	#ifdef ISOVERIF
129	!WRITE(,) 'surf_land_bucket 152'
130	DO i=1,knon
131	IF (iso_eau > 0) THEN
132	CALL iso_verif_egalite_choix(precip_snow(i), &
133	xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
134	errmax,errmaxrel)
135	CALL iso_verif_egalite_choix(qsol(i), &
136	xtsol(iso_eau,i),'surf_land_bucket 134', &
137	errmax,errmaxrel)
138	ENDIF
139	ENDDO
140	#endif
141	#ifdef ISOVERIF
142	DO i=1,knon
143	DO ixt=1,niso
144	CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
145	ENDDO !do ixt=1,niso
146	ENDDO !do i=1,knon
147	!WRITE(,) 'surf_land_bucket 152'
148	#endif
149	#endif
150
151	!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
152
153	CALL limit_read_rug_alb(itime, dtime, jour,&
154	knon, knindex, &
155	z0_new, alb_lim)
156
157	!* Calcultaion of fluxes
158
159	! calculate total absorbed radiance at surface
160	radsol(:) = 0.0
161	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
162
163	! calculate constants
164	CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
165	IF (type_veget=='betaclim') THEN
166	CALL calbeta_clim(knon,jour,latitude(knindex(1:knon)),beta)
167	endif
168
169	! calculate temperature, heat capacity and conduction flux in soil
170	IF (soil_model) THEN
171	CALL soil(dtime, is_ter, knon, snow, tsurf, qsol, &
172	longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
173
174	DO i=1, knon
175	cal(i) = RCPD / soilcap(i)
176	radsol(i) = radsol(i) + soilflux(i)
177	END DO
178	ELSE
179	cal(:) = RCPD * capsol(:)
180	IF (klon_glo == 1) THEN
181	cal(:) = 0.
182	ENDIF
183	ENDIF
184
185	! Suppose zero surface speed
186	u0(:)=0.0
187	v0(:)=0.0
188	u1_lay(:) = u1(:) - u0(:)
189	v1_lay(:) = v1(:) - v0(:)
190
191	CALL calcul_fluxs(knon, is_ter, dtime, &
192	tsurf, p1lay, cal, beta, tq_cdrag, tq_cdrag, pref, &
193	precip_rain, precip_snow, snow, qsurf, &
194	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
195	1.,petAcoef, peqAcoef, petBcoef, peqBcoef, &
196	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
197
198	#ifdef ISO
199	! verif
200	#ifdef ISOVERIF
201	!WRITE(,) 'surf_land_bucket 211'
202	DO i=1,knon
203	IF (iso_eau > 0) THEN
204	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
205	snow(i),'surf_land_bucket 522', &
206	errmax,errmaxrel)
207	ENDIF !IF (iso_eau > 0) THEN
208	ENDDO !DO i=1,knon
209	#endif
210	! end verif
211	#endif
212	#ifdef ISO
213	DO i=1,knon
214	snow_prec(i)=snow(i)
215	qsol_prec(i)=qsol(i)
216	DO ixt=1,niso
217	xtsnow_prec(ixt,i)=xtsnow(ixt,i)
218	xtsol_prec(ixt,i) =xtsol(ixt,i)
219	ENDDO !DO ixt=1,niso
220	! initialisation:
221	fqfonte_diag(i) =0.0
222	fq_fonte_diag(i) =0.0
223	snow_evap_diag(i)=0.0
224	ENDDO !DO i=1,knon
225	#ifdef ISOVERIF
226	! WRITE(,) 'surf_land_bucket 235'
227	DO i=1,knon
228	IF (iso_eau > 0) THEN
229	CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
230	'surf_land_bucket 141')
231	ENDIF
232	ENDDO !DO i=1,knon
233	#endif
234	#endif
235
236	!* Calculate snow height, run_off, age of snow
237
238	CALL fonte_neige( knon, is_ter, knindex, dtime, &
239	tsurf, precip_rain, precip_snow, &
240	snow, qsol, tsurf_new, evap &
241	#ifdef ISO
242	,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag &
243	,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
244	#endif
245	)
246
247	#ifdef ISO
248	#ifdef ISOVERIF
249	DO i=1,knon
250	DO ixt=1,niso
251	CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
252	ENDDO
253	ENDDO
254	#endif
255	#ifdef ISOVERIF
256	!WRITE(,) 'surf_land_bucket 235'
257	DO i=1,knon
258	IF (iso_eau > 0) THEN
259	CALL iso_verif_egalite_choix(qsol_prec(i), &
260	xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
261	errmax,errmaxrel)
262	CALL iso_verif_egalite_choix(precip_snow(i), &
263	xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
264	errmax,errmaxrel)
265	! attention, dans fonte_neige, on modifie snow sans modifier
266	! xtsnow
267	! c'est fait plus tard dans gestion_neige
268	! WRITE(,) 'surf_land_bucket 287: i=',i
269	! WRITE(,) 'snow(i)=',snow(i)
270	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
271	snow_prec(i),'surf_land_bucket 245', &
272	errmax,errmaxrel)
273	ENDIF
274	IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
275	IF (qsol_prec(i) > ridicule_qsol) THEN
276	CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) &
277	,xtsol_prec(iso_O18,i)/qsol_prec(i) &
278	,'surf_land_bucket 642')
279	ENDIF !IF ((qsol_prec(i) > ridicule_qsol) &
280	ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
281	ENDDO !DO i=1,knon
282	!WRITE(,) 'surf_land_mod 291'
283	!WRITE(,) 'snow_evap_diag(1)=',snow_evap_diag(1)
284	#endif
285	CALL calcul_iso_surf_ter_vectall(klon,knon, &
286	evap,snow_evap_diag,snow, &
287	fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
288	precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
289	tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
290	qsol,xtsol,qsol_prec,xtsol_prec, &
291	max_eau_sol_diag, &
292	xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
293	knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
294	)
295	!#ifdef ISOVERIF
296	! WRITE(,) 'surf_land_bucket 303'
297	!#endif
298	#endif
299
300	!* Calculate the age of snow
301
302	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
303
304	WHERE (snow(1 : knon) < 0.0001) agesno(1 : knon) = 0.
305
306	DO i=1, knon
307	zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
308	alb_lim(i) = alb_neig(i) zfra(i) + alb_lim(i)(1.0-zfra(i))
309	END DO
310
311	!* Return albedo :
312	! alb1_new and alb2_new are here given the same values
313
314	alb1_new(:) = 0.0
315	alb2_new(:) = 0.0
316	alb1_new(1:knon) = alb_lim(1:knon)
317	alb2_new(1:knon) = alb_lim(1:knon)
318
319	!* Calculate the rugosity
320
321	DO i = 1, knon
322	z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)2 + rugoro(i)2))
323	END DO
324
325	!* Send to coupler
326	! The run-off from river and coast are not calculated in the bucket modele.
327	! For testing purpose of the coupled modele we put the run-off to zero.
328	IF (type_ocean=='couple') THEN
329	dummy_riverflow(:) = 0.0
330	dummy_coastalflow(:) = 0.0
331	CALL cpl_send_land_fields(itime, knon, knindex, &
332	dummy_riverflow, dummy_coastalflow)
333	ENDIF
334
335	!* End
336
337	END SUBROUTINE surf_land_bucket
338
339	!****************************************************************************************
340
341	END MODULE surf_land_bucket_mod

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

Download in other formats:

Original Format