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

Last change on this file since 2394 was 2391, checked in by Ehouarn Millour, 9 years ago

Fix some minor anomalies spotted by the xlf compiler:

  • infotrac : wrongly giving integer values to logicals
  • surf_ocean_mod and yamada_c : should be a space between "stop" and message; but avoid using stop, use abort_physic routine instead.
  • readchlorophyll: using isnan() is not standard; compare the variable to itself instead (will return .false. if NaN).

While at it, also added some missing "only" clauses when using modules.

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