Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

fonte_neige_mod.F90 @ 5872

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

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

Download in other formats:

Original Format