Context Navigation

fonte_neige_mod.F90

Last change on this file was 3331, checked in by acozic, 7 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 22.9 KB

Rev	Line
[3331]	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