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

Last change on this file since 4033 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
RevLine 
[3927]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
[3940]48    INCLUDE "YOMCST.h"
49    ! for rd and retv
50
[3927]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 <<<
[3940]118
119    real rhoa(knon) ! density of moist air  (kg / m3)
120
[3927]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
[3940]132    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
133
[3927]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, &
[3940]151            tsurf_new, dflux_s, dflux_l, rhoa)
[3927]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, &
[3940]173            tsurf_new, dflux_s, dflux_l, rhoa &
[3927]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.