Context Navigation

ocean_forced_mod.F90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 31 hours ago
Replace yomcst.h by existing module
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 `Id`
File size: 20.6 KB

Line
1	!
2	! $Id: ocean_forced_mod.F90 5274 2024-10-25 13:41:23Z abarral $
3	!
4	MODULE ocean_forced_mod
5	!
6	! This module is used for both the sub-surfaces ocean and sea-ice for the case of a
7	! forced ocean, "ocean=force".
8	!
9	IMPLICIT NONE
10
11	CONTAINS
12	!
13	!****************************************************************************************
14	!
15	SUBROUTINE ocean_forced_noice( &
16	itime, dtime, jour, knon, knindex, &
17	p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
18	temp_air, spechum, &
19	AcoefH, AcoefQ, BcoefH, BcoefQ, &
20	AcoefU, AcoefV, BcoefU, BcoefV, &
21	ps, u1, v1, gustiness, tsurf_in, &
22	radsol, snow, agesno, &
23	qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
24	tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
25	#ifdef ISO
26	,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
27	xtsnow,xtevap,h1 &
28	#endif
29	)
30	!
31	! This subroutine treats the "open ocean", all grid points that are not entierly covered
32	! by ice.
33	! The routine receives data from climatologie file limit.nc and does some calculations at the
34	! surface.
35	!
36	USE dimphy
37	USE calcul_fluxs_mod
38	USE limit_read_mod
39	USE mod_grid_phy_lmdz
40	USE indice_sol_mod
41	USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
42	use config_ocean_skin_m, only: activate_ocean_skin
43	#ifdef ISO
44	USE infotrac_phy, ONLY: ntiso,niso
45	USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall
46	#ifdef ISOVERIF
47	USE isotopes_mod, ONLY: iso_eau,ridicule
48	!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
49	USE isotopes_verif_mod
50	#endif
51	#endif
52	USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO &
53	, RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA &
54	, R_ecc, R_peri, R_incl &
55	, RA, RG, R1SA &
56	, RSIGMA &
57	, R, RMD, RMV, RD, RV, RCPD &
58	, RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 &
59	, RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w &
60	, RCW, RCS &
61	, RLVTT, RLSTT, RLMLT, RTT, RATM &
62	, RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS &
63	, RALPD, RBETD, RGAMD
64	INCLUDE "clesphys.h"
65	INCLUDE "flux_arp.h"
66
67	! Input arguments
68	!****************************************************************************************
69	INTEGER, INTENT(IN) :: itime, jour, knon
70	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
71	REAL, INTENT(IN) :: dtime
72	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
73	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragq, cdragm
74	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
75	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
76	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
77	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
78	REAL, DIMENSION(klon), INTENT(IN) :: ps
79	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
80	REAL, DIMENSION(klon), INTENT(IN) :: tsurf_in
81	real, intent(in):: rhoa(:) ! (knon) density of moist air (kg / m3)
82
83	#ifdef ISO
84	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
85	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
86	REAL, DIMENSION(klon), INTENT(IN) :: rlat
87	#endif
88
89	! In/Output arguments
90	!****************************************************************************************
91	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
92	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
93	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno !? put to 0 in ocean
94	#ifdef ISO
95	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsnow
96	REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce
97	#endif
98
99	! Output arguments
100	!****************************************************************************************
101	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
102	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
103	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
104	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
105	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
106	REAL, intent(out):: sens_prec_liq(:) ! (knon)
107
108	#ifdef ISO
109	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
110	REAL, DIMENSION(klon), INTENT(OUT) :: h1 ! just a diagnostic, not useful for the simulation
111	#endif
112
113	! Local variables
114	!****************************************************************************************
115	INTEGER :: i, j
116	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
117	REAL, DIMENSION(klon) :: alb_neig, tsurf_lim, zx_sl
118	REAL, DIMENSION(klon) :: u0, v0
119	REAL, DIMENSION(klon) :: u1_lay, v1_lay
120	LOGICAL :: check=.FALSE.
121	REAL, DIMENSION(knon) :: sens_prec_sol
122	REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
123	#ifdef ISO
124	REAL, PARAMETER :: t_coup = 273.15
125	#endif
126
127
128	!****************************************************************************************
129	! Start calculation
130	!****************************************************************************************
131	IF (check) WRITE(,)' Entering ocean_forced_noice'
132
133	#ifdef ISO
134	#ifdef ISOVERIF
135	DO i = 1, knon
136	IF (iso_eau > 0) THEN
137	CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), &
138	& spechum(i),'ocean_forced_mod 111', &
139	& errmax,errmaxrel)
140	CALL iso_verif_egalite_choix(snow(i), &
141	& xtsnow(iso_eau,i),'ocean_forced_mod 117', &
142	& errmax,errmaxrel)
143	ENDIF !IF (iso_eau > 0) THEN
144	ENDDO !DO i=1,knon
145	#endif
146	#endif
147
148	!****************************************************************************************
149	! 1)
150	! Read sea-surface temperature from file limit.nc
151	!
152	!****************************************************************************************
153	!--sb:
154	!!jyg if (knon.eq.1) then ! single-column model
155	if (klon_glo.eq.1) then ! single-column model
156	! EV: now surface Tin flux_arp.h
157	!CALL read_tsurf1d(knon,tsurf_lim) ! new
158	DO i = 1, knon
159	tsurf_lim(i) = tg
160	ENDDO
161
162	else ! GCM
163	CALL limit_read_sst(knon,knindex,tsurf_lim &
164	#ifdef ISO
165	& ,Roce,rlat &
166	#endif
167	& )
168	endif ! knon
169	!sb--
170
171	!****************************************************************************************
172	! 2)
173	! Flux calculation
174	!
175	!****************************************************************************************
176	! Set some variables for calcul_fluxs
177	!cal = 0.
178	!beta = 1.
179	!dif_grnd = 0.
180
181
182	! EV: use calbeta to calculate beta
183	! Need to initialize qsurf for calbeta but it is not modified by this routine
184	qsurf(:)=0.
185	CALL calbeta(dtime, is_oce, knon, snow, qsurf, beta, cal, dif_grnd)
186
187
188	alb_neig(:) = 0.
189	agesno(:) = 0.
190	lat_prec_liq = 0.; lat_prec_sol = 0.
191
192	! Suppose zero surface speed
193	u0(:)=0.0
194	v0(:)=0.0
195	u1_lay(:) = u1(:) - u0(:)
196	v1_lay(:) = v1(:) - v0(:)
197
198	! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
199	CALL calcul_fluxs(knon, is_oce, dtime, &
200	merge(tsurf_in, tsurf_lim, activate_ocean_skin == 2), p1lay, cal, &
201	beta, cdragh, cdragq, ps, &
202	precip_rain, precip_snow, snow, qsurf, &
203	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
204	f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
205	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
206	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
207	if (activate_ocean_skin == 2) tsurf_new = tsurf_lim
208
209	do j = 1, knon
210	i = knindex(j)
211	sens_prec_liq_o(i,1) = sens_prec_liq(j)
212	sens_prec_sol_o(i,1) = sens_prec_sol(j)
213	lat_prec_liq_o(i,1) = lat_prec_liq(j)
214	lat_prec_sol_o(i,1) = lat_prec_sol(j)
215	enddo
216
217
218	! - Flux calculation at first modele level for U and V
219	CALL calcul_flux_wind(knon, dtime, &
220	u0, v0, u1, v1, gustiness, cdragm, &
221	AcoefU, AcoefV, BcoefU, BcoefV, &
222	p1lay, temp_air, &
223	flux_u1, flux_v1)
224
225	#ifdef ISO
226	CALL calcul_iso_surf_oce_vectall(klon, knon,t_coup, &
227	& ps,tsurf_new,spechum,u1_lay, v1_lay, xtspechum, &
228	& evap, Roce,xtevap,h1 &
229	#ifdef ISOTRAC
230	& ,knindex &
231	#endif
232	& )
233	#endif
234
235	#ifdef ISO
236	#ifdef ISOVERIF
237	! write(,) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
238	IF (iso_eau > 0) THEN
239	DO i = 1, knon
240	CALL iso_verif_egalite_choix(snow(i), &
241	& xtsnow(iso_eau,i),'ocean_forced_mod 180', &
242	& errmax,errmaxrel)
243	ENDDO ! DO j=1,knon
244	ENDIF !IF (iso_eau > 0) THEN
245	#endif
246	#endif
247
248	END SUBROUTINE ocean_forced_noice
249	!
250	!***************************************************************************************
251	!
252	SUBROUTINE ocean_forced_ice( &
253	itime, dtime, jour, knon, knindex, &
254	tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air,spechum, &
255	AcoefH, AcoefQ, BcoefH, BcoefQ, &
256	AcoefU, AcoefV, BcoefU, BcoefV, &
257	ps, u1, v1, gustiness, &
258	radsol, snow, qsol, agesno, tsoil, &
259	qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
260	tsurf_new, dflux_s, dflux_l, rhoa &
261	#ifdef ISO
262	,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
263	xtsnow, xtsol,xtevap,Rland_ice &
264	#endif
265	)
266	!
267	! This subroutine treats the ocean where there is ice.
268	! The routine reads data from climatologie file and does flux calculations at the
269	! surface.
270	!
271	USE dimphy
272	USE geometry_mod, ONLY: longitude,latitude
273	USE calcul_fluxs_mod
274	USE surface_data, ONLY : calice, calsno
275	USE limit_read_mod
276	USE fonte_neige_mod, ONLY : fonte_neige
277	USE indice_sol_mod
278	USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
279	#ifdef ISO
280	USE infotrac_phy, ONLY: niso, ntiso
281	USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall
282	#ifdef ISOVERIF
283	USE isotopes_mod, ONLY: iso_eau,ridicule
284	!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
285	USE isotopes_verif_mod
286	#endif
287	#endif
288	USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO &
289	, RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA &
290	, R_ecc, R_peri, R_incl &
291	, RA, RG, R1SA &
292	, RSIGMA &
293	, R, RMD, RMV, RD, RV, RCPD &
294	, RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 &
295	, RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w &
296	, RCW, RCS &
297	, RLVTT, RLSTT, RLMLT, RTT, RATM &
298	, RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS &
299	, RALPD, RBETD, RGAMD
300	USE dimsoil_mod_h, ONLY: nsoilmx
301
302	! INCLUDE "indicesol.h"
303
304	INCLUDE "clesphys.h"
305	INCLUDE "flux_arp.h"
306
307	! Input arguments
308	!****************************************************************************************
309	INTEGER, INTENT(IN) :: itime, jour, knon
310	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
311	REAL, INTENT(IN) :: dtime
312	REAL, DIMENSION(klon), INTENT(IN) :: tsurf_in
313	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
314	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
315	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
316	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
317	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
318	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
319	REAL, DIMENSION(klon), INTENT(IN) :: ps
320	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
321	real, intent(in):: rhoa(:) ! (knon) density of moist air (kg / m3)
322	#ifdef ISO
323	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
324	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
325	REAL, DIMENSION(niso,klon), INTENT(IN) :: Roce
326	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
327	#endif
328
329	! In/Output arguments
330	!****************************************************************************************
331	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
332	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
333	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
334	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
335	#ifdef ISO
336	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow
337	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsol
338	#endif
339
340	! Output arguments
341	!****************************************************************************************
342	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
343	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval
344	REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval
345	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
346	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
347	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
348	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
349	#ifdef ISO
350	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
351	#endif
352
353	! Local variables
354	!****************************************************************************************
355	LOGICAL :: check=.FALSE.
356	INTEGER :: i, j
357	REAL :: zfra
358	REAL, PARAMETER :: t_grnd=271.35
359	REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
360	REAL, DIMENSION(klon) :: alb_neig, tsurf_tmp
361	REAL, DIMENSION(klon) :: soilcap, soilflux
362	REAL, DIMENSION(klon) :: u0, v0
363	REAL, DIMENSION(klon) :: u1_lay, v1_lay
364	REAL, DIMENSION(knon) :: sens_prec_liq, sens_prec_sol
365	REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
366
367	#ifdef ISO
368	REAL, PARAMETER :: t_coup = 273.15
369	REAL, DIMENSION(klon) :: fq_fonte_diag
370	REAL, DIMENSION(klon) :: fqfonte_diag
371	REAL, DIMENSION(klon) :: snow_evap_diag
372	REAL, DIMENSION(klon) :: fqcalving_diag
373	REAL, DIMENSION(klon) :: run_off_lic_diag
374	REAL :: coeff_rel_diag
375	REAL :: max_eau_sol_diag
376	REAL, DIMENSION(klon) :: runoff_diag
377	INTEGER IXT
378	REAL, DIMENSION(niso,klon) :: xtsnow_prec, xtsol_prec
379	REAL, DIMENSION(klon) :: snow_prec, qsol_prec
380	#endif
381
382	!****************************************************************************************
383	! Start calculation
384	!****************************************************************************************
385	IF (check) WRITE(,)'Entering surface_seaice, knon=',knon
386
387	!****************************************************************************************
388	! 1)
389	! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
390	! dflux_s, dflux_l and qsurf
391	!****************************************************************************************
392
393	tsurf_tmp(:) = tsurf_in(:)
394
395	! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
396	CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
397
398
399	IF (soil_model) THEN
400	! update tsoil and calculate soilcap and soilflux
401	CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, qsol, &
402	& longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil,soilcap, soilflux)
403	cal(1:knon) = RCPD / soilcap(1:knon)
404	radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
405	dif_grnd = 1.0 / tau_gl
406	ELSE
407	dif_grnd = 1.0 / tau_gl
408	cal = RCPD * calice
409	WHERE (snow > 0.0) cal = RCPD * calsno
410	ENDIF
411
412	! beta = 1.0
413	lat_prec_liq = 0.; lat_prec_sol = 0.
414
415	! Suppose zero surface speed
416	u0(:)=0.0
417	v0(:)=0.0
418	u1_lay(:) = u1(:) - u0(:)
419	v1_lay(:) = v1(:) - v0(:)
420	CALL calcul_fluxs(knon, is_sic, dtime, &
421	tsurf_tmp, p1lay, cal, beta, cdragh, cdragh, ps, &
422	precip_rain, precip_snow, snow, qsurf, &
423	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
424	f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
425	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
426	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
427	do j = 1, knon
428	i = knindex(j)
429	sens_prec_liq_o(i,2) = sens_prec_liq(j)
430	sens_prec_sol_o(i,2) = sens_prec_sol(j)
431	lat_prec_liq_o(i,2) = lat_prec_liq(j)
432	lat_prec_sol_o(i,2) = lat_prec_sol(j)
433	enddo
434
435	! - Flux calculation at first modele level for U and V
436	CALL calcul_flux_wind(knon, dtime, &
437	u0, v0, u1, v1, gustiness, cdragm, &
438	AcoefU, AcoefV, BcoefU, BcoefV, &
439	p1lay, temp_air, &
440	flux_u1, flux_v1)
441
442	!****************************************************************************************
443	! 2)
444	! Calculations due to snow and runoff
445	!
446	!****************************************************************************************
447	#ifdef ISO
448	! verif
449	#ifdef ISOVERIF
450	DO i = 1, knon
451	IF (iso_eau > 0) THEN
452	IF (snow(i) > ridicule) THEN
453	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
454	& 'interfsurf 964',errmax,errmaxrel)
455	ENDIF !IF ((snow(i) > ridicule)) THEN
456	ENDIF !IF (iso_eau > 0) THEN
457	ENDDO !DO i=1,knon
458	#endif
459	! end verif
460
461	DO i = 1, knon
462	snow_prec(i) = snow(i)
463	DO ixt = 1, niso
464	xtsnow_prec(ixt,i) = xtsnow(ixt,i)
465	ENDDO !DO ixt=1,niso
466	! initialisation:
467	fq_fonte_diag(i) = 0.0
468	fqfonte_diag(i) = 0.0
469	snow_evap_diag(i)= 0.0
470	ENDDO !DO i=1,knon
471	#endif
472
473
474	CALL fonte_neige( knon, is_sic, knindex, dtime, &
475	tsurf_tmp, precip_rain, precip_snow, &
476	snow, qsol, tsurf_new, evap &
477	#ifdef ISO
478	& ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag &
479	& ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
480	#endif
481	& )
482
483
484	#ifdef ISO
485	! isotopes: tout est externalisé
486	!#ifdef ISOVERIF
487	! write(,) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
488	! write(,) 'klon,knon=',klon,knon
489	!#endif
490	CALL calcul_iso_surf_sic_vectall(klon,knon, &
491	& evap,snow_evap_diag,Tsurf_new,Roce,snow, &
492	& fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
493	& precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec, &
494	& xtspechum,spechum,ps, &
495	& xtevap,xtsnow,fqcalving_diag, &
496	& knindex,is_sic,run_off_lic_diag,coeff_rel_diag,Rland_ice &
497	& )
498	#ifdef ISOVERIF
499	!write(,) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
500	IF (iso_eau > 0) THEN
501	DO i = 1, knon
502	CALL iso_verif_egalite_choix(snow(i), &
503	& xtsnow(iso_eau,i),'ocean_forced_mod 396', &
504	& errmax,errmaxrel)
505	ENDDO ! DO j=1,knon
506	ENDIF !IF (iso_eau > 0) then
507	#endif
508	!#ifdef ISOVERIF
509	#endif
510	!#ifdef ISO
511
512	! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
513	!
514	CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:))
515
516	WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
517
518	alb1_new(:) = 0.0
519	DO i=1, knon
520	zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
521	alb1_new(i) = alb_neig(i) * zfra + 0.6 * (1.0-zfra)
522	ENDDO
523
524	alb2_new(:) = alb1_new(:)
525
526	END SUBROUTINE ocean_forced_ice
527
528	!************************************************************************
529	! 1D case
530	!************************************************************************
531	! SUBROUTINE read_tsurf1d(knon,sst_out)
532	!
533	! This subroutine specifies the surface temperature to be used in 1D simulations
534	!
535	! USE dimphy, ONLY : klon
536	!
537	! INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid
538	! REAL, DIMENSION(klon), INTENT(OUT) :: sst_out ! tsurf used to force the single-column model
539	!
540	! INTEGER :: i
541	! COMMON defined in lmdz1d.F:
542	! real ts_cur
543	! common /sst_forcing/ts_cur
544	!
545	! DO i = 1, knon
546	! sst_out(i) = ts_cur
547	! ENDDO
548	!
549	! END SUBROUTINE read_tsurf1d
550	!
551	!
552	!************************************************************************
553	END MODULE ocean_forced_mod
554
555
556
557
558
559

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

Download in other formats:

Original Format