Context Navigation

fonte_neige_mod.F90 @ 3929

Last change on this file since 3929 was 3927, checked in by Laurent Fairhead, 3 years ago
Initial import of the physics wih isotopes from Camille Risi CR
File size: 24.6 KB

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

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

Download in other formats:

Original Format