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

Last change on this file since 1912 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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: 10.4 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
[1785]32    USE indice_sol_mod
33
[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!****************************************************************************************
[996]83    CALL limit_read_sst(knon,knindex,tsurf_lim)
84
[781]85!****************************************************************************************
86! 2)
87! Flux calculation
88!
89!****************************************************************************************
90! Set some variables for calcul_fluxs
91    cal = 0.
92    beta = 1.
93    dif_grnd = 0.
94    alb_neig(:) = 0.
95    agesno(:) = 0.
[1067]96! Suppose zero surface speed
97    u0(:)=0.0
98    v0(:)=0.0
99    u1_lay(:) = u1(:) - u0(:)
100    v1_lay(:) = v1(:) - v0(:)
101
[781]102! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
103    CALL calcul_fluxs(knon, is_oce, dtime, &
[1067]104         tsurf_lim, p1lay, cal, beta, cdragh, ps, &
[781]105         precip_rain, precip_snow, snow, qsurf,  &
106         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
[1067]107         AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]108         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
109
[1067]110! - Flux calculation at first modele level for U and V
111    CALL calcul_flux_wind(knon, dtime, &
112         u0, v0, u1, v1, cdragm, &
113         AcoefU, AcoefV, BcoefU, BcoefV, &
114         p1lay, temp_air, &
115         flux_u1, flux_v1) 
[781]116
117  END SUBROUTINE ocean_forced_noice
118!
[1067]119!***************************************************************************************
[781]120!
[1067]121  SUBROUTINE ocean_forced_ice( &
122       itime, dtime, jour, knon, knindex, &
123       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
124       AcoefH, AcoefQ, BcoefH, BcoefQ, &
125       AcoefU, AcoefV, BcoefU, BcoefV, &
126       ps, u1, v1, &
[888]127       radsol, snow, qsol, agesno, tsoil, &
[1067]128       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]129       tsurf_new, dflux_s, dflux_l)
[781]130!
131! This subroutine treats the ocean where there is ice.
132! The routine reads data from climatologie file and does flux calculations at the
133! surface.
[996]134!
[1067]135    USE dimphy
136    USE calcul_fluxs_mod
137    USE surface_data,     ONLY : calice, calsno, tau_gl
[996]138    USE limit_read_mod
[1067]139    USE fonte_neige_mod,  ONLY : fonte_neige
[1785]140    USE indice_sol_mod
[996]141
[781]142    INCLUDE "dimsoil.h"
[793]143    INCLUDE "YOMCST.h"
144    INCLUDE "clesphys.h"
[781]145
146! Input arguments
147!****************************************************************************************
148    INTEGER, INTENT(IN)                  :: itime, jour, knon
149    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
150    REAL, INTENT(IN)                     :: dtime
151    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
152    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
[1067]153    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
[781]154    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
155    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
[1067]156    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
157    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
[781]158    REAL, DIMENSION(klon), INTENT(IN)    :: ps
[1067]159    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1
[781]160
161! In/Output arguments
162!****************************************************************************************
163    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
164    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
165    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
166    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
167
168! Output arguments
169!****************************************************************************************
170    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
[888]171    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
172    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
[781]173    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
[1067]174    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
[888]175    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
[781]176    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
177
178! Local variables
179!****************************************************************************************
180    LOGICAL                     :: check=.FALSE.
181    INTEGER                     :: i
182    REAL                        :: zfra
183    REAL, PARAMETER             :: t_grnd=271.35
184    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
185    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
186    REAL, DIMENSION(klon)       :: soilcap, soilflux
[1067]187    REAL, DIMENSION(klon)       :: u0, v0
188    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
[781]189
190!****************************************************************************************
191! Start calculation
192!****************************************************************************************
193    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
194
195!****************************************************************************************
[996]196! 1)
[1067]197! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
[781]198!                    dflux_s, dflux_l and qsurf
199!****************************************************************************************
[996]200    tsurf_tmp(:) = tsurf_in(:)
[781]201
202! calculate the parameters cal, beta, capsol and dif_grnd
[996]203    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
[781]204
205   
206    IF (soil_model) THEN
207! update tsoil and calculate soilcap and soilflux
[996]208       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
[781]209       cal(1:knon) = RCPD / soilcap(1:knon)
210       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
211       dif_grnd = 1.0 / tau_gl
212    ELSE
213       dif_grnd = 1.0 / tau_gl
214       cal = RCPD * calice
215       WHERE (snow > 0.0) cal = RCPD * calsno
216    ENDIF
217
218    beta = 1.0
[1067]219! Suppose zero surface speed
220    u0(:)=0.0
221    v0(:)=0.0
222    u1_lay(:) = u1(:) - u0(:)
223    v1_lay(:) = v1(:) - v0(:)
[781]224    CALL calcul_fluxs(knon, is_sic, dtime, &
[1067]225         tsurf_tmp, p1lay, cal, beta, cdragh, ps, &
[781]226         precip_rain, precip_snow, snow, qsurf,  &
227         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
[1067]228         AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]229         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
230
[1067]231! - Flux calculation at first modele level for U and V
232    CALL calcul_flux_wind(knon, dtime, &
233         u0, v0, u1, v1, cdragm, &
234         AcoefU, AcoefV, BcoefU, BcoefV, &
235         p1lay, temp_air, &
236         flux_u1, flux_v1) 
237
[781]238!****************************************************************************************
[996]239! 2)
[781]240! Calculations due to snow and runoff
241!
242!****************************************************************************************
243    CALL fonte_neige( knon, is_sic, knindex, dtime, &
244         tsurf_tmp, precip_rain, precip_snow, &
245         snow, qsol, tsurf_new, evap)
246   
247! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
248!
249    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) 
250
251    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
252
[888]253    alb1_new(:) = 0.0
[781]254    DO i=1, knon
255       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
[888]256       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
[781]257    ENDDO
258
[888]259    alb2_new(:) = alb1_new(:)
260
[781]261  END SUBROUTINE ocean_forced_ice
262!
263!****************************************************************************************
264!
265END MODULE ocean_forced_mod
266
267
268
269
270
271
Note: See TracBrowser for help on using the repository browser.