1 | MODULE sbcabl |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE sbcabl *** |
---|
4 | !! Ocean forcing: momentum, heat and freshwater flux formulation |
---|
5 | !! derived from an ABL model |
---|
6 | !!===================================================================== |
---|
7 | !! History : 4.0 ! 2019-03 (F. Lemarié & G. Samson) Original code |
---|
8 | !!---------------------------------------------------------------------- |
---|
9 | |
---|
10 | !!---------------------------------------------------------------------- |
---|
11 | !! sbc_abl_init : Initialization of ABL model based on namelist options |
---|
12 | !! sbc_abl : driver for the computation of momentum, heat and freshwater |
---|
13 | !! fluxes over ocean via the ABL model |
---|
14 | !!---------------------------------------------------------------------- |
---|
15 | USE abl ! ABL |
---|
16 | USE par_abl ! abl parameters |
---|
17 | USE ablmod |
---|
18 | |
---|
19 | USE phycst ! physical constants |
---|
20 | USE fldread ! read input fields |
---|
21 | USE sbc_oce ! Surface boundary condition: ocean fields |
---|
22 | USE sbcblk ! Surface boundary condition: bulk formulae |
---|
23 | USE dom_oce, ONLY : tmask |
---|
24 | ! |
---|
25 | USE iom ! I/O manager library |
---|
26 | USE in_out_manager ! I/O manager |
---|
27 | USE lib_mpp ! distribued memory computing library |
---|
28 | USE lib_fortran ! to use key_nosignedzero |
---|
29 | USE timing ! Timing |
---|
30 | USE lbclnk ! ocean lateral boundary conditions (or mpp link) |
---|
31 | USE prtctl ! Print control |
---|
32 | #if defined key_si3 |
---|
33 | USE ice , ONLY : u_ice, v_ice, tm_su, ato_i ! ato_i = total open water fractional area |
---|
34 | USE sbc_ice, ONLY : wndm_ice, utau_ice, vtau_ice |
---|
35 | #endif |
---|
36 | #if ! defined key_iomput |
---|
37 | USE diawri , ONLY : dia_wri_alloc_abl |
---|
38 | #endif |
---|
39 | IMPLICIT NONE |
---|
40 | PRIVATE |
---|
41 | |
---|
42 | PUBLIC sbc_abl_init ! routine called in sbcmod module |
---|
43 | PUBLIC sbc_abl ! routine called in sbcmod module |
---|
44 | |
---|
45 | !! * Substitutions |
---|
46 | # include "vectopt_loop_substitute.h90" |
---|
47 | !!---------------------------------------------------------------------- |
---|
48 | !! NEMO/OPA 3.7 , NEMO-consortium (2014) |
---|
49 | !! $Id: sbcabl.F90 6416 2016-04-01 12:22:17Z clem $ |
---|
50 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
51 | !!---------------------------------------------------------------------- |
---|
52 | CONTAINS |
---|
53 | |
---|
54 | SUBROUTINE sbc_abl_init |
---|
55 | !!--------------------------------------------------------------------- |
---|
56 | !! *** ROUTINE sbc_abl_init *** |
---|
57 | !! |
---|
58 | !! ** Purposes : - read namelist section namsbc_abl |
---|
59 | !! - initialize and check parameter values |
---|
60 | !! - initialize variables of ABL model |
---|
61 | !! |
---|
62 | !!---------------------------------------------------------------------- |
---|
63 | INTEGER :: ji, jj, jk, jbak, jbak_dta ! dummy loop indices |
---|
64 | INTEGER :: ios, ierror, ioptio ! Local integer |
---|
65 | INTEGER :: inum, indims, idimsz(4), id |
---|
66 | CHARACTER(len=100) :: cn_dir, cn_dom ! Atmospheric grid directory |
---|
67 | REAL(wp) :: zcff,zcff1 |
---|
68 | LOGICAL :: lluldl |
---|
69 | NAMELIST/namsbc_abl/ cn_dir , cn_dom, ln_hpgls_frc, ln_geos_winds, & |
---|
70 | & nn_dyn_restore, & |
---|
71 | & rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max, & |
---|
72 | & nn_amxl, rn_cm, rn_ct, rn_ce, rn_ceps, rn_Rod, rn_Ric, & |
---|
73 | & ln_smth_pblh |
---|
74 | !!--------------------------------------------------------------------- |
---|
75 | |
---|
76 | REWIND( numnam_ref ) ! Namelist namsbc_abl in reference namelist : ABL parameters |
---|
77 | READ ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 ) |
---|
78 | 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' ) |
---|
79 | ! |
---|
80 | REWIND( numnam_cfg ) ! Namelist namsbc_abl in configuration namelist : ABL parameters |
---|
81 | READ ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 ) |
---|
82 | 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' ) |
---|
83 | ! |
---|
84 | IF(lwm) WRITE( numond, namsbc_abl ) |
---|
85 | ! |
---|
86 | ! Check ABL mixing length option |
---|
87 | IF( nn_amxl < 0 .OR. nn_amxl > 2 ) & |
---|
88 | & CALL ctl_stop( 'abl_init : bad flag, nn_amxl must be 0, 1 or 2 ' ) |
---|
89 | ! |
---|
90 | ! Check ABL dyn restore option |
---|
91 | IF( nn_dyn_restore < 0 .OR. nn_dyn_restore > 2 ) & |
---|
92 | & CALL ctl_stop( 'abl_init : bad flag, nn_dyn_restore must be 0, 1 or 2 ' ) |
---|
93 | ! |
---|
94 | !!--------------------------------------------------------------------- |
---|
95 | !! Control prints |
---|
96 | !!--------------------------------------------------------------------- |
---|
97 | IF(lwp) THEN ! Control print (other namelist variable) |
---|
98 | WRITE(numout,*) |
---|
99 | WRITE(numout,*) ' ABL -- cn_dir = ', cn_dir |
---|
100 | WRITE(numout,*) ' ABL -- cn_dom = ', cn_dom |
---|
101 | IF( ln_hpgls_frc ) THEN |
---|
102 | WRITE(numout,*) ' ABL -- winds forced by large-scale pressure gradient' |
---|
103 | IF(ln_geos_winds) THEN |
---|
104 | ln_geos_winds = .FALSE. |
---|
105 | WRITE(numout,*) ' ABL -- geostrophic guide disabled (not compatible with ln_hpgls_frc = .T.)' |
---|
106 | END IF |
---|
107 | ELSE IF( ln_geos_winds ) THEN |
---|
108 | WRITE(numout,*) ' ABL -- winds forced by geostrophic winds' |
---|
109 | ELSE |
---|
110 | WRITE(numout,*) ' ABL -- Geostrophic winds and large-scale pressure gradient are ignored' |
---|
111 | END IF |
---|
112 | ! |
---|
113 | SELECT CASE ( nn_dyn_restore ) |
---|
114 | CASE ( 0 ) |
---|
115 | WRITE(numout,*) ' ABL -- No restoring for ABL winds' |
---|
116 | CASE ( 1 ) |
---|
117 | WRITE(numout,*) ' ABL -- Restoring of ABL winds only in the equatorial region ' |
---|
118 | CASE ( 2 ) |
---|
119 | WRITE(numout,*) ' ABL -- Restoring of ABL winds activated everywhere ' |
---|
120 | END SELECT |
---|
121 | ! |
---|
122 | IF( ln_smth_pblh ) WRITE(numout,*) ' ABL -- Smoothing of PBL height is activated' |
---|
123 | ! |
---|
124 | ENDIF |
---|
125 | |
---|
126 | !!--------------------------------------------------------------------- |
---|
127 | !! Convert nudging coefficient from hours to 1/sec |
---|
128 | !!--------------------------------------------------------------------- |
---|
129 | zcff = 1._wp / 3600._wp |
---|
130 | rn_ldyn_min = zcff / rn_ldyn_min |
---|
131 | rn_ldyn_max = zcff / rn_ldyn_max |
---|
132 | rn_ltra_min = zcff / rn_ltra_min |
---|
133 | rn_ltra_max = zcff / rn_ltra_max |
---|
134 | |
---|
135 | !!--------------------------------------------------------------------- |
---|
136 | !! ABL grid initialization |
---|
137 | !!--------------------------------------------------------------------- |
---|
138 | CALL iom_open( TRIM(cn_dir)//TRIM(cn_dom), inum ) |
---|
139 | id = iom_varid( inum, 'e3t_abl', kdimsz=idimsz, kndims=indims, lduld=lluldl ) |
---|
140 | jpka = idimsz(indims - COUNT( (/lluldl/) ) ) |
---|
141 | jpkam1 = jpka - 1 |
---|
142 | |
---|
143 | IF( abl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'abl_init : unable to allocate arrays' ) |
---|
144 | CALL iom_get( inum, jpdom_unknown, 'e3t_abl', e3t_abl(:) ) |
---|
145 | CALL iom_get( inum, jpdom_unknown, 'e3w_abl', e3w_abl(:) ) |
---|
146 | CALL iom_get( inum, jpdom_unknown, 'ght_abl', ght_abl(:) ) |
---|
147 | CALL iom_get( inum, jpdom_unknown, 'ghw_abl', ghw_abl(:) ) |
---|
148 | CALL iom_close( inum ) |
---|
149 | |
---|
150 | #if ! defined key_iomput |
---|
151 | IF( dia_wri_alloc_abl() /= 0 ) CALL ctl_stop( 'STOP', 'abl_init : unable to allocate arrays' ) |
---|
152 | #endif |
---|
153 | |
---|
154 | IF(lwp) THEN |
---|
155 | WRITE(numout,*) |
---|
156 | WRITE(numout,*) ' sbc_abl_init : ABL Reference vertical grid' |
---|
157 | WRITE(numout,*) ' ~~~~~~~' |
---|
158 | WRITE(numout, "(9x,' level ght_abl ghw_abl e3t_abl e3w_abl ')" ) |
---|
159 | WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, ght_abl(jk), ghw_abl(jk), e3t_abl(jk), e3w_abl(jk), jk = 1, jpka ) |
---|
160 | END IF |
---|
161 | |
---|
162 | !!--------------------------------------------------------------------- |
---|
163 | !! Check TKE closure parameters |
---|
164 | !!--------------------------------------------------------------------- |
---|
165 | rn_Sch = rn_ce / rn_cm |
---|
166 | mxl_min = (avm_bak / rn_cm) / sqrt( tke_min ) |
---|
167 | |
---|
168 | IF(lwp) THEN |
---|
169 | WRITE(numout,*) |
---|
170 | WRITE(numout,*) ' abl_zdf_tke : ABL TKE turbulent closure' |
---|
171 | WRITE(numout,*) ' ~~~~~~~~~~~' |
---|
172 | IF(nn_amxl==0) WRITE(numout,*) 'Deardorff 80 length-scale ' |
---|
173 | IF(nn_amxl==1) WRITE(numout,*) 'length-scale based on the distance to the PBL height ' |
---|
174 | WRITE(numout,*) ' Minimum value of atmospheric TKE = ',tke_min,' m^2 s^-2' |
---|
175 | WRITE(numout,*) ' Minimum value of atmospheric mixing length = ',mxl_min,' m' |
---|
176 | WRITE(numout,*) ' Constant for turbulent viscosity = ',rn_Cm |
---|
177 | WRITE(numout,*) ' Constant for turbulent diffusivity = ',rn_Ct |
---|
178 | WRITE(numout,*) ' Constant for Schmidt number = ',rn_Sch |
---|
179 | WRITE(numout,*) ' Constant for TKE dissipation = ',rn_Ceps |
---|
180 | END IF |
---|
181 | |
---|
182 | !!------------------------------------------------------------------------------------------- |
---|
183 | !! Compute parameters to build the vertical profile for the nudging term (used in abl_stp()) |
---|
184 | !!------------------------------------------------------------------------------------------- |
---|
185 | zcff1 = 1._wp / ( jp_bmax - jp_bmin )**3 |
---|
186 | ! for active tracers |
---|
187 | jp_alp3_tra = -2._wp * zcff1 * ( rn_ltra_max - rn_ltra_min ) |
---|
188 | jp_alp2_tra = 3._wp * zcff1 * (jp_bmax + jp_bmin) * ( rn_ltra_max - rn_ltra_min ) |
---|
189 | jp_alp1_tra = -6._wp * zcff1 * jp_bmax * jp_bmin * ( rn_ltra_max - rn_ltra_min ) |
---|
190 | jp_alp0_tra = zcff1 * ( rn_ltra_max * jp_bmin*jp_bmin * (3._wp*jp_bmax - jp_bmin) & |
---|
191 | & - rn_ltra_min * jp_bmax*jp_bmax * (3._wp*jp_bmin - jp_bmax) ) |
---|
192 | ! for dynamics |
---|
193 | jp_alp3_dyn = -2._wp * zcff1 * ( rn_ldyn_max - rn_ldyn_min ) |
---|
194 | jp_alp2_dyn = 3._wp * zcff1 * (jp_bmax + jp_bmin) * ( rn_ldyn_max - rn_ldyn_min ) |
---|
195 | jp_alp1_dyn = -6._wp * zcff1 * jp_bmax * jp_bmin * ( rn_ldyn_max - rn_ldyn_min ) |
---|
196 | jp_alp0_dyn = zcff1 * ( rn_ldyn_max * jp_bmin*jp_bmin * (3._wp*jp_bmax - jp_bmin) & |
---|
197 | & - rn_ldyn_min * jp_bmax*jp_bmax * (3._wp*jp_bmin - jp_bmax) ) |
---|
198 | |
---|
199 | jp_pblh_min = ghw_abl( 4) / jp_bmin !<-- at least 3 grid points at the bottom have value rn_ltra_min |
---|
200 | jp_pblh_max = ghw_abl(jpka-3) / jp_bmax !<-- at least 3 grid points at the top have value rn_ltra_max |
---|
201 | |
---|
202 | ! ABL timestep |
---|
203 | rdt_abl = nn_fsbc * rdt |
---|
204 | |
---|
205 | ! Check parameters for dynamics |
---|
206 | zcff = ( jp_alp3_dyn * jp_bmin**3 + jp_alp2_dyn * jp_bmin**2 & |
---|
207 | & + jp_alp1_dyn * jp_bmin + jp_alp0_dyn ) * rdt_abl |
---|
208 | zcff1 = ( jp_alp3_dyn * jp_bmax**3 + jp_alp2_dyn * jp_bmax**2 & |
---|
209 | & + jp_alp1_dyn * jp_bmax + jp_alp0_dyn ) * rdt_abl |
---|
210 | IF(lwp) THEN |
---|
211 | IF(nn_dyn_restore > 0) THEN |
---|
212 | WRITE(numout,*) ' ABL Minimum value for dynamics restoring = ',zcff |
---|
213 | WRITE(numout,*) ' ABL Maximum value for dynamics restoring = ',zcff1 |
---|
214 | ! Check that restoring coefficients are between 0 and 1 |
---|
215 | !IF( zcff1 > 1._wp .OR. zcff1 < 0._wp ) & |
---|
216 | !IF( zcff1 > nn_fsbc .OR. zcff1 < 0._wp ) & |
---|
217 | IF( zcff1 - nn_fsbc > 0.001_wp .OR. zcff1 < 0._wp ) & |
---|
218 | & CALL ctl_stop( 'abl_init : wrong value for rn_ldyn_max' ) |
---|
219 | !IF( zcff > 1._wp .OR. zcff < 0._wp ) & |
---|
220 | IF( zcff - nn_fsbc > 0.001_wp .OR. zcff < 0._wp ) & |
---|
221 | & CALL ctl_stop( 'abl_init : wrong value for rn_ldyn_min' ) |
---|
222 | IF( zcff > zcff1 ) & |
---|
223 | & CALL ctl_stop( 'abl_init : rn_ldyn_max must be smaller than rn_ldyn_min' ) |
---|
224 | END IF |
---|
225 | END IF |
---|
226 | |
---|
227 | ! Check parameters for active tracers |
---|
228 | zcff = ( jp_alp3_tra * jp_bmin**3 + jp_alp2_tra * jp_bmin**2 & |
---|
229 | & + jp_alp1_tra * jp_bmin + jp_alp0_tra ) * rdt_abl |
---|
230 | zcff1 = ( jp_alp3_tra * jp_bmax**3 + jp_alp2_tra * jp_bmax**2 & |
---|
231 | & + jp_alp1_tra * jp_bmax + jp_alp0_tra ) * rdt_abl |
---|
232 | IF(lwp) THEN |
---|
233 | WRITE(numout,*) ' ABL Minimum value for tracers restoring = ',zcff |
---|
234 | WRITE(numout,*) ' ABL Maximum value for tracers restoring = ',zcff1 |
---|
235 | ! Check that restoring coefficients are between 0 and 1 |
---|
236 | !IF( zcff1 > 1._wp .OR. zcff1 < 0._wp ) & |
---|
237 | IF( zcff1 - nn_fsbc > 0.001_wp .OR. zcff1 < 0._wp ) & |
---|
238 | & CALL ctl_stop( 'abl_init : wrong value for rn_ltra_max' ) |
---|
239 | !IF( zcff > 1._wp .OR. zcff < 0._wp ) & |
---|
240 | IF( zcff - nn_fsbc > 0.001_wp .OR. zcff < 0._wp ) & |
---|
241 | & CALL ctl_stop( 'abl_init : wrong value for rn_ltra_min' ) |
---|
242 | IF( zcff > zcff1 ) & |
---|
243 | & CALL ctl_stop( 'abl_init : rn_ltra_max must be smaller than rn_ltra_min' ) |
---|
244 | END IF |
---|
245 | |
---|
246 | !!------------------------------------------------------------------------------------------- |
---|
247 | !! Initialize Coriolis frequency, equatorial restoring and land/sea mask |
---|
248 | !!------------------------------------------------------------------------------------------- |
---|
249 | fft_abl(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) ) |
---|
250 | |
---|
251 | ! Equatorial restoring |
---|
252 | IF( nn_dyn_restore == 1 ) THEN |
---|
253 | zcff = 2._wp * omega * SIN( rad * 90._wp ) !++ fmax |
---|
254 | rest_eq(:,:) = SIN( 0.5_wp*rpi*( (fft_abl(:,:) - zcff) / zcff ) )**8 |
---|
255 | !!GS: alternative shape |
---|
256 | !rest_eq(:,:) = SIN( 0.5_wp*rpi*(zcff - ABS(ff_t(:,:))) / (zcff - 3.e-5) )**8 |
---|
257 | !WHERE(ABS(ff_t(:,:)).LE.3.e-5) rest_eq(:,:) = 1._wp |
---|
258 | ELSE |
---|
259 | rest_eq(:,:) = 1._wp |
---|
260 | END IF |
---|
261 | ! T-mask |
---|
262 | msk_abl(:,:) = tmask(:,:,1) |
---|
263 | |
---|
264 | !!------------------------------------------------------------------------------------------- |
---|
265 | |
---|
266 | ! initialize 2D bulk fields AND 3D abl data |
---|
267 | CALL sbc_blk_init |
---|
268 | |
---|
269 | ! initialize ABL from data or restart |
---|
270 | !!GS disabled for now |
---|
271 | !IF( ln_rstart ) THEN |
---|
272 | ! CALL ctl_stop( 'STOP', 'sbc_abl_init: restart mode not supported yet' ) |
---|
273 | !ELSE |
---|
274 | |
---|
275 | CALL fld_read( nit000, nn_fsbc, sf ) ! input fields provided at the first time-step |
---|
276 | |
---|
277 | ! Initialize the time index for now time (nt_n) and after time (nt_a) |
---|
278 | nt_n = 1 + MOD( nit000 , 2) |
---|
279 | nt_a = 1 + MOD( nit000+1, 2) |
---|
280 | |
---|
281 | u_abl(:,:,:,nt_n ) = sf(jp_wndi)%fnow(:,:,:) |
---|
282 | v_abl(:,:,:,nt_n ) = sf(jp_wndj)%fnow(:,:,:) |
---|
283 | tq_abl(:,:,:,nt_n,jp_ta) = sf(jp_tair)%fnow(:,:,:) |
---|
284 | tq_abl(:,:,:,nt_n,jp_qa) = sf(jp_humi)%fnow(:,:,:) |
---|
285 | |
---|
286 | tke_abl(:,:,:,nt_n ) = tke_min |
---|
287 | avm_abl(:,:,: ) = avm_bak |
---|
288 | avt_abl(:,:,: ) = avt_bak |
---|
289 | mxl_abl(:,:,: ) = mxl_min |
---|
290 | pblh (:,: ) = ghw_abl( 3 ) !<-- assume that the pbl contains 3 grid points |
---|
291 | u_abl (:,:,:,nt_a ) = 0._wp |
---|
292 | v_abl (:,:,:,nt_a ) = 0._wp |
---|
293 | tq_abl (:,:,:,nt_a,: ) = 0._wp |
---|
294 | tke_abl(:,:,:,nt_a ) = 0._wp |
---|
295 | !ENDIF |
---|
296 | !!GS restart case not supported |
---|
297 | |
---|
298 | END SUBROUTINE sbc_abl_init |
---|
299 | |
---|
300 | |
---|
301 | |
---|
302 | SUBROUTINE sbc_abl( kt ) |
---|
303 | !!--------------------------------------------------------------------- |
---|
304 | !! *** ROUTINE sbc_abl *** |
---|
305 | !! |
---|
306 | !! ** Purpose : provide the momentum, heat and freshwater fluxes at |
---|
307 | !! the ocean surface from an ABL calculation at each oceanic time step |
---|
308 | !! |
---|
309 | !! ** Method : |
---|
310 | !! - Pre-compute part of turbulent fluxes in blk_oce_1 |
---|
311 | !! - Perform 1 time-step of the ABL model |
---|
312 | !! - Finalize flux computation in blk_oce_2 |
---|
313 | !! |
---|
314 | !! ** Outputs : - utau : i-component of the stress at U-point (N/m2) |
---|
315 | !! - vtau : j-component of the stress at V-point (N/m2) |
---|
316 | !! - taum : Wind stress module at T-point (N/m2) |
---|
317 | !! - wndm : Wind speed module at T-point (m/s) |
---|
318 | !! - qsr : Solar heat flux over the ocean (W/m2) |
---|
319 | !! - qns : Non Solar heat flux over the ocean (W/m2) |
---|
320 | !! - emp : evaporation minus precipitation (kg/m2/s) |
---|
321 | !! |
---|
322 | !!--------------------------------------------------------------------- |
---|
323 | INTEGER , INTENT(in) :: kt ! ocean time step |
---|
324 | !! |
---|
325 | REAL(wp), DIMENSION(jpi,jpj) :: zssq, zcd_du, zsen, zevp |
---|
326 | #if defined key_si3 |
---|
327 | REAL(wp), DIMENSION(jpi,jpj) :: zssqi, zcd_dui, zseni, zevpi |
---|
328 | #endif |
---|
329 | INTEGER :: jbak, jbak_dta, ji, jj |
---|
330 | !!--------------------------------------------------------------------- |
---|
331 | ! |
---|
332 | !!------------------------------------------------------------------------------------------- |
---|
333 | !! 1 - Read Atmospheric 3D data for large-scale forcing |
---|
334 | !!------------------------------------------------------------------------------------------- |
---|
335 | |
---|
336 | CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step |
---|
337 | |
---|
338 | !!------------------------------------------------------------------------------------------- |
---|
339 | !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields |
---|
340 | !!------------------------------------------------------------------------------------------- |
---|
341 | |
---|
342 | CALL blk_oce_1( kt, u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in |
---|
343 | & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in |
---|
344 | & sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m , & ! <<= in |
---|
345 | & zssq, zcd_du, zsen, zevp ) ! =>> out |
---|
346 | |
---|
347 | #if defined key_si3 |
---|
348 | CALL blk_ice_1( u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in |
---|
349 | & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in |
---|
350 | & sf(jp_slp)%fnow(:,:,1) , u_ice, v_ice, tm_su , & ! <<= in |
---|
351 | & pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui ) ! <<= out |
---|
352 | #endif |
---|
353 | |
---|
354 | !!------------------------------------------------------------------------------------------- |
---|
355 | !! 3 - Advance ABL variables from now (n) to after (n+1) |
---|
356 | !!------------------------------------------------------------------------------------------- |
---|
357 | |
---|
358 | CALL abl_stp( kt, sst_m, ssu_m, ssv_m, zssq, & ! <<= in |
---|
359 | & sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:), & ! <<= in |
---|
360 | & sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:), & ! <<= in |
---|
361 | & sf(jp_slp )%fnow(:,:,1), & ! <<= in |
---|
362 | & sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:), & ! <<= in |
---|
363 | & zcd_du, zsen, zevp, & ! <=> in/out |
---|
364 | & wndm, utau, vtau, taum & ! =>> out |
---|
365 | #if defined key_si3 |
---|
366 | & , tm_su, u_ice, v_ice, zssqi, zcd_dui & ! <<= in |
---|
367 | & , zseni, zevpi, wndm_ice, ato_i & ! <<= in |
---|
368 | & , utau_ice, vtau_ice & ! =>> out |
---|
369 | #endif |
---|
370 | & ) |
---|
371 | !!------------------------------------------------------------------------------------------- |
---|
372 | !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since |
---|
373 | !! time swap is done in abl_stp |
---|
374 | !!------------------------------------------------------------------------------------------- |
---|
375 | |
---|
376 | CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta), & |
---|
377 | & sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1), & |
---|
378 | & sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1), & |
---|
379 | & sst_m, zsen, zevp ) |
---|
380 | |
---|
381 | #if defined key_si3 |
---|
382 | ! Avoid a USE abl in icesbc module |
---|
383 | sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta); sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) |
---|
384 | #endif |
---|
385 | |
---|
386 | END SUBROUTINE sbc_abl |
---|
387 | |
---|
388 | !!====================================================================== |
---|
389 | END MODULE sbcabl |
---|