Context Navigation

fonte_neige_mod.F90 @ 5111

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

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

Download in other formats:

Original Format