Context Navigation

fonte_neige_mod.F90 @ 5227

Last change on this file since 5227 was 5217, checked in by Ehouarn Millour, 8 weeks ago
Replace "abort_gcm" in physics with "abort_physic" to ensure clean dynamics-physics separation. EM
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

Rev	Line
[782]	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
[1785]	11	USE indice_sol_mod
[782]	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)
[3900]	30	REAL, ALLOCATABLE, DIMENSION(:,:) :: ffonte_global
[782]	31	!$OMP THREADPRIVATE(ffonte_global)
[3900]	32	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqfonte_global
[782]	33	!$OMP THREADPRIVATE(fqfonte_global)
[3900]	34	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqcalving_global
[782]	35	!$OMP THREADPRIVATE(fqcalving_global)
[3900]	36	REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
[2617]	37	!$OMP THREADPRIVATE(runofflic_global)
[5022]	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
[782]	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	! Input argument
	65	REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
	66
	67	! Local variables
	68	INTEGER :: error
	69	CHARACTER (len = 80) :: abort_message
	70	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
	71
	72
	73	!****************************************************************************************
	74	! Allocate run-off at landice and initilize with field read from restart
	75	!
	76	!****************************************************************************************
	77
	78	ALLOCATE(run_off_lic_0(klon), stat = error)
	79	IF (error /= 0) THEN
	80	abort_message='Pb allocation run_off_lic'
[2311]	81	CALL abort_physic(modname,abort_message,1)
[782]	82	ENDIF
	83	run_off_lic_0(:) = restart_runoff(:)
	84
	85	!****************************************************************************************
	86	! Allocate other variables and initilize to zero
	87	!
	88	!****************************************************************************************
	89	ALLOCATE(run_off_ter(klon), stat = error)
	90	IF (error /= 0) THEN
	91	abort_message='Pb allocation run_off_ter'
[2311]	92	CALL abort_physic(modname,abort_message,1)
[782]	93	ENDIF
	94	run_off_ter(:) = 0.
	95
	96	ALLOCATE(run_off_lic(klon), stat = error)
	97	IF (error /= 0) THEN
	98	abort_message='Pb allocation run_off_lic'
[2311]	99	CALL abort_physic(modname,abort_message,1)
[782]	100	ENDIF
	101	run_off_lic(:) = 0.
	102
	103	ALLOCATE(ffonte_global(klon,nbsrf))
	104	IF (error /= 0) THEN
	105	abort_message='Pb allocation ffonte_global'
[2311]	106	CALL abort_physic(modname,abort_message,1)
[782]	107	ENDIF
	108	ffonte_global(:,:) = 0.0
	109
	110	ALLOCATE(fqfonte_global(klon,nbsrf))
	111	IF (error /= 0) THEN
	112	abort_message='Pb allocation fqfonte_global'
[2311]	113	CALL abort_physic(modname,abort_message,1)
[782]	114	ENDIF
	115	fqfonte_global(:,:) = 0.0
	116
	117	ALLOCATE(fqcalving_global(klon,nbsrf))
	118	IF (error /= 0) THEN
	119	abort_message='Pb allocation fqcalving_global'
[2311]	120	CALL abort_physic(modname,abort_message,1)
[782]	121	ENDIF
	122	fqcalving_global(:,:) = 0.0
	123
[2617]	124	ALLOCATE(runofflic_global(klon))
	125	IF (error /= 0) THEN
	126	abort_message='Pb allocation runofflic_global'
	127	CALL abort_physic(modname,abort_message,1)
	128	ENDIF
	129	runofflic_global(:) = 0.0
	130
[782]	131	!****************************************************************************************
	132	! Read tau_calv
	133	!
	134	!****************************************************************************************
	135	CALL conf_interface(tau_calv)
	136
	137
	138	END SUBROUTINE fonte_neige_init
