source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/surf_ocean_mod.F90 @ 3983

Last change on this file since 3983 was 3809, checked in by ymipsl, 10 years ago

Add LMDZ in aquaplanet configuration
YM
  • Property svn:executable set to *
File size: 8.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, 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
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
93! End definition
94!****************************************************************************************
95
96
97!****************************************************************************************
98! Calculate total net radiance at surface
99!
100!****************************************************************************************
101    radsol(:) = 0.0
102    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
103
104!****************************************************************************************
105! Switch according to type of ocean (couple, slab or forced)
106!****************************************************************************************
107    SELECT CASE(type_ocean)
108    CASE('couple')
109       CALL ocean_cpl_noice( &
110            swnet, lwnet, alb1, &
111            windsp, fder, &
112            itime, dtime, knon, knindex, &
113            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
114            AcoefH, AcoefQ, BcoefH, BcoefQ, &
115            AcoefU, AcoefV, BcoefU, BcoefV, &
116            ps, u1, v1, gustiness, &
117            radsol, snow, agesno, &
118            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
119            tsurf_new, dflux_s, dflux_l)
120
121    CASE('slab')
122       CALL ocean_slab_noice( &
123            itime, dtime, jour, knon, knindex, &
124            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
125            AcoefH, AcoefQ, BcoefH, BcoefQ, &
126            AcoefU, AcoefV, BcoefU, BcoefV, &
127            ps, u1, v1, gustiness, tsurf_in, &
128            radsol, snow, &
129            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
130            tsurf_new, dflux_s, dflux_l, lmt_bils)
131       
132    CASE('force')
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, gustiness, &
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! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
147!****************************************************************************************
148    IF (type_ocean.NE.'slab') THEN
149        lmt_bils(:)=0.
150        DO i=1,knon
151           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
152           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
153        END DO
154    END IF
155
156!****************************************************************************************
157! Calculate albedo
158!
159!****************************************************************************************
160!albedo SB >>>
161
162
163  if(iflag_albedo==1)then
164    call ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
165  else
166    IF (cycle_diurne) THEN
167       CALL alboc_cd(rmu0,alb_eau)
168    ELSE
169       CALL alboc(REAL(jour),rlat,alb_eau)
170    ENDIF
171
172    DO i =1, knon
173      do  k=1,nsw
174       alb_dir_new(i,k) = alb_eau(knindex(i))
175      enddo
176    ENDDO
177     alb_dif_new=0.05 !alb_dir_new
178endif
179
180!albedo SB <<<
181
182!****************************************************************************************
183! Calculate the rugosity
184!
185!****************************************************************************************
186IF (iflag_z0_oce==0) THEN
187    DO i = 1, knon
188       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
189       z0m(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
190            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
191       z0m(i) = MAX(1.5e-05,z0m(i))
192    ENDDO   
193    z0h(1:knon)=z0m(1:knon) ! En attendant mieux
194
195ELSE
196       STOP'Alina, au boulot :)'
197ENDIF
198!
199!****************************************************************************************
200!   
201  END SUBROUTINE surf_ocean
202!
203!****************************************************************************************
204!
205END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.