Context Navigation

← Previous Revision
Next Revision →
Normal
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

Rev	Line
[5099]	1
[782]	2	! $Header$
[5099]	3
[782]	4	MODULE fonte_neige_mod
[5099]	5
[782]	6	! This module will treat the process of snow, melting, accumulating, calving, in
	7	! case of simplified soil model.
[5099]	8
[782]	9	!****************************************************************************************
[5101]	10	USE dimphy, ONLY: klon
[1785]	11	USE indice_sol_mod
[782]	12
[5128]	13
[782]	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
[5113]	19	! Note: run_off_lic is used in mod_landice and therfore not PRIVATE
[782]	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)
[3900]	31	REAL, ALLOCATABLE, DIMENSION(:,:) :: ffonte_global
[782]	32	!$OMP THREADPRIVATE(ffonte_global)
[3900]	33	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqfonte_global
[782]	34	!$OMP THREADPRIVATE(fqfonte_global)
[3900]	35	REAL, ALLOCATABLE, DIMENSION(:,:) :: fqcalving_global
[782]	36	!$OMP THREADPRIVATE(fqcalving_global)
[3900]	37	REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
[2617]	38	!$OMP THREADPRIVATE(runofflic_global)
[5022]	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
[782]	53
	54	CONTAINS
[5099]	55
[782]	56	!****************************************************************************************
[5099]	57
[782]	58	SUBROUTINE fonte_neige_init(restart_runoff)
	59
[5103]	60	! This SUBROUTINE allocates and initialize variables in the module.
[782]	61	! The variable run_off_lic_0 is initialized to the field read from
	62	! restart file. The other variables are initialized to zero.
[5099]	63
[782]	64	!****************************************************************************************
[5111]	65	USE lmdz_abort_physic, ONLY: abort_physic
[782]	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
[5099]	77
[782]	78	!****************************************************************************************
	79
	80	ALLOCATE(run_off_lic_0(klon), stat = error)
	81	IF (error /= 0) THEN
	82	abort_message='Pb allocation run_off_lic'
[2311]	83	CALL abort_physic(modname,abort_message,1)
[782]	84	ENDIF
	85	run_off_lic_0(:) = restart_runoff(:)
	86
	87	!****************************************************************************************
	88	! Allocate other variables and initilize to zero
[5099]	89
[782]	90	!****************************************************************************************
	91	ALLOCATE(run_off_ter(klon), stat = error)
	92	IF (error /= 0) THEN
	93	abort_message='Pb allocation run_off_ter'
[2311]	94	CALL abort_physic(modname,abort_message,1)
[782]	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'
[2311]	101	CALL abort_physic(modname,abort_message,1)
[782]	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'
[2311]	108	CALL abort_physic(modname,abort_message,1)
[782]	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'
[2311]	115	CALL abort_physic(modname,abort_message,1)
[782]	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'
[2311]	122	CALL abort_physic(modname,abort_message,1)
[782]	123	ENDIF
	124	fqcalving_global(:,:) = 0.0
	125
[2617]	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
[782]	133	!****************************************************************************************
	134	! Read tau_calv
[5099]	135
[782]	136	!****************************************************************************************
	137	CALL conf_interface(tau_calv)
	138
	139
	140	END SUBROUTINE fonte_neige_init
[5022]	141
	142	#ifdef ISO
	143	SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
	144
[5103]	145	! This SUBROUTINE allocates and initialize variables in the module.
[5022]	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
[5231]	150	USE lmdz_abort_physic, ONLY: abort_physic
[5022]	151	#ifdef ISOVERIF
	152	USE isotopes_mod, ONLY: iso_eau,iso_HDO
	153	USE isotopes_verif_mod
	154	#endif
[5099]	155
[782]	156	!****************************************************************************************
[5022]	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
[5099]	169
[5022]	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'
[5231]	175	CALL abort_physic(modname,abort_message,1)
[5022]	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( &
[5087]	183	xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
	184	niso,klon)
[5022]	185	ENDIF !IF (iso_eau > 0) THEN
	186	#endif
	187
	188	!****************************************************************************************
	189	! Allocate other variables and initilize to zero
