Context Navigation

fonte_neige_mod.F90 @ 5486

Last change on this file since 5486 was 5486, checked in by evignon, 13 days ago
inclusion d'un diagnostique de la sublimation de la glace sur les landice pour la conservation de l'eau
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: 24.2 KB

Line
1	!
2	! $Header$
3	!
4	MODULE fonte_neige_mod
5	!
6	! This module will treat the process of snow, melting, accumulating, calving, in
7	! case of simplified soil model.
8	!
9	!****************************************************************************************
10	USE dimphy, ONLY : klon
11	USE indice_sol_mod
12
13	IMPLICIT NONE
14	SAVE
15
16	! run_off_ter and run_off_lic are the runoff at the compressed grid knon for
17	! land and land-ice respectively
18	! Note: run_off_lic is used in mod_landice and therfore not private
19	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_ter
20	!$OMP THREADPRIVATE(run_off_ter)
21	REAL, ALLOCATABLE, DIMENSION(:) :: run_off_lic
22	!$OMP THREADPRIVATE(run_off_lic)
23
24	! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
25	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_lic_0
26	!$OMP THREADPRIVATE(run_off_lic_0)
27
28	REAL, PRIVATE :: tau_calv
29	!$OMP THREADPRIVATE(tau_calv)
30	REAL, ALLOCATABLE, DIMENSION(:,:) :: ffonte_global
31	!$OMP THREADPRIVATE(ffonte_global)
32	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqfonte_global
33	!$OMP THREADPRIVATE(fqfonte_global)
34	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqcalving_global
35	!$OMP THREADPRIVATE(fqcalving_global)
36	REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
37	!$OMP THREADPRIVATE(runofflic_global)
38	#ifdef ISO
39	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrun_off_ter
40	!$OMP THREADPRIVATE(xtrun_off_ter)
41	REAL, ALLOCATABLE, DIMENSION(:,:) :: xtrun_off_lic
42	!$OMP THREADPRIVATE(xtrun_off_lic)
43	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrun_off_lic_0
44	!$OMP THREADPRIVATE(xtrun_off_lic_0)
45	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global
46	!$OMP THREADPRIVATE(fxtfonte_global)
47	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global
48	!$OMP THREADPRIVATE(fxtcalving_global)
49	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrunofflic_global
50	!$OMP THREADPRIVATE(xtrunofflic_global)
51	#endif
52
53	CONTAINS
54	!
55	!****************************************************************************************
56	!
57	SUBROUTINE fonte_neige_init(restart_runoff)
58
59	! This subroutine allocates and initialize variables in the module.
60	! The variable run_off_lic_0 is initialized to the field read from
61	! restart file. The other variables are initialized to zero.
62	!
63	!****************************************************************************************
64	! Input argument
65	REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
66
67	! Local variables
68	INTEGER :: error
69	CHARACTER (len = 80) :: abort_message
70	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
71
72
73	!****************************************************************************************
74	! Allocate run-off at landice and initilize with field read from restart
75	!
76	!****************************************************************************************
77
78	ALLOCATE(run_off_lic_0(klon), stat = error)
79	IF (error /= 0) THEN
80	abort_message='Pb allocation run_off_lic'
81	CALL abort_physic(modname,abort_message,1)
82	ENDIF
83	run_off_lic_0(:) = restart_runoff(:)
84
85	!****************************************************************************************
86	! Allocate other variables and initilize to zero
87	!
88	!****************************************************************************************
89	ALLOCATE(run_off_ter(klon), stat = error)
90	IF (error /= 0) THEN
91	abort_message='Pb allocation run_off_ter'
92	CALL abort_physic(modname,abort_message,1)
93	ENDIF
94	run_off_ter(:) = 0.
95
96	ALLOCATE(run_off_lic(klon), stat = error)
97	IF (error /= 0) THEN
98	abort_message='Pb allocation run_off_lic'
99	CALL abort_physic(modname,abort_message,1)
100	ENDIF
101	run_off_lic(:) = 0.
102
103	ALLOCATE(ffonte_global(klon,nbsrf))
104	IF (error /= 0) THEN
105	abort_message='Pb allocation ffonte_global'
106	CALL abort_physic(modname,abort_message,1)
107	ENDIF
108	ffonte_global(:,:) = 0.0
109
110	ALLOCATE(fqfonte_global(klon,nbsrf))
111	IF (error /= 0) THEN
112	abort_message='Pb allocation fqfonte_global'
113	CALL abort_physic(modname,abort_message,1)
114	ENDIF
115	fqfonte_global(:,:) = 0.0
116
117	ALLOCATE(fqcalving_global(klon,nbsrf))
118	IF (error /= 0) THEN
119	abort_message='Pb allocation fqcalving_global'
120	CALL abort_physic(modname,abort_message,1)
121	ENDIF
122	fqcalving_global(:,:) = 0.0
123
124	ALLOCATE(runofflic_global(klon))
125	IF (error /= 0) THEN
126	abort_message='Pb allocation runofflic_global'
127	CALL abort_physic(modname,abort_message,1)
128	ENDIF
129	runofflic_global(:) = 0.0
130
131	!****************************************************************************************
132	! Read tau_calv
133	!
134	!****************************************************************************************
135	CALL conf_interface(tau_calv)
136
137
138	END SUBROUTINE fonte_neige_init
139
140	#ifdef ISO
141	SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
142
143	! This subroutine allocates and initialize variables in the module.
144	! The variable run_off_lic_0 is initialized to the field read from
145	! restart file. The other variables are initialized to zero.
146
147	USE infotrac_phy, ONLY: niso
148	#ifdef ISOVERIF
149	USE isotopes_mod, ONLY: iso_eau,iso_HDO
150	USE isotopes_verif_mod
151	#endif
152	!
153	!****************************************************************************************
154	! Input argument
155	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff
156
157	! Local variables
158	INTEGER :: error
159	CHARACTER (len = 80) :: abort_message
160	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
161	INTEGER :: i
162
163
164	!****************************************************************************************
165	! Allocate run-off at landice and initilize with field read from restart
166	!
167	!****************************************************************************************
168
169	ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
170	IF (error /= 0) THEN
171	abort_message='Pb allocation run_off_lic'
172	CALL abort_physic(modname,abort_message,1)
173	ENDIF
174
175	xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)
176
177	#ifdef ISOVERIF
178	IF (iso_eau > 0) THEN
179	CALL iso_verif_egalite_vect1D( &
180	& xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
181	& niso,klon)
182	ENDIF !IF (iso_eau > 0) THEN
183	#endif
184
185	!****************************************************************************************
186	! Allocate other variables and initilize to zero
187	!
188	!****************************************************************************************
189
190	ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
191	IF (error /= 0) THEN
192	abort_message='Pb allocation xtrun_off_ter'
193	CALL abort_physic(modname,abort_message,1)
194	ENDIF
195	xtrun_off_ter(:,:) = 0.
196
197	ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
198	IF (error /= 0) THEN
199	abort_message='Pb allocation xtrun_off_lic'
200	CALL abort_physic(modname,abort_message,1)
201	ENDIF
202	xtrun_off_lic(:,:) = 0.
203
204	ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
205	IF (error /= 0) THEN
206	abort_message='Pb allocation fxtfonte_global'
207	CALL abort_physic(modname,abort_message,1)
208	ENDIF
209	fxtfonte_global(:,:,:) = 0.0
210
211	ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
212	IF (error /= 0) THEN
213	abort_message='Pb allocation fxtcalving_global'
214	CALL abort_physic(modname,abort_message,1)
215	ENDIF
216	fxtcalving_global(:,:,:) = 0.0
217
218	ALLOCATE(xtrunofflic_global(niso,klon))
219	IF (error /= 0) THEN
220	abort_message='Pb allocation xtrunofflic_global'
221	CALL abort_physic(modname,abort_message,1)
222	ENDIF
223	xtrunofflic_global(:,:) = 0.0
224
225	END SUBROUTINE fonte_neige_init_iso
226	#endif
227
228	!
229	!****************************************************************************************
230	!
231	SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
232	tsurf, precip_rain, precip_snow, &
233	snow, qsol, tsurf_new, evap, ice_sub &
234	#ifdef ISO
235	& ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag &
236	& ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
237	#endif
238	& )
239
240	USE indice_sol_mod
241	#ifdef ISO
242	USE infotrac_phy, ONLY: niso
243	!use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
244	#ifdef ISOVERIF
245	USE isotopes_verif_mod
246	#endif
247	#endif
248	USE yoethf_mod_h
249	USE clesphys_mod_h
250	USE yomcst_mod_h
251
252	! Routine de traitement de la fonte de la neige dans le cas du traitement
253	! de sol simplifie!
254	! LF 03/2001
255	! input:
256	! knon nombre de points a traiter
257	! nisurf surface a traiter
258	! knindex index des mailles valables pour surface a traiter
259	! dtime
260	! tsurf temperature de surface
261	! precip_rain precipitations liquides
262	! precip_snow precipitations solides
263	!
264	! input/output:
265	! snow champs hauteur de neige
266	! qsol hauteur d'eau contenu dans le sol
267	! tsurf_new temperature au sol
268	! evap
269	!
270	INCLUDE "FCTTRE.h"
271
272	! Input variables
273	!****************************************************************************************
274	INTEGER, INTENT(IN) :: knon
275	INTEGER, INTENT(IN) :: nisurf
276	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
277	REAL , INTENT(IN) :: dtime
278	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
279	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain
280	REAL, DIMENSION(klon), INTENT(IN) :: precip_snow
281
282	! Input/Output variables
283	!****************************************************************************************
284
285	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
286	REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
287	REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
288	REAL, DIMENSION(klon), INTENT(INOUT) :: evap
289
290
291	REAL, DIMENSION(klon), INTENT(OUT) :: ice_sub
292	#ifdef ISO
293	! sortie de quelques diagnostiques
294	REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
295	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
296	REAL, DIMENSION(klon), INTENT(OUT) :: snow_evap_diag
297	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_diag
298	REAL, INTENT(OUT) :: max_eau_sol_diag
299	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
300	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag
301	REAL, INTENT(OUT) :: coeff_rel_diag
302	#endif
303
304
305	! Local variables
306	!****************************************************************************************
307
308	INTEGER :: i, j
309	REAL :: fq_fonte
310	REAL :: coeff_rel
311	REAL, PARAMETER :: snow_max=3000.
312	REAL, PARAMETER :: max_eau_sol = 150.0
313	!! PB temporaire en attendant mieux pour le modele de neige
314	! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
315	REAL, PARAMETER :: chasno = 3.334E+05/(2.3867E+06*0.15)
316	!IM cf JLD/ GKtest
317	REAL, PARAMETER :: chaice = 3.334E+05/(2.3867E+06*0.15)
318	! fin GKtest
319	REAL, DIMENSION(klon) :: ffonte
320	REAL, DIMENSION(klon) :: fqcalving, fqfonte
321	REAL, DIMENSION(klon) :: d_ts
322	REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
323
324	LOGICAL :: neige_fond
325
326	#ifdef ISO
327	max_eau_sol_diag=max_eau_sol
328	#endif
329
330
331	!****************************************************************************************
332	! Start calculation
333	! - Initialization
334	!
335	!****************************************************************************************
336	coeff_rel = dtime/(tau_calv * rday)
337
338	bil_eau_s(:) = 0.
339
340	!****************************************************************************************
341	! - Increment snow due to precipitation and evaporation
342	! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
343	!
344	!****************************************************************************************
345	WHERE (precip_snow > 0.)
346	snow = snow + (precip_snow * dtime)
347	END WHERE
348
349	snow_evap = 0.
350	ice_sub(:) = 0.
351
352	IF (.NOT. ok_lic_cond) THEN
353	!---only positive evaporation has an impact on snow
354	!---note that this could create a bit of water
355	!---this was the default until CMIP6
356	WHERE (evap > 0. )
357	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
358	snow = snow - snow_evap * dtime !---snow that remains on the ground
359	snow = MAX(0.0, snow) !---just in case
360	END WHERE
361	ELSE
362	!--now considers both positive and negative evaporation in the budget of snow
363	snow_evap = MIN (snow / dtime, evap) !---one cannot evaporate more than the amount of snow
364	snow = snow - snow_evap * dtime !---snow that remains or deposits on the ground
365	snow = MAX(0.0, snow) !---just in case
366	ENDIF
367
368	bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
369
370	IF (nisurf==is_lic) THEN
371	DO i=1,knon
372	ice_sub(i)=evap(i)-snow_evap(i)
373	ENDDO
374	ENDIF
375
376	#ifdef ISO
377	snow_evap_diag(:) = snow_evap(:)
378	coeff_rel_diag = coeff_rel
379	#endif
380
381
382
383	!****************************************************************************************
384	! - Calculate melting snow
385	! - Calculate calving and decrement snow, if there are to much snow
386	! - Update temperature at surface
387	!
388	!****************************************************************************************
389
390	ffonte(:) = 0.0
391	fqcalving(:) = 0.0
392	fqfonte(:) = 0.0
393
394	DO i = 1, knon
395	! Y'a-t-il fonte de neige?
396	neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
397	IF (neige_fond) THEN
398	fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
399	ffonte(i) = fq_fonte * RLMLT/dtime
400	fqfonte(i) = fq_fonte/dtime
401	snow(i) = MAX(0., snow(i) - fq_fonte)
402	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
403	tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno
404	#ifdef ISO
405	fq_fonte_diag(i) = fq_fonte
406	#endif
407
408
409	!IM cf JLD OK
410	!IM cf JLD/ GKtest fonte aussi pour la glace
411	IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
412	fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
413	ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
414	IF ( ok_lic_melt ) THEN
415	fqfonte(i) = fqfonte(i) + fq_fonte/dtime
416	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
417	ENDIF
418	tsurf_new(i) = RTT
419	ENDIF
420	d_ts(i) = tsurf_new(i) - tsurf(i)
421	ENDIF
422
423	! s'il y a une hauteur trop importante de neige, elle est ecretee
424	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
425	snow(i)=MIN(snow(i),snow_max)
426	ENDDO
427	#ifdef ISO
428	DO i = 1, knon
429	fqcalving_diag(i) = fqcalving(i)
430	fqfonte_diag(i) = fqfonte(i)
431	ENDDO !DO i = 1, knon
432	#endif
433
434
435	IF (nisurf == is_ter) THEN
436	DO i = 1, knon
437	qsol(i) = qsol(i) + bil_eau_s(i)
438	run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
439	#ifdef ISO
440	runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
441	#endif
442	qsol(i) = MIN(qsol(i), max_eau_sol)
443	ENDDO
444	ELSE IF (nisurf == is_lic) THEN
445	DO i = 1, knon
446	j = knindex(i)
447	!--temporal filtering
448	run_off_lic(i) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
449	run_off_lic_0(j) = run_off_lic(i)
450	!--add melting snow and liquid precip to runoff of ice cap
451	run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i)
452	ENDDO
453	ENDIF
454
455	#ifdef ISO
456	DO i = 1, klon
457	run_off_lic_diag(i) = run_off_lic(i)
458	ENDDO ! DO i = 1, knon
459	#endif
460
461	!****************************************************************************************
462	! Save ffonte, fqfonte and fqcalving in global arrays for each
463	! sub-surface separately
464	!
465	!****************************************************************************************
466	DO i = 1, knon
467	ffonte_global(knindex(i),nisurf) = ffonte(i)
468	fqfonte_global(knindex(i),nisurf) = fqfonte(i)
469	fqcalving_global(knindex(i),nisurf) = fqcalving(i)
470	ENDDO
471
472	IF (nisurf == is_lic) THEN
473	DO i = 1, knon
474	runofflic_global(knindex(i)) = run_off_lic(i)
475	ENDDO
476	ENDIF
477
478	END SUBROUTINE fonte_neige
479	!
480	!****************************************************************************************
481	!
482	SUBROUTINE fonte_neige_final(restart_runoff &
483	#ifdef ISO
484	& ,xtrestart_runoff &
485	#endif
486	& )
487	!
488	! This subroutine returns run_off_lic_0 for later writing to restart file.
489	!
490	#ifdef ISO
491	USE infotrac_phy, ONLY: niso
492	#ifdef ISOVERIF
493	USE isotopes_mod, ONLY: iso_eau
494	USE isotopes_verif_mod
495	#endif
496	#endif
497	!
498	!****************************************************************************************
499	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
500	#ifdef ISO
501	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
502	#ifdef ISOVERIF
503	INTEGER :: i
504	#endif
505	#endif
506
507
508
509	!****************************************************************************************
510	! Set the output variables
511	restart_runoff(:) = run_off_lic_0(:)
512	#ifdef ISO
513	xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
514	#ifdef ISOVERIF
515	IF (iso_eau > 0) THEN
516	DO i=1,klon
517	IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
518	& ,xtrun_off_lic_0(iso_eau,i) &
519	& ,'fonte_neige 413') &
520	& == 1) then
521	WRITE(,) 'i=',i
522	STOP
523	ENDIF
524	ENDDO !DO i=1,klon
525	ENDIF !IF (iso_eau > 0) then
526	#endif
527	#endif
528
529
530
531	! Deallocation of all varaibles in the module
532	! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
533	! fqfonte_global, fqcalving_global)
534
535	IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
536	IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
537	IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
538	IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
539	IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
540	IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
541	IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
542	#ifdef ISO
543	IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
544	IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
545	IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
546	IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
547	IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
548	IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
549	#endif
550
551
552	END SUBROUTINE fonte_neige_final
553	!
554	!****************************************************************************************
555	!
556	SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
557	fqfonte_out, ffonte_out, run_off_lic_out &
558	#ifdef ISO
559	& ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
560	#endif
561	& )
562
563
564	! Cumulate ffonte, fqfonte and fqcalving respectively for
565	! all type of surfaces according to their fraction.
566	!
567	! This routine is called from physiq.F before histwrite.
568	!****************************************************************************************
569
570	USE indice_sol_mod
571	#ifdef ISO
572	USE infotrac_phy, ONLY: niso
573	#endif
574
575	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
576
577	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_out
578	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_out
579	REAL, DIMENSION(klon), INTENT(OUT) :: ffonte_out
580	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out
581
582	#ifdef ISO
583	REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
584	REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
585	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
586	INTEGER :: i,ixt
587	#endif
588
589	INTEGER :: nisurf
590	!****************************************************************************************
591
592	ffonte_out(:) = 0.0
593	fqfonte_out(:) = 0.0
594	fqcalving_out(:) = 0.0
595	#ifdef ISO
596	fxtfonte_out(:,:) = 0.0
597	fxtcalving_out(:,:) = 0.0
598	#endif
599
600	DO nisurf = 1, nbsrf
601	ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
602	fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
603	fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
604	ENDDO
605
606	run_off_lic_out(:)=runofflic_global(:)
607
608	#ifdef ISO
609	DO nisurf = 1, nbsrf
610	DO i=1,klon
611	DO ixt=1,niso
612	fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
613	fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
614	ENDDO !DO ixt=1,niso
615	ENDDO !DO i=1,klon
616	ENDDO !DO nisurf = 1, nbsrf
617	xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
618	#endif
619
620	END SUBROUTINE fonte_neige_get_vars
621	!
622	!****************************************************************************************
623	!
624	!#ifdef ISO
625	! subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
626	! use infotrac_phy, ONLY: niso
627	!
628	! ! inputs
629	! INTEGER, INTENT(IN) :: knon
630	! real, INTENT(IN), DIMENSION(niso,klon) :: xtrun_off_lic_0_diag
631	!
632	! xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
633	!
634	! end subroutine fonte_neige_export_xtrun_off_lic_0
635	!#endif
636
637	#ifdef ISO
638	SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
639	& xtprecip_snow,xtprecip_rain, &
640	& fxtfonte_neige,fxtcalving, &
641	& knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
642
643	! dans cette routine, on a besoin des variables globales de
644	! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
645	! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
646	! de dépendance circulaire.
647
648	USE infotrac_phy, ONLY: ntiso,niso
649	USE isotopes_mod, ONLY: iso_eau
650	USE indice_sol_mod
651	#ifdef ISOVERIF
652	USE isotopes_verif_mod
653	#endif
654	IMPLICIT NONE
655
656	! inputs
657	INTEGER, INTENT(IN) :: klon,knon
658	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
659	REAL, DIMENSION(niso,klon), INTENT(IN) :: fxtfonte_neige,fxtcalving
660	INTEGER, INTENT(IN) :: nisurf
661	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
662	REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
663	REAL, INTENT(IN) :: coeff_rel_diag
664
665	! locals
666	INTEGER :: i,ixt,j
667
668	#ifdef ISOVERIF
669	IF (nisurf == is_lic) THEN
670	IF (iso_eau > 0) THEN
671	DO i = 1, knon
672	j = knindex(i)
673	CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
674	& run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
675	ENDDO
676	ENDIF
677	ENDIF
678	#endif
679
680	! calcul de run_off_lic
681
682	IF (nisurf == is_lic) THEN
683	! coeff_rel = dtime/(tau_calv * rday)
684
685	DO i = 1, knon
686	j = knindex(i)
687	DO ixt = 1, niso
688	xtrun_off_lic(ixt,i) = (coeff_rel_diag * fxtcalving(ixt,i)) &
689	& +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
690	xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
691	xtrun_off_lic(ixt,i) = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
692	ENDDO !DO ixt=1,niso
693	#ifdef ISOVERIF
694	IF (iso_eau > 0) THEN
695	IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
696	& run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
697	& errmax,errmaxrel) == 1) THEN
698	WRITE(,) 'i,j=',i,j
699	WRITE(,) 'coeff_rel_diag=',coeff_rel_diag
700	STOP
701	ENDIF
702	ENDIF
703	#endif
704	ENDDO
705	ENDIF !IF (nisurf == is_lic) THEN
706
707	! Save ffonte, fqfonte and fqcalving in global arrays for each
708	! sub-surface separately
709	DO i = 1, knon
710	DO ixt = 1, niso
711	fxtfonte_global(ixt,knindex(i),nisurf) = fxtfonte_neige(ixt,i)
712	fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
713	ENDDO !do ixt=1,niso
714	ENDDO
715
716	IF (nisurf == is_lic) THEN
717	DO i = 1, knon
718	DO ixt = 1, niso
719	xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
720	ENDDO ! DO ixt=1,niso
721	ENDDO
722	ENDIF
723
724	END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
725	#endif
726
727
728	END MODULE fonte_neige_mod

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

Download in other formats:

Original Format