Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

fonte_neige_mod.F90

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

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

Download in other formats:

Original Format