source: lmdz_wrf/trunk/WRFV3/lmdz/surf_ocean_mod.F90 @ 354

Last change on this file since 354 was 186, checked in by lfita, 10 years ago

Removing checking printings
  • Property svn:executable set to *
File size: 7.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       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! Lluis
88    INTEGER                                              :: lp
89
90    lp = 498
91
92! End definition
93!****************************************************************************************
94
95
96!****************************************************************************************
97! Calculate total net radiance at surface
98!
99!****************************************************************************************
100    radsol(:) = 0.0
101    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
102
103!****************************************************************************************
104! Switch according to type of ocean (couple, slab or forced)
105!****************************************************************************************
106    SELECT CASE(type_ocean)
107    CASE('couple')
108       CALL ocean_cpl_noice( &
109            swnet, lwnet, alb1, &
110            windsp, fder, &
111            itime, dtime, knon, knindex, &
112            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
113            AcoefH, AcoefQ, BcoefH, BcoefQ, &
114            AcoefU, AcoefV, BcoefU, BcoefV, &
115            ps, u1, v1, &
116            radsol, snow, agesno, &
117            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
118            tsurf_new, dflux_s, dflux_l)
119
120    CASE('slab')
121       CALL ocean_slab_noice( &
122            itime, dtime, jour, knon, knindex, &
123            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
124            AcoefH, AcoefQ, BcoefH, BcoefQ, &
125            AcoefU, AcoefV, BcoefU, BcoefV, &
126            ps, u1, v1, tsurf_in, &
127            radsol, snow, agesno, &
128            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
129            tsurf_new, dflux_s, dflux_l, lmt_bils)
130       
131    CASE('force')
132
133       CALL ocean_forced_noice( &
134            itime, dtime, jour, knon, knindex, &
135            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
136            temp_air, spechum, &
137            AcoefH, AcoefQ, BcoefH, BcoefQ, &
138            AcoefU, AcoefV, BcoefU, BcoefV, &
139            ps, u1, v1, &
140            radsol, snow, agesno, &
141            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
142            tsurf_new, dflux_s, dflux_l)
143    END SELECT
144
145!****************************************************************************************
146! Calculate albedo
147!
148!****************************************************************************************
149    IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
150       CALL alboc(REAL(jour),rlat,alb_eau)
151    ELSE  ! diurnal cycle
152       CALL alboc_cd(rmu0,alb_eau)
153    ENDIF
154
155    DO i =1, knon
156       alb1_new(i) = alb_eau(knindex(i))
157    ENDDO
158    alb2_new(1:knon) = alb1_new(1:knon)
159
160!****************************************************************************************
161! Calculate the rugosity
162!
163!****************************************************************************************
164    DO i = 1, knon
165       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
166       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
167            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
168       z0_new(i) = MAX(1.5e-05,z0_new(i))
169    ENDDO   
170!
171!****************************************************************************************
172!   
173  END SUBROUTINE surf_ocean
174!
175!****************************************************************************************
176!
177END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.