source: LMDZ6/trunk/libf/phylmdiso/surf_seaice_mod.F90 @ 4096

Last change on this file since 4096 was 3940, checked in by crisi, 3 years ago

replace files by symbloic liks from phylmdiso towards phylmd.
Many files at once
File size: 8.2 KB
Line 
1!
2! $Id: surf_seaice_mod.F90 3102 2017-12-03 20:27:42Z oboucher $
3!
4MODULE surf_seaice_mod
5
6  IMPLICIT NONE
7
8CONTAINS
9!
10!****************************************************************************************
11!
12  SUBROUTINE surf_seaice( &
13       rlon, rlat, swnet, lwnet, alb1, fder, &
14       itime, dtime, jour, knon, knindex, &
15       lafin, &
16       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
17       AcoefH, AcoefQ, BcoefH, BcoefQ, &
18       AcoefU, AcoefV, BcoefU, BcoefV, &
19       ps, u1, v1, gustiness, pctsrf, &
20       snow, qsurf, qsol, agesno, tsoil, &
21       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
22       tsurf_new, dflux_s, dflux_l, &
23       flux_u1, flux_v1 &
24#ifdef ISO
25         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
26         &      xtsnow,xtsol,xtevap,Rland_ice &
27#endif               
28         &      )
29
30  USE dimphy
31  USE surface_data
32  USE ocean_forced_mod, ONLY : ocean_forced_ice
33  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
34  USE ocean_slab_mod, ONLY   : ocean_slab_ice
35  USE indice_sol_mod
36#ifdef ISO
37  USE infotrac_phy, ONLY : ntraciso,niso
38#endif
39
40!
41! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
42! slab or couple). The calculation of rugosity for the sea-ice surface is also done
43! in here because it is the same calculation for the different modes of ocean.
44!
45    INCLUDE "dimsoil.h"
46    INCLUDE "clesphys.h"
47
48    INCLUDE "YOMCST.h"
49    ! for rd and retv
50
51! Input arguments
52!****************************************************************************************
53    INTEGER, INTENT(IN)                      :: itime, jour, knon
54    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
55    LOGICAL, INTENT(IN)                      :: lafin
56    REAL, INTENT(IN)                         :: dtime
57    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
58    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
59    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
60    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
61    REAL, DIMENSION(klon), INTENT(IN)        :: fder
62    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf
63    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
64    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
65    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
66    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
67    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
68    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
69    REAL, DIMENSION(klon), INTENT(IN)        :: ps
70    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
71    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
72#ifdef ISO
73    REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
74    REAL, DIMENSION(klon), INTENT(IN)        :: xtspechum
75    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Roce
76    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
77#endif
78
79! In/Output arguments
80!****************************************************************************************
81    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsurf, qsol
82    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
83    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
84#ifdef ISO
85    REAL, DIMENSION(niso,klon), INTENT(INOUT)        :: xtsnow 
86    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol
87#endif
88
89! Output arguments
90!****************************************************************************************
91    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
92!albedo SB >>>
93!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
94!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
95    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
96    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
97!albedo SB <<<
98    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
99    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
100    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
101    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
102#ifdef ISO
103    REAL, DIMENSION(ntraciso,klon), INTENT(OUT)        :: xtevap 
104#endif
105
106! Local arguments
107!****************************************************************************************
108    REAL, DIMENSION(klon)  :: radsol
109#ifdef ISO
110#ifdef ISOVERIF
111    integer j
112#endif
113#endif
114
115!albedo SB >>>
116    REAL, DIMENSION(klon) :: alb1_new,alb2_new
117!albedo SB <<<
118
119    real rhoa(knon) ! density of moist air  (kg / m3)
120
121! End definitions
122!****************************************************************************************
123
124
125!****************************************************************************************
126! Calculate total net radiance at surface
127!
128!****************************************************************************************
129    radsol(:) = 0.0
130    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
131
132    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
133
134!****************************************************************************************
135! Switch according to type of ocean (couple, slab or forced)
136!
137!****************************************************************************************
138    IF (type_ocean == 'couple') THEN
139       
140       CALL ocean_cpl_ice( &
141            rlon, rlat, swnet, lwnet, alb1, &
142            fder, &
143            itime, dtime, knon, knindex, &
144            lafin,&
145            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
146            AcoefH, AcoefQ, BcoefH, BcoefQ, &
147            AcoefU, AcoefV, BcoefU, BcoefV, &
148            ps, u1, v1, gustiness, pctsrf, &
149            radsol, snow, qsurf, &
150            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
151            tsurf_new, dflux_s, dflux_l, rhoa)
152       
153    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
154       CALL ocean_slab_ice( &
155          itime, dtime, jour, knon, knindex, &
156          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
157          AcoefH, AcoefQ, BcoefH, BcoefQ, &
158            AcoefU, AcoefV, BcoefU, BcoefV, &
159          ps, u1, v1, gustiness, &
160          radsol, snow, qsurf, qsol, agesno, &
161          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
162          tsurf_new, dflux_s, dflux_l, swnet)
163
164      ELSE ! type_ocean=force or slab +sicOBS or sicNO
165       CALL ocean_forced_ice( &
166            itime, dtime, jour, knon, knindex, &
167            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
168            AcoefH, AcoefQ, BcoefH, BcoefQ, &
169            AcoefU, AcoefV, BcoefU, BcoefV, &
170            ps, u1, v1, gustiness, &
171            radsol, snow, qsol, agesno, tsoil, &
172            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
173            tsurf_new, dflux_s, dflux_l, rhoa &
174#ifdef ISO
175            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
176            xtsnow, xtsol,xtevap,Rland_ice & 
177#endif           
178            )
179
180    END IF
181
182!****************************************************************************************
183! Calculate rugosity
184!
185!****************************************************************************************
186
187    z0m=z0m_seaice
188    z0h = z0h_seaice
189
190!albedo SB >>>
191     select case(NSW)
192     case(2)
193       alb_dir_new(1:knon,1)=alb1_new(1:knon)
194       alb_dir_new(1:knon,2)=alb2_new(1:knon)
195     case(4)
196       alb_dir_new(1:knon,1)=alb1_new(1:knon)
197       alb_dir_new(1:knon,2)=alb2_new(1:knon)
198       alb_dir_new(1:knon,3)=alb2_new(1:knon)
199       alb_dir_new(1:knon,4)=alb2_new(1:knon)
200     case(6)
201       alb_dir_new(1:knon,1)=alb1_new(1:knon)
202       alb_dir_new(1:knon,2)=alb1_new(1:knon)
203       alb_dir_new(1:knon,3)=alb1_new(1:knon)
204       alb_dir_new(1:knon,4)=alb2_new(1:knon)
205       alb_dir_new(1:knon,5)=alb2_new(1:knon)
206       alb_dir_new(1:knon,6)=alb2_new(1:knon)
207     end select
208alb_dif_new=alb_dir_new
209!albedo SB <<<
210
211
212
213
214  END SUBROUTINE surf_seaice
215!
216!****************************************************************************************
217!
218END MODULE surf_seaice_mod
219
Note: See TracBrowser for help on using the repository browser.