[5099]	190
[5022]	191	!****************************************************************************************
	192
	193	ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
	194	IF (error /= 0) THEN
	195	abort_message='Pb allocation xtrun_off_ter'
[5231]	196	CALL abort_physic(modname,abort_message,1)
[5022]	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'
[5231]	203	CALL abort_physic(modname,abort_message,1)
[5022]	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'
[5231]	210	CALL abort_physic(modname,abort_message,1)
[5022]	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'
[5231]	217	CALL abort_physic(modname,abort_message,1)
[5022]	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'
[5231]	224	CALL abort_physic(modname,abort_message,1)
[5022]	225	ENDIF
	226	xtrunofflic_global(:,:) = 0.0
	227
	228	END SUBROUTINE fonte_neige_init_iso
	229	#endif
	230
	231	!****************************************************************************************
[5099]	232
[782]	233	SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
	234	tsurf, precip_rain, precip_snow, &
[5022]	235	snow, qsol, tsurf_new, evap &
	236	#ifdef ISO
[5087]	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 &
[5022]	239	#endif
[5087]	240	)
[1785]	241
[5022]	242	USE indice_sol_mod
[5137]	243	USE lmdz_clesphys
[5144]	244	USE lmdz_yoethf
[5022]	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
[5153]	252
[5144]	253	USE lmdz_yomcst
[5153]	254
	255	IMPLICIT NONE
	256	INCLUDE "FCTTRE.h"
[782]	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
[5099]	269
[782]	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
[5099]	275
[782]	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
[4523]	285
	286	! Input/Output variables
[782]	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
[5022]	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
[782]	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
[5022]	327	#ifdef ISO
	328	max_eau_sol_diag=max_eau_sol
	329	#endif
	330
	331
[782]	332	!****************************************************************************************
	333	! Start calculation
	334	! - Initialization
[5099]	335
[782]	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)
[5099]	344
[782]	345	!****************************************************************************************
	346	WHERE (precip_snow > 0.)
	347	snow = snow + (precip_snow * dtime)
	348	END WHERE
	349
	350	snow_evap = 0.
[2946]	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
[782]	367
	368	bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
[5022]	369	#ifdef ISO
	370	snow_evap_diag(:) = snow_evap(:)
	371	coeff_rel_diag = coeff_rel
	372	#endif
[782]	373
	374
[5022]	375
[782]	376	!****************************************************************************************
	377	! - Calculate melting snow
	378	! - Calculate calving and decrement snow, if there are to much snow
	379	! - Update temperature at surface
[5099]	380
[782]	381	!****************************************************************************************
	382
	383	ffonte(:) = 0.0
	384	fqcalving(:) = 0.0
	385	fqfonte(:) = 0.0
[2946]	386
[782]	387	DO i = 1, knon
	388	! Y'a-t-il fonte de neige?
[2946]	389	neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
[782]	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
[5022]	397	#ifdef ISO
	398	fq_fonte_diag(i) = fq_fonte
	399	#endif
[782]	400
[5022]	401
[782]	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
[2946]	416	! s'il y a une hauteur trop importante de neige, elle est ecretee
[782]	417	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
	418	snow(i)=MIN(snow(i),snow_max)
[2946]	419	ENDDO
[5022]	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
[782]	426
[5022]	427
[782]	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)
[5022]	432	#ifdef ISO
	433	runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
	434	#endif
[782]	435	qsol(i) = MIN(qsol(i), max_eau_sol)
[2946]	436	ENDDO
[782]	437	ELSE IF (nisurf == is_lic) THEN
	438	DO i = 1, knon
	439	j = knindex(i)
[2946]	440	!--temporal filtering
	441	run_off_lic(i) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
[782]	442	run_off_lic_0(j) = run_off_lic(i)
[2946]	443	!--add melting snow and liquid precip to runoff of ice cap
[1504]	444	run_off_lic(i) = run_off_lic(i) + fqfonte(i) + precip_rain(i)
[2946]	445	ENDDO
[782]	446	ENDIF
[5022]	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
[782]	453
	454	!****************************************************************************************
	455	! Save ffonte, fqfonte and fqcalving in global arrays for each
	456	! sub-surface separately
