Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

simplehydrol_mod.F90

Last change on this file was 6055, checked in by evignon, 3 weeks ago
correction commit 6053
File size: 27.9 KB

Rev	Line
[6033]	1	! $Header$
	2	!
	3	MODULE simplehydrol_mod
	4
	5	!*******************************************************************************************
	6	! This module contains a simple hydrology model to compute the soil water content,
	7	! the melting and accumulation of snow as well as ice sheet "calving" (rough assumptions)
	8	! It is especially used over land and landice surfaces when the coupling with ORCHIDEE
	9	! is not active, and over sea ice (especially for snow) when the coupling with NEMO
	10	! is not active.
	11	! contact: F. Cheruy, frederique.cheruy@lmd.ipsl.fr ; E. Vignon, etienne.vignon@lmd.ipsl.fr
	12	!*******************************************************************************************
	13	USE dimphy, ONLY: klon
	14	USE indice_sol_mod
	15
	16	IMPLICIT NONE
	17	SAVE
	18
	19	! run_off_ter and run_off_lic are the runoff at the compressed grid knon for
	20	! land and land-ice respectively
	21	! Note: run_off_lic is used in mod_landice and therfore not private
	22	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_ter
	23	!$OMP THREADPRIVATE(run_off_ter)
	24	REAL, ALLOCATABLE, DIMENSION(:) :: run_off_lic
	25	!$OMP THREADPRIVATE(run_off_lic)
	26
	27	! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
	28	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE :: run_off_lic_0
	29	!$OMP THREADPRIVATE(run_off_lic_0)
	30
	31	REAL, PRIVATE :: tau_calv
	32	!$OMP THREADPRIVATE(tau_calv)
	33	REAL, ALLOCATABLE, DIMENSION(:, :) :: ffonte_global
	34	!$OMP THREADPRIVATE(ffonte_global)
	35	REAL, ALLOCATABLE, DIMENSION(:, :) :: fqfonte_global
	36	!$OMP THREADPRIVATE(fqfonte_global)
	37	REAL, ALLOCATABLE, DIMENSION(:, :) :: fqcalving_global
	38	!$OMP THREADPRIVATE(fqcalving_global)
	39	REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global
	40	!$OMP THREADPRIVATE(runofflic_global)
	41	#ifdef ISO
	42	REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE :: xtrun_off_ter
	43	!$OMP THREADPRIVATE(xtrun_off_ter)
	44	REAL, ALLOCATABLE, DIMENSION(:, :) :: xtrun_off_lic
	45	!$OMP THREADPRIVATE(xtrun_off_lic)
	46	REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE :: xtrun_off_lic_0
	47	!$OMP THREADPRIVATE(xtrun_off_lic_0)
	48	REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE:: fxtfonte_global
	49	!$OMP THREADPRIVATE(fxtfonte_global)
	50	REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE:: fxtcalving_global
	51	!$OMP THREADPRIVATE(fxtcalving_global)
	52	REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE :: xtrunofflic_global
	53	!$OMP THREADPRIVATE(xtrunofflic_global)
	54	#endif
	55
	56	CONTAINS
	57	!
	58	!****************************************************************************************
	59	SUBROUTINE simplehydrol_init(restart_runoff)
	60
	61	! This subroutine allocates and initialize variables in the module.
	62	! The variable run_off_lic_0 is initialized to the field read from
	63	! restart file. The other variables are initialized to zero.
	64	!
	65	!****************************************************************************************
	66	! Input argument
	67	REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff
	68
	69	! Local variables
	70	INTEGER :: error
	71	CHARACTER(len=80) :: abort_message
