source: LMDZ6/trunk/libf/phylmd/surf_seaice_mod.F90 @ 5449

Last change on this file since 5449 was 5285, checked in by abarral, 8 weeks ago

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