source: LMDZ5/branches/testing/libf/phylmd/surf_ocean_mod.F90 @ 2339

Last change on this file since 2339 was 2298, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes -r2237:2291 into testing branch
  • 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: 9.0 KB
Line 
1!
2MODULE surf_ocean_mod
3
4  IMPLICIT NONE
5
6CONTAINS
7!
8!******************************************************************************
9!
10  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
11       windsp, rmu0, fder, tsurf_in, &
12       itime, dtime, jour, knon, knindex, &
13       p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15       AcoefU, AcoefV, BcoefU, BcoefV, &
16       ps, u1, v1, gustiness, rugoro, pctsrf, &
17       snow, qsurf, agesno, &
18       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
19       tsurf_new, dflux_s, dflux_l, lmt_bils, &
20       flux_u1, flux_v1)
21
22  USE dimphy
23  USE surface_data, ONLY     : type_ocean
24  USE ocean_forced_mod, ONLY : ocean_forced_noice
25  USE ocean_slab_mod, ONLY   : ocean_slab_noice
26  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
27  USE indice_sol_mod
28!
29! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
30! slab or couple). The calculations of albedo and rugosity for the ocean surface are
31! done in here because they are identical for the different modes of ocean.
32
33
34    INCLUDE "YOMCST.h"
35
36    include "clesphys.h"
37    ! for cycle_diurne
38
39! Input variables
40!******************************************************************************
41    INTEGER, INTENT(IN)                      :: itime, jour, knon
42    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
43    REAL, INTENT(IN)                         :: dtime
44    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
45    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
46    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
47    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
48    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
49    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
50    REAL, DIMENSION(klon), INTENT(IN)        :: fder
51    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
52    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay,z1lay ! pression (Pa) et altitude (m) du premier niveau
53    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
54    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
55    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
56    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
57    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
58    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
59    REAL, DIMENSION(klon), INTENT(IN)        :: ps
60    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
61    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
62    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
63
64! In/Output variables
65!******************************************************************************
66    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
67    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
68    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
69
70! Output variables
71!******************************************************************************
72    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
73!albedo SB >>>
74!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
75!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
76    REAL, DIMENSION(6), INTENT(IN)          :: SFRWL
77    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
78!albedo SB <<<     
79    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
80    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
81    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
82    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
83    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
84
85! Local variables
86!******************************************************************************
87    INTEGER               :: i, k
88    REAL                  :: tmp
89    REAL, PARAMETER       :: cepdu2=(0.1)**2
90    REAL, DIMENSION(klon) :: alb_eau
91    REAL, DIMENSION(klon) :: radsol
92    REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation
93
94! End definition
95!******************************************************************************
96
97
98!******************************************************************************
99! Calculate total net radiance at surface
100!
101!******************************************************************************
102    radsol(:) = 0.0
103    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
104
105!******************************************************************************
106! Cdragq computed from cdrag
107! The difference comes only from a factor (f_z0qh_oce) on z0, so that
108! it can be computed inside surf_ocean
109! More complicated appraches may require the propagation through
110! pbl_surface of an independant cdragq variable.
111!******************************************************************************
112
113    IF ( f_z0qh_oce .ne. 1.) THEN
114! Si on suit les formulations par exemple de Tessel, on
115! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
116       cdragq(:)=cdragh(:)*                                      &
117       log(z1lay(:)/z0h(:))/log(z1lay(:)/(f_z0qh_oce*z0h(:)))
118    ELSE
119       cdragq(:)=cdragh(:)
120    ENDIF
121
122!******************************************************************************
123! Switch according to type of ocean (couple, slab or forced)
124!******************************************************************************
125    SELECT CASE(type_ocean)
126    CASE('couple')
127       CALL ocean_cpl_noice( &
128            swnet, lwnet, alb1, &
129            windsp, fder, &
130            itime, dtime, knon, knindex, &
131            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow,temp_air,spechum,&
132            AcoefH, AcoefQ, BcoefH, BcoefQ, &
133            AcoefU, AcoefV, BcoefU, BcoefV, &
134            ps, u1, v1, gustiness, &
135            radsol, snow, agesno, &
136            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
137            tsurf_new, dflux_s, dflux_l)
138
139    CASE('slab')
140       CALL ocean_slab_noice( &
141            itime, dtime, jour, knon, knindex, &
142            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum,&
143            AcoefH, AcoefQ, BcoefH, BcoefQ, &
144            AcoefU, AcoefV, BcoefU, BcoefV, &
145            ps, u1, v1, gustiness, tsurf_in, &
146            radsol, snow, &
147            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
148            tsurf_new, dflux_s, dflux_l, lmt_bils)
149       
150    CASE('force')
151       CALL ocean_forced_noice( &
152            itime, dtime, jour, knon, knindex, &
153            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
154            temp_air, spechum, &
155            AcoefH, AcoefQ, BcoefH, BcoefQ, &
156            AcoefU, AcoefV, BcoefU, BcoefV, &
157            ps, u1, v1, gustiness, &
158            radsol, snow, agesno, &
159            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
160            tsurf_new, dflux_s, dflux_l)
161    END SELECT
162
163!******************************************************************************
164! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
165!******************************************************************************
166    IF (type_ocean.NE.'slab') THEN
167        lmt_bils(:)=0.
168        DO i=1,knon
169           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
170           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
171        END DO
172    END IF
173
174!******************************************************************************
175! Calculate albedo
176!******************************************************************************
177!albedo SB >>>
178  if(iflag_albedo==1)then
179    call ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
180  else
181    IF (cycle_diurne) THEN
182       CALL alboc_cd(rmu0,alb_eau)
183    ELSE
184       CALL alboc(REAL(jour),rlat,alb_eau)
185    ENDIF
186
187    DO i =1, knon
188      do  k=1,nsw
189       alb_dir_new(i,k) = alb_eau(knindex(i))
190      enddo
191    ENDDO
192     alb_dif_new=0.05 !alb_dir_new
193endif
194
195!albedo SB <<<
196
197!******************************************************************************
198! Calculate the rugosity
199!******************************************************************************
200IF (iflag_z0_oce==0) THEN
201    DO i = 1, knon
202       tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
203       z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
204            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
205       z0m(i) = MAX(1.5e-05,z0m(i))
206    ENDDO   
207    z0h(1:knon)=z0m(1:knon) ! En attendant mieux
208
209ELSE IF (iflag_z0_oce==1) THEN
210    DO i = 1, knon
211       tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
212       z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
213            + 0.11*14e-6 / SQRT(cdragm(i) * tmp)
214       z0m(i) = MAX(1.5e-05,z0m(i))
215       z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp)
216    ENDDO
217ELSE
218       STOP'version non prevue'
219ENDIF
220!
221!******************************************************************************
222  END SUBROUTINE surf_ocean
223!******************************************************************************
224!
225END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.