[6034]	72	CHARACTER(len=20) :: modname = 'simplehydrol_init'
[6033]	73
	74	! Allocate run-off at landice and initilize with field read from restart
	75	!****************************************************************************************
	76
	77	ALLOCATE (run_off_lic_0(klon), stat=error)
	78	IF (error /= 0) THEN
	79	abort_message = 'Pb allocation run_off_lic'
	80	CALL abort_physic(modname, abort_message, 1)
	81	END IF
	82	run_off_lic_0(:) = restart_runoff(:)
	83
	84	! Allocate other variables and initilize to zero
	85	!****************************************************************************************
	86	ALLOCATE (run_off_ter(klon), stat=error)
	87	IF (error /= 0) THEN
	88	abort_message = 'Pb allocation run_off_ter'
	89	CALL abort_physic(modname, abort_message, 1)
	90	END IF
	91	run_off_ter(:) = 0.
	92
	93	ALLOCATE (run_off_lic(klon), stat=error)
	94	IF (error /= 0) THEN
	95	abort_message = 'Pb allocation run_off_lic'
	96	CALL abort_physic(modname, abort_message, 1)
	97	END IF
	98	run_off_lic(:) = 0.
	99
	100	ALLOCATE (ffonte_global(klon, nbsrf))
	101	IF (error /= 0) THEN
	102	abort_message = 'Pb allocation ffonte_global'
	103	CALL abort_physic(modname, abort_message, 1)
	104	END IF
	105	ffonte_global(:, :) = 0.0
	106
	107	ALLOCATE (fqfonte_global(klon, nbsrf))
	108	IF (error /= 0) THEN
	109	abort_message = 'Pb allocation fqfonte_global'
	110	CALL abort_physic(modname, abort_message, 1)
	111	END IF
	112	fqfonte_global(:, :) = 0.0
	113
	114	ALLOCATE (fqcalving_global(klon, nbsrf))
	115	IF (error /= 0) THEN
	116	abort_message = 'Pb allocation fqcalving_global'
	117	CALL abort_physic(modname, abort_message, 1)
	118	END IF
	119	fqcalving_global(:, :) = 0.0
	120
	121	ALLOCATE (runofflic_global(klon))
	122	IF (error /= 0) THEN
	123	abort_message = 'Pb allocation runofflic_global'
	124	CALL abort_physic(modname, abort_message, 1)
	125	END IF
	126	runofflic_global(:) = 0.0
	127
	128	! Read tau_calv
	129	!***************
	130	CALL conf_interface(tau_calv)
	131
	132	END SUBROUTINE simplehydrol_init
	133	!************************************************************************************
	134
	135	#ifdef ISO
	136	!************************************************************************************
	137	SUBROUTINE simplehydrol_init_iso(xtrestart_runoff)
	138
	139	! This subroutine allocates and initialize variables in the module for water isotopes.
	140	! The variable run_off_lic_0 is initialized to the field read from
	141	! restart file. The other variables are initialized to zero.
	142	!************************************************************************************
	143
	144	USE infotrac_phy, ONLY: niso
	145	#ifdef ISOVERIF
	146	USE isotopes_mod, ONLY: iso_eau, iso_HDO
	147	USE isotopes_verif_mod
	148	#endif
	149
	150	! Declarations
	151	!****************************************************************************************
	152
	153	! Input argument
	154	REAL, DIMENSION(niso, klon), INTENT(IN) :: xtrestart_runoff
	155
	156	! Local variables
	157	INTEGER :: error
	158	CHARACTER(len=80) :: abort_message
	159	CHARACTER(len=20) :: modname = 'simplehydrol_init'
	160	INTEGER :: i
	161
	162	! Allocate run-off at landice and initilize with field read from restart
	163	!****************************************************************************************
	164
	165	ALLOCATE (xtrun_off_lic_0(niso, klon), stat=error)
	166	IF (error /= 0) THEN
	167	abort_message = 'Pb allocation run_off_lic'
	168	CALL abort_physic(modname, abort_message, 1)
	169	END IF
	170
	171	xtrun_off_lic_0(:, :) = xtrestart_runoff(:, :)
	172
	173	#ifdef ISOVERIF
	174	IF (iso_eau > 0) THEN
	175	CALL iso_verif_egalite_vect1D( &
	176	& xtrun_off_lic_0, run_off_lic_0, 'simplehydrol 100', &
	177	& niso, klon)
	178	END IF !IF (iso_eau > 0) THEN
	179	#endif
	180
	181	! Allocate other variables and initialize to zero
	182	!****************************************************************************************
	183
	184	ALLOCATE (xtrun_off_ter(niso, klon), stat=error)
	185	IF (error /= 0) THEN
	186	abort_message = 'Pb allocation xtrun_off_ter'
	187	CALL abort_physic(modname, abort_message, 1)
	188	END IF
	189	xtrun_off_ter(:, :) = 0.
	190
	191	ALLOCATE (xtrun_off_lic(niso, klon), stat=error)
	192	IF (error /= 0) THEN
	193	abort_message = 'Pb allocation xtrun_off_lic'
	194	CALL abort_physic(modname, abort_message, 1)
	195	END IF
	196	xtrun_off_lic(:, :) = 0.
	197
	198	ALLOCATE (fxtfonte_global(niso, klon, nbsrf))
	199	IF (error /= 0) THEN
	200	abort_message = 'Pb allocation fxtfonte_global'
	201	CALL abort_physic(modname, abort_message, 1)
	202	END IF
	203	fxtfonte_global(:, :, :) = 0.0
	204
	205	ALLOCATE (fxtcalving_global(niso, klon, nbsrf))
	206	IF (error /= 0) THEN
	207	abort_message = 'Pb allocation fxtcalving_global'
	208	CALL abort_physic(modname, abort_message, 1)
	209	END IF
	210	fxtcalving_global(:, :, :) = 0.0
	211
	212	ALLOCATE (xtrunofflic_global(niso, klon))
	213	IF (error /= 0) THEN
	214	abort_message = 'Pb allocation xtrunofflic_global'
	215	CALL abort_physic(modname, abort_message, 1)
	216	END IF
	217	xtrunofflic_global(:, :) = 0.0
	218
	219	END SUBROUTINE simplehydrol_init_iso
	220	#endif
	221	!****************************************************************************************
	222
	223	!****************************************************************************************
	224	SUBROUTINE simplehydrol(knon, nisurf, knindex, dtime, &
	225	tsurf, precip_rain, precip_snow, &
[6053]	226	snow, qsol, tsurf_new, evap, ice_sub, ice_melt &
[6033]	227	#ifdef ISO
	228	, fq_fonte_diag, fqfonte_diag, snow_sub_diag, fqcalving_diag &
	229	, max_eau_sol_diag, runoff_diag, run_off_lic_diag, coeff_rel_diag &
	230	#endif
	231	)
	232	!$gpum horizontal knon klon
	233	USE indice_sol_mod
	234	#ifdef ISO
	235	USE infotrac_phy, ONLY: niso
	236	!use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
	237	#ifdef ISOVERIF
	238	USE isotopes_verif_mod
	239	#endif
	240	#endif
	241	USE yoethf_mod_h
	242	USE clesphys_mod_h
	243	USE yomcst_mod_h
	244
	245	!**********************************************************************************************
	246	! This routines is a simple hydrology model to compute the soil water content,
	247	! the melting and accumulation of snow as well as ice sheet "calving" terms (rough assumptions)
	248	! It is especially used over land and landice surfaces when the coupling with ORCHIDEE
	249	! is not active, and over sea ice (especially for snow above it) when the coupling with NEMO
	250	! is not active.
	251	! contact: F. Cheruy, frederique.cheruy@lmd.ipsl.fr ; E. Vignon, etienne.vignon@lmd.ipsl.fr
	252	!**********************************************************************************************
	253
	254	INCLUDE "FCTTRE.h"
	255
	256	! Declaration
	257	!****************************************************************************************
	258
	259	! Input variables
	260	!----------------
	261	INTEGER, INTENT(IN) :: knon ! number of horizontal grid points
	262	INTEGER, INTENT(IN) :: nisurf ! index for surface type that is considered
	263	INTEGER, DIMENSION(knon), INTENT(IN) :: knindex ! list of horizontal indices on the native
	264	! horizontal grid for the considered surface type
	265
	266	REAL, INTENT(IN) :: dtime ! time step [s]
	267	REAL, DIMENSION(knon), INTENT(IN) :: tsurf ! surface temperature [K]
	268	REAL, DIMENSION(knon), INTENT(IN) :: precip_rain ! rainfall flux [kg/m2/s]
	269	REAL, DIMENSION(knon), INTENT(IN) :: precip_snow ! snowfall flux [kg/m2/s]
	270
	271	! Input/Output variables
	272	!-----------------------
	273
	274	REAL, DIMENSION(knon), INTENT(INOUT) :: snow ! snow amount on ground [kg/m2]
	275	REAL, DIMENSION(knon), INTENT(INOUT) :: qsol ! amount of water in the soil [kg/m2]
	276	REAL, DIMENSION(knon), INTENT(INOUT) :: tsurf_new ! updated surface temperature [K]
	277	REAL, DIMENSION(knon), INTENT(INOUT) :: evap ! evaporation flux [kg/m2]
	278
	279	! Output variables
	280	!-----------------
	281
