source: LMDZ5/trunk/libf/phy1d/ocean_forced_mod.F90 @ 1700

Last change on this file since 1700 was 1607, checked in by lguez, 13 years ago

Import 1D files. Files added to directory "phy1d" were in directories:

lmdz1d_source_20111207/phy1d_source
lmdz1d_source_20111207/phy1d_source_upd

extracted from:

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