source: LMDZ5/trunk/libf/phylmd/ocean_forced_mod.F90 @ 2201

Last change on this file since 2201 was 1961, checked in by fhourdin, 11 years ago

ocean_force_mod est mis à jour pour inclure en option le cas 1D, et éviter

de dupliquer la routine dans phy1d.

clesphys.h est modifié pour placer les réels avant les entiers et logiques

pour éviter des warnings à la compilation.

  • 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:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 11.3 KB
RevLine 
[781]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!
[1067]13  SUBROUTINE ocean_forced_noice( &
14       itime, dtime, jour, knon, knindex, &
15       p1lay, cdragh, cdragm, precip_rain, precip_snow, &
[781]16       temp_air, spechum, &
[1067]17       AcoefH, AcoefQ, BcoefH, BcoefQ, &
18       AcoefU, AcoefV, BcoefU, BcoefV, &
19       ps, u1, v1, &
[888]20       radsol, snow, agesno, &
[1067]21       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]22       tsurf_new, dflux_s, dflux_l)
[781]23!
24! This subroutine treats the "open ocean", all grid points that are not entierly covered
25! by ice.
[996]26! The routine receives data from climatologie file limit.nc and does some calculations at the
[781]27! surface.
28!
[1067]29    USE dimphy
30    USE calcul_fluxs_mod
[996]31    USE limit_read_mod
[1961]32    USE mod_grid_phy_lmdz
[1785]33    USE indice_sol_mod
[793]34    INCLUDE "YOMCST.h"
[781]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
[1067]42    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
[781]43    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
44    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
[1067]45    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
46    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
[781]47    REAL, DIMENSION(klon), INTENT(IN)        :: ps
[1067]48    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
[781]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
[1067]60    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
[781]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
[1067]69    REAL, DIMENSION(klon)       :: u0, v0
70    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
[781]71    LOGICAL                     :: check=.FALSE.
72
73!****************************************************************************************
74! Start calculation
75!****************************************************************************************
76    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
[1067]77   
[781]78!****************************************************************************************
79! 1)   
[996]80! Read sea-surface temperature from file limit.nc
[781]81!
82!****************************************************************************************
[1961]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,tsurf_lim) ! new
87    else ! GCM
88      CALL limit_read_sst(knon,knindex,tsurf_lim)
89    endif ! knon
90!sb--
[996]91
[781]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.
[1067]103! Suppose zero surface speed
104    u0(:)=0.0
105    v0(:)=0.0
106    u1_lay(:) = u1(:) - u0(:)
107    v1_lay(:) = v1(:) - v0(:)
108
[781]109! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
110    CALL calcul_fluxs(knon, is_oce, dtime, &
[1067]111         tsurf_lim, p1lay, cal, beta, cdragh, ps, &
[781]112         precip_rain, precip_snow, snow, qsurf,  &
113         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
[1067]114         AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]115         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
116
[1067]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) 
[781]123
124  END SUBROUTINE ocean_forced_noice
125!
[1067]126!***************************************************************************************
[781]127!
[1067]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, &
[888]134       radsol, snow, qsol, agesno, tsoil, &
[1067]135       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]136       tsurf_new, dflux_s, dflux_l)
[781]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.
[996]141!
[1067]142    USE dimphy
143    USE calcul_fluxs_mod
144    USE surface_data,     ONLY : calice, calsno, tau_gl
[996]145    USE limit_read_mod
[1067]146    USE fonte_neige_mod,  ONLY : fonte_neige
[1785]147    USE indice_sol_mod
[996]148
[1961]149!    INCLUDE "indicesol.h"
[781]150    INCLUDE "dimsoil.h"
[793]151    INCLUDE "YOMCST.h"
152    INCLUDE "clesphys.h"
[781]153
154! Input arguments
155!****************************************************************************************
156    INTEGER, INTENT(IN)                  :: itime, jour, knon
157    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
158    REAL, INTENT(IN)                     :: dtime
159    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
160    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
[1067]161    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
[781]162    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
163    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
[1067]164    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
165    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
[781]166    REAL, DIMENSION(klon), INTENT(IN)    :: ps
[1067]167    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1
[781]168
169! In/Output arguments
170!****************************************************************************************
171    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
172    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
173    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
174    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
175
176! Output arguments
177!****************************************************************************************
178    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
[888]179    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
180    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
[781]181    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
[1067]182    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
[888]183    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
[781]184    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
185
186! Local variables
187!****************************************************************************************
188    LOGICAL                     :: check=.FALSE.
189    INTEGER                     :: i
190    REAL                        :: zfra
191    REAL, PARAMETER             :: t_grnd=271.35
192    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
193    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
194    REAL, DIMENSION(klon)       :: soilcap, soilflux
[1067]195    REAL, DIMENSION(klon)       :: u0, v0
196    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
[781]197
198!****************************************************************************************
199! Start calculation
200!****************************************************************************************
201    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
202
203!****************************************************************************************
[996]204! 1)
[1067]205! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
[781]206!                    dflux_s, dflux_l and qsurf
207!****************************************************************************************
[996]208    tsurf_tmp(:) = tsurf_in(:)
[781]209
210! calculate the parameters cal, beta, capsol and dif_grnd
[996]211    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
[781]212
213   
214    IF (soil_model) THEN
215! update tsoil and calculate soilcap and soilflux
[996]216       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
[781]217       cal(1:knon) = RCPD / soilcap(1:knon)
218       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
219       dif_grnd = 1.0 / tau_gl
220    ELSE
221       dif_grnd = 1.0 / tau_gl
222       cal = RCPD * calice
223       WHERE (snow > 0.0) cal = RCPD * calsno
224    ENDIF
225
226    beta = 1.0
[1067]227! Suppose zero surface speed
228    u0(:)=0.0
229    v0(:)=0.0
230    u1_lay(:) = u1(:) - u0(:)
231    v1_lay(:) = v1(:) - v0(:)
[781]232    CALL calcul_fluxs(knon, is_sic, dtime, &
[1067]233         tsurf_tmp, p1lay, cal, beta, cdragh, ps, &
[781]234         precip_rain, precip_snow, snow, qsurf,  &
235         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
[1067]236         AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]237         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
238
[1067]239! - Flux calculation at first modele level for U and V
240    CALL calcul_flux_wind(knon, dtime, &
241         u0, v0, u1, v1, cdragm, &
242         AcoefU, AcoefV, BcoefU, BcoefV, &
243         p1lay, temp_air, &
244         flux_u1, flux_v1) 
245
[781]246!****************************************************************************************
[996]247! 2)
[781]248! Calculations due to snow and runoff
249!
250!****************************************************************************************
251    CALL fonte_neige( knon, is_sic, knindex, dtime, &
252         tsurf_tmp, precip_rain, precip_snow, &
253         snow, qsol, tsurf_new, evap)
254   
255! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
256!
257    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) 
258
259    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
260
[888]261    alb1_new(:) = 0.0
[781]262    DO i=1, knon
263       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
[888]264       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
[781]265    ENDDO
266
[888]267    alb2_new(:) = alb1_new(:)
268
[781]269  END SUBROUTINE ocean_forced_ice
[1961]270
271!************************************************************************
272! 1D case
273!************************************************************************
274  SUBROUTINE read_tsurf1d(knon,sst_out)
275
276! This subroutine specifies the surface temperature to be used in 1D simulations
277
278      USE dimphy, ONLY : klon
279
280      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
281      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
282
283       INTEGER :: i
284! COMMON defined in lmdz1d.F:
285       real ts_cur
286       common /sst_forcing/ts_cur
287
288       DO i = 1, knon
289        sst_out(i) = ts_cur
290       ENDDO
291
292      END SUBROUTINE read_tsurf1d
293
[781]294!
[1961]295!************************************************************************
[781]296!
297END MODULE ocean_forced_mod
298
299
300
301
302
303
Note: See TracBrowser for help on using the repository browser.