[6053]	282	REAL, DIMENSION(knon), INTENT(OUT) :: ice_sub ! sublimation flux from ice over iced surfaces [kg/m2/s]
	283	REAL, DIMENSION(knon), INTENT(OUT) :: ice_melt ! melting flux from ice over iced surfaces [kg/m2/s]
	284
[6033]	285	#ifdef ISO
	286	! diagnostics for isotopes
	287	REAL, DIMENSION(knon), INTENT(OUT) :: fq_fonte_diag
	288	REAL, DIMENSION(knon), INTENT(OUT) :: fqfonte_diag
	289	REAL, DIMENSION(knon), INTENT(OUT) :: snow_sub_diag
	290	REAL, DIMENSION(knon), INTENT(OUT) :: fqcalving_diag
	291	REAL, INTENT(OUT) :: max_eau_sol_diag
	292	REAL, DIMENSION(knon), INTENT(OUT) :: runoff_diag
	293	REAL, DIMENSION(knon), INTENT(OUT) :: run_off_lic_diag
	294	REAL, INTENT(OUT) :: coeff_rel_diag
	295	#endif
	296
	297	! Local variables
	298	!----------------
	299
	300	INTEGER :: i, j
	301	REAL :: fq_fonte ! quantify of snow that is melted [kg/m2]
