source: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_seaice_mod.F90 @ 5411

Last change on this file since 5411 was 5144, checked in by abarral, 5 months ago

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