[5022]	139
	140	#ifdef ISO
	141	SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
	142
	143	! This subroutine allocates and initialize variables in the module.
	144	! The variable run_off_lic_0 is initialized to the field read from
	145	! restart file. The other variables are initialized to zero.
	146
	147	USE infotrac_phy, ONLY: niso
	148	#ifdef ISOVERIF
	149	USE isotopes_mod, ONLY: iso_eau,iso_HDO
	150	USE isotopes_verif_mod
	151	#endif
[782]	152	!
	153	!****************************************************************************************
[5022]	154	! Input argument
	155	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff
	156
	157	! Local variables
	158	INTEGER :: error
	159	CHARACTER (len = 80) :: abort_message
	160	CHARACTER (len = 20) :: modname = 'fonte_neige_init'
	161	INTEGER :: i
	162
	163
	164	!****************************************************************************************
	165	! Allocate run-off at landice and initilize with field read from restart
[782]	166	!
[5022]	167	!****************************************************************************************
	168
	169	ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
	170	IF (error /= 0) THEN
	171	abort_message='Pb allocation run_off_lic'
[5217]	172	CALL abort_physic(modname,abort_message,1)
[5022]	173	ENDIF
	174
	175	xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)
	176
	177	#ifdef ISOVERIF
	178	IF (iso_eau > 0) THEN
	179	CALL iso_verif_egalite_vect1D( &
	180	& xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
	181	& niso,klon)
	182	ENDIF !IF (iso_eau > 0) THEN
	183	#endif
	184
	185	!****************************************************************************************
	186	! Allocate other variables and initilize to zero
	187	!
	188	!****************************************************************************************
	189
	190	ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
	191	IF (error /= 0) THEN
	192	abort_message='Pb allocation xtrun_off_ter'
[5217]	193	CALL abort_physic(modname,abort_message,1)
[5022]	194	ENDIF
	195	xtrun_off_ter(:,:) = 0.
	196
	197	ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
	198	IF (error /= 0) THEN
	199	abort_message='Pb allocation xtrun_off_lic'
[5217]	200	CALL abort_physic(modname,abort_message,1)
[5022]	201	ENDIF
	202	xtrun_off_lic(:,:) = 0.
	203
	204	ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
	205	IF (error /= 0) THEN
	206	abort_message='Pb allocation fxtfonte_global'
[5217]	207	CALL abort_physic(modname,abort_message,1)
[5022]	208	ENDIF
	209	fxtfonte_global(:,:,:) = 0.0
	210
	211	ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
	212	IF (error /= 0) THEN
	213	abort_message='Pb allocation fxtcalving_global'
[5217]	214	CALL abort_physic(modname,abort_message,1)
[5022]	215	ENDIF
	216	fxtcalving_global(:,:,:) = 0.0
	217
	218	ALLOCATE(xtrunofflic_global(niso,klon))
	219	IF (error /= 0) THEN
	220	abort_message='Pb allocation xtrunofflic_global'
[5217]	221	CALL abort_physic(modname,abort_message,1)
[5022]	222	ENDIF
	223	xtrunofflic_global(:,:) = 0.0
	224
	225	END SUBROUTINE fonte_neige_init_iso
	226	#endif
	227
	228	!
	229	!****************************************************************************************
	230	!
[782]	231	SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
	232	tsurf, precip_rain, precip_snow, &
[5022]	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	& )
[1785]	239
[5022]	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
[782]	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	!
[793]	267	INCLUDE "YOETHF.h"
	268	INCLUDE "YOMCST.h"
	269	INCLUDE "FCTTRE.h"
	270	INCLUDE "clesphys.h"
[782]	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
[4523]	281
	282	! Input/Output variables
[782]	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
[5022]	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
[782]	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
[5022]	323	#ifdef ISO
	324	max_eau_sol_diag=max_eau_sol
	325	#endif
	326
	327
[782]	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.
[2946]	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
[782]	363
	364	bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
