source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/surf_ocean_mod.F90 @ 3496

Last change on this file since 3496 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: 7.1 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! Input variables
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)        :: rlon, rlat
42    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
43    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
44    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
45    REAL, DIMENSION(klon), INTENT(IN)        :: rugos
46    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
47    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
48    REAL, DIMENSION(klon), INTENT(IN)        :: fder
49    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
50    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
51    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
52    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
53    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
54    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
55    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
56    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
57    REAL, DIMENSION(klon), INTENT(IN)        :: ps
58    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
59    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
60    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
61
62! In/Output variables
63!****************************************************************************************
64    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
65    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
66    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
67
68! Output variables
69!****************************************************************************************
70    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
71    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
72    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
73    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
74    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
75    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
76    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
77    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
78
79! Local variables
80!****************************************************************************************
81    INTEGER               :: i
82    REAL                  :: tmp
83    REAL, PARAMETER       :: cepdu2=(0.1)**2
84    REAL, DIMENSION(klon) :: alb_eau
85    REAL, DIMENSION(klon) :: radsol
86
87! End definition
88!****************************************************************************************
89
90
91!****************************************************************************************
92! Calculate total net radiance at surface
93!
94!****************************************************************************************
95    radsol(:) = 0.0
96    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
97
98!****************************************************************************************
99! Switch according to type of ocean (couple, slab or forced)
100!****************************************************************************************
101    SELECT CASE(type_ocean)
102    CASE('couple')
103       CALL ocean_cpl_noice( &
104            swnet, lwnet, alb1, &
105            windsp, fder, &
106            itime, dtime, knon, knindex, &
107            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
108            AcoefH, AcoefQ, BcoefH, BcoefQ, &
109            AcoefU, AcoefV, BcoefU, BcoefV, &
110            ps, u1, v1, &
111            radsol, snow, agesno, &
112            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
113            tsurf_new, dflux_s, dflux_l)
114
115    CASE('slab')
116       CALL ocean_slab_noice( &
117            itime, dtime, jour, knon, knindex, &
118            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
119            AcoefH, AcoefQ, BcoefH, BcoefQ, &
120            AcoefU, AcoefV, BcoefU, BcoefV, &
121            ps, u1, v1, tsurf_in, &
122            radsol, snow, agesno, &
123            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
124            tsurf_new, dflux_s, dflux_l, lmt_bils)
125       
126    CASE('force')
127       CALL ocean_forced_noice( &
128            itime, dtime, jour, knon, knindex, &
129            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
130            temp_air, spechum, &
131            AcoefH, AcoefQ, BcoefH, BcoefQ, &
132            AcoefU, AcoefV, BcoefU, BcoefV, &
133            ps, u1, v1, &
134            radsol, snow, agesno, &
135            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
136            tsurf_new, dflux_s, dflux_l)
137    END SELECT
138
139!****************************************************************************************
140! Calculate albedo
141!
142!****************************************************************************************
143    IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
144       CALL alboc(REAL(jour),rlat,alb_eau)
145    ELSE  ! diurnal cycle
146       CALL alboc_cd(rmu0,alb_eau)
147    ENDIF
148
149    DO i =1, knon
150       alb1_new(i) = alb_eau(knindex(i))
151    ENDDO
152    alb2_new(1:knon) = alb1_new(1:knon)
153
154!****************************************************************************************
155! Calculate the rugosity
156!
157!****************************************************************************************
158    DO i = 1, knon
159       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
160       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
161            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
162       z0_new(i) = MAX(1.5e-05,z0_new(i))
163    ENDDO   
164!
165!****************************************************************************************
166!   
167  END SUBROUTINE surf_ocean
168!
169!****************************************************************************************
170!
171END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.