[6053]	302	REAL :: coeff_rel, chasno
[6033]	303	REAL, PARAMETER :: snow_max = 3000. ! maximum snow amount over ice sheets [kg/m2]
	304	REAL, PARAMETER :: max_eau_sol = 150.0 ! maximum water amount in the soil [kg/m2]
	305	REAL, DIMENSION(knon) :: ffonte ! flux of energy associated with snow melting [W/m2]
	306	REAL, DIMENSION(knon) :: fqcalving ! flux of water associated with calving [kg/m2]
	307	REAL, DIMENSION(knon) :: fqfonte ! flux of water associated with snow melting [kg/s/m2]
	308	REAL, DIMENSION(knon) :: d_ts ! increment surface temperature [K]
	309	REAL, DIMENSION(knon) :: bil_eau_s ! water budget in soil [kg/m2/s]
	310	REAL, DIMENSION(knon) :: snow_sub ! snow sublimation flux [kg/m2/s]
	311
	312	LOGICAL :: is_snow_melting ! Is snow melting?
	313
	314	#ifdef ISO
	315	max_eau_sol_diag = max_eau_sol
	316	#endif
	317
	318	! initial calculations
	319	!****************************************************************************************
	320	coeff_rel = dtime/(tau_calv*rday)
	321	bil_eau_s(:) = 0.
[6053]	322	chasno = 3.334E+05/(2.3867E+06*chasno_tun)
[6033]	323
	324	! Snow increment snow due to precipitation and sublimation
	325	!****************************************************************************************
	326	WHERE (precip_snow > 0.)
	327	snow = snow + (precip_snow*dtime)
	328	END WHERE
	329
	330	snow_sub(:) = 0.
	331	ice_sub(:) = 0.
	332
	333	IF (.NOT. ok_lic_cond) THEN
	334	!---only positive sublimation has an impact on snow
	335	!---note that this could create a bit of water
	336	!---this was the default until CMIP6
	337	!---Note that evap includes BOTH liquid water evaporation AND snow+ice sublimation
	338	WHERE (evap(:) > 0.)
	339	snow_sub(:) = MIN(snow(:)/dtime, evap(:)) !---one cannot sublimate more than the amount of snow
	340	snow(:) = snow(:) - snow_sub(:)*dtime !---snow that remains on the ground
	341	snow(:) = MAX(0.0, snow(:)) !---just in case
	342	END WHERE
	343	ELSE
	344	!---now considers both positive and negative sublimation (so surface condensation) in the budget of snow
	345	snow_sub(:) = MIN(snow(:)/dtime, evap(:)) !---one cannot evaporate more than the amount of snow
	346	snow(:) = snow(:) - snow_sub(:)*dtime !---snow that remains or deposits on the ground
	347	snow(:) = MAX(0.0, snow(:)) !---just in case
	348	END IF
	349
