Context Navigation

simplehydrol_mod.F90 @ 6033

Last change on this file since 6033 was 6033, checked in by evignon, 5 weeks ago
fonte_neige becomes simplehydrol (follow-up on F. Cheruy presentation in LMDZ training session) and the routines are further commented and indented
File size: 28.8 KB

Line
1	! $Header$
2	!
3	MODULE simplehydrol_mod
4
5	!*******************************************************************************************
6	! This module contains a simple hydrology model to compute the soil water content,
7	! the melting and accumulation of snow as well as ice sheet "calving" (rough assumptions)
8	! It is especially used over land and landice surfaces when the coupling with ORCHIDEE
9	! is not active, and over sea ice (especially for snow) when the coupling with NEMO
10	! is not active.
11	! contact: F. Cheruy, frederique.cheruy@lmd.ipsl.fr ; E. Vignon, etienne.vignon@lmd.ipsl.fr
12	!*******************************************************************************************
13	USE dimphy, ONLY: klon
14	USE indice_sol_mod
15
16	IMPLICIT NONE
17	SAVE
18
19	! run_off_ter and run_off_lic are the runoff at the compressed grid knon for
20	! land and land-ice respectively
21	! Note: run_off_lic is used in mod_landice and therfore not private
22	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_ter
23	!$OMP THREADPRIVATE(run_off_ter)
24	REAL, ALLOCATABLE, DIMENSION(:) :: run_off_lic
25	!$OMP THREADPRIVATE(run_off_lic)
26
27	! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
28	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_lic_0
29	!$OMP THREADPRIVATE(run_off_lic_0)
30
31	REAL, PRIVATE :: tau_calv
32	!$OMP THREADPRIVATE(tau_calv)
33	REAL, ALLOCATABLE, DIMENSION(:, :) :: ffonte_global
34	!$OMP THREADPRIVATE(ffonte_global)
35	REAL, ALLOCATABLE, DIMENSION(:, :) :: fqfonte_global
36	!$OMP THREADPRIVATE(fqfonte_global)
37	REAL, ALLOCATABLE, DIMENSION(:, :) :: fqcalving_global
38	!$OMP THREADPRIVATE(fqcalving_global)
39	REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
40	!$OMP THREADPRIVATE(runofflic_global)
41	#ifdef ISO
42	REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE :: xtrun_off_ter
43	!$OMP THREADPRIVATE(xtrun_off_ter)
44	REAL, ALLOCATABLE, DIMENSION(:, :) :: xtrun_off_lic
45	!$OMP THREADPRIVATE(xtrun_off_lic)
46	REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE :: xtrun_off_lic_0
47	!$OMP THREADPRIVATE(xtrun_off_lic_0)
48	REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE:: fxtfonte_global
49	!$OMP THREADPRIVATE(fxtfonte_global)
50	REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE:: fxtcalving_global
51	!$OMP THREADPRIVATE(fxtcalving_global)
52	REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE :: xtrunofflic_global
53	!$OMP THREADPRIVATE(xtrunofflic_global)
54	#endif
55
56	CONTAINS
57	!
58	!****************************************************************************************
59	SUBROUTINE simplehydrol_init(restart_runoff)
60
61	! This subroutine allocates and initialize variables in the module.
62	! The variable run_off_lic_0 is initialized to the field read from
63	! restart file. The other variables are initialized to zero.
64	!
65	!****************************************************************************************
66	! Input argument
67	REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
68
69	! Local variables
70	INTEGER :: error
71	CHARACTER(len=80) :: abort_message
72	CHARACTER(len=20) :: modname = 'fonte_neige_init'
73
74	! Allocate run-off at landice and initilize with field read from restart
75	!****************************************************************************************
76
77	ALLOCATE (run_off_lic_0(klon), stat=error)
78	IF (error /= 0) THEN
79	abort_message = 'Pb allocation run_off_lic'
80	CALL abort_physic(modname, abort_message, 1)
81	END IF
82	run_off_lic_0(:) = restart_runoff(:)
83
84	! Allocate other variables and initilize to zero
85	!****************************************************************************************
86	ALLOCATE (run_off_ter(klon), stat=error)
87	IF (error /= 0) THEN
88	abort_message = 'Pb allocation run_off_ter'
89	CALL abort_physic(modname, abort_message, 1)
90	END IF
91	run_off_ter(:) = 0.
92
93	ALLOCATE (run_off_lic(klon), stat=error)
94	IF (error /= 0) THEN
95	abort_message = 'Pb allocation run_off_lic'
96	CALL abort_physic(modname, abort_message, 1)
97	END IF
98	run_off_lic(:) = 0.
99
100	ALLOCATE (ffonte_global(klon, nbsrf))
101	IF (error /= 0) THEN
102	abort_message = 'Pb allocation ffonte_global'
103	CALL abort_physic(modname, abort_message, 1)
104	END IF
105	ffonte_global(:, :) = 0.0
106
107	ALLOCATE (fqfonte_global(klon, nbsrf))
108	IF (error /= 0) THEN
109	abort_message = 'Pb allocation fqfonte_global'
110	CALL abort_physic(modname, abort_message, 1)
111	END IF
112	fqfonte_global(:, :) = 0.0
113
114	ALLOCATE (fqcalving_global(klon, nbsrf))
115	IF (error /= 0) THEN
116	abort_message = 'Pb allocation fqcalving_global'
117	CALL abort_physic(modname, abort_message, 1)
118	END IF
119	fqcalving_global(:, :) = 0.0
120
121	ALLOCATE (runofflic_global(klon))
122	IF (error /= 0) THEN
123	abort_message = 'Pb allocation runofflic_global'
124	CALL abort_physic(modname, abort_message, 1)
125	END IF
126	runofflic_global(:) = 0.0
127
128	! Read tau_calv
129	!***************
130	CALL conf_interface(tau_calv)
131
132	END SUBROUTINE simplehydrol_init
133	!************************************************************************************
134
135	#ifdef ISO
136	!************************************************************************************
137	SUBROUTINE simplehydrol_init_iso(xtrestart_runoff)
138
139	! This subroutine allocates and initialize variables in the module for water isotopes.
140	! The variable run_off_lic_0 is initialized to the field read from
141	! restart file. The other variables are initialized to zero.
142	!************************************************************************************
143
144	USE infotrac_phy, ONLY: niso
145	#ifdef ISOVERIF
146	USE isotopes_mod, ONLY: iso_eau, iso_HDO
147	USE isotopes_verif_mod
148	#endif
149
150	! Declarations
151	!****************************************************************************************
152
153	! Input argument
154	REAL, DIMENSION(niso, klon), INTENT(IN) :: xtrestart_runoff
155
156	! Local variables
157	INTEGER :: error
158	CHARACTER(len=80) :: abort_message
159	CHARACTER(len=20) :: modname = 'simplehydrol_init'
160	INTEGER :: i
161
162	! Allocate run-off at landice and initilize with field read from restart
163	!****************************************************************************************
164
165	ALLOCATE (xtrun_off_lic_0(niso, klon), stat=error)
166	IF (error /= 0) THEN
167	abort_message = 'Pb allocation run_off_lic'
168	CALL abort_physic(modname, abort_message, 1)
169	END IF
170
171	xtrun_off_lic_0(:, :) = xtrestart_runoff(:, :)
172
173	#ifdef ISOVERIF
174	IF (iso_eau > 0) THEN
175	CALL iso_verif_egalite_vect1D( &
176	& xtrun_off_lic_0, run_off_lic_0, 'simplehydrol 100', &
177	& niso, klon)
178	END IF !IF (iso_eau > 0) THEN
179	#endif
180
181	! Allocate other variables and initialize to zero
182	!****************************************************************************************
183
184	ALLOCATE (xtrun_off_ter(niso, klon), stat=error)
185	IF (error /= 0) THEN
186	abort_message = 'Pb allocation xtrun_off_ter'
187	CALL abort_physic(modname, abort_message, 1)
188	END IF
189	xtrun_off_ter(:, :) = 0.
190
191	ALLOCATE (xtrun_off_lic(niso, klon), stat=error)
192	IF (error /= 0) THEN
193	abort_message = 'Pb allocation xtrun_off_lic'
194	CALL abort_physic(modname, abort_message, 1)
195	END IF
196	xtrun_off_lic(:, :) = 0.
197
198	ALLOCATE (fxtfonte_global(niso, klon, nbsrf))
199	IF (error /= 0) THEN
200	abort_message = 'Pb allocation fxtfonte_global'
201	CALL abort_physic(modname, abort_message, 1)
202	END IF
203	fxtfonte_global(:, :, :) = 0.0
204
205	ALLOCATE (fxtcalving_global(niso, klon, nbsrf))
206	IF (error /= 0) THEN
207	abort_message = 'Pb allocation fxtcalving_global'
208	CALL abort_physic(modname, abort_message, 1)
209	END IF
210	fxtcalving_global(:, :, :) = 0.0
211
212	ALLOCATE (xtrunofflic_global(niso, klon))
213	IF (error /= 0) THEN
214	abort_message = 'Pb allocation xtrunofflic_global'
215	CALL abort_physic(modname, abort_message, 1)
216	END IF
217	xtrunofflic_global(:, :) = 0.0
218
219	END SUBROUTINE simplehydrol_init_iso
220	#endif
221	!****************************************************************************************
222
223	!****************************************************************************************
224	SUBROUTINE simplehydrol(knon, nisurf, knindex, dtime, &
225	tsurf, precip_rain, precip_snow, &
226	snow, qsol, tsurf_new, evap, ice_sub &
227	#ifdef ISO
228	, fq_fonte_diag, fqfonte_diag, snow_sub_diag, fqcalving_diag &
229	, max_eau_sol_diag, runoff_diag, run_off_lic_diag, coeff_rel_diag &
230	#endif
231	)
232	!$gpum horizontal knon klon
233	USE indice_sol_mod
234	#ifdef ISO
235	USE infotrac_phy, ONLY: niso
236	!use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
237	#ifdef ISOVERIF
238	USE isotopes_verif_mod
239	#endif
240	#endif
241	USE yoethf_mod_h
242	USE clesphys_mod_h
243	USE yomcst_mod_h
244
245	!**********************************************************************************************
246	! This routines is a simple hydrology model to compute the soil water content,
247	! the melting and accumulation of snow as well as ice sheet "calving" terms (rough assumptions)
248	! It is especially used over land and landice surfaces when the coupling with ORCHIDEE
249	! is not active, and over sea ice (especially for snow above it) when the coupling with NEMO
250	! is not active.
251	! contact: F. Cheruy, frederique.cheruy@lmd.ipsl.fr ; E. Vignon, etienne.vignon@lmd.ipsl.fr
252	!**********************************************************************************************
253
254	INCLUDE "FCTTRE.h"
255
256	! Declaration
257	!****************************************************************************************
258
259	! Input variables
260	!----------------
261	INTEGER, INTENT(IN) :: knon ! number of horizontal grid points
262	INTEGER, INTENT(IN) :: nisurf ! index for surface type that is considered
263	INTEGER, DIMENSION(knon), INTENT(IN) :: knindex ! list of horizontal indices on the native
264	! horizontal grid for the considered surface type
265
266	REAL, INTENT(IN) :: dtime ! time step [s]
267	REAL, DIMENSION(knon), INTENT(IN) :: tsurf ! surface temperature [K]
268	REAL, DIMENSION(knon), INTENT(IN) :: precip_rain ! rainfall flux [kg/m2/s]
269	REAL, DIMENSION(knon), INTENT(IN) :: precip_snow ! snowfall flux [kg/m2/s]
270
271	! Input/Output variables
272	!-----------------------
273
274	REAL, DIMENSION(knon), INTENT(INOUT) :: snow ! snow amount on ground [kg/m2]
275	REAL, DIMENSION(knon), INTENT(INOUT) :: qsol ! amount of water in the soil [kg/m2]
276	REAL, DIMENSION(knon), INTENT(INOUT) :: tsurf_new ! updated surface temperature [K]
277	REAL, DIMENSION(knon), INTENT(INOUT) :: evap ! evaporation flux [kg/m2]
278
279	! Output variables
280	!-----------------
281
282	REAL, DIMENSION(knon), INTENT(OUT) :: ice_sub ! sublimation flux from ice over landice surfaces [kg/m2/s]
283	#ifdef ISO
284	! diagnostics for isotopes
285	REAL, DIMENSION(knon), INTENT(OUT) :: fq_fonte_diag
286	REAL, DIMENSION(knon), INTENT(OUT) :: fqfonte_diag
287	REAL, DIMENSION(knon), INTENT(OUT) :: snow_sub_diag
288	REAL, DIMENSION(knon), INTENT(OUT) :: fqcalving_diag
289	REAL, INTENT(OUT) :: max_eau_sol_diag
290	REAL, DIMENSION(knon), INTENT(OUT) :: runoff_diag
291	REAL, DIMENSION(knon), INTENT(OUT) :: run_off_lic_diag
292	REAL, INTENT(OUT) :: coeff_rel_diag
293	#endif
294
295	! Local variables
296	!----------------
297
298	INTEGER :: i, j
299	REAL :: fq_fonte ! quantify of snow that is melted [kg/m2]
300	REAL :: coeff_rel
301	REAL, PARAMETER :: snow_max = 3000. ! maximum snow amount over ice sheets [kg/m2]
302	REAL, PARAMETER :: max_eau_sol = 150.0 ! maximum water amount in the soil [kg/m2]
303	REAL, PARAMETER :: chasno = 3.334E+05/(2.3867E+06*0.15) ! Latent heat of ice melting / (cp water) / tuning param=0.15
304	REAL, DIMENSION(knon) :: ffonte ! flux of energy associated with snow melting [W/m2]
305	REAL, DIMENSION(knon) :: fqcalving ! flux of water associated with calving [kg/m2]
306	REAL, DIMENSION(knon) :: fqfonte ! flux of water associated with snow melting [kg/s/m2]
307	REAL, DIMENSION(knon) :: d_ts ! increment surface temperature [K]
308	REAL, DIMENSION(knon) :: bil_eau_s ! water budget in soil [kg/m2/s]
309	REAL, DIMENSION(knon) :: snow_sub ! snow sublimation flux [kg/m2/s]
310
311	LOGICAL :: is_snow_melting ! Is snow melting?
312
313	#ifdef ISO
314	max_eau_sol_diag = max_eau_sol
315	#endif
316
317	! initial calculations
318	!****************************************************************************************
319	coeff_rel = dtime/(tau_calv*rday)
320	bil_eau_s(:) = 0.
321
322	! Snow increment snow due to precipitation and sublimation
323	!****************************************************************************************
324	WHERE (precip_snow > 0.)
325	snow = snow + (precip_snow*dtime)
326	END WHERE
327
328	snow_sub(:) = 0.
329	ice_sub(:) = 0.
330
331	IF (.NOT. ok_lic_cond) THEN
332	!---only positive sublimation has an impact on snow
333	!---note that this could create a bit of water
334	!---this was the default until CMIP6
335	!---Note that evap includes BOTH liquid water evaporation AND snow+ice sublimation
336	WHERE (evap(:) > 0.)
337	snow_sub(:) = MIN(snow(:)/dtime, evap(:)) !---one cannot sublimate more than the amount of snow
338	snow(:) = snow(:) - snow_sub(:)*dtime !---snow that remains on the ground
339	snow(:) = MAX(0.0, snow(:)) !---just in case
340	END WHERE
341	ELSE
342	!---now considers both positive and negative sublimation (so surface condensation) in the budget of snow
343	snow_sub(:) = MIN(snow(:)/dtime, evap(:)) !---one cannot evaporate more than the amount of snow
344	snow(:) = snow(:) - snow_sub(:)*dtime !---snow that remains or deposits on the ground
345	snow(:) = MAX(0.0, snow(:)) !---just in case
346	END IF
347
348	!---diagnostics of sublimation/condensation of ice over landice surfaces (when all the snow above has been sublimated)
349	!---in principle it should be 0 when ok_lic_cond that is when surface water condensation over landice was not allowed
350	IF (nisurf == is_lic) THEN
351	DO i = 1, knon
352	ice_sub(i) = evap(i) - snow_sub(i)
353	END DO
354	END IF
355
356	!---diagnostics for isotopes
357	#ifdef ISO
358	snow_sub_diag(:) = snow_sub(:)
359	coeff_rel_diag = coeff_rel
360	#endif
361
362	! total water flux that goes into the soil (liquid precipitation - "liquid" evaporation)
363	!****************************************************************************************
364	bil_eau_s(:) = (precip_rain(:)dtime) - (evap(:) - snow_sub(:))dtime
365
366	! Snow melting and calving (we remove the excess of snow wrt snowmax over ice sheets)
367	! + update surface temperature
368	!****************************************************************************************
369
370	ffonte(:) = 0.0
371	fqcalving(:) = 0.0
372	fqfonte(:) = 0.0
373
374	! snow melting
375	DO i = 1, knon
376	! Is snow melting?
377	is_snow_melting = (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) .AND. tsurf_new(i) >= RTT
378
379	IF (is_snow_melting) THEN
380	! quantity of snow that is melted
381	! it is based on the energy conservation equation
382	! LmDq = cpDT*tuning_param (tuning_param=0.15)
383	fq_fonte = MIN(MAX((tsurf_new(i) - RTT)/chasno, 0.0), snow(i))
384	! flux of energy corresponding to snow melting
385	ffonte(i) = fq_fonte*RLMLT/dtime
386	! flux of water corresponding to snow melting
387	fqfonte(i) = fq_fonte/dtime
388	! update of snow amount on ground
389	snow(i) = MAX(0., snow(i) - fq_fonte)
390	! flux of melted water goes into the soil
391	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
392	! surface temperature update
393	tsurf_new(i) = tsurf_new(i) - fq_fonte*chasno
394	! diag for isotopes
395	#ifdef ISO
396	fq_fonte_diag(i) = fq_fonte
397	#endif
398
399	! snow/ice melting over ice surfaces
400	IF (nisurf == is_sic .OR. nisurf == is_lic) THEN
401	! pay attention, melting over sea ice and landice
402	! is not bounded by the amount of available snow (no MIN)
403	! so when snow has been completely melted, the ice below melts
404	! which is an infinite source of water for the model
405	! BUT:
406	! when snow has been fully melted, the flux due to ice melting should be explicitly computed
407	! why are we adding the flux to that previously computed (double counting).
408	! why ffonte and tsurf_new updates are not in ok_lic_melt?
409	! why over lic and sic we impose tsurf=RTT and not over lands when snow remains?
410	! now by default, ok_lic_melt = false which means ffonte and fqfonte are not consistent
411	! moreover, imposing tsurf_new=RTT means that the update in tsurf is not consistent
412	! with the quantity of melting snow.
413	!
414	! Suggestion:
415	! - compute separately fq_fonte over lic/sic only if ok_lic_melt (lower-bound by 0 and not snow)
416	! - add an output variable ice_melt = max(0,fq_fonte - snow)/dtime to quantify the melt of ice (net water source)
417	! and update snow with the melt of snow only i.e. fq_fonte - ice_melt
418	! - remove the tsurf_new = RTT over lic and sic but implies a loss of convergence
419
420	fq_fonte = MAX((tsurf_new(i) - RTT)/chasno, 0.0)
421	ffonte(i) = ffonte(i) + fq_fonte*RLMLT/dtime
422
423	IF (ok_lic_melt) THEN
424	fqfonte(i) = fqfonte(i) + fq_fonte/dtime
425	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
426	END IF
427	tsurf_new(i) = RTT
428	END IF
429	d_ts(i) = tsurf_new(i) - tsurf(i)
430	END IF
431
432	! so called 'calving', if there is an excess of snow wrt snowmax
433	! it is instantaneously removed
434	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
435	snow(i) = MIN(snow(i), snow_max)
436	END DO
437	#ifdef ISO
438	DO i = 1, knon
439	fqcalving_diag(i) = fqcalving(i)
440	fqfonte_diag(i) = fqfonte(i)
441	END DO !DO i = 1, knon
442	#endif
443
444	! Soil water content and runoff
445	!****************************************************************************************
446	! over land surfaces
447	IF (nisurf == is_ter) THEN
448	DO i = 1, knon
449	j = knindex(i)
450	! qsol update with bil_eau_s
451	qsol(i) = qsol(i) + bil_eau_s(i)
452	! water that exceeds max_eau_sol feeds the runoff
453	run_off_ter(j) = run_off_ter(j) + MAX(qsol(i) - max_eau_sol, 0.0)
454	#ifdef ISO
455	runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
456	#endif
457	qsol(i) = MIN(qsol(i), max_eau_sol)
458	END DO
459	! over landice surfaces
460	ELSE IF (nisurf == is_lic) THEN
461	DO i = 1, knon
462	j = knindex(i)
463	!--temporal filtering
464	run_off_lic(j) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
465	run_off_lic_0(j) = run_off_lic(j)
466	!--add melting snow and liquid precip to runoff over ice cap
467	run_off_lic(j) = run_off_lic(j) + fqfonte(i) + precip_rain(i)
468	END DO
469	END IF
470
471	#ifdef ISO
472	DO i = 1, knon
473	run_off_lic_diag(i) = run_off_lic(knindex(i))
474	END DO
475	#endif
476
477	! Save ffonte, fqfonte and fqcalving in global arrays for each
478	! sub-surface separately
479	!****************************************************************************************
480	DO i = 1, knon
481	j = knindex(i)
482	ffonte_global(j, nisurf) = ffonte(i)
483	fqfonte_global(j, nisurf) = fqfonte(i)
484	fqcalving_global(j, nisurf) = fqcalving(i)
485	END DO
486
487	IF (nisurf == is_lic) THEN
488	DO i = 1, knon
489	runofflic_global(knindex(i)) = run_off_lic(knindex(i))
490	END DO
491	END IF
492
493	END SUBROUTINE simplehydrol
494	!****************************************************************************************
495
496	!****************************************************************************************
497	SUBROUTINE simplehydrol_final(restart_runoff &
498	#ifdef ISO
499	, xtrestart_runoff &
500	#endif
501	)
502	!
503	! This subroutine returns run_off_lic_0 for later writing to restart file.
504	!****************************************************************************************
505
506	#ifdef ISO
507	USE infotrac_phy, ONLY: niso
508	#ifdef ISOVERIF
509	USE isotopes_mod, ONLY: iso_eau
510	USE isotopes_verif_mod
511	#endif
512	#endif
513
514	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
515	#ifdef ISO
516	REAL, DIMENSION(niso, klon), INTENT(OUT) :: xtrestart_runoff
517	#ifdef ISOVERIF
518	INTEGER :: i
519	#endif
520	#endif
521
522	! Set the output variables
523	restart_runoff(:) = run_off_lic_0(:)
524	#ifdef ISO
525	xtrestart_runoff(:, :) = xtrun_off_lic_0(:, :)
526	#ifdef ISOVERIF
527	IF (iso_eau > 0) THEN
528	DO i = 1, klon
529	IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
530	& , xtrun_off_lic_0(iso_eau, i) &
531	& , 'simplehydrol 413') &
532	& == 1) then
533	WRITE (, ) 'i=', i
534	STOP
535	END IF
536	END DO !DO i=1,klon
537	END IF !IF (iso_eau > 0) then
538	#endif
539	#endif
540
541	! Deallocation of all varaibles in the module
542
543	IF (ALLOCATED(run_off_lic_0)) DEALLOCATE (run_off_lic_0)
544	IF (ALLOCATED(run_off_ter)) DEALLOCATE (run_off_ter)
545	IF (ALLOCATED(run_off_lic)) DEALLOCATE (run_off_lic)
546	IF (ALLOCATED(ffonte_global)) DEALLOCATE (ffonte_global)
547	IF (ALLOCATED(fqfonte_global)) DEALLOCATE (fqfonte_global)
548	IF (ALLOCATED(fqcalving_global)) DEALLOCATE (fqcalving_global)
549	IF (ALLOCATED(runofflic_global)) DEALLOCATE (runofflic_global)
550	#ifdef ISO
551	IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE (xtrun_off_lic_0)
552	IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE (xtrun_off_ter)
553	IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE (xtrun_off_lic)
554	IF (ALLOCATED(fxtfonte_global)) DEALLOCATE (fxtfonte_global)
555	IF (ALLOCATED(fxtcalving_global)) DEALLOCATE (fxtcalving_global)
556	IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE (xtrunofflic_global)
557	#endif
558
559	END SUBROUTINE simplehydrol_final
560	!****************************************************************************************
561	SUBROUTINE simplehydrol_get_vars(pctsrf, fqcalving_out, &
562	fqfonte_out, ffonte_out, run_off_lic_out &
563	#ifdef ISO
564	, fxtcalving_out, fxtfonte_out, xtrun_off_lic_out &
565	#endif
566	)
567
568	! This routine cumulates ffonte, fqfonte and fqcalving respectively for
569	! all type of surfaces according to their fraction.
570	!
571	! This routine is called from physiq_mod before outputs' writting (histwrite)
572	!****************************************************************************************
573
574	USE indice_sol_mod
575	#ifdef ISO
576	USE infotrac_phy, ONLY: niso
577	#endif
578
579	! Input variables
580	!----------------
581	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! fraction of subsurfaces [0-1]
582
583	! Output variables
584	!-----------------
585	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_out ! flux of water associated with calving [kg/m2/s]
586	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_out ! flux of water associated with snow melting [kg/m2/s]
587	REAL, DIMENSION(klon), INTENT(OUT) :: ffonte_out ! flux of energy associated with snow melting [W/m2]
588	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out ! runoff flux [kg/m2/s]
589
590	#ifdef ISO
591	REAL, DIMENSION(niso, klon), INTENT(OUT) :: fxtcalving_out
592	REAL, DIMENSION(niso, klon), INTENT(OUT) :: fxtfonte_out
593	REAL, DIMENSION(niso, klon), INTENT(OUT) :: xtrun_off_lic_out
594	INTEGER :: i, ixt
595	#endif
596
597	! Local variables
598	!----------------
599	INTEGER :: nisurf
600	!****************************************************************************************
601
602	ffonte_out(:) = 0.0
603	fqfonte_out(:) = 0.0
604	fqcalving_out(:) = 0.0
605	#ifdef ISO
606	fxtfonte_out(:, :) = 0.0
607	fxtcalving_out(:, :) = 0.0
608	#endif
609
610	DO nisurf = 1, nbsrf
611	ffonte_out(:) = ffonte_out(:) + ffonte_global(:, nisurf)*pctsrf(:, nisurf)
612	fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:, nisurf)*pctsrf(:, nisurf)
613	fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:, nisurf)*pctsrf(:, nisurf)
614	END DO
615
616	run_off_lic_out(:) = runofflic_global(:)
617
618	#ifdef ISO
619	DO nisurf = 1, nbsrf
620	DO i = 1, klon
621	DO ixt = 1, niso
622	fxtfonte_out(ixt, i) = fxtfonte_out(ixt, i) + fxtfonte_global(ixt, i, nisurf)*pctsrf(i, nisurf)
623	fxtcalving_out(ixt, i) = fxtcalving_out(ixt, i) + fxtcalving_global(ixt, i, nisurf)*pctsrf(i, nisurf)
624	END DO
625	END DO
626	END DO
627	xtrun_off_lic_out(:, :) = xtrunofflic_global(:, :)
628	#endif
629
630	END SUBROUTINE simplehydrol_get_vars
631	!****************************************************************************************
632	!
633	!#ifdef ISO
634	! subroutine simplehydrol_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
635	! use infotrac_phy, ONLY: niso
636	!
637	! ! inputs
638	! INTEGER, INTENT(IN) :: knon
639	! real, INTENT(IN), DIMENSION(niso,klon) :: xtrun_off_lic_0_diag
640	!
641	! xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
642	!
643	! end subroutine simplehydrol_export_xtrun_off_lic_0
644	!#endif
645
646	!****************************************************************************************
647	#ifdef ISO
648	SUBROUTINE gestion_neige_besoin_varglob_simplehydrol(klon, knon, &
649	xtprecip_snow, xtprecip_rain, &
650	fxtfonte_neige, fxtcalving, &
651	knindex, nisurf, run_off_lic_diag, coeff_rel_diag)
652
653	! In this routine, we need global variables from simplehydrol_mod
654	! It must be included in simplehydrol_mod
655	! The other part of 'gestion_neige' is in insotopes_routines_mod because of circular
656	! dependencies
657
658	USE infotrac_phy, ONLY: ntiso, niso
659	USE isotopes_mod, ONLY: iso_eau
660	USE indice_sol_mod
661	#ifdef ISOVERIF
662	USE isotopes_verif_mod
663	#endif
664	IMPLICIT NONE
665
666	! inputs
667	INTEGER, INTENT(IN) :: klon, knon
668	REAL, DIMENSION(ntiso, knon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
669	REAL, DIMENSION(niso, knon), INTENT(IN) :: fxtfonte_neige, fxtcalving
670	INTEGER, INTENT(IN) :: nisurf
671	INTEGER, DIMENSION(knon), INTENT(IN) :: knindex
672	REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
673	REAL, INTENT(IN) :: coeff_rel_diag
674
675	! locals
676	INTEGER :: i, ixt, j
677
678	#ifdef ISOVERIF
679	IF (nisurf == is_lic) THEN
680	IF (iso_eau > 0) THEN
681	DO i = 1, knon
682	j = knindex(i)
683	CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau, j), &
684	& run_off_lic_0(j), 'gestion_neige_besoin_varglob_simplehydrol 625')
685	END DO
686	END IF
687	END IF
688	#endif
689
690	! run_off_lic calculation
691	IF (nisurf == is_lic) THEN
692
693	DO i = 1, knon
694	j = knindex(i)
695	DO ixt = 1, niso
696	xtrun_off_lic(ixt, i) = (coeff_rel_diag*fxtcalving(ixt, i)) &
697	& + (1.-coeff_rel_diag)*xtrun_off_lic_0(ixt, j)
698	xtrun_off_lic_0(ixt, j) = xtrun_off_lic(ixt, i)
699	xtrun_off_lic(ixt, i) = xtrun_off_lic(ixt, i) + fxtfonte_neige(ixt, i) + xtprecip_rain(ixt, i)
700	END DO !DO ixt=1,niso
701	#ifdef ISOVERIF
702	IF (iso_eau > 0) THEN
703	IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau, i), &
704	& run_off_lic_diag(i), 'gestion_neige_besoin_varglob_simplehydrol 1201a', &
705	& errmax, errmaxrel) == 1) THEN
706	WRITE (, ) 'i,j=', i, j
707	WRITE (, ) 'coeff_rel_diag=', coeff_rel_diag
708	STOP
709	END IF
710	END IF
711	#endif
712	END DO
713	END IF !IF (nisurf == is_lic) THEN
714
715	! Save ffonte, fqfonte and fqcalving in global arrays for each
716	! sub-surface separately
717	DO i = 1, knon
718	DO ixt = 1, niso
719	fxtfonte_global(ixt, knindex(i), nisurf) = fxtfonte_neige(ixt, i)
720	fxtcalving_global(ixt, knindex(i), nisurf) = fxtcalving(ixt, i)
721	END DO !do ixt=1,niso
722	END DO
723
724	IF (nisurf == is_lic) THEN
725	DO i = 1, knon
726	DO ixt = 1, niso
727	xtrunofflic_global(ixt, knindex(i)) = xtrun_off_lic(ixt, i)
728	END DO ! DO ixt=1,niso
729	END DO
730	END IF
731
732	END SUBROUTINE gestion_neige_besoin_varglob_simplehydrol
733	#endif
734
735	END MODULE simplehydrol_mod

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

Download in other formats:

Original Format