source: LMDZ5/trunk/libf/phylmd/surf_ocean_mod.F90 @ 2189

Last change on this file since 2189 was 2178, checked in by lguez, 10 years ago

Bug fix. This modification should have been done in revision 1068. The
bug was only for cycle_diurne false.
  • 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: 7.6 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       rugos, windsp, rmu0, fder, tsurf_in, &
12       itime, dtime, jour, knon, knindex, &
13       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15       AcoefU, AcoefV, BcoefU, BcoefV, &
16       ps, u1, v1, rugoro, pctsrf, &
17       snow, qsurf, agesno, &
18       z0_new, alb1_new, alb2_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)        :: rugos
49    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
50    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
51    REAL, DIMENSION(klon), INTENT(IN)        :: fder
52    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
53    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
54    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
55    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
56    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
57    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
58    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
59    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
60    REAL, DIMENSION(klon), INTENT(IN)        :: ps
61    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
62    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
63    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
64
65! In/Output variables
66!****************************************************************************************
67    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
68    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
69    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
70
71! Output variables
72!****************************************************************************************
73    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
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(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
77    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
78    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
79    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
80    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
81
82! Local variables
83!****************************************************************************************
84    INTEGER               :: i
85    REAL                  :: tmp
86    REAL, PARAMETER       :: cepdu2=(0.1)**2
87    REAL, DIMENSION(klon) :: alb_eau
88    REAL, DIMENSION(klon) :: radsol
89
90! End definition
91!****************************************************************************************
92
93
94!****************************************************************************************
95! Calculate total net radiance at surface
96!
97!****************************************************************************************
98    radsol(:) = 0.0
99    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
100
101!****************************************************************************************
102! Switch according to type of ocean (couple, slab or forced)
103!****************************************************************************************
104    SELECT CASE(type_ocean)
105    CASE('couple')
106       CALL ocean_cpl_noice( &
107            swnet, lwnet, alb1, &
108            windsp, fder, &
109            itime, dtime, knon, knindex, &
110            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
111            AcoefH, AcoefQ, BcoefH, BcoefQ, &
112            AcoefU, AcoefV, BcoefU, BcoefV, &
113            ps, u1, v1, &
114            radsol, snow, agesno, &
115            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
116            tsurf_new, dflux_s, dflux_l)
117
118    CASE('slab')
119       CALL ocean_slab_noice( &
120            itime, dtime, jour, knon, knindex, &
121            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
122            AcoefH, AcoefQ, BcoefH, BcoefQ, &
123            AcoefU, AcoefV, BcoefU, BcoefV, &
124            ps, u1, v1, tsurf_in, &
125            radsol, snow, agesno, &
126            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
127            tsurf_new, dflux_s, dflux_l, lmt_bils)
128       
129    CASE('force')
130       CALL ocean_forced_noice( &
131            itime, dtime, jour, knon, knindex, &
132            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
133            temp_air, spechum, &
134            AcoefH, AcoefQ, BcoefH, BcoefQ, &
135            AcoefU, AcoefV, BcoefU, BcoefV, &
136            ps, u1, v1, &
137            radsol, snow, agesno, &
138            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
139            tsurf_new, dflux_s, dflux_l)
140    END SELECT
141
142!****************************************************************************************
143! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
144!****************************************************************************************
145    IF (type_ocean.NE.'slab') THEN
146        lmt_bils(:)=0.
147        DO i=1,knon
148           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
149           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
150        END DO
151    END IF
152
153!****************************************************************************************
154! Calculate albedo
155!
156!****************************************************************************************
157    IF (cycle_diurne) THEN
158       CALL alboc_cd(rmu0,alb_eau)
159    ELSE
160       CALL alboc(REAL(jour),rlat,alb_eau)
161    ENDIF
162
163    DO i =1, knon
164       alb1_new(i) = alb_eau(knindex(i))
165    ENDDO
166    alb2_new(1:knon) = alb1_new(1:knon)
167
168!****************************************************************************************
169! Calculate the rugosity
170!
171!****************************************************************************************
172    DO i = 1, knon
173       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
174       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
175            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
176       z0_new(i) = MAX(1.5e-05,z0_new(i))
177    ENDDO   
178!
179!****************************************************************************************
180!   
181  END SUBROUTINE surf_ocean
182!
183!****************************************************************************************
184!
185END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.