[5099]	457
[782]	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
[2617]	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
[782]	471	END SUBROUTINE fonte_neige
[5099]	472
[782]	473	!****************************************************************************************
[5099]	474
[5022]	475	SUBROUTINE fonte_neige_final(restart_runoff &
	476	#ifdef ISO
[5087]	477	,xtrestart_runoff &
[5022]	478	#endif
[5087]	479	)
[5099]	480
[5103]	481	! This SUBROUTINE returns run_off_lic_0 for later writing to restart file.
[5099]	482
[5022]	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
[5099]	490
[782]	491	!****************************************************************************************
	492	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
[5022]	493	#ifdef ISO
	494	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
	495	#ifdef ISOVERIF
	496	INTEGER :: i
	497	#endif
	498	#endif
[782]	499
[5022]	500
	501
[782]	502	!****************************************************************************************
	503	! Set the output variables
	504	restart_runoff(:) = run_off_lic_0(:)
[5022]	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) &
[5087]	511	,xtrun_off_lic_0(iso_eau,i) &
	512	,'fonte_neige 413') &
[5116]	513	== 1) THEN
[5022]	514	WRITE(,) 'i=',i
	515	STOP
	516	ENDIF
	517	ENDDO !DO i=1,klon
[5116]	518	ENDIF !IF (iso_eau > 0) THEN
[5022]	519	#endif
	520	#endif
[782]	521
[5022]	522
	523
[782]	524	! Deallocation of all varaibles in the module
[1413]	525	! DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
	526	! fqfonte_global, fqcalving_global)
[782]	527
[1413]	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)
[2619]	534	IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
[5022]	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
[1413]	543
[5022]	544
[782]	545	END SUBROUTINE fonte_neige_final
[5099]	546
[782]	547	!****************************************************************************************
[5099]	548
[782]	549	SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
[5022]	550	fqfonte_out, ffonte_out, run_off_lic_out &
	551	#ifdef ISO
[5087]	552	,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
[5022]	553	#endif
[5087]	554	)
[782]	555
[1785]	556
[782]	557	! Cumulate ffonte, fqfonte and fqcalving respectively for
	558	! all type of surfaces according to their fraction.
[5099]	559
[782]	560	! This routine is called from physiq.F before histwrite.
[1785]	561	!****************************************************************************************
[782]	562
[5022]	563	USE indice_sol_mod
	564	#ifdef ISO
	565	USE infotrac_phy, ONLY: niso
	566	#endif
[1785]	567
[782]	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
[2517]	573	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out
[782]	574
[5022]	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
[782]	582	INTEGER :: nisurf
	583	!****************************************************************************************
	584
	585	ffonte_out(:) = 0.0
	586	fqfonte_out(:) = 0.0
	587	fqcalving_out(:) = 0.0
[5022]	588	#ifdef ISO
	589	fxtfonte_out(:,:) = 0.0
	590	fxtcalving_out(:,:) = 0.0
	591	#endif
[782]	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
[2617]	599	run_off_lic_out(:)=runofflic_global(:)
	600
[5022]	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
[782]	613	END SUBROUTINE fonte_neige_get_vars
[5099]	614
[782]	615	!****************************************************************************************
[5099]	616
[5022]	617	!#ifdef ISO
[5103]	618	! SUBROUTINE fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
[5022]	619	! use infotrac_phy, ONLY: niso
[5099]	620
[5022]	621	! ! inputs
	622	! INTEGER, INTENT(IN) :: knon
[5117]	623	! REAL, INTENT(IN), DIMENSION(niso,klon) :: xtrun_off_lic_0_diag
[5099]	624
[5022]	625	! xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
[5099]	626
[5103]	627	! END SUBROUTINE fonte_neige_export_xtrun_off_lic_0
[5022]	628	!#endif
	629
	630	#ifdef ISO
	631	SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
[5087]	632	xtprecip_snow,xtprecip_rain, &
	633	fxtfonte_neige,fxtcalving, &
	634	knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
[5022]	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), &
[5087]	667	run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
[5022]	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)) &
[5087]	682	+(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
[5022]	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), &
[5087]	689	run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
	690	errmax,errmaxrel) == 1) THEN
[5022]	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
[782]	721	END MODULE fonte_neige_mod

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

Download in other formats:

Original Format