source: LMDZ4/trunk/libf/phylmd/ocean_forced_mod.F90 @ 1940

Last change on this file since 1940 was 1067, checked in by Laurent Fairhead, 16 years ago
  • Modifications lie au premier niveau du modele pour la diffusion turbulent

du vent.

  • Preparation pour un couplage des courrant oceaniques.

JG
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.4 KB
Line 
1!
2MODULE ocean_forced_mod
3!
4! This module is used for both the sub-surfaces ocean and sea-ice for the case of a
5! forced ocean,  "ocean=force".
6!
7  IMPLICIT NONE
8
9CONTAINS
10!
11!****************************************************************************************
12!
13  SUBROUTINE ocean_forced_noice( &
14       itime, dtime, jour, knon, knindex, &
15       p1lay, cdragh, cdragm, precip_rain, precip_snow, &
16       temp_air, spechum, &
17       AcoefH, AcoefQ, BcoefH, BcoefQ, &
18       AcoefU, AcoefV, BcoefU, BcoefV, &
19       ps, u1, v1, &
20       radsol, snow, agesno, &
21       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
22       tsurf_new, dflux_s, dflux_l)
23!
24! This subroutine treats the "open ocean", all grid points that are not entierly covered
25! by ice.
26! The routine receives data from climatologie file limit.nc and does some calculations at the
27! surface.
28!
29    USE dimphy
30    USE calcul_fluxs_mod
31    USE limit_read_mod
32    INCLUDE "indicesol.h"
33    INCLUDE "YOMCST.h"
34
35! Input arguments
36!****************************************************************************************
37    INTEGER, INTENT(IN)                      :: itime, jour, knon
38    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
39    REAL, INTENT(IN)                         :: dtime
40    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
41    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
42    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
43    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
44    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
45    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
46    REAL, DIMENSION(klon), INTENT(IN)        :: ps
47    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
48
49! In/Output arguments
50!****************************************************************************************
51    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
52    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
53    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno !? put to 0 in ocean
54 
55! Output arguments
56!****************************************************************************************
57    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
58    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
59    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
60    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
61    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
62
63! Local variables
64!****************************************************************************************
65    INTEGER                     :: i
66    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd
67    REAL, DIMENSION(klon)       :: alb_neig, tsurf_lim, zx_sl
68    REAL, DIMENSION(klon)       :: u0, v0
69    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
70    LOGICAL                     :: check=.FALSE.
71
72!****************************************************************************************
73! Start calculation
74!****************************************************************************************
75    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
76   
77!****************************************************************************************
78! 1)   
79! Read sea-surface temperature from file limit.nc
80!
81!****************************************************************************************
82    CALL limit_read_sst(knon,knindex,tsurf_lim)
83
84!****************************************************************************************
85! 2)
86! Flux calculation
87!
88!****************************************************************************************
89! Set some variables for calcul_fluxs
90    cal = 0.
91    beta = 1.
92    dif_grnd = 0.
93    alb_neig(:) = 0.
94    agesno(:) = 0.
95! Suppose zero surface speed
96    u0(:)=0.0
97    v0(:)=0.0
98    u1_lay(:) = u1(:) - u0(:)
99    v1_lay(:) = v1(:) - v0(:)
100
101! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
102    CALL calcul_fluxs(knon, is_oce, dtime, &
103         tsurf_lim, p1lay, cal, beta, cdragh, ps, &
104         precip_rain, precip_snow, snow, qsurf,  &
105         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
106         AcoefH, AcoefQ, BcoefH, BcoefQ, &
107         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
108
109! - Flux calculation at first modele level for U and V
110    CALL calcul_flux_wind(knon, dtime, &
111         u0, v0, u1, v1, cdragm, &
112         AcoefU, AcoefV, BcoefU, BcoefV, &
113         p1lay, temp_air, &
114         flux_u1, flux_v1) 
115
116  END SUBROUTINE ocean_forced_noice
117!
118!***************************************************************************************
119!
120  SUBROUTINE ocean_forced_ice( &
121       itime, dtime, jour, knon, knindex, &
122       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
123       AcoefH, AcoefQ, BcoefH, BcoefQ, &
124       AcoefU, AcoefV, BcoefU, BcoefV, &
125       ps, u1, v1, &
126       radsol, snow, qsol, agesno, tsoil, &
127       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
128       tsurf_new, dflux_s, dflux_l)
129!
130! This subroutine treats the ocean where there is ice.
131! The routine reads data from climatologie file and does flux calculations at the
132! surface.
133!
134    USE dimphy
135    USE calcul_fluxs_mod
136    USE surface_data,     ONLY : calice, calsno, tau_gl
137    USE limit_read_mod
138    USE fonte_neige_mod,  ONLY : fonte_neige
139
140    INCLUDE "indicesol.h"
141    INCLUDE "dimsoil.h"
142    INCLUDE "YOMCST.h"
143    INCLUDE "clesphys.h"
144
145! Input arguments
146!****************************************************************************************
147    INTEGER, INTENT(IN)                  :: itime, jour, knon
148    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
149    REAL, INTENT(IN)                     :: dtime
150    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
151    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
152    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
153    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
154    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
155    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
156    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
157    REAL, DIMENSION(klon), INTENT(IN)    :: ps
158    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1
159
160! In/Output arguments
161!****************************************************************************************
162    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
163    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
164    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
165    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
166
167! Output arguments
168!****************************************************************************************
169    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
170    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
171    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
172    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
173    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
174    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
175    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
176
177! Local variables
178!****************************************************************************************
179    LOGICAL                     :: check=.FALSE.
180    INTEGER                     :: i
181    REAL                        :: zfra
182    REAL, PARAMETER             :: t_grnd=271.35
183    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
184    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
185    REAL, DIMENSION(klon)       :: soilcap, soilflux
186    REAL, DIMENSION(klon)       :: u0, v0
187    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
188
189!****************************************************************************************
190! Start calculation
191!****************************************************************************************
192    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
193
194!****************************************************************************************
195! 1)
196! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
197!                    dflux_s, dflux_l and qsurf
198!****************************************************************************************
199    tsurf_tmp(:) = tsurf_in(:)
200
201! calculate the parameters cal, beta, capsol and dif_grnd
202    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
203
204   
205    IF (soil_model) THEN
206! update tsoil and calculate soilcap and soilflux
207       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
208       cal(1:knon) = RCPD / soilcap(1:knon)
209       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
210       dif_grnd = 1.0 / tau_gl
211    ELSE
212       dif_grnd = 1.0 / tau_gl
213       cal = RCPD * calice
214       WHERE (snow > 0.0) cal = RCPD * calsno
215    ENDIF
216
217    beta = 1.0
218! Suppose zero surface speed
219    u0(:)=0.0
220    v0(:)=0.0
221    u1_lay(:) = u1(:) - u0(:)
222    v1_lay(:) = v1(:) - v0(:)
223    CALL calcul_fluxs(knon, is_sic, dtime, &
224         tsurf_tmp, p1lay, cal, beta, cdragh, ps, &
225         precip_rain, precip_snow, snow, qsurf,  &
226         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
227         AcoefH, AcoefQ, BcoefH, BcoefQ, &
228         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
229
230! - Flux calculation at first modele level for U and V
231    CALL calcul_flux_wind(knon, dtime, &
232         u0, v0, u1, v1, cdragm, &
233         AcoefU, AcoefV, BcoefU, BcoefV, &
234         p1lay, temp_air, &
235         flux_u1, flux_v1) 
236
237!****************************************************************************************
238! 2)
239! Calculations due to snow and runoff
240!
241!****************************************************************************************
242    CALL fonte_neige( knon, is_sic, knindex, dtime, &
243         tsurf_tmp, precip_rain, precip_snow, &
244         snow, qsol, tsurf_new, evap)
245   
246! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
247!
248    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) 
249
250    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
251
252    alb1_new(:) = 0.0
253    DO i=1, knon
254       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
255       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
256    ENDDO
257
258    alb2_new(:) = alb1_new(:)
259
260  END SUBROUTINE ocean_forced_ice
261!
262!****************************************************************************************
263!
264END MODULE ocean_forced_mod
265
266
267
268
269
270
Note: See TracBrowser for help on using the repository browser.