[6053]	350	!---diagnostics of sublimation/condensation of ice over ice surfaces (when all the snow above has been sublimated)
	351	!---in principle it should be 0 when ok_lic_cond that is when surface water condensation over ice was not allowed
	352	IF (nisurf .EQ. is_lic .OR. nisurf .EQ. is_sic) THEN
[6033]	353	DO i = 1, knon
	354	ice_sub(i) = evap(i) - snow_sub(i)
	355	END DO
	356	END IF
	357
	358	!---diagnostics for isotopes
	359	#ifdef ISO
	360	snow_sub_diag(:) = snow_sub(:)
	361	coeff_rel_diag = coeff_rel
	362	#endif
	363
	364	! total water flux that goes into the soil (liquid precipitation - "liquid" evaporation)
	365	!****************************************************************************************
	366	bil_eau_s(:) = (precip_rain(:)dtime) - (evap(:) - snow_sub(:))dtime
	367
	368	! Snow melting and calving (we remove the excess of snow wrt snowmax over ice sheets)
[6053]	369	! + update of surface temperature
[6033]	370	!****************************************************************************************
	371
	372	ffonte(:) = 0.0
	373	fqcalving(:) = 0.0
	374	fqfonte(:) = 0.0
[6053]	375	ice_melt(:) = 0.0
[6033]	376
	377	! snow melting
	378	DO i = 1, knon
	379	! Is snow melting?
	380	is_snow_melting = (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) .AND. tsurf_new(i) >= RTT
	381
	382	IF (is_snow_melting) THEN
	383	! quantity of snow that is melted
	384	! it is based on the energy conservation equation
	385	! LmDq = cpDT*tuning_param (tuning_param=0.15)
	386	fq_fonte = MIN(MAX((tsurf_new(i) - RTT)/chasno, 0.0), snow(i))
	387	! flux of energy corresponding to snow melting
	388	ffonte(i) = fq_fonte*RLMLT/dtime
	389	! flux of water corresponding to snow melting
	390	fqfonte(i) = fq_fonte/dtime
	391	! update of snow amount on ground
	392	snow(i) = MAX(0., snow(i) - fq_fonte)
	393	! flux of melted water goes into the soil
	394	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
	395	! surface temperature update
	396	tsurf_new(i) = tsurf_new(i) - fq_fonte*chasno
	397	! diag for isotopes
	398	#ifdef ISO
	399	fq_fonte_diag(i) = fq_fonte
	400	#endif
	401
	402	! snow/ice melting over ice surfaces
[6055]	403	IF ((nisurf == is_sic .OR. nisurf == is_lic) .AND. ok_lic_melt .AND. snow(i) .EQ. 0.) THEN
[6053]	404	! when snow has been completely melted, the ice below can melt
[6033]	405	! which is an infinite source of water for the model
	406	fq_fonte = MAX((tsurf_new(i) - RTT)/chasno, 0.0)
	407	ffonte(i) = ffonte(i) + fq_fonte*RLMLT/dtime
[6053]	408	fqfonte(i) = fqfonte(i) + fq_fonte/dtime
	409	bil_eau_s(i) = bil_eau_s(i) + fq_fonte
	410	tsurf_new(i) = tsurf_new(i) - fq_fonte*chasno
	411	ice_melt(i) = fq_fonte/dtime
	412	END IF
[6033]	413
[6053]	414	! surface temperature tendency associated with snow and icemelting
	415	IF (forc_ts_melt) THEN
[6033]	416	tsurf_new(i) = RTT
[6053]	417	ENDIF
	418
[6033]	419	d_ts(i) = tsurf_new(i) - tsurf(i)
[6053]	420
	421	END IF
