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

Last change on this file since 3927 was 3927, checked in by Laurent Fairhead, 3 years ago

Initial import of the physics wih isotopes from Camille Risi
CR
File size: 8.0 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! Input arguments
49!****************************************************************************************
50    INTEGER, INTENT(IN)                      :: itime, jour, knon
51    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
52    LOGICAL, INTENT(IN)                      :: lafin
53    REAL, INTENT(IN)                         :: dtime
54    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
55    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
56    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
57    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
58    REAL, DIMENSION(klon), INTENT(IN)        :: fder
59    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf
60    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
61    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
62    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
63    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
64    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
65    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
66    REAL, DIMENSION(klon), INTENT(IN)        :: ps
67    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
68    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
69#ifdef ISO
70    REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
71    REAL, DIMENSION(klon), INTENT(IN)        :: xtspechum
72    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Roce
73    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
74#endif
75
76! In/Output arguments
77!****************************************************************************************
78    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsurf, qsol
79    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
80    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
81#ifdef ISO
82    REAL, DIMENSION(niso,klon), INTENT(INOUT)        :: xtsnow 
83    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol
84#endif
85
86! Output arguments
87!****************************************************************************************
88    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
89!albedo SB >>>
90!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
91!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
92    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
93    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
94!albedo SB <<<
95    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
96    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
97    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
98    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
99#ifdef ISO
100    REAL, DIMENSION(ntraciso,klon), INTENT(OUT)        :: xtevap 
101#endif
102
103! Local arguments
104!****************************************************************************************
105    REAL, DIMENSION(klon)  :: radsol
106#ifdef ISO
107#ifdef ISOVERIF
108    integer j
109#endif
110#endif
111
112!albedo SB >>>
113    REAL, DIMENSION(klon) :: alb1_new,alb2_new
114!albedo SB <<<
115!
116! End definitions
117!****************************************************************************************
118
119
120!****************************************************************************************
121! Calculate total net radiance at surface
122!
123!****************************************************************************************
124    radsol(:) = 0.0
125    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
126
127!****************************************************************************************
128! Switch according to type of ocean (couple, slab or forced)
129!
130!****************************************************************************************
131    IF (type_ocean == 'couple') THEN
132       
133       CALL ocean_cpl_ice( &
134            rlon, rlat, swnet, lwnet, alb1, &
135            fder, &
136            itime, dtime, knon, knindex, &
137            lafin,&
138            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
139            AcoefH, AcoefQ, BcoefH, BcoefQ, &
140            AcoefU, AcoefV, BcoefU, BcoefV, &
141            ps, u1, v1, gustiness, pctsrf, &
142            radsol, snow, qsurf, &
143            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
144            tsurf_new, dflux_s, dflux_l)
145       
146    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
147       CALL ocean_slab_ice( &
148          itime, dtime, jour, knon, knindex, &
149          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
150          AcoefH, AcoefQ, BcoefH, BcoefQ, &
151            AcoefU, AcoefV, BcoefU, BcoefV, &
152          ps, u1, v1, gustiness, &
153          radsol, snow, qsurf, qsol, agesno, &
154          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
155          tsurf_new, dflux_s, dflux_l, swnet)
156
157      ELSE ! type_ocean=force or slab +sicOBS or sicNO
158       CALL ocean_forced_ice( &
159            itime, dtime, jour, knon, knindex, &
160            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
161            AcoefH, AcoefQ, BcoefH, BcoefQ, &
162            AcoefU, AcoefV, BcoefU, BcoefV, &
163            ps, u1, v1, gustiness, &
164            radsol, snow, qsol, agesno, tsoil, &
165            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
166            tsurf_new, dflux_s, dflux_l &
167#ifdef ISO
168            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
169            xtsnow, xtsol,xtevap,Rland_ice & 
170#endif           
171            )
172
173    END IF
174
175!****************************************************************************************
176! Calculate rugosity
177!
178!****************************************************************************************
179
180    z0m=z0m_seaice
181    z0h = z0h_seaice
182
183!albedo SB >>>
184     select case(NSW)
185     case(2)
186       alb_dir_new(1:knon,1)=alb1_new(1:knon)
187       alb_dir_new(1:knon,2)=alb2_new(1:knon)
188     case(4)
189       alb_dir_new(1:knon,1)=alb1_new(1:knon)
190       alb_dir_new(1:knon,2)=alb2_new(1:knon)
191       alb_dir_new(1:knon,3)=alb2_new(1:knon)
192       alb_dir_new(1:knon,4)=alb2_new(1:knon)
193     case(6)
194       alb_dir_new(1:knon,1)=alb1_new(1:knon)
195       alb_dir_new(1:knon,2)=alb1_new(1:knon)
196       alb_dir_new(1:knon,3)=alb1_new(1:knon)
197       alb_dir_new(1:knon,4)=alb2_new(1:knon)
198       alb_dir_new(1:knon,5)=alb2_new(1:knon)
199       alb_dir_new(1:knon,6)=alb2_new(1:knon)
200     end select
201alb_dif_new=alb_dir_new
202!albedo SB <<<
203
204
205
206
207  END SUBROUTINE surf_seaice
208!
209!****************************************************************************************
210!
211END MODULE surf_seaice_mod
212
Note: See TracBrowser for help on using the repository browser.