Context Navigation

ocean_forced_mod.F90 @ 5209

Last change on this file since 5209 was 5158, checked in by abarral, 7 weeks ago
Add missing klon on strataer_emiss_mod.F90 Correct various missing explicit declarations Replace tabs by spaces (tabs are not part of the fortran charset) Continue cleaning modules Removed unused arguments and variables
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: 19.0 KB

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

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

Download in other formats:

Original Format