source: LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/surf_seaice_mod.F90 @ 5889

Last change on this file since 5889 was 5889, checked in by yann meurdesoif, 6 weeks ago

GPU port of surf_seaice

YM
  • 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: 14.3 KB
Line 
1!
2! $Id: surf_seaice_mod.F90 5889 2025-11-27 17:44:57Z ymeurdesoif $
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!GG       flux_u1, flux_v1)
24       flux_u1, flux_v1, hice, tice,bilg_cumul, &
25       fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, &
26       dtice_melt, dtice_snow2sic &
27!GG
28#ifdef ISO
29         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
30         &      xtsnow,xtsol,xtevap,Rland_ice &
31#endif               
32         &      )
33!$gpum horizontal knon klon
34
35  USE dimphy
36  USE surface_data
37  USE ocean_forced_mod, ONLY : ocean_forced_ice
38  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
39  USE ocean_slab_mod, ONLY   : ocean_slab_ice
40  USE indice_sol_mod
41#ifdef ISO
42  USE infotrac_phy, ONLY : ntiso,niso
43#endif
44  USE clesphys_mod_h
45    USE yomcst_mod_h
46USE dimsoil_mod_h, ONLY: nsoilmx
47USE print_control_mod, ONLY: lunout
48USE lmdz_checksum
49USE mod_phys_lmdz_para, ONLY : is_master
50
51!
52! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
53! slab or couple). The calculation of rugosity for the sea-ice surface is also done
54! in here because it is the same calculation for the different modes of ocean.
55!
56
57
58    ! for rd and retv
59
60! Input arguments
61!****************************************************************************************
62    INTEGER, INTENT(IN)                      :: itime, jour, knon
63    INTEGER, DIMENSION(knon), INTENT(IN)     :: knindex
64    LOGICAL, INTENT(IN)                      :: lafin
65    REAL, INTENT(IN)                         :: dtime
66    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
67    REAL, DIMENSION(knon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
68    REAL, DIMENSION(knon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
69    REAL, DIMENSION(knon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
70    REAL, DIMENSION(knon), INTENT(IN)        :: fder
71    REAL, DIMENSION(knon), INTENT(IN)        :: tsurf
72    REAL, DIMENSION(knon), INTENT(IN)        :: p1lay
73    REAL, DIMENSION(knon), INTENT(IN)        :: cdragh, cdragm
74    REAL, DIMENSION(knon), INTENT(IN)        :: precip_rain, precip_snow
75    REAL, DIMENSION(knon), INTENT(IN)        :: temp_air, spechum
76    REAL, DIMENSION(knon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
77    REAL, DIMENSION(knon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
78    REAL, DIMENSION(knon), INTENT(IN)        :: ps
79    REAL, DIMENSION(knon), INTENT(IN)        :: u1, v1, gustiness
80    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
81#ifdef ISO
82    REAL, DIMENSION(ntiso,knon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
83    REAL, DIMENSION(knon),       INTENT(IN)  :: xtspechum
84    REAL, DIMENSION(niso,knon),  INTENT(IN)  :: Roce
85    REAL, DIMENSION(niso,knon),  INTENT(IN)  :: Rland_ice
86#endif
87
88! In/Output arguments
89!****************************************************************************************
90    REAL, DIMENSION(knon), INTENT(INOUT)          :: snow, qsurf, qsol
91    REAL, DIMENSION(knon), INTENT(INOUT)          :: agesno
92    REAL, DIMENSION(knon, nsoilmx), INTENT(INOUT) :: tsoil
93#ifdef ISO
94    REAL, DIMENSION(niso,knon), INTENT(INOUT)     :: xtsnow 
95    REAL, DIMENSION(niso,knon), INTENT(IN)        :: xtsol
96#endif
97
98! Output arguments
99!****************************************************************************************
100    REAL, DIMENSION(knon), INTENT(OUT)       :: z0m, z0h
101!albedo SB >>>
102!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
103!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
104    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
105    REAL, DIMENSION(knon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
106!albedo SB <<<
107    REAL, DIMENSION(knon), INTENT(OUT)       :: evap, fluxsens, fluxlat
108    REAL, DIMENSION(knon), INTENT(OUT)       :: tsurf_new
109    REAL, DIMENSION(knon), INTENT(OUT)       :: dflux_s, dflux_l     
110    REAL, DIMENSION(knon), INTENT(OUT)       :: flux_u1, flux_v1
111!GG
112    REAL, DIMENSION(klon), INTENT(INOUT)       :: hice, tice, bilg_cumul     !ym WARNING uncompressed
113    REAL, DIMENSION(klon), INTENT(INOUT)       :: fcds,fcdi, dh_basal_growth,dh_basal_melt !ym WARNING uncompressed
114    REAL, DIMENSION(klon), INTENT(INOUT)       :: dh_top_melt, dh_snow2sic, dtice_melt, dtice_snow2sic !ym WARNING uncompressed
115!GG
116#ifdef ISO
117    REAL, DIMENSION(ntiso,knon), INTENT(OUT) :: xtevap
118#endif
119
120! Local arguments
121!****************************************************************************************
122    REAL, DIMENSION(knon)  :: radsol
123#ifdef ISO
124#ifdef ISOVERIF
125    INTEGER :: j
126#endif
127#endif
128
129!albedo SB >>>
130    REAL, DIMENSION(knon) :: alb1_new,alb2_new
131!albedo SB <<<
132
133    real rhoa(knon) ! density of moist air  (kg / m3)
134
135! End definitions
136!****************************************************************************************
137
138
139!****************************************************************************************
140! Calculate total net radiance at surface
141!
142!****************************************************************************************
143    radsol(:) = 0.0
144    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
145
146    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
147
148!****************************************************************************************
149! Switch according to type of ocean (couple, slab or forced)
150!
151!****************************************************************************************
152    IF (type_ocean == 'couple') THEN
153!$gpum nocall       
154       CALL ocean_cpl_ice( &
155            rlon, rlat, swnet, lwnet, alb1, &
156            fder, &
157            itime, dtime, knon, knindex, &
158            lafin,&
159            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
160            AcoefH, AcoefQ, BcoefH, BcoefQ, &
161            AcoefU, AcoefV, BcoefU, BcoefV, &
162            ps, u1, v1, gustiness, pctsrf, &
163            radsol, snow, qsurf, &
164            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
165            tsurf_new, dflux_s, dflux_l, rhoa)
166       
167    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
168!$gpum nocall 
169       CALL ocean_slab_ice( &
170          itime, dtime, jour, knon, knindex, &
171          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
172          AcoefH, AcoefQ, BcoefH, BcoefQ, &
173            AcoefU, AcoefV, BcoefU, BcoefV, &
174          ps, u1, v1, gustiness, &
175          radsol, snow, qsurf, qsol, agesno, &
176          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
177          tsurf_new, dflux_s, dflux_l, swnet)
178
179      ELSE ! type_ocean=force or slab +sicOBS or sicNO
180
181       IF (is_master) WRITE(lunout,*) "******* CHECKSUM  ==> ocean_forced IN *******"
182!$gpum nocall checksum
183       CALL checksum("itime", itime)
184       CALL checksum("dtime", dtime)
185       CALL checksum("jour", jour)
186       CALL checksum("knon", knon)
187       CALL checksum("knindex", knindex(1:knon))
188       CALL checksum("tsurf", tsurf(1:knon))
189       CALL checksum("p1lay", p1lay(1:knon))
190       CALL checksum("cdragh", cdragh(1:knon))
191       CALL checksum("cdragm", cdragm(1:knon))
192       CALL checksum("precip_rain", precip_rain(1:knon))
193       CALL checksum("precip_snow", precip_snow(1:knon))
194       CALL checksum("temp_air", temp_air(1:knon))
195       CALL checksum("spechum", spechum(1:knon))
196       CALL checksum("AcoefH", AcoefH(1:knon))
197       CALL checksum("AcoefQ", AcoefQ(1:knon))
198       CALL checksum("BcoefH", BcoefH(1:knon))
199       CALL checksum("BcoefQ", BcoefQ(1:knon))
200       CALL checksum("AcoefU", AcoefU(1:knon))
201       CALL checksum("AcoefV", AcoefV(1:knon))
202       CALL checksum("BcoefU", BcoefU(1:knon))
203       CALL checksum("BcoefV", BcoefV(1:knon))
204       CALL checksum("ps", ps(1:knon))
205       CALL checksum("u1", u1(1:knon))
206       CALL checksum("v1", v1(1:knon))
207       CALL checksum("gustiness", gustiness(1:knon))
208       CALL checksum("pctsrf", pctsrf)
209       CALL checksum("radsol", radsol(1:knon))
210       CALL checksum("snow", snow(1:knon))
211       CALL checksum("qsol", qsol(1:knon))
212       CALL checksum("agesno", agesno(1:knon))
213       CALL checksum("tsoil", tsoil(1:knon,:))
214       CALL checksum("qsurf", qsurf(1:knon))
215       CALL checksum("alb1_new", alb1_new(1:knon))
216       CALL checksum("alb2_new", alb2_new(1:knon))
217       CALL checksum("evap", evap(1:knon))
218       CALL checksum("fluxsens", fluxsens(1:knon))
219       CALL checksum("fluxlat", fluxlat(1:knon))
220       CALL checksum("flux_u1", flux_u1(1:knon))
221       CALL checksum("flux_v1", flux_v1(1:knon))
222       CALL checksum("tsurf_new", tsurf_new(1:knon))
223       CALL checksum("dflux_s", dflux_s(1:knon))
224       CALL checksum("dflux_l", dflux_l(1:knon))
225       CALL checksum("rhoa", rhoa(1:knon))
226       CALL checksum("swnet", swnet(1:knon))
227       CALL checksum("hice", hice)
228       CALL checksum("tice", tice)
229       CALL checksum("bilg_cumul", bilg_cumul)
230       CALL checksum("fcds", fcds)
231       CALL checksum("fcdi", fcdi)
232       CALL checksum("dh_basal_growth", dh_basal_growth)
233       CALL checksum("dh_basal_melt", dh_basal_melt)
234       CALL checksum("dh_top_melt", dh_top_melt)
235       CALL checksum("dh_snow2sic", dh_snow2sic)
236       CALL checksum("dtice_melt", dtice_melt)
237       CALL checksum("dtice_snow2sic", dtice_snow2sic)
238       CALL ocean_forced_ice( &
239            itime, dtime, jour, knon, knindex, &
240            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
241            AcoefH, AcoefQ, BcoefH, BcoefQ, &
242            AcoefU, AcoefV, BcoefU, BcoefV, &
243!GG            ps, u1, v1, gustiness, &
244            ps, u1, v1, gustiness,pctsrf, &
245!GG
246            radsol, snow, qsol, agesno, tsoil, &
247            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
248!GG            tsurf_new, dflux_s, dflux_l, rhoa)
249            tsurf_new, dflux_s, dflux_l,rhoa,swnet,hice, tice, bilg_cumul, &
250            fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, &
251            dtice_melt, dtice_snow2sic &
252!GG
253#ifdef ISO
254            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
255            xtsnow, xtsol,xtevap,Rland_ice & 
256#endif           
257            )
258       IF (is_master) WRITE(lunout,*) "******* CHECKSUM  ==> ocean_forced OUT *******"
259       CALL checksum("itime", itime)
260       CALL checksum("dtime", dtime)
261       CALL checksum("jour", jour)
262       CALL checksum("knon", knon)
263       CALL checksum("knindex", knindex(1:knon))
264       CALL checksum("tsurf", tsurf(1:knon))
265       CALL checksum("p1lay", p1lay(1:knon))
266       CALL checksum("cdragh", cdragh(1:knon))
267       CALL checksum("cdragm", cdragm(1:knon))
268       CALL checksum("precip_rain", precip_rain(1:knon))
269       CALL checksum("precip_snow", precip_snow(1:knon))
270       CALL checksum("temp_air", temp_air(1:knon))
271       CALL checksum("spechum", spechum(1:knon))
272       CALL checksum("AcoefH", AcoefH(1:knon))
273       CALL checksum("AcoefQ", AcoefQ(1:knon))
274       CALL checksum("BcoefH", BcoefH(1:knon))
275       CALL checksum("BcoefQ", BcoefQ(1:knon))
276       CALL checksum("AcoefU", AcoefU(1:knon))
277       CALL checksum("AcoefV", AcoefV(1:knon))
278       CALL checksum("BcoefU", BcoefU(1:knon))
279       CALL checksum("BcoefV", BcoefV(1:knon))
280       CALL checksum("ps", ps(1:knon))
281       CALL checksum("u1", u1(1:knon))
282       CALL checksum("v1", v1(1:knon))
283       CALL checksum("gustiness", gustiness(1:knon))
284       CALL checksum("pctsrf", pctsrf)
285       CALL checksum("radsol", radsol(1:knon))
286       CALL checksum("snow", snow(1:knon))
287       CALL checksum("qsol", qsol(1:knon))
288       CALL checksum("agesno", agesno(1:knon))
289       CALL checksum("tsoil", tsoil(1:knon,:))
290       CALL checksum("qsurf", qsurf(1:knon))
291       CALL checksum("alb1_new", alb1_new(1:knon))
292       CALL checksum("alb2_new", alb2_new(1:knon))
293       CALL checksum("evap", evap(1:knon))
294       CALL checksum("fluxsens", fluxsens(1:knon))
295       CALL checksum("fluxlat", fluxlat(1:knon))
296       CALL checksum("flux_u1", flux_u1(1:knon))
297       CALL checksum("flux_v1", flux_v1(1:knon))
298       CALL checksum("tsurf_new", tsurf_new(1:knon))
299       CALL checksum("dflux_s", dflux_s(1:knon))
300       CALL checksum("dflux_l", dflux_l(1:knon))
301       CALL checksum("rhoa", rhoa(1:knon))
302       CALL checksum("swnet", swnet(1:knon))
303       CALL checksum("hice", hice)
304       CALL checksum("tice", tice)
305       CALL checksum("bilg_cumul", bilg_cumul)
306       CALL checksum("fcds", fcds)
307       CALL checksum("fcdi", fcdi)
308       CALL checksum("dh_basal_growth", dh_basal_growth)
309       CALL checksum("dh_basal_melt", dh_basal_melt)
310       CALL checksum("dh_top_melt", dh_top_melt)
311       CALL checksum("dh_snow2sic", dh_snow2sic)
312       CALL checksum("dtice_melt", dtice_melt)
313       CALL checksum("dtice_snow2sic", dtice_snow2sic)
314       IF (is_master) WRITE(lunout,*) "******* CHECKSUM **************************"
315
316    END IF
317
318!****************************************************************************************
319! Calculate rugosity
320!
321!****************************************************************************************
322
323    z0m=z0m_seaice
324    z0h = z0h_seaice
325
326!albedo SB >>>
327     select case(NSW)
328     case(2)
329       alb_dir_new(1:knon,1)=alb1_new(1:knon)
330       alb_dir_new(1:knon,2)=alb2_new(1:knon)
331     case(4)
332       alb_dir_new(1:knon,1)=alb1_new(1:knon)
333       alb_dir_new(1:knon,2)=alb2_new(1:knon)
334       alb_dir_new(1:knon,3)=alb2_new(1:knon)
335       alb_dir_new(1:knon,4)=alb2_new(1:knon)
336     case(6)
337       alb_dir_new(1:knon,1)=alb1_new(1:knon)
338       alb_dir_new(1:knon,2)=alb1_new(1:knon)
339       alb_dir_new(1:knon,3)=alb1_new(1:knon)
340       alb_dir_new(1:knon,4)=alb2_new(1:knon)
341       alb_dir_new(1:knon,5)=alb2_new(1:knon)
342       alb_dir_new(1:knon,6)=alb2_new(1:knon)
343     end select
344alb_dif_new=alb_dir_new
345!albedo SB <<<
346
347
348
349
350  END SUBROUTINE surf_seaice
351!
352!****************************************************************************************
353!
354END MODULE surf_seaice_mod
355
Note: See TracBrowser for help on using the repository browser.