[6033]	422
	423	! so called 'calving', if there is an excess of snow wrt snowmax
	424	! it is instantaneously removed
	425	fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
	426	snow(i) = MIN(snow(i), snow_max)
	427	END DO
	428	#ifdef ISO
	429	DO i = 1, knon
	430	fqcalving_diag(i) = fqcalving(i)
	431	fqfonte_diag(i) = fqfonte(i)
	432	END DO !DO i = 1, knon
	433	#endif
	434
	435	! Soil water content and runoff
	436	!****************************************************************************************
	437	! over land surfaces
	438	IF (nisurf == is_ter) THEN
	439	DO i = 1, knon
	440	j = knindex(i)
	441	! qsol update with bil_eau_s
	442	qsol(i) = qsol(i) + bil_eau_s(i)
	443	! water that exceeds max_eau_sol feeds the runoff
	444	run_off_ter(j) = run_off_ter(j) + MAX(qsol(i) - max_eau_sol, 0.0)
	445	#ifdef ISO
	446	runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
	447	#endif
	448	qsol(i) = MIN(qsol(i), max_eau_sol)
	449	END DO
	450	! over landice surfaces
	451	ELSE IF (nisurf == is_lic) THEN
	452	DO i = 1, knon
	453	j = knindex(i)
	454	!--temporal filtering
	455	run_off_lic(j) = coeff_relfqcalving(i) + (1.-coeff_rel)run_off_lic_0(j)
	456	run_off_lic_0(j) = run_off_lic(j)
	457	!--add melting snow and liquid precip to runoff over ice cap
	458	run_off_lic(j) = run_off_lic(j) + fqfonte(i) + precip_rain(i)
	459	END DO
	460	END IF
	461
	462	#ifdef ISO
	463	DO i = 1, knon
	464	run_off_lic_diag(i) = run_off_lic(knindex(i))
	465	END DO
	466	#endif
	467
	468	! Save ffonte, fqfonte and fqcalving in global arrays for each
	469	! sub-surface separately
	470	!****************************************************************************************
	471	DO i = 1, knon
	472	j = knindex(i)
	473	ffonte_global(j, nisurf) = ffonte(i)
	474	fqfonte_global(j, nisurf) = fqfonte(i)
	475	fqcalving_global(j, nisurf) = fqcalving(i)
	476	END DO
	477
	478	IF (nisurf == is_lic) THEN
	479	DO i = 1, knon
	480	runofflic_global(knindex(i)) = run_off_lic(knindex(i))
	481	END DO
	482	END IF
	483
	484	END SUBROUTINE simplehydrol
	485	!****************************************************************************************
	486
	487	!****************************************************************************************
	488	SUBROUTINE simplehydrol_final(restart_runoff &
	489	#ifdef ISO
	490	, xtrestart_runoff &
	491	#endif
	492	)
	493	!
	494	! This subroutine returns run_off_lic_0 for later writing to restart file.
	495	!****************************************************************************************
	496
	497	#ifdef ISO
	498	USE infotrac_phy, ONLY: niso
	499	#ifdef ISOVERIF
	500	USE isotopes_mod, ONLY: iso_eau
	501	USE isotopes_verif_mod
	502	#endif
	503	#endif
	504
	505	REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
	506	#ifdef ISO
	507	REAL, DIMENSION(niso, klon), INTENT(OUT) :: xtrestart_runoff
	508	#ifdef ISOVERIF
	509	INTEGER :: i
	510	#endif
	511	#endif
	512
	513	! Set the output variables
	514	restart_runoff(:) = run_off_lic_0(:)
	515	#ifdef ISO
	516	xtrestart_runoff(:, :) = xtrun_off_lic_0(:, :)
	517	#ifdef ISOVERIF
	518	IF (iso_eau > 0) THEN
	519	DO i = 1, klon
	520	IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
	521	& , xtrun_off_lic_0(iso_eau, i) &
	522	& , 'simplehydrol 413') &
	523	& == 1) then
	524	WRITE (, ) 'i=', i
	525	STOP
	526	END IF
	527	END DO !DO i=1,klon
	528	END IF !IF (iso_eau > 0) then
	529	#endif
	530	#endif
	531
	532	! Deallocation of all varaibles in the module
	533
	534	IF (ALLOCATED(run_off_lic_0)) DEALLOCATE (run_off_lic_0)
	535	IF (ALLOCATED(run_off_ter)) DEALLOCATE (run_off_ter)
	536	IF (ALLOCATED(run_off_lic)) DEALLOCATE (run_off_lic)
	537	IF (ALLOCATED(ffonte_global)) DEALLOCATE (ffonte_global)
	538	IF (ALLOCATED(fqfonte_global)) DEALLOCATE (fqfonte_global)
	539	IF (ALLOCATED(fqcalving_global)) DEALLOCATE (fqcalving_global)
	540	IF (ALLOCATED(runofflic_global)) DEALLOCATE (runofflic_global)
	541	#ifdef ISO
	542	IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE (xtrun_off_lic_0)
	543	IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE (xtrun_off_ter)
	544	IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE (xtrun_off_lic)
	545	IF (ALLOCATED(fxtfonte_global)) DEALLOCATE (fxtfonte_global)
	546	IF (ALLOCATED(fxtcalving_global)) DEALLOCATE (fxtcalving_global)
	547	IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE (xtrunofflic_global)
	548	#endif
	549
	550	END SUBROUTINE simplehydrol_final
	551	!****************************************************************************************
	552	SUBROUTINE simplehydrol_get_vars(pctsrf, fqcalving_out, &
	553	fqfonte_out, ffonte_out, run_off_lic_out &
	554	#ifdef ISO
	555	, fxtcalving_out, fxtfonte_out, xtrun_off_lic_out &
	556	#endif
	557	)
	558
	559	! This routine cumulates ffonte, fqfonte and fqcalving respectively for
	560	! all type of surfaces according to their fraction.
	561	!
	562	! This routine is called from physiq_mod before outputs' writting (histwrite)
	563	!****************************************************************************************
	564
	565	USE indice_sol_mod
	566	#ifdef ISO
	567	USE infotrac_phy, ONLY: niso
	568	#endif
	569
	570	! Input variables
	571	!----------------
	572	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! fraction of subsurfaces [0-1]
	573
	574	! Output variables
	575	!-----------------
	576	REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_out ! flux of water associated with calving [kg/m2/s]
	577	REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_out ! flux of water associated with snow melting [kg/m2/s]
	578	REAL, DIMENSION(klon), INTENT(OUT) :: ffonte_out ! flux of energy associated with snow melting [W/m2]
	579	REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out ! runoff flux [kg/m2/s]
	580
	581	#ifdef ISO
	582	REAL, DIMENSION(niso, klon), INTENT(OUT) :: fxtcalving_out
	583	REAL, DIMENSION(niso, klon), INTENT(OUT) :: fxtfonte_out
	584	REAL, DIMENSION(niso, klon), INTENT(OUT) :: xtrun_off_lic_out
	585	INTEGER :: i, ixt
	586	#endif
	587
	588	! Local variables
	589	!----------------
	590	INTEGER :: nisurf
	591	!****************************************************************************************
	592
	593	ffonte_out(:) = 0.0
	594	fqfonte_out(:) = 0.0
	595	fqcalving_out(:) = 0.0
	596	#ifdef ISO
	597	fxtfonte_out(:, :) = 0.0
	598	fxtcalving_out(:, :) = 0.0
	599	#endif
	600
	601	DO nisurf = 1, nbsrf
	602	ffonte_out(:) = ffonte_out(:) + ffonte_global(:, nisurf)*pctsrf(:, nisurf)
	603	fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:, nisurf)*pctsrf(:, nisurf)
	604	fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:, nisurf)*pctsrf(:, nisurf)
	605	END DO
	606
	607	run_off_lic_out(:) = runofflic_global(:)
	608
	609	#ifdef ISO
	610	DO nisurf = 1, nbsrf
	611	DO i = 1, klon
	612	DO ixt = 1, niso
	613	fxtfonte_out(ixt, i) = fxtfonte_out(ixt, i) + fxtfonte_global(ixt, i, nisurf)*pctsrf(i, nisurf)
	614	fxtcalving_out(ixt, i) = fxtcalving_out(ixt, i) + fxtcalving_global(ixt, i, nisurf)*pctsrf(i, nisurf)
	615	END DO
	616	END DO
	617	END DO
	618	xtrun_off_lic_out(:, :) = xtrunofflic_global(:, :)
	619	#endif
	620
	621	END SUBROUTINE simplehydrol_get_vars
	622	!****************************************************************************************
	623	!
	624	!#ifdef ISO
	625	! subroutine simplehydrol_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
	626	! use infotrac_phy, ONLY: niso
	627	!
	628	! ! inputs
	629	! INTEGER, INTENT(IN) :: knon
	630	! real, INTENT(IN), DIMENSION(niso,klon) :: xtrun_off_lic_0_diag
	631	!
	632	! xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
	633	!
	634	! end subroutine simplehydrol_export_xtrun_off_lic_0
	635	!#endif
	636
	637	!****************************************************************************************
	638	#ifdef ISO
	639	SUBROUTINE gestion_neige_besoin_varglob_simplehydrol(klon, knon, &
	640	xtprecip_snow, xtprecip_rain, &
	641	fxtfonte_neige, fxtcalving, &
	642	knindex, nisurf, run_off_lic_diag, coeff_rel_diag)
	643
	644	! In this routine, we need global variables from simplehydrol_mod
	645	! It must be included in simplehydrol_mod
	646	! The other part of 'gestion_neige' is in insotopes_routines_mod because of circular
	647	! dependencies
	648
	649	USE infotrac_phy, ONLY: ntiso, niso
	650	USE isotopes_mod, ONLY: iso_eau
	651	USE indice_sol_mod
	652	#ifdef ISOVERIF
	653	USE isotopes_verif_mod
	654	#endif
	655	IMPLICIT NONE
	656
	657	! inputs
	658	INTEGER, INTENT(IN) :: klon, knon
	659	REAL, DIMENSION(ntiso, knon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
	660	REAL, DIMENSION(niso, knon), INTENT(IN) :: fxtfonte_neige, fxtcalving
	661	INTEGER, INTENT(IN) :: nisurf
	662	INTEGER, DIMENSION(knon), INTENT(IN) :: knindex
	663	REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
	664	REAL, INTENT(IN) :: coeff_rel_diag
	665
	666	! locals
	667	INTEGER :: i, ixt, j
	668
	669	#ifdef ISOVERIF
	670	IF (nisurf == is_lic) THEN
	671	IF (iso_eau > 0) THEN
	672	DO i = 1, knon
	673	j = knindex(i)
	674	CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau, j), &
	675	& run_off_lic_0(j), 'gestion_neige_besoin_varglob_simplehydrol 625')
	676	END DO
	677	END IF
	678	END IF
	679	#endif
	680
	681	! run_off_lic calculation
	682	IF (nisurf == is_lic) THEN
	683
	684	DO i = 1, knon
	685	j = knindex(i)
	686	DO ixt = 1, niso
	687	xtrun_off_lic(ixt, i) = (coeff_rel_diag*fxtcalving(ixt, i)) &
	688	& + (1.-coeff_rel_diag)*xtrun_off_lic_0(ixt, j)
	689	xtrun_off_lic_0(ixt, j) = xtrun_off_lic(ixt, i)
	690	xtrun_off_lic(ixt, i) = xtrun_off_lic(ixt, i) + fxtfonte_neige(ixt, i) + xtprecip_rain(ixt, i)
	691	END DO !DO ixt=1,niso
	692	#ifdef ISOVERIF
	693	IF (iso_eau > 0) THEN
	694	IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau, i), &
	695	& run_off_lic_diag(i), 'gestion_neige_besoin_varglob_simplehydrol 1201a', &
	696	& errmax, errmaxrel) == 1) THEN
	697	WRITE (, ) 'i,j=', i, j
	698	WRITE (, ) 'coeff_rel_diag=', coeff_rel_diag
	699	STOP
	700	END IF
	701	END IF
	702	#endif
	703	END DO
	704	END IF !IF (nisurf == is_lic) THEN
	705
	706	! Save ffonte, fqfonte and fqcalving in global arrays for each
	707	! sub-surface separately
	708	DO i = 1, knon
	709	DO ixt = 1, niso
	710	fxtfonte_global(ixt, knindex(i), nisurf) = fxtfonte_neige(ixt, i)
	711	fxtcalving_global(ixt, knindex(i), nisurf) = fxtcalving(ixt, i)
	712	END DO !do ixt=1,niso
	713	END DO
	714
	715	IF (nisurf == is_lic) THEN
	716	DO i = 1, knon
	717	DO ixt = 1, niso
	718	xtrunofflic_global(ixt, knindex(i)) = xtrun_off_lic(ixt, i)
	719	END DO ! DO ixt=1,niso
	720	END DO
	721	END IF
	722
	723	END SUBROUTINE gestion_neige_besoin_varglob_simplehydrol
	724	#endif
	725
	726	END MODULE simplehydrol_mod

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

Download in other formats:

Original Format