Context Navigation

ocean_slab_mod.F90 @ 972

Last change on this file since 972 was 888, checked in by Laurent Fairhead, 17 years ago
Modifications sur l'albedo JG LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 23.3 KB

Line
1	!
2	! $Header$
3	!
4	MODULE ocean_slab_mod
5	!
6	! This module is used for both surface ocean and sea-ice when using the slab ocean,
7	! "ocean=slab".
8	!
9	USE surface_data, ONLY : tau_gl, calice, calsno
10	USE fonte_neige_mod, ONLY : fonte_neige
11	USE calcul_fluxs_mod, ONLY : calcul_fluxs
12	USE dimphy
13
14	IMPLICIT NONE
15
16	INTEGER, PRIVATE, SAVE :: lmt_pas, julien, idayvrai
17	!$OMP THREADPRIVATE(lmt_pas,julien,idayvrai)
18	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tmp_seaice
19	!$OMP THREADPRIVATE(tmp_seaice)
20	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tmp_tslab_loc
21	!$OMP THREADPRIVATE(tmp_tslab_loc)
22	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: slab_bils
23	!$OMP THREADPRIVATE(slab_bils)
24	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE , SAVE :: lmt_bils
25	!$OMP THREADPRIVATE(lmt_bils)
26	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: tmp_pctsrf_slab
27	!$OMP THREADPRIVATE(tmp_pctsrf_slab)
28	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tmp_tslab
29	!$OMP THREADPRIVATE(tmp_tslab)
30	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tmp_radsol
31	!$OMP THREADPRIVATE(tmp_radsol)
32	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tmp_flux_o, tmp_flux_g
33	!$OMP THREADPRIVATE(tmp_flux_o,tmp_flux_g)
34	LOGICAL, PRIVATE, SAVE :: check = .FALSE.
35	!$OMP THREADPRIVATE(check)
36
37	CONTAINS
38	!
39	!****************************************************************************************
40	!
41	SUBROUTINE ocean_slab_init(dtime, tslab_rst, seaice_rst, pctsrf_rst)
42
43	INCLUDE "indicesol.h"
44	INCLUDE "iniprint.h"
45
46	! Input variables
47	!****************************************************************************************
48	REAL, INTENT(IN) :: dtime
49	! Variables read from restart file
50	REAL, DIMENSION(klon), INTENT(IN) :: tslab_rst
51	REAL, DIMENSION(klon), INTENT(IN) :: seaice_rst
52	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf_rst
53
54
55	! Local variables
56	!****************************************************************************************
57	INTEGER :: error
58	CHARACTER (len = 80) :: abort_message
59	CHARACTER (len = 20) :: modname = 'ocean_slab_intit'
60
61
62	WRITE(lunout,) '***********************'
63	WRITE(lunout,*) 'SLAB OCEAN est actif, prenez precautions !'
64	WRITE(lunout,) '***********************'
65
66	! Allocate variables initialize from restart fields
67	ALLOCATE(tmp_tslab(klon), stat = error)
68	IF (error /= 0) THEN
69	abort_message='Pb allocation tmp_tslab'
70	CALL abort_gcm(modname,abort_message,1)
71	ENDIF
72	tmp_tslab(:) = tslab_rst(:)
73
74	ALLOCATE(tmp_tslab_loc(klon), stat = error)
75	IF (error /= 0) THEN
76	abort_message='Pb allocation tmp_tslab_loc'
77	CALL abort_gcm(modname,abort_message,1)
78	ENDIF
79	tmp_tslab_loc(:) = tslab_rst(:)
80
81	ALLOCATE(tmp_seaice(klon), stat = error)
82	IF (error /= 0) THEN
83	abort_message='Pb allocation tmp_seaice'
84	CALL abort_gcm(modname,abort_message,1)
85	ENDIF
86	tmp_seaice(:) = seaice_rst(:)
87
88	ALLOCATE(tmp_pctsrf_slab(klon,nbsrf), stat = error)
89	IF (error /= 0) THEN
90	abort_message='Pb allocation tmp_pctsrf_slab'
91	CALL abort_gcm(modname,abort_message,1)
92	ENDIF
93	tmp_pctsrf_slab(:,:) = pctsrf_rst(:,:)
94
95	! Allocate some other variables internal in module mod_oceanslab
96	ALLOCATE(tmp_radsol(klon), stat = error)
97	IF (error /= 0) THEN
98	abort_message='Pb allocation tmp_radsol'
99	CALL abort_gcm(modname,abort_message,1)
100	ENDIF
101
102	ALLOCATE(tmp_flux_o(klon), stat = error)
103	IF (error /= 0) THEN
104	abort_message='Pb allocation tmp_flux_o'
105	CALL abort_gcm(modname,abort_message,1)
106	ENDIF
107
108	ALLOCATE(tmp_flux_g(klon), stat = error)
109	IF (error /= 0) THEN
110	abort_message='Pb allocation tmp_flux_g'
111	CALL abort_gcm(modname,abort_message,1)
112	ENDIF
113
114	! a mettre un slab_bils aussi en force !!!
115	ALLOCATE(slab_bils(klon), stat = error)
116	IF (error /= 0) THEN
117	abort_message='Pb allocation slab_bils'
118	CALL abort_gcm(modname,abort_message,1)
119	ENDIF
120	slab_bils(:) = 0.0
121
122	ALLOCATE(lmt_bils(klon), stat = error)
123	IF (error /= 0) THEN
124	abort_message='Pb allocation lmt_bils'
125	CALL abort_gcm(modname,abort_message,1)
126	ENDIF
127
128
129	! pour une lecture une fois par jour
130	lmt_pas = NINT(86400./dtime * 1.0)
131
132	END SUBROUTINE ocean_slab_init
133	!
134	!****************************************************************************************
135	!
136	SUBROUTINE ocean_slab_noice( &
137	dtime, knon, knindex, &
138	p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
139	petAcoef, peqAcoef, petBcoef, peqBcoef, &
140	ps, u1_lay, v1_lay, &
141	radsol, snow, agesno, &
142	qsurf, evap, fluxsens, fluxlat, &
143	tsurf_new, dflux_s, dflux_l, pctsrf_oce)
144
145	INCLUDE "indicesol.h"
146	INCLUDE "iniprint.h"
147
148	! Input arguments
149	!****************************************************************************************
150	INTEGER, INTENT(IN) :: knon
151	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
152	REAL, INTENT(IN) :: dtime
153	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
154	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
155	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
156	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
157	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
158	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
159	REAL, DIMENSION(klon), INTENT(IN) :: ps
160	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay
161
162	! In/Output arguments
163	!****************************************************************************************
164	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
165	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
166	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
167
168	! Output arguments
169	!****************************************************************************************
170	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
171	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
172	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
173	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
174	REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_oce
175
176	! Local variables
177	!****************************************************************************************
178	INTEGER :: i
179	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
180	REAL, DIMENSION(klon) :: tsurf_temp
181
182	!****************************************************************************************
183	IF (check) WRITE(,)' Entering ocean_slab_noice'
184
185	tsurf_new(1:knon) = tmp_tslab(knindex(1:knon))
186	pctsrf_oce(:) = tmp_pctsrf_slab(:,is_oce)
187
188	tsurf_temp(:) = tsurf_new(:)
189	cal = 0.
190	beta = 1.
191	dif_grnd = 0.
192	agesno(:) = 0.
193
194	CALL calcul_fluxs(knon, is_oce, dtime, &
195	tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
196	precip_rain, precip_snow, snow, qsurf, &
197	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
198	petAcoef, peqAcoef, petBcoef, peqBcoef, &
199	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
200
201	tmp_flux_o(:) = 0.0
202	tmp_radsol(:) = 0.0
203
204	DO i=1, knon
205	tmp_radsol(knindex(i))=radsol(i)
206
207	IF (pctsrf_oce(knindex(i)) .GT. epsfra) &
208	tmp_flux_o(knindex(i)) = fluxsens(i) + fluxlat(i)
209	ENDDO
210
211	END SUBROUTINE ocean_slab_noice
212	!
213	!****************************************************************************************
214	!
215	SUBROUTINE ocean_slab_ice( &
216	itime, dtime, jour, knon, knindex, &
217	debut, &
218	tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
219	petAcoef, peqAcoef, petBcoef, peqBcoef, &
220	ps, u1_lay, v1_lay, &
221	radsol, snow, qsurf, qsol, agesno, tsoil, &
222	alb1_new, alb2_new, evap, fluxsens, fluxlat, &
223	tsurf_new, dflux_s, dflux_l, pctsrf_sic)
224
225	INCLUDE "indicesol.h"
226	INCLUDE "dimsoil.h"
227	INCLUDE "YOMCST.h"
228	INCLUDE "iniprint.h"
229	INCLUDE "clesphys.h"
230
231	! Input arguments
232	!****************************************************************************************
233	INTEGER, INTENT(IN) :: itime, jour, knon
234	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
235	REAL, INTENT(IN) :: dtime
236	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
237	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
238	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
239	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
240	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
241	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
242	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
243	REAL, DIMENSION(klon), INTENT(IN) :: ps
244	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay
245	LOGICAL, INTENT(IN) :: debut
246
247	!In/Output arguments
248	!****************************************************************************************
249	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
250	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
251	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
252	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
253
254	! Output arguments
255	!****************************************************************************************
256	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
257	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval
258	REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval
259	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
260	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
261	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
262	REAL, DIMENSION(klon), INTENT(OUT) :: pctsrf_sic
263
264	! Local variables
265	!****************************************************************************************
266	INTEGER :: i
267	REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
268	REAL, DIMENSION(klon) :: alb_neig, tsurf_temp
269	REAL, DIMENSION(klon) :: soilcap, soilflux
270	REAL, DIMENSION(klon) :: zfra
271	REAL, PARAMETER :: t_grnd=271.35
272	REAL :: amn, amx
273	REAL, DIMENSION(klon) :: tslab
274	REAL, DIMENSION(klon) :: seaice ! glace de mer (kg/m2)
275	REAL, DIMENSION(klon,nbsrf) :: pctsrf_new
276
277	!****************************************************************************************
278
279	IF (check) WRITE(,)'Entering surface_seaice, knon=',knon
280
281	! Initialization of output variables
282	alb1_new(:) = 0.0
283
284	!****************************************************************************************
285	!
286	!
287	!****************************************************************************************
288	IF ( ok_slab_sicOBS) THEN
289	! glace de mer observee, lecture conditions limites
290	CALL interfoce_lim(itime, dtime, jour, &
291	knon, knindex, &
292	debut, &
293	tsurf_new, pctsrf_new)
294
295	tmp_pctsrf_slab(:,:) = pctsrf_new(:,:)
296	WRITE(lunout,*) 'jour lecture pctsrf_new sic =',jour
297
298	ELSE
299	pctsrf_new=tmp_pctsrf_slab
300	ENDIF
301
302	DO i = 1, knon
303	tsurf_new(i) = tsurf(i)
304	IF (pctsrf_new(knindex(i),is_sic) < EPSFRA) THEN
305	snow(i) = 0.0
306	tsurf_new(i) = RTT - 1.8
307	IF (soil_model) tsoil(i,:) = RTT -1.8
308	ENDIF
309	ENDDO
310
311	CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
312
313	IF (soil_model) THEN
314	CALL soil(dtime, is_sic, knon, snow, tsurf_new, tsoil, soilcap, soilflux)
315	cal(1:knon) = RCPD / soilcap(1:knon)
316	radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
317	ELSE
318	dif_grnd = 1.0 / tau_gl
319	cal = RCPD * calice
320	WHERE (snow > 0.0) cal = RCPD * calsno
321	ENDIF
322	tsurf_temp = tsurf_new
323	beta = 1.0
324
325	!****************************************************************************************
326	!
327	!
328	!****************************************************************************************
329	CALL calcul_fluxs(knon, is_sic, dtime, &
330	tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
331	precip_rain, precip_snow, snow, qsurf, &
332	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
333	petAcoef, peqAcoef, petBcoef, peqBcoef, &
334	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
335
336	CALL fonte_neige( knon, is_sic, knindex, dtime, &
337	tsurf_temp, precip_rain, precip_snow, &
338	snow, qsol, tsurf_new, evap)
339
340	!****************************************************************************************
341	! calcul albedo
342	!
343	!****************************************************************************************
344	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
345	WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
346	zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
347	alb1_new(1 : knon) = alb_neig(1 : knon) *zfra(1:knon) + &
348	0.6 * (1.0-zfra(1:knon))
349
350	alb2_new(:) = alb1_new(:)
351
352	!
353	!IM: flux entre l'ocean et la glace de mer pour le "slab" ocean
354	tmp_flux_g(:) = 0.0
355	DO i = 1, knon
356	!
357	!IM: faire dependre le coefficient de conduction de la glace de mer
358	! de l'epaisseur de la glace de mer, dans l'hypothese ou le coeff.
359	! actuel correspond a 3m de glace de mer, cf. L.Li
360	!
361	IF ((cal(i).GT.1.0e-15) .AND. (pctsrf_new(knindex(i),is_sic) .GT. epsfra)) THEN
362	tmp_flux_g(knindex(i))=(tsurf_new(i)-t_grnd) &
363	* dif_grnd(i) *RCPD/cal(i)
364	ENDIF
365	!
366	!IM: Attention: ne pas initialiser le tmp_radsol puisque c'est deja fait sur is_oce;
367	!IM: tmp_radsol doit etre le flux solaire qui arrive sur l'ocean
368	!IM: et non pas celui qui arrive sur la glace de mer
369	ENDDO
370
371	!
372	! 2eme appel a interfoce pour le cumul et le passage des flux a l'ocean
373	!
374
375	IF (check) THEN
376	amn=MIN(tmp_tslab(1),1000.)
377	amx=MAX(tmp_tslab(1),-1000.)
378	DO i=2, klon
379	amn=MIN(tmp_tslab(i),amn)
380	amx=MAX(tmp_tslab(i),amx)
381	ENDDO
382
383	WRITE(lunout,*) ' debut avant interfoce_slab min max tmp_tslab',amn,amx
384	ENDIF !(check) THEN
385
386	tslab = tmp_tslab
387
388	CALL interfoce_slab(klon, debut, itime, dtime, jour, &
389	tmp_radsol, tmp_flux_o, tmp_flux_g, tmp_pctsrf_slab, &
390	tslab, seaice, pctsrf_new)
391
392	tmp_pctsrf_slab=pctsrf_new
393
394	DO i=1, knon
395	tmp_tslab(knindex(i))=tslab(knindex(i))
396	ENDDO
397
398
399	!****************************************************************************************
400	! Return the fraction of sea-ice
401	! NB! jg : Peut-etre un probleme, faut-il prend aussi tmp_pctsrf_slab(:,is_oce)???
402	!****************************************************************************************
403	pctsrf_sic(:) = tmp_pctsrf_slab(:,is_sic)
404
405
406	END SUBROUTINE ocean_slab_ice
407	!
408	!****************************************************************************************
409	!
410	SUBROUTINE interfoce_slab(klon, debut, itap, dtime, ijour, &
411	radsol, fluxo, fluxg, pctsrf, &
412	tslab, seaice, pctsrf_slab)
413	!
414	! Cette routine calcule la temperature d'un slab ocean, la glace de mer
415	! et les pourcentages de la maille couverte par l'ocean libre et/ou
416	! la glace de mer pour un "slab" ocean de 50m
417	!
418	! Conception: Laurent Li
419	! Re-ecriture + adaptation LMDZ4: I. Musat
420	!
421	! input:
422	! klon nombre total de points de grille
423	! debut logical: 1er appel a la physique
424	! itap numero du pas de temps
425	! dtime pas de temps de la physique (en s)
426	! ijour jour dans l'annee en cours
427	! radsol rayonnement net au sol (LW + SW)
428	! fluxo flux turbulent (sensible + latent) sur les mailles oceaniques
429	! fluxg flux de conduction entre la surface de la glace de mer et l'ocean
430	! pctsrf tableau des pourcentages de surface de chaque maille
431	! output:
432	! tslab temperature de l'ocean libre
433	! seaice glace de mer (kg/m2)
434	! pctsrf_slab "pourcentages" (valeurs entre 0. et 1.) surfaces issus du slab
435
436	INCLUDE "indicesol.h"
437	INCLUDE "YOMCST.h"
438	INCLUDE "iniprint.h"
439	INCLUDE "clesphys.h"
440
441	! Input arguments
442	!****************************************************************************************
443	INTEGER, INTENT(IN) :: klon
444	LOGICAL, INTENT(IN) :: debut ! not used
445	INTEGER, INTENT(IN) :: itap
446	REAL, INTENT(IN) :: dtime ! not used
447	INTEGER, INTENT(IN) :: ijour
448	REAL, DIMENSION(klon), INTENT(IN) :: radsol
449	REAL, DIMENSION(klon), INTENT(IN) :: fluxo
450	REAL, DIMENSION(klon), INTENT(IN) :: fluxg
451	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf
452
453	! Output arguments
454	!****************************************************************************************
455	REAL, DIMENSION(klon), INTENT(OUT) :: tslab
456	REAL, DIMENSION(klon), INTENT(OUT) :: seaice ! glace de mer (kg/m2)
457	REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: pctsrf_slab
458
459	! Local variables
460	!****************************************************************************************
461	REAL :: amn, amx
462	REAL, PARAMETER :: unjour=86400.
463	REAL, PARAMETER :: cyang=50.0 * 4.228e+06 ! capacite calorifique volumetrique de l'eau J/(m2 K)
464	REAL, PARAMETER :: cbing=0.334e+05 ! J/kg
465	REAL, DIMENSION(klon) :: siceh !hauteur de la glace de mer (m)
466	INTEGER :: i
467	REAL :: zz, za, zb
468	!
469	!****************************************************************************************
470	!
471	julien = MOD(ijour,360)
472
473	IF (check ) THEN
474	amn=MIN(tmp_tslab_loc(1),1000.)
475	amx=MAX(tmp_tslab_loc(1),-1000.)
476	DO i=2, klon
477	amn=MIN(tmp_tslab_loc(i),amn)
478	amx=MAX(tmp_tslab_loc(i),amx)
479	ENDDO
480
481	WRITE(lunout,*) ' debut min max tslab',amn,amx
482	WRITE(lunout,*) ' itap,lmt_pas unjour',itap,lmt_pas,unjour
483	ENDIF
484
485	pctsrf_slab(1:klon,1:nbsrf) = pctsrf(1:klon,1:nbsrf)
486	!
487	! lecture du bilan au sol lmt_bils issu d'une simulation forcee en debut de journee
488	!
489	IF (MOD(itap,lmt_pas) .EQ. 1) THEN
490	! 1er pas de temps de la journee
491	idayvrai = ijour
492	CALL condsurf(julien,idayvrai, lmt_bils)
493	ENDIF
494
495	DO i = 1, klon
496	IF((pctsrf_slab(i,is_oce).GT.epsfra).OR. &
497	(pctsrf_slab(i,is_sic).GT.epsfra)) THEN
498	!
499	! fabriquer de la glace si congelation atteinte:
500	!
501	IF (tmp_tslab_loc(i).LT.(RTT-1.8)) THEN
502	zz = (RTT-1.8)-tmp_tslab_loc(i)
503	tmp_seaice(i) = tmp_seaice(i) + cyang/cbing * zz
504	seaice(i) = tmp_seaice(i)
505	tmp_tslab_loc(i) = RTT-1.8
506	ENDIF
507	!
508	! faire fondre de la glace si temperature est superieure a 0:
509	!
510	IF ((tmp_tslab_loc(i).GT.RTT) .AND. (tmp_seaice(i).GT.0.0)) THEN
511	zz = cyang/cbing * (tmp_tslab_loc(i)-RTT)
512	zz = MIN(zz,tmp_seaice(i))
513	tmp_seaice(i) = tmp_seaice(i) - zz
514	seaice(i) = tmp_seaice(i)
515	tmp_tslab_loc(i) = tmp_tslab_loc(i) - zz*cbing/cyang
516	ENDIF
517	!
518	! limiter la glace de mer a 10 metres (10000 kg/m2)
519	!
520	IF(tmp_seaice(i).GT.45.) THEN
521	tmp_seaice(i) = MIN(tmp_seaice(i),10000.0)
522	ELSE
523	tmp_seaice(i) = 0.
524	ENDIF
525	seaice(i) = tmp_seaice(i)
526	siceh(i)=tmp_seaice(i)/1000. !en metres
527	!
528	! determiner la nature du sol (glace de mer ou ocean libre):
529	!
530	! on fait dependre la fraction de seaice "pctsrf(i,is_sic)"
531	! de l'epaisseur de seaice :
532	! pctsrf(i,is_sic)=1. si l'epaisseur de la glace de mer est >= a 20cm
533	! et pctsrf(i,is_sic) croit lineairement avec seaice de 0. a 20cm d'epaisseur
534	!
535
536	IF(.NOT.ok_slab_sicOBS) THEN
537	pctsrf_slab(i,is_sic)=MIN(siceh(i)/0.20, &
538	1.-(pctsrf_slab(i,is_ter)+pctsrf_slab(i,is_lic)))
539	pctsrf_slab(i,is_oce)=1.0 - &
540	(pctsrf_slab(i,is_ter)+pctsrf_slab(i,is_lic)+pctsrf_slab(i,is_sic))
541	ELSE
542	IF (i.EQ.1) WRITE(lunout,*) 'cas ok_slab_sicOBS TRUE : passe sur la modif.'
543	ENDIF !(.NOT.ok_slab_sicOBS) then
544	ENDIF !pctsrf
545	ENDDO
546	!
547	! Calculer le bilan du flux de chaleur au sol :
548	!
549	DO i = 1, klon
550	za = radsol(i) + fluxo(i)
551	zb = fluxg(i)
552	IF((pctsrf_slab(i,is_oce).GT.epsfra).OR. &
553	(pctsrf_slab(i,is_sic).GT.epsfra)) THEN
554	slab_bils(i)=slab_bils(i)+(za*pctsrf_slab(i,is_oce) &
555	+zb*pctsrf_slab(i,is_sic))/ FLOAT(lmt_pas)
556	ENDIF
557	ENDDO !klon
558	!
559	! calcul tslab
560	!
561	IF (MOD(itap,lmt_pas).EQ.0) THEN !fin de journee
562	!
563	! calcul tslab
564	amn=MIN(tmp_tslab_loc(1),1000.)
565	amx=MAX(tmp_tslab_loc(1),-1000.)
566	DO i = 1, klon
567	IF ((pctsrf_slab(i,is_oce).GT.epsfra).OR. &
568	(pctsrf_slab(i,is_sic).GT.epsfra)) THEN
569	tmp_tslab_loc(i) = tmp_tslab_loc(i) + &
570	(slab_bils(i)-lmt_bils(i)) &
571	/cyang*unjour
572
573	! on remet l'accumulation a 0
574	slab_bils(i) = 0.
575	ENDIF !pctsrf
576	!
577	IF (check) THEN
578	IF(i.EQ.1) THEN
579	WRITE(lunout,*) 'i tmp_tslab_loc MOD(itap,lmt_pas).EQ.0 sicINTER',i,itap, &
580	tmp_tslab_loc(i), tmp_seaice(i)
581	ENDIF
582
583	amn=MIN(tmp_tslab_loc(i),amn)
584	amx=MAX(tmp_tslab_loc(i),amx)
585	ENDIF
586	ENDDO !klon
587	ENDIF !(MOD(itap,lmt_pas).EQ.0) THEN
588
589	IF ( check ) THEN
590	WRITE(lunout,*) 'fin min max tslab',amn,amx
591	ENDIF
592
593	tslab = tmp_tslab_loc
594	seaice = tmp_seaice
595
596	END SUBROUTINE interfoce_slab
597	!
598	!****************************************************************************************
599	!
600	SUBROUTINE ocean_slab_final(tslab_rst, seaice_rst)
601
602	! This subroutine will send to phyredem the variables concerning the slab
603	! ocean that should be written to restart file.
604
605	!****************************************************************************************
606
607	REAL, DIMENSION(klon), INTENT(OUT) :: tslab_rst
608	REAL, DIMENSION(klon), INTENT(OUT) :: seaice_rst
609
610	!****************************************************************************************
611	! Set the output variables
612	tslab_rst(:) = tmp_tslab(:)
613	! tslab_rst(:) = tmp_tslab_loc(:)
614	seaice_rst(:) = tmp_seaice(:)
615
616	! Deallocation of all variables in module
617	DEALLOCATE(tmp_tslab, tmp_tslab_loc, tmp_pctsrf_slab)
618	DEALLOCATE(tmp_seaice, tmp_radsol, tmp_flux_o, tmp_flux_g)
619	DEALLOCATE(slab_bils, lmt_bils)
620
621	END SUBROUTINE ocean_slab_final
622	!
623	!****************************************************************************************
624	!
625	SUBROUTINE ocean_slab_get_vars(tslab_loc, seaice_loc, flux_o_loc, flux_g_loc)
626	! "Get some variables from module ocean_slab_mod"
627	! This subroutine prints variables to a external routine
628
629	REAL, DIMENSION(klon), INTENT(OUT) :: tslab_loc
630	REAL, DIMENSION(klon), INTENT(OUT) :: seaice_loc
631	REAL, DIMENSION(klon), INTENT(OUT) :: flux_o_loc
632	REAL, DIMENSION(klon), INTENT(OUT) :: flux_g_loc
633
634	! Set the output variables
635	tslab_loc(:) = tmp_tslab(:)
636	seaice_loc(:) = tmp_seaice(:)
637	flux_o_loc(:) = tmp_flux_o(:)
638	flux_g_loc(:) = tmp_flux_g(:)
639
640	END SUBROUTINE ocean_slab_get_vars
641	!
642	!****************************************************************************************
643	!
644	END MODULE ocean_slab_mod

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

Download in other formats:

Original Format