Context Navigation

fonte_neige_mod.F90 @ 3927

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

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

Download in other formats:

Original Format