[5022]	365	#ifdef ISO
	366	snow_evap_diag(:) = snow_evap(:)
	367	coeff_rel_diag = coeff_rel
	368	#endif
[782]	369
	370
[5022]	371
[782]	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
[2946]	382
[782]	383	DO i = 1, knon
	384	! Y'a-t-il fonte de neige?
[2946]	385	neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
[782]	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
[5022]	393	#ifdef ISO
	394	fq_fonte_diag(i) = fq_fonte
	395	#endif
[782]	396
[5022]	397
[782]	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
[2946]	412	! s'il y a une hauteur trop importante de neige, elle est ecretee
[782]	413	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
	414	snow(i)=MIN(snow(i),snow_max)
[2946]	415	ENDDO
[5022]	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
[782]	422
[5022]	423
[782]	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)
[5022]	428	#ifdef ISO
	429	runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
	430	#endif
[782]	431	qsol(i) = MIN(qsol(i), max_eau_sol)
[2946]	432	ENDDO
[782]	433	ELSE IF (nisurf == is_lic) THEN
	434	DO i = 1, knon
	435	j = knindex(i)
[2946]	436	!--temporal filtering
	437	run_off_lic(i) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
[782]	438	run_off_lic_0(j) = run_off_lic(i)
[2946]	439	!--add melting snow and liquid precip to runoff of ice cap
[1504]	440	run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i)
[2946]	441	ENDDO
[782]	442	ENDIF
[5022]	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
[782]	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
[2617]	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
[782]	467	END SUBROUTINE fonte_neige
	468	!
	469	!****************************************************************************************
	470	!
[5022]	471	SUBROUTINE fonte_neige_final(restart_runoff &
	472	#ifdef ISO
	473	& ,xtrestart_runoff &
	474	#endif
	475	& )
[782]	476	!
	477	! This subroutine returns run_off_lic_0 for later writing to restart file.
	478	!
[5022]	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	!
[782]	487	!****************************************************************************************
	488	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
[5022]	489	#ifdef ISO
	490	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
	491	#ifdef ISOVERIF
	492	INTEGER :: i
	493	#endif
	494	#endif
[782]	495
[5022]	496
	497
[782]	498	!****************************************************************************************
	499	! Set the output variables
	500	restart_runoff(:) = run_off_lic_0(:)
[5022]	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
[782]	517
[5022]	518
	519
[782]	520	! Deallocation of all varaibles in the module
[1413]	521	! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
	522	! fqfonte_global, fqcalving_global)
[782]	523
[1413]	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)
[2619]	530	IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
[5022]	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
[1413]	539
[5022]	540
[782]	541	END SUBROUTINE fonte_neige_final
	542	!
	543	!****************************************************************************************
	544	!
	545	SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
[5022]	546	fqfonte_out, ffonte_out, run_off_lic_out &
	547	#ifdef ISO
	548	& ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
	549	#endif
	550	& )
[782]	551
[1785]	552
[782]	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.
[1785]	557	!****************************************************************************************
[782]	558
[5022]	559	USE indice_sol_mod
	560	#ifdef ISO
	561	USE infotrac_phy, ONLY: niso
	562	#endif
[1785]	563
[782]	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
[2517]	569	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out
[782]	570
[5022]	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
[782]	578	INTEGER :: nisurf
	579	!****************************************************************************************
	580
	581	ffonte_out(:) = 0.0
	582	fqfonte_out(:) = 0.0
	583	fqcalving_out(:) = 0.0
[5022]	584	#ifdef ISO
	585	fxtfonte_out(:,:) = 0.0
	586	fxtcalving_out(:,:) = 0.0
	587	#endif
[782]	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
[2617]	595	run_off_lic_out(:)=runofflic_global(:)
	596
[5022]	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
[782]	609	END SUBROUTINE fonte_neige_get_vars
	610	!
	611	!****************************************************************************************
	612	!
[5022]	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
[782]	717	END MODULE fonte_neige_mod

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

Download in other formats:

Original Format