Line data Source code
1 : !=======================================================================
2 : !
3 : ! Contains Icepack component driver routines common to all drivers.
4 : !
5 : ! authors Elizabeth C. Hunke, LANL
6 :
7 : module icedrv_step
8 :
9 : use icedrv_constants, only: c0, nu_diag, c4
10 : use icedrv_kinds
11 : ! use icedrv_calendar, only: istep1
12 : use icedrv_forcing, only: ocn_data_type
13 : use icedrv_system, only: icedrv_system_abort
14 : use icepack_intfc, only: icepack_warnings_flush
15 : use icepack_intfc, only: icepack_warnings_aborted
16 : use icepack_intfc, only: icepack_query_tracer_flags
17 : use icepack_intfc, only: icepack_query_tracer_indices
18 : use icepack_intfc, only: icepack_query_tracer_sizes
19 : use icepack_intfc, only: icepack_query_parameters
20 :
21 : implicit none
22 : private
23 :
24 : public :: step_therm1, step_therm2, step_dyn_ridge, &
25 : prep_radiation, step_radiation, ocean_mixed_layer, &
26 : update_state, biogeochemistry, step_dyn_wave
27 :
28 : !=======================================================================
29 :
30 : contains
31 :
32 : !=======================================================================
33 : !
34 : ! Scales radiation fields computed on the previous time step.
35 : !
36 : ! authors: Elizabeth Hunke, LANL
37 :
38 318408 : subroutine prep_radiation ()
39 :
40 : use icedrv_domain_size, only: ncat, nilyr, nslyr, nx
41 : use icedrv_flux, only: scale_factor, swvdr, swvdf, swidr, swidf
42 : use icedrv_flux, only: alvdr_ai, alvdf_ai, alidr_ai, alidf_ai
43 : use icedrv_flux, only: alvdr_init, alvdf_init, alidr_init, alidf_init
44 : use icedrv_arrays_column, only: fswsfcn, fswintn, fswthrun
45 : use icedrv_arrays_column, only: fswpenln, Sswabsn, Iswabsn
46 : use icedrv_state, only: aice, aicen
47 :
48 : ! column package includes
49 : use icepack_intfc, only: icepack_prep_radiation
50 :
51 : ! local variables
52 :
53 : integer (kind=int_kind) :: &
54 : i ! horizontal indices
55 :
56 : character(len=*), parameter :: subname='(prep_radiation)'
57 :
58 : !-----------------------------------------------------------------
59 : ! Compute netsw scaling factor (new netsw / old netsw)
60 : !-----------------------------------------------------------------
61 :
62 1592040 : do i = 1, nx
63 :
64 1273632 : alvdr_init(i) = alvdr_ai(i)
65 1273632 : alvdf_init(i) = alvdf_ai(i)
66 1273632 : alidr_init(i) = alidr_ai(i)
67 1273632 : alidf_init(i) = alidf_ai(i)
68 :
69 : call icepack_prep_radiation(ncat=ncat, nilyr=nilyr, nslyr=nslyr, &
70 439248 : aice=aice(i), aicen=aicen(i,:), &
71 439248 : swvdr=swvdr(i), swvdf=swvdf(i), &
72 439248 : swidr=swidr(i), swidf=swidf(i), &
73 439248 : alvdr_ai=alvdr_ai(i), alvdf_ai=alvdf_ai(i), &
74 439248 : alidr_ai=alidr_ai(i), alidf_ai=alidf_ai(i), &
75 439248 : scale_factor=scale_factor(i), &
76 : fswsfcn=fswsfcn(i,:), fswintn=fswintn(i,:), &
77 : fswthrun=fswthrun(i,:), fswpenln=fswpenln(i,:,:), &
78 2031288 : Sswabsn=Sswabsn(i,:,:), Iswabsn=Iswabsn(i,:,:))
79 :
80 : enddo ! i
81 318408 : call icepack_warnings_flush(nu_diag)
82 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
83 0 : file=__FILE__, line=__LINE__)
84 :
85 318408 : end subroutine prep_radiation
86 :
87 : !=======================================================================
88 : !
89 : ! Driver for updating ice and snow internal temperatures and
90 : ! computing thermodynamic growth rates and coupler fluxes.
91 : !
92 : ! authors: William H. Lipscomb, LANL
93 :
94 318408 : subroutine step_therm1 (dt)
95 :
96 : use icedrv_arrays_column, only: ffracn, dhsn
97 : use icedrv_arrays_column, only: Cdn_ocn, Cdn_ocn_skin, Cdn_ocn_floe
98 : use icedrv_arrays_column, only: Cdn_ocn_keel, Cdn_atm_ratio
99 : use icedrv_arrays_column, only: Cdn_atm, Cdn_atm_skin, Cdn_atm_floe
100 : use icedrv_arrays_column, only: Cdn_atm_rdg, Cdn_atm_pond
101 : use icedrv_arrays_column, only: hfreebd, hdraft, hridge, distrdg
102 : use icedrv_arrays_column, only: hkeel, dkeel, lfloe, dfloe
103 : use icedrv_arrays_column, only: fswsfcn, fswintn, fswthrun, Sswabsn, Iswabsn
104 : use icedrv_calendar, only: yday
105 : use icedrv_domain_size, only: ncat, nilyr, nslyr, n_aero, n_iso, nx
106 : use icedrv_flux, only: frzmlt, sst, Tf, strocnxT, strocnyT, rside, fside, &
107 : fbot, Tbot, Tsnice
108 : use icedrv_flux, only: meltsn, melttn, meltbn, congeln, snoicen, uatm, vatm
109 : use icedrv_flux, only: wind, rhoa, potT, Qa, Qa_iso, zlvl, strax, stray, flatn
110 : use icedrv_flux, only: fsensn, fsurfn, fcondtopn, fcondbotn
111 : use icedrv_flux, only: flw, fsnow, fpond, sss, mlt_onset, frz_onset
112 : use icedrv_flux, only: frain, Tair, strairxT, strairyT, fsurf
113 : use icedrv_flux, only: fcondtop, fcondbot, fsens, fresh, fsalt, fhocn
114 : use icedrv_flux, only: flat, fswabs, flwout, evap, evaps, evapi
115 : use icedrv_flux, only: Tref, Qref, Qref_iso, Uref
116 : use icedrv_flux, only: fswthru, meltt, melts, meltb, congel, snoice
117 : use icedrv_flux, only: flatn_f, fsensn_f, fsurfn_f, fcondtopn_f
118 : use icedrv_flux, only: dsnown, faero_atm, faero_ocn
119 : use icedrv_flux, only: fiso_atm, fiso_ocn, fiso_evap
120 : use icedrv_flux, only: HDO_ocn, H2_16O_ocn, H2_18O_ocn
121 : use icedrv_init, only: lmask_n, lmask_s
122 : use icedrv_state, only: aice, aicen, aice_init, aicen_init, vicen_init
123 : use icedrv_state, only: vice, vicen, vsno, vsnon, trcrn, uvel, vvel, vsnon_init
124 :
125 : ! column packge includes
126 : use icepack_intfc, only: icepack_step_therm1
127 :
128 : logical (kind=log_kind) :: &
129 : prescribed_ice ! if .true., use prescribed ice instead of computed
130 :
131 : real (kind=dbl_kind), intent(in) :: &
132 : dt ! time step
133 :
134 : ! local variables
135 :
136 : integer (kind=int_kind) :: &
137 : i , & ! horizontal indices
138 : n , & ! thickness category index
139 : k, kk ! indices for aerosols
140 :
141 : integer (kind=int_kind) :: &
142 : ntrcr, nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, nt_vlvl, nt_Tsfc, &
143 : nt_iage, nt_FY, nt_qice, nt_sice, nt_qsno, &
144 : nt_aero, nt_isosno, nt_isoice
145 :
146 : logical (kind=log_kind) :: &
147 : tr_iage, tr_FY, tr_aero, tr_iso, tr_pond, tr_pond_cesm, &
148 : tr_pond_lvl, tr_pond_topo, calc_Tsfc
149 :
150 : real (kind=dbl_kind), dimension(n_aero,2,ncat) :: &
151 5113212 : aerosno, aeroice ! kg/m^2
152 :
153 : real (kind=dbl_kind), dimension(n_iso,ncat) :: &
154 1137852 : isosno, isoice ! kg/m^2
155 :
156 : real (kind=dbl_kind) :: &
157 109812 : puny
158 :
159 : character(len=*), parameter :: subname='(step_therm1)'
160 :
161 : !-----------------------------------------------------------------
162 : ! query icepack values
163 : !-----------------------------------------------------------------
164 :
165 318408 : call icepack_query_parameters(puny_out=puny)
166 318408 : call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc)
167 318408 : call icepack_warnings_flush(nu_diag)
168 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
169 0 : file=__FILE__,line= __LINE__)
170 :
171 : call icepack_query_tracer_sizes( &
172 318408 : ntrcr_out=ntrcr)
173 318408 : call icepack_warnings_flush(nu_diag)
174 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
175 0 : file=__FILE__,line= __LINE__)
176 :
177 : call icepack_query_tracer_flags( &
178 : tr_iage_out=tr_iage, tr_FY_out=tr_FY, &
179 : tr_aero_out=tr_aero, tr_iso_out=tr_iso, &
180 : tr_pond_out=tr_pond, tr_pond_cesm_out=tr_pond_cesm, &
181 318408 : tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo)
182 318408 : call icepack_warnings_flush(nu_diag)
183 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
184 0 : file=__FILE__,line= __LINE__)
185 :
186 : call icepack_query_tracer_indices( &
187 : nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, &
188 : nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, &
189 : nt_iage_out=nt_iage, nt_FY_out=nt_FY, &
190 : nt_qice_out=nt_qice, nt_sice_out=nt_sice, &
191 : nt_aero_out=nt_aero, nt_qsno_out=nt_qsno, &
192 318408 : nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice)
193 318408 : call icepack_warnings_flush(nu_diag)
194 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
195 0 : file=__FILE__,line= __LINE__)
196 :
197 : !-----------------------------------------------------------------
198 :
199 318408 : prescribed_ice = .false.
200 318408 : aerosno(:,:,:) = c0
201 318408 : aeroice(:,:,:) = c0
202 318408 : isosno (:,:) = c0
203 318408 : isoice (:,:) = c0
204 :
205 1592040 : do i = 1, nx
206 :
207 : !-----------------------------------------------------------------
208 : ! Save the ice area passed to the coupler (so that history fields
209 : ! can be made consistent with coupler fields).
210 : ! Save the initial ice area and volume in each category.
211 : !-----------------------------------------------------------------
212 :
213 1273632 : aice_init (i) = aice (i)
214 :
215 7574088 : do n = 1, ncat
216 5982048 : aicen_init(i,n) = aicen(i,n)
217 5982048 : vicen_init(i,n) = vicen(i,n)
218 7255680 : vsnon_init(i,n) = vsnon(i,n)
219 : enddo
220 :
221 : enddo ! i
222 :
223 1592040 : do i = 1, nx
224 1273632 : if (tr_aero) then
225 : ! trcrn(nt_aero) has units kg/m^3
226 368928 : do n=1,ncat
227 676368 : do k=1,n_aero
228 0 : aerosno (k,:,n) = &
229 0 : trcrn(i,nt_aero+(k-1)*4 :nt_aero+(k-1)*4+1,n) &
230 922320 : * vsnon_init(i,n)
231 0 : aeroice (k,:,n) = &
232 0 : trcrn(i,nt_aero+(k-1)*4+2:nt_aero+(k-1)*4+3,n) &
233 1229760 : * vicen_init(i,n)
234 : enddo
235 : enddo
236 : endif ! tr_aero
237 :
238 1273632 : if (tr_iso) then
239 : ! trcrn(nt_isosno/ice) has units kg/m^3
240 368928 : do n=1,ncat
241 1291248 : do k=1,n_iso
242 922320 : isosno(k,n) = trcrn(i,nt_isosno+k-1,n) * vsnon_init(i,n)
243 1229760 : isoice(k,n) = trcrn(i,nt_isoice+k-1,n) * vicen_init(i,n)
244 : enddo
245 : enddo
246 : endif ! tr_iso
247 :
248 : call icepack_step_therm1(dt=dt, ncat=ncat, nilyr=nilyr, nslyr=nslyr, &
249 : aicen_init = aicen_init(i,:), &
250 : vicen_init = vicen_init(i,:), &
251 : vsnon_init = vsnon_init(i,:), &
252 439248 : aice = aice(i), aicen = aicen(i,:), &
253 439248 : vice = vice(i), vicen = vicen(i,:), &
254 439248 : vsno = vsno(i), vsnon = vsnon(i,:), &
255 439248 : uvel = uvel(i), vvel = vvel(i), &
256 : Tsfc = trcrn(i,nt_Tsfc,:), &
257 0 : zqsn = trcrn(i,nt_qsno:nt_qsno+nslyr-1,:), &
258 0 : zqin = trcrn(i,nt_qice:nt_qice+nilyr-1,:), &
259 0 : zSin = trcrn(i,nt_sice:nt_sice+nilyr-1,:), &
260 : alvl = trcrn(i,nt_alvl,:), &
261 : vlvl = trcrn(i,nt_vlvl,:), &
262 : apnd = trcrn(i,nt_apnd,:), &
263 : hpnd = trcrn(i,nt_hpnd,:), &
264 : ipnd = trcrn(i,nt_ipnd,:), &
265 : iage = trcrn(i,nt_iage,:), &
266 : FY = trcrn(i,nt_FY,:), &
267 : aerosno = aerosno(:,:,:), &
268 : aeroice = aeroice(:,:,:), &
269 : isosno = isosno(:,:), &
270 : isoice = isoice(:,:), &
271 439248 : uatm = uatm(i), vatm = vatm(i), &
272 439248 : wind = wind(i), zlvl = zlvl(i), &
273 439248 : Qa = Qa(i), rhoa = rhoa(i), &
274 : Qa_iso = Qa_iso(i,:), &
275 439248 : Tair = Tair(i), Tref = Tref(i), &
276 439248 : Qref = Qref(i), Uref = Uref(i), &
277 : Qref_iso = Qref_iso(i,:), &
278 439248 : Cdn_atm_ratio = Cdn_atm_ratio(i),&
279 439248 : Cdn_ocn = Cdn_ocn(i), &
280 439248 : Cdn_ocn_skin = Cdn_ocn_skin(i), &
281 439248 : Cdn_ocn_floe = Cdn_ocn_floe(i), &
282 439248 : Cdn_ocn_keel = Cdn_ocn_keel(i), &
283 439248 : Cdn_atm = Cdn_atm(i), &
284 439248 : Cdn_atm_skin = Cdn_atm_skin(i), &
285 439248 : Cdn_atm_floe = Cdn_atm_floe(i), &
286 439248 : Cdn_atm_pond = Cdn_atm_pond(i), &
287 439248 : Cdn_atm_rdg = Cdn_atm_rdg(i), &
288 878496 : hfreebd = hfreebd(i), hkeel = hkeel(i), &
289 439248 : hdraft = hdraft(i), hridge = hridge(i), &
290 878496 : distrdg = distrdg(i), dkeel = dkeel(i), &
291 439248 : lfloe = lfloe(i), dfloe = dfloe(i), &
292 439248 : strax = strax(i), stray = stray(i), &
293 439248 : strairxT = strairxT(i), strairyT = strairyT(i), &
294 439248 : potT = potT(i), sst = sst(i), &
295 439248 : sss = sss(i), Tf = Tf(i), &
296 439248 : strocnxT = strocnxT(i), strocnyT = strocnyT(i), &
297 878496 : fbot = fbot(i), frzmlt = frzmlt(i), &
298 439248 : Tbot = Tbot(i), Tsnice = Tsnice(i), &
299 439248 : rside = rside(i), fside = fside(i), &
300 439248 : fsnow = fsnow(i), frain = frain(i), &
301 439248 : fpond = fpond(i), &
302 439248 : fsurf = fsurf(i), fsurfn = fsurfn(i,:), &
303 439248 : fcondtop = fcondtop(i), fcondtopn = fcondtopn(i,:), &
304 439248 : fcondbot = fcondbot(i), fcondbotn = fcondbotn(i,:), &
305 : fswsfcn = fswsfcn(i,:), fswintn = fswintn(i,:), &
306 439248 : fswthrun = fswthrun(i,:), fswabs = fswabs(i), &
307 878496 : flwout = flwout(i), flw = flw(i), &
308 439248 : fsens = fsens(i), fsensn = fsensn(i,:), &
309 439248 : flat = flat(i), flatn = flatn(i,:), &
310 439248 : fresh = fresh(i), fsalt = fsalt(i), &
311 439248 : fhocn = fhocn(i), fswthru = fswthru(i), &
312 : flatn_f = flatn_f(i,:), fsensn_f = fsensn_f(i,:), &
313 : fsurfn_f = fsurfn_f(i,:), &
314 : fcondtopn_f = fcondtopn_f(i,:), &
315 : faero_atm = faero_atm(i,1:n_aero), &
316 : faero_ocn = faero_ocn(i,1:n_aero), &
317 : fiso_atm = fiso_atm (i,:), &
318 : fiso_ocn = fiso_ocn (i,:), &
319 : fiso_evap = fiso_evap (i,:), &
320 439248 : HDO_ocn = HDO_ocn (i), &
321 439248 : H2_16O_ocn = H2_16O_ocn (i), &
322 439248 : H2_18O_ocn = H2_18O_ocn (i), &
323 : Sswabsn = Sswabsn(i,:,:),Iswabsn = Iswabsn(i,:,:), &
324 439248 : evap = evap(i), evaps = evaps(i), evapi = evapi(i), &
325 : dhsn = dhsn(i,:), ffracn = ffracn(i,:), &
326 439248 : meltt = meltt(i), melttn = melttn(i,:), &
327 439248 : meltb = meltb(i), meltbn = meltbn(i,:), &
328 439248 : melts = melts(i), meltsn = meltsn(i,:), &
329 439248 : congel = congel(i), congeln = congeln(i,:), &
330 439248 : snoice = snoice(i), snoicen = snoicen(i,:), &
331 : dsnown = dsnown(i,:), &
332 439248 : lmask_n = lmask_n(i), lmask_s = lmask_s(i), &
333 439248 : mlt_onset=mlt_onset(i), frz_onset = frz_onset(i), &
334 10058592 : yday = yday, prescribed_ice = prescribed_ice)
335 :
336 1273632 : if (tr_aero) then
337 368928 : do n = 1, ncat
338 307440 : if (vicen(i,n) > puny) &
339 1148695 : aeroice(:,:,n) = aeroice(:,:,n)/vicen(i,n)
340 307440 : if (vsnon(i,n) > puny) &
341 1132865 : aerosno(:,:,n) = aerosno(:,:,n)/vsnon(i,n)
342 676368 : do k = 1, n_aero
343 1229760 : do kk = 1, 2
344 614880 : trcrn(i,nt_aero+(k-1)*4+kk-1,n)=aerosno(k,kk,n)
345 922320 : trcrn(i,nt_aero+(k-1)*4+kk+1,n)=aeroice(k,kk,n)
346 : enddo
347 : enddo
348 : enddo
349 : endif ! tr_aero
350 :
351 1592040 : if (tr_iso) then
352 368928 : do n = 1, ncat
353 996717 : if (vicen(i,n) > puny) isoice(:,n) = isoice(:,n)/vicen(i,n)
354 985359 : if (vsnon(i,n) > puny) isosno(:,n) = isosno(:,n)/vsnon(i,n)
355 1291248 : do k = 1, n_iso
356 922320 : trcrn(i,nt_isosno+k-1,n) = isosno(k,n)
357 1229760 : trcrn(i,nt_isoice+k-1,n) = isoice(k,n)
358 : enddo
359 : enddo
360 : endif ! tr_iso
361 :
362 : enddo ! i
363 318408 : call icepack_warnings_flush(nu_diag)
364 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
365 0 : file=__FILE__, line=__LINE__)
366 :
367 318408 : end subroutine step_therm1
368 :
369 : !=======================================================================
370 : ! Driver for thermodynamic changes not needed for coupling:
371 : ! transport in thickness space, lateral growth and melting.
372 : !
373 : ! authors: William H. Lipscomb, LANL
374 : ! Elizabeth C. Hunke, LANL
375 :
376 318408 : subroutine step_therm2 (dt)
377 :
378 : use icedrv_arrays_column, only: hin_max, fzsal, ocean_bio, &
379 : wave_sig_ht, wave_spectrum, &
380 : wavefreq, dwavefreq, &
381 : floe_rad_c, floe_binwidth, &
382 : d_afsd_latg, d_afsd_newi, d_afsd_latm, d_afsd_weld
383 : use icedrv_arrays_column, only: first_ice, bgrid, cgrid, igrid
384 : use icedrv_calendar, only: yday
385 : use icedrv_domain_size, only: ncat, nilyr, nslyr, n_aero, nblyr, &
386 : nltrcr, nx, nfsd
387 : use icedrv_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset
388 : use icedrv_flux, only: update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside
389 : use icedrv_flux, only: meltl, frazil_diag, flux_bio, faero_ocn, fiso_ocn
390 : use icedrv_flux, only: HDO_ocn, H2_16O_ocn, H2_18O_ocn
391 : use icedrv_init, only: tmask
392 : use icedrv_state, only: aice, aicen, aice0, trcr_depend
393 : use icedrv_state, only: aicen_init, vicen_init, trcrn, vicen, vsnon
394 : use icedrv_state, only: trcr_base, n_trcr_strata, nt_strata
395 :
396 : ! column package_includes
397 : use icepack_intfc, only: icepack_step_therm2
398 :
399 : real (kind=dbl_kind), intent(in) :: &
400 : dt ! time step
401 :
402 : ! local variables
403 :
404 : integer (kind=int_kind) :: &
405 : i ! horizontal index
406 :
407 : integer (kind=int_kind) :: &
408 : ntrcr, nbtrcr
409 :
410 : logical (kind=log_kind) :: &
411 : tr_fsd ! floe size distribution tracers
412 :
413 : character(len=*), parameter :: subname='(step_therm2)'
414 :
415 : !-----------------------------------------------------------------
416 : ! query icepack values
417 : !-----------------------------------------------------------------
418 :
419 318408 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr)
420 318408 : call icepack_query_tracer_flags(tr_fsd_out=tr_fsd)
421 318408 : call icepack_warnings_flush(nu_diag)
422 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
423 0 : file=__FILE__,line= __LINE__)
424 :
425 : !-----------------------------------------------------------------
426 :
427 1592040 : do i = 1, nx
428 :
429 1592040 : if (tmask(i)) then
430 : ! wave_sig_ht - compute here to pass to add new ice
431 955224 : if (tr_fsd) &
432 683280 : wave_sig_ht(i) = c4*SQRT(SUM(wave_spectrum(i,:)*dwavefreq(:)))
433 :
434 : call icepack_step_therm2(dt=dt, ncat=ncat, &
435 : nltrcr=nltrcr, nilyr=nilyr, nslyr=nslyr, &
436 : hin_max=hin_max(:), nblyr=nblyr, &
437 : aicen=aicen(i,:), &
438 : vicen=vicen(i,:), &
439 : vsnon=vsnon(i,:), &
440 : aicen_init=aicen_init(i,:), &
441 : vicen_init=vicen_init(i,:), &
442 0 : trcrn=trcrn(i,1:ntrcr,:), &
443 329436 : aice0=aice0(i), &
444 329436 : aice =aice(i), &
445 0 : trcr_depend=trcr_depend(1:ntrcr), &
446 0 : trcr_base=trcr_base(1:ntrcr,:), &
447 0 : n_trcr_strata=n_trcr_strata(1:ntrcr), &
448 0 : nt_strata=nt_strata(1:ntrcr,:), &
449 329436 : Tf=Tf(i), sss=sss(i), &
450 329436 : salinz=salinz(i,:), fside=fside(i), &
451 329436 : rside=rside(i), meltl=meltl(i), &
452 329436 : frzmlt=frzmlt(i), frazil=frazil(i), &
453 329436 : frain=frain(i), fpond=fpond(i), &
454 329436 : fresh=fresh(i), fsalt=fsalt(i), &
455 329436 : fhocn=fhocn(i), update_ocn_f=update_ocn_f, &
456 : bgrid=bgrid, cgrid=cgrid, &
457 : igrid=igrid, faero_ocn=faero_ocn(i,:), &
458 : first_ice=first_ice(i,:), &
459 329436 : fzsal=fzsal(i), &
460 0 : flux_bio=flux_bio(i,1:nbtrcr), &
461 0 : ocean_bio=ocean_bio(i,1:nbtrcr), &
462 329436 : frazil_diag=frazil_diag(i), &
463 329436 : frz_onset=frz_onset(i), &
464 : yday=yday, &
465 : fiso_ocn=fiso_ocn(i,:), &
466 329436 : HDO_ocn=HDO_ocn(i), &
467 329436 : H2_16O_ocn=H2_16O_ocn(i), &
468 329436 : H2_18O_ocn=H2_18O_ocn(i), &
469 329436 : nfsd=nfsd, wave_sig_ht=wave_sig_ht(i), &
470 : wave_spectrum=wave_spectrum(i,:), &
471 : wavefreq=wavefreq(:), &
472 : dwavefreq=dwavefreq(:), &
473 : d_afsd_latg=d_afsd_latg(i,:), &
474 : d_afsd_newi=d_afsd_newi(i,:), &
475 : d_afsd_latm=d_afsd_latm(i,:), &
476 : d_afsd_weld=d_afsd_weld(i,:), &
477 : floe_rad_c=floe_rad_c(:), &
478 2931840 : floe_binwidth=floe_binwidth(:))
479 :
480 : endif ! tmask
481 :
482 : enddo ! i
483 318408 : call icepack_warnings_flush(nu_diag)
484 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
485 0 : file=__FILE__, line=__LINE__)
486 :
487 318408 : end subroutine step_therm2
488 :
489 : !=======================================================================
490 : !
491 : ! finalize thermo updates
492 : !
493 : ! authors: Elizabeth Hunke, LANL
494 :
495 660948 : subroutine update_state (dt, daidt, dvidt, dagedt, offset)
496 :
497 : use icedrv_domain_size, only: ncat, nx
498 : use icedrv_init, only: tmask
499 : use icedrv_state, only: aicen, trcrn, vicen, vsnon
500 : use icedrv_state, only: aice, trcr, vice, vsno, aice0, trcr_depend
501 : use icedrv_state, only: trcr_base, nt_strata, n_trcr_strata
502 :
503 : ! column package includes
504 : use icepack_intfc, only: icepack_aggregate
505 :
506 : real (kind=dbl_kind), intent(in) :: &
507 : dt , & ! time step
508 : offset ! d(age)/dt time offset = dt for thermo, 0 for dyn
509 :
510 : real (kind=dbl_kind), dimension(:), intent(inout) :: &
511 : daidt, & ! change in ice area per time step
512 : dvidt, & ! change in ice volume per time step
513 : dagedt ! change in ice age per time step
514 :
515 : integer (kind=int_kind) :: &
516 : i, & ! horizontal indices
517 : ntrcr, & !
518 : nt_iage !
519 :
520 : logical (kind=log_kind) :: &
521 : tr_iage ! ice age tracer
522 :
523 : character(len=*), parameter :: subname='(update_state)'
524 :
525 : !-----------------------------------------------------------------
526 : ! query icepack values
527 : !-----------------------------------------------------------------
528 :
529 660948 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
530 660948 : call icepack_warnings_flush(nu_diag)
531 660948 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
532 0 : file=__FILE__,line= __LINE__)
533 :
534 660948 : call icepack_query_tracer_indices(nt_iage_out=nt_iage)
535 660948 : call icepack_warnings_flush(nu_diag)
536 660948 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
537 0 : file=__FILE__,line= __LINE__)
538 :
539 660948 : call icepack_query_tracer_flags(tr_iage_out=tr_iage)
540 660948 : call icepack_warnings_flush(nu_diag)
541 660948 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
542 0 : file=__FILE__,line= __LINE__)
543 :
544 : !$OMP PARALLEL DO PRIVATE(i)
545 3304740 : do i = 1, nx
546 :
547 : !-----------------------------------------------------------------
548 : ! Aggregate the updated state variables (includes ghost cells).
549 : !-----------------------------------------------------------------
550 :
551 2643792 : if (tmask(i)) then
552 : call icepack_aggregate (ncat=ncat, &
553 0 : aicen=aicen(i,:), trcrn=trcrn(i,1:ntrcr,:), &
554 : vicen=vicen(i,:), vsnon=vsnon(i,:), &
555 685152 : aice =aice (i), trcr =trcr (i,1:ntrcr), &
556 685152 : vice =vice (i), vsno =vsno (i), &
557 685152 : aice0=aice0(i), &
558 : ntrcr=ntrcr, &
559 0 : trcr_depend=trcr_depend (1:ntrcr), &
560 0 : trcr_base=trcr_base (1:ntrcr,:), &
561 0 : n_trcr_strata=n_trcr_strata(1:ntrcr), &
562 3353148 : nt_strata=nt_strata (1:ntrcr,:))
563 : endif
564 :
565 : !-----------------------------------------------------------------
566 : ! Compute thermodynamic area and volume tendencies.
567 : !-----------------------------------------------------------------
568 :
569 2643792 : daidt(i) = (aice(i) - daidt(i)) / dt
570 2643792 : dvidt(i) = (vice(i) - dvidt(i)) / dt
571 3304740 : if (tr_iage) then
572 122976 : if (offset > c0) then ! thermo
573 61488 : if (trcr(i,nt_iage) > c0) &
574 0 : dagedt(i) = (trcr(i,nt_iage) &
575 46111 : - dagedt(i) - offset) / dt
576 : else ! dynamics
577 0 : dagedt(i) = (trcr(i,nt_iage) &
578 61488 : - dagedt(i)) / dt
579 : endif
580 : endif
581 :
582 : enddo ! i
583 : !$OMP END PARALLEL DO
584 660948 : call icepack_warnings_flush(nu_diag)
585 660948 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
586 0 : file=__FILE__, line=__LINE__)
587 :
588 660948 : end subroutine update_state
589 :
590 : !=======================================================================
591 : !
592 : ! Run one time step of wave-fracturing the floe size distribution
593 : !
594 : ! authors: Lettie Roach, NIWA
595 : ! Elizabeth C. Hunke, LANL
596 :
597 0 : subroutine step_dyn_wave (dt)
598 :
599 : use icedrv_arrays_column, only: wave_spectrum, wave_sig_ht, &
600 : d_afsd_wave, floe_rad_l, floe_rad_c, wavefreq, dwavefreq
601 : use icedrv_domain_size, only: ncat, nfsd, nfreq, nx
602 : use icedrv_state, only: trcrn, aicen, aice, vice
603 : use icepack_intfc, only: icepack_step_wavefracture
604 :
605 : real (kind=dbl_kind), intent(in) :: &
606 : dt ! time step
607 :
608 : ! local variables
609 :
610 : integer (kind=int_kind) :: &
611 : i, j, & ! horizontal indices
612 : ntrcr, & !
613 : nbtrcr !
614 :
615 : character (len=char_len) :: wave_spec_type
616 :
617 : character(len=*), parameter :: subname = '(step_dyn_wave)'
618 :
619 0 : call icepack_query_parameters(wave_spec_type_out=wave_spec_type)
620 0 : call icepack_warnings_flush(nu_diag)
621 0 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
622 0 : file=__FILE__,line= __LINE__)
623 :
624 0 : do i = 1, nx
625 0 : d_afsd_wave(i,:) = c0
626 : call icepack_step_wavefracture (wave_spec_type=wave_spec_type, &
627 : dt=dt, ncat=ncat, nfsd=nfsd, nfreq=nfreq, &
628 0 : aice = aice (i), &
629 0 : vice = vice (i), &
630 : aicen = aicen (i,:), &
631 : floe_rad_l = floe_rad_l (:), &
632 : floe_rad_c = floe_rad_c (:), &
633 : wave_spectrum = wave_spectrum(i,:), &
634 : wavefreq = wavefreq (:), &
635 : dwavefreq = dwavefreq (:), &
636 : trcrn = trcrn (i,:,:), &
637 0 : d_afsd_wave = d_afsd_wave (i,:))
638 : end do ! i
639 :
640 0 : call icepack_warnings_flush(nu_diag)
641 0 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
642 0 : file=__FILE__,line= __LINE__)
643 :
644 0 : end subroutine step_dyn_wave
645 :
646 : !=======================================================================
647 : !
648 : ! Run one time step of ridging.
649 : !
650 : ! authors: William H. Lipscomb, LANL
651 : ! Elizabeth C. Hunke, LANL
652 :
653 342540 : subroutine step_dyn_ridge (dt, ndtd)
654 :
655 : use icedrv_arrays_column, only: hin_max, fzsal, first_ice
656 : use icedrv_domain_size, only: ncat, nilyr, nslyr, n_aero, n_iso, nblyr, nx
657 : use icedrv_flux, only: rdg_conv, rdg_shear, dardg1dt, dardg2dt
658 : use icedrv_flux, only: dvirdgdt, opening, closing, fpond, fresh, fhocn
659 : use icedrv_flux, only: aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt
660 : use icedrv_flux, only: dvirdgndt, araftn, vraftn, fsalt, flux_bio, faero_ocn, fiso_ocn
661 : use icedrv_init, only: tmask
662 : use icedrv_state, only: trcrn, vsnon, aicen, vicen
663 : use icedrv_state, only: aice, aice0, trcr_depend, n_trcr_strata
664 : use icedrv_state, only: trcr_base, nt_strata
665 :
666 : ! column package includes
667 : use icepack_intfc, only: icepack_step_ridge
668 :
669 : real (kind=dbl_kind), intent(in) :: &
670 : dt ! time step
671 :
672 : integer (kind=int_kind), intent(in) :: &
673 : ndtd ! number of dynamics subcycles
674 :
675 : ! local variables
676 :
677 : integer (kind=int_kind) :: &
678 : i, & ! horizontal indices
679 : ntrcr, & !
680 : nbtrcr !
681 :
682 : character(len=*), parameter :: subname='(step_dyn_ridge)'
683 :
684 : !-----------------------------------------------------------------
685 : ! query icepack values
686 : !-----------------------------------------------------------------
687 :
688 342540 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr)
689 342540 : call icepack_warnings_flush(nu_diag)
690 342540 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
691 0 : file=__FILE__,line= __LINE__)
692 :
693 : !-----------------------------------------------------------------
694 : ! Ridging
695 : !-----------------------------------------------------------------
696 :
697 342540 : if (trim(ocn_data_type) == "SHEBA") then
698 :
699 1480980 : do i = 1, nx
700 :
701 : !echmod: this changes the answers, continue using tmask for now
702 : ! call aggregate_area (ncat, aicen(:), atmp, atmp0)
703 : ! if (atmp > c0) then
704 :
705 1480980 : if (tmask(i)) then
706 :
707 : call icepack_step_ridge(dt=dt, ndtd=ndtd, &
708 : nilyr=nilyr, nslyr=nslyr, &
709 : nblyr=nblyr, &
710 : ncat=ncat, hin_max=hin_max(:), &
711 308916 : rdg_conv=rdg_conv(i), rdg_shear=rdg_shear(i), &
712 : aicen=aicen(i,:), &
713 0 : trcrn=trcrn(i,1:ntrcr,:), &
714 : vicen=vicen(i,:), vsnon=vsnon(i,:), &
715 308916 : aice0=aice0(i), &
716 0 : trcr_depend=trcr_depend(1:ntrcr), &
717 0 : trcr_base=trcr_base(1:ntrcr,:), &
718 0 : n_trcr_strata=n_trcr_strata(1:ntrcr), &
719 0 : nt_strata=nt_strata(1:ntrcr,:), &
720 308916 : dardg1dt=dardg1dt(i), dardg2dt=dardg2dt(i), &
721 308916 : dvirdgdt=dvirdgdt(i), opening=opening(i), &
722 308916 : fpond=fpond(i), &
723 308916 : fresh=fresh(i), fhocn=fhocn(i), &
724 : n_aero=n_aero, &
725 : faero_ocn=faero_ocn(i,:), fiso_ocn=fiso_ocn(i,:), &
726 : aparticn=aparticn(i,:), krdgn=krdgn(i,:), &
727 : aredistn=aredistn(i,:), vredistn=vredistn(i,:), &
728 : dardg1ndt=dardg1ndt(i,:), dardg2ndt=dardg2ndt(i,:), &
729 : dvirdgndt=dvirdgndt(i,:), &
730 : araftn=araftn(i,:), vraftn=vraftn(i,:), &
731 308916 : aice=aice(i), fsalt=fsalt(i), &
732 308916 : first_ice=first_ice(i,:), fzsal=fzsal(i), &
733 0 : flux_bio=flux_bio(i,1:nbtrcr), &
734 2124252 : closing=closing(i) )
735 :
736 : endif ! tmask
737 :
738 : enddo ! i
739 :
740 : else ! closing not read in
741 :
742 231720 : do i = 1, nx
743 :
744 : !echmod: this changes the answers, continue using tmask for now
745 : ! call aggregate_area (ncat, aicen(:), atmp, atmp0)
746 : ! if (atmp > c0) then
747 :
748 231720 : if (tmask(i)) then
749 :
750 : call icepack_step_ridge (dt=dt, ndtd=ndtd, &
751 : nilyr=nilyr, nslyr=nslyr, &
752 : nblyr=nblyr, &
753 : ncat=ncat, hin_max=hin_max(:), &
754 46800 : rdg_conv=rdg_conv(i), rdg_shear=rdg_shear(i), &
755 : aicen=aicen(i,:), &
756 0 : trcrn=trcrn(i,1:ntrcr,:), &
757 : vicen=vicen(i,:), vsnon=vsnon(i,:), &
758 46800 : aice0=aice0(i), &
759 0 : trcr_depend=trcr_depend(1:ntrcr), &
760 0 : trcr_base=trcr_base(1:ntrcr,:), &
761 0 : n_trcr_strata=n_trcr_strata(1:ntrcr), &
762 0 : nt_strata=nt_strata(1:ntrcr,:), &
763 46800 : dardg1dt=dardg1dt(i), dardg2dt=dardg2dt(i), &
764 46800 : dvirdgdt=dvirdgdt(i), opening=opening(i), &
765 46800 : fpond=fpond(i), &
766 46800 : fresh=fresh(i), fhocn=fhocn(i), &
767 : n_aero=n_aero, &
768 : faero_ocn=faero_ocn(i,:), fiso_ocn=fiso_ocn(i,:), &
769 : aparticn=aparticn(i,:), krdgn=krdgn(i,:), &
770 : aredistn=aredistn(i,:), vredistn=vredistn(i,:), &
771 : dardg1ndt=dardg1ndt(i,:), dardg2ndt=dardg2ndt(i,:), &
772 : dvirdgndt=dvirdgndt(i,:), &
773 : araftn=araftn(i,:), vraftn=vraftn(i,:), &
774 46800 : aice=aice(i), fsalt=fsalt(i), &
775 46800 : first_ice=first_ice(i,:), fzsal=fzsal(i), &
776 326232 : flux_bio=flux_bio(i,1:nbtrcr))
777 :
778 : endif ! tmask
779 :
780 : enddo ! i
781 :
782 : endif
783 342540 : call icepack_warnings_flush(nu_diag)
784 342540 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
785 0 : file=__FILE__, line=__LINE__)
786 :
787 342540 : end subroutine step_dyn_ridge
788 :
789 : !=======================================================================
790 : !
791 : ! Computes radiation fields
792 : !
793 : ! authors: William H. Lipscomb, LANL
794 : ! David Bailey, NCAR
795 : ! Elizabeth C. Hunke, LANL
796 :
797 318408 : subroutine step_radiation (dt)
798 :
799 : use icedrv_arrays_column, only: ffracn, dhsn
800 : use icedrv_arrays_column, only: fswsfcn, fswintn, fswthrun, fswpenln, Sswabsn, Iswabsn
801 : use icedrv_arrays_column, only: albicen, albsnon, albpndn
802 : use icedrv_arrays_column, only: alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn
803 : use icedrv_arrays_column, only: kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab
804 : use icedrv_arrays_column, only: gaer_bc_tab, bcenh, swgrid, igrid
805 : use icedrv_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, sec
806 : use icedrv_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr, nx
807 : use icedrv_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow
808 : use icedrv_init, only: TLAT, TLON, tmask
809 : use icedrv_state, only: aicen, vicen, vsnon, trcrn
810 :
811 : ! column package includes
812 : use icepack_intfc, only: icepack_step_radiation
813 :
814 : real (kind=dbl_kind), intent(in) :: &
815 : dt ! time step
816 :
817 : ! local variables
818 :
819 : integer (kind=int_kind) :: &
820 : i, n, k ! horizontal indices
821 :
822 : integer (kind=int_kind) :: &
823 : max_aero, max_algae, nt_Tsfc, nt_alvl, &
824 : nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, &
825 : ntrcr, nbtrcr_sw, nt_fbri
826 :
827 : integer (kind=int_kind), dimension(:), allocatable :: &
828 318408 : nlt_zaero_sw, nt_zaero, nt_bgc_N
829 :
830 : logical (kind=log_kind) :: &
831 : tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero
832 :
833 : real (kind=dbl_kind), dimension(ncat) :: &
834 623832 : fbri ! brine height to ice thickness
835 :
836 : real(kind= dbl_kind), dimension(:,:), allocatable :: &
837 318408 : ztrcr_sw
838 :
839 : logical (kind=log_kind) :: &
840 : l_print_point ! flag for printing debugging information
841 :
842 : character(len=*), parameter :: subname='(step_radiation)'
843 :
844 : !-----------------------------------------------------------------
845 : ! query icepack values
846 : !-----------------------------------------------------------------
847 :
848 : call icepack_query_tracer_sizes( &
849 318408 : max_aero_out=max_aero, max_algae_out=max_algae)
850 318408 : call icepack_warnings_flush(nu_diag)
851 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
852 0 : file=__FILE__,line= __LINE__)
853 318408 : allocate(nlt_zaero_sw(max_aero))
854 318408 : allocate(nt_zaero(max_aero))
855 318408 : allocate(nt_bgc_N(max_algae))
856 :
857 318408 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_sw_out=nbtrcr_sw)
858 318408 : call icepack_warnings_flush(nu_diag)
859 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
860 0 : file=__FILE__,line= __LINE__)
861 :
862 : call icepack_query_tracer_flags( &
863 318408 : tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_zaero_out=tr_zaero)
864 318408 : call icepack_warnings_flush(nu_diag)
865 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
866 0 : file=__FILE__,line= __LINE__)
867 :
868 : call icepack_query_tracer_indices( &
869 : nt_Tsfc_out=nt_Tsfc, nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, &
870 : nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, &
871 : nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, &
872 318408 : nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N)
873 318408 : call icepack_warnings_flush(nu_diag)
874 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
875 0 : file=__FILE__,line= __LINE__)
876 :
877 318408 : call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero)
878 318408 : call icepack_warnings_flush(nu_diag)
879 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
880 0 : file=__FILE__,line= __LINE__)
881 :
882 : !-----------------------------------------------------------------
883 :
884 318408 : allocate(ztrcr_sw(nbtrcr_sw,ncat))
885 :
886 318408 : l_print_point = .false.
887 :
888 1592040 : do i = 1, nx
889 :
890 1273632 : fbri(:) = c0
891 7255680 : ztrcr_sw(:,:) = c0
892 7255680 : do n = 1, ncat
893 7255680 : if (tr_brine) fbri(n) = trcrn(i,nt_fbri,n)
894 : enddo
895 :
896 1273632 : if (tmask(i)) then
897 :
898 : call icepack_step_radiation(dt=dt, ncat=ncat, &
899 : nblyr=nblyr, nilyr=nilyr, &
900 : nslyr=nslyr, dEdd_algae=dEdd_algae, &
901 : swgrid=swgrid(:), igrid=igrid(:), &
902 : fbri=fbri(:), &
903 : aicen=aicen(i,:), vicen=vicen(i,:), &
904 : vsnon=vsnon(i,:), &
905 : Tsfcn=trcrn(i,nt_Tsfc,:), &
906 : alvln=trcrn(i,nt_alvl,:), &
907 : apndn=trcrn(i,nt_apnd,:), &
908 : hpndn=trcrn(i,nt_hpnd,:), &
909 : ipndn=trcrn(i,nt_ipnd,:), &
910 0 : aeron=trcrn(i,nt_aero:nt_aero+4*n_aero-1,:), &
911 0 : bgcNn=trcrn(i,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:), &
912 0 : zaeron=trcrn(i,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:), &
913 : trcrn_bgcsw=ztrcr_sw, &
914 329436 : TLAT=TLAT(i), TLON=TLON(i), &
915 : calendar_type=calendar_type, &
916 : days_per_year=days_per_year, sec=sec, &
917 : nextsw_cday=nextsw_cday, yday=yday, &
918 : kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), &
919 : waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), &
920 : gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), &
921 : bcenh=bcenh(:,:,:), modal_aero=modal_aero, &
922 329436 : swvdr=swvdr(i), swvdf=swvdf(i), &
923 329436 : swidr=swidr(i), swidf=swidf(i), &
924 329436 : coszen=coszen(i), fsnow=fsnow(i), &
925 : alvdrn=alvdrn(i,:), alvdfn=alvdfn(i,:), &
926 : alidrn=alidrn(i,:), alidfn=alidfn(i,:), &
927 : fswsfcn=fswsfcn(i,:), fswintn=fswintn(i,:), &
928 : fswthrun=fswthrun(i,:), fswpenln=fswpenln(i,:,:), &
929 : Sswabsn=Sswabsn(i,:,:), Iswabsn=Iswabsn(i,:,:), &
930 : albicen=albicen(i,:), albsnon=albsnon(i,:), &
931 : albpndn=albpndn(i,:), apeffn=apeffn(i,:), &
932 : snowfracn=snowfracn(i,:), &
933 : dhsn=dhsn(i,:), ffracn=ffracn(i,:), &
934 1614096 : l_print_point=l_print_point)
935 :
936 : endif ! tmask
937 :
938 1592040 : if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then
939 0 : do n = 1, ncat
940 1273632 : do k = 1, nbtrcr_sw
941 0 : trcrn_sw(i,k,n) = ztrcr_sw(k,n)
942 : enddo
943 : enddo
944 : endif
945 :
946 : enddo ! i
947 318408 : call icepack_warnings_flush(nu_diag)
948 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
949 0 : file=__FILE__, line=__LINE__)
950 :
951 318408 : deallocate(ztrcr_sw)
952 318408 : deallocate(nlt_zaero_sw)
953 318408 : deallocate(nt_zaero)
954 318408 : deallocate(nt_bgc_N)
955 :
956 318408 : end subroutine step_radiation
957 :
958 : !=======================================================================
959 : ! Ocean mixed layer calculation (internal to sea ice model).
960 : ! Allows heat storage in ocean for uncoupled runs.
961 : !
962 : ! authors: John Weatherly, CRREL
963 : ! C.M. Bitz, UW
964 : ! Elizabeth C. Hunke, LANL
965 : ! Bruce P. Briegleb, NCAR
966 : ! William H. Lipscomb, LANL
967 :
968 318408 : subroutine ocean_mixed_layer (dt)
969 :
970 : use icedrv_arrays_column, only: Cdn_atm, Cdn_atm_ratio
971 : use icepack_intfc, only: icepack_ocn_mixed_layer, icepack_atm_boundary
972 : use icedrv_init, only: tmask
973 : use icedrv_domain_size, only: nx
974 : use icedrv_flux, only: sst, Tf, Qa, uatm, vatm, wind, potT, rhoa, zlvl
975 : use icedrv_flux, only: frzmlt, fhocn, fswthru, flw, flwout_ocn, fsens_ocn, flat_ocn, evap_ocn
976 : use icedrv_flux, only: alvdr_ocn, alidr_ocn, alvdf_ocn, alidf_ocn, swidf, swvdf, swidr, swvdr
977 : use icedrv_flux, only: qdp, hmix, strairx_ocn, strairy_ocn, Tref_ocn, Qref_ocn
978 : use icedrv_state, only: aice
979 :
980 : real (kind=dbl_kind), intent(in) :: &
981 : dt ! time step
982 :
983 : ! local variables
984 :
985 : integer (kind=int_kind) :: &
986 : i ! horizontal indices
987 :
988 : real (kind=dbl_kind) :: &
989 109812 : albocn
990 :
991 : real (kind=dbl_kind), dimension(nx) :: &
992 549060 : delt , & ! potential temperature difference (K)
993 549060 : delq , & ! specific humidity difference (kg/kg)
994 549060 : shcoef, & ! transfer coefficient for sensible heat
995 549060 : lhcoef ! transfer coefficient for latent heat
996 :
997 : character(len=*), parameter :: subname='(ocean_mixed_layer)'
998 :
999 : !-----------------------------------------------------------------
1000 : ! query icepack values
1001 : !-----------------------------------------------------------------
1002 :
1003 318408 : call icepack_query_parameters(albocn_out=albocn)
1004 318408 : call icepack_warnings_flush(nu_diag)
1005 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1006 0 : file=__FILE__, line=__LINE__)
1007 :
1008 : !-----------------------------------------------------------------
1009 : ! Identify ocean cells.
1010 : ! Set fluxes to zero in land cells.
1011 : !-----------------------------------------------------------------
1012 :
1013 1592040 : do i = 1, nx
1014 1592040 : if (.not.tmask(i)) then
1015 318408 : sst (i) = c0
1016 318408 : frzmlt (i) = c0
1017 318408 : flwout_ocn(i) = c0
1018 318408 : fsens_ocn (i) = c0
1019 318408 : flat_ocn (i) = c0
1020 318408 : evap_ocn (i) = c0
1021 : endif
1022 : enddo ! i
1023 :
1024 : !-----------------------------------------------------------------
1025 : ! Compute boundary layer quantities
1026 : !-----------------------------------------------------------------
1027 :
1028 1592040 : do i = 1, nx
1029 1592040 : if (tmask(i)) then
1030 : call icepack_atm_boundary(sfctype = 'ocn', &
1031 329436 : Tsf = sst(i), &
1032 329436 : potT = potT(i), &
1033 329436 : uatm = uatm(i), &
1034 329436 : vatm = vatm(i), &
1035 329436 : wind = wind(i), &
1036 329436 : zlvl = zlvl(i), &
1037 329436 : Qa = Qa(i), &
1038 329436 : rhoa = rhoa(i), &
1039 329436 : strx = strairx_ocn(i), &
1040 329436 : stry = strairy_ocn(i), &
1041 329436 : Tref = Tref_ocn(i), &
1042 329436 : Qref = Qref_ocn(i), &
1043 329436 : delt = delt(i), &
1044 329436 : delq = delq(i), &
1045 329436 : lhcoef = lhcoef(i), &
1046 329436 : shcoef = shcoef(i), &
1047 329436 : Cdn_atm = Cdn_atm(i), &
1048 955224 : Cdn_atm_ratio_n = Cdn_atm_ratio(i))
1049 : endif
1050 : enddo ! i
1051 318408 : call icepack_warnings_flush(nu_diag)
1052 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1053 0 : file=__FILE__, line=__LINE__)
1054 :
1055 : !-----------------------------------------------------------------
1056 : ! Ocean albedo
1057 : ! For now, assume albedo = albocn in each spectral band.
1058 : !-----------------------------------------------------------------
1059 :
1060 1592040 : alvdr_ocn(:) = albocn
1061 1592040 : alidr_ocn(:) = albocn
1062 1592040 : alvdf_ocn(:) = albocn
1063 1592040 : alidf_ocn(:) = albocn
1064 :
1065 : !-----------------------------------------------------------------
1066 : ! Compute ocean fluxes and update SST
1067 : !-----------------------------------------------------------------
1068 1592040 : do i = 1, nx
1069 1592040 : if (tmask(i)) then
1070 329436 : call icepack_ocn_mixed_layer(alvdr_ocn=alvdr_ocn(i), swvdr=swvdr(i), &
1071 329436 : alidr_ocn=alidr_ocn(i), swidr=swidr(i), &
1072 329436 : alvdf_ocn=alvdf_ocn(i), swvdf=swvdf(i), &
1073 329436 : alidf_ocn=alidf_ocn(i), swidf=swidf(i), &
1074 329436 : flwout_ocn=flwout_ocn(i),sst=sst(i), &
1075 329436 : fsens_ocn=fsens_ocn(i), shcoef=shcoef(i), &
1076 329436 : flat_ocn=flat_ocn(i), lhcoef=lhcoef(i), &
1077 329436 : evap_ocn=evap_ocn(i), flw=flw(i), &
1078 329436 : delt=delt(i), delq=delq(i), &
1079 329436 : aice=aice(i), fhocn=fhocn(i), &
1080 329436 : fswthru=fswthru(i), hmix=hmix(i), &
1081 329436 : Tf=Tf(i), qdp=qdp(i), &
1082 955224 : frzmlt=frzmlt(i), dt=dt)
1083 : endif
1084 : enddo ! i
1085 318408 : call icepack_warnings_flush(nu_diag)
1086 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1087 0 : file=__FILE__, line=__LINE__)
1088 :
1089 318408 : end subroutine ocean_mixed_layer
1090 :
1091 : !=======================================================================
1092 :
1093 318408 : subroutine biogeochemistry (dt)
1094 :
1095 : use icedrv_arrays_column, only: upNO, upNH, iDi, iki, zfswin
1096 : use icedrv_arrays_column, only: zsal_tot, darcy_V, grow_net
1097 : use icedrv_arrays_column, only: PP_net, hbri,dhbr_bot, dhbr_top, Zoo
1098 : use icedrv_arrays_column, only: fbio_snoice, fbio_atmice, ocean_bio
1099 : use icedrv_arrays_column, only: first_ice, fswpenln, bphi, bTiz, ice_bio_net
1100 : use icedrv_arrays_column, only: snow_bio_net, fswthrun, Rayleigh_criteria
1101 : use icedrv_arrays_column, only: ocean_bio_all, sice_rho, fzsal, fzsal_g
1102 : use icedrv_arrays_column, only: bgrid, igrid, icgrid, cgrid
1103 : use icepack_intfc, only: icepack_biogeochemistry, icepack_load_ocean_bio_array
1104 : use icedrv_domain_size, only: nblyr, nilyr, nslyr, n_algae, n_zaero, ncat
1105 : use icedrv_domain_size, only: n_doc, n_dic, n_don, n_fed, n_fep, nx
1106 : use icedrv_flux, only: meltbn, melttn, congeln, snoicen
1107 : use icedrv_flux, only: sst, sss, fsnow, meltsn
1108 : use icedrv_flux, only: hin_old, flux_bio, flux_bio_atm, faero_atm
1109 : use icedrv_flux, only: nit, amm, sil, dmsp, dms, algalN, doc, don, dic, fed, fep, zaeros, hum
1110 : use icedrv_state, only: aicen_init, vicen_init, aicen, vicen, vsnon
1111 : use icedrv_state, only: trcrn, vsnon_init, aice0
1112 :
1113 : real (kind=dbl_kind), intent(in) :: &
1114 : dt ! time step
1115 :
1116 : ! local variables
1117 :
1118 : integer (kind=int_kind) :: &
1119 : i , & ! horizontal indices
1120 : mm ! tracer index
1121 :
1122 : integer (kind=int_kind) :: &
1123 : max_algae, max_nbtrcr, max_don, &
1124 : max_doc, max_dic, max_aero, max_fe, &
1125 : nbtrcr, ntrcr
1126 :
1127 : integer (kind=int_kind), dimension(:), allocatable :: &
1128 318408 : nlt_zaero
1129 :
1130 : integer (kind=int_kind), allocatable :: &
1131 318408 : bio_index_o(:)
1132 :
1133 : logical (kind=log_kind) :: &
1134 : skl_bgc, tr_brine, tr_zaero
1135 :
1136 : character(len=*), parameter :: subname='(biogeochemistry)'
1137 :
1138 : !-----------------------------------------------------------------
1139 : ! query icepack values
1140 : !-----------------------------------------------------------------
1141 :
1142 318408 : call icepack_query_tracer_flags(tr_brine_out=tr_brine)
1143 318408 : call icepack_warnings_flush(nu_diag)
1144 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1145 0 : file=__FILE__,line= __LINE__)
1146 :
1147 318408 : call icepack_query_parameters(skl_bgc_out=skl_bgc)
1148 318408 : call icepack_warnings_flush(nu_diag)
1149 318408 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1150 0 : file=__FILE__,line= __LINE__)
1151 :
1152 : !-----------------------------------------------------------------
1153 :
1154 318408 : if (tr_brine .or. skl_bgc) then
1155 :
1156 : !-----------------------------------------------------------------
1157 :
1158 : call icepack_query_tracer_sizes( &
1159 : max_algae_out=max_algae, max_nbtrcr_out=max_nbtrcr, max_don_out=max_don, &
1160 22212 : max_doc_out=max_doc, max_dic_out=max_dic, max_aero_out=max_aero, max_fe_out=max_fe)
1161 22212 : call icepack_warnings_flush(nu_diag)
1162 22212 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1163 0 : file=__FILE__,line= __LINE__)
1164 :
1165 : !-----------------------------------------------------------------
1166 :
1167 22212 : allocate(bio_index_o(max_nbtrcr))
1168 22212 : allocate(nlt_zaero(max_aero))
1169 :
1170 : !-----------------------------------------------------------------
1171 :
1172 22212 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr)
1173 22212 : call icepack_query_tracer_flags(tr_zaero_out=tr_zaero)
1174 22212 : call icepack_query_tracer_indices(nlt_zaero_out=nlt_zaero)
1175 22212 : call icepack_query_tracer_indices(bio_index_o_out=bio_index_o)
1176 22212 : call icepack_warnings_flush(nu_diag)
1177 22212 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1178 0 : file=__FILE__,line= __LINE__)
1179 :
1180 : !-----------------------------------------------------------------
1181 :
1182 : ! Define ocean concentrations for tracers used in simulation
1183 111060 : do i = 1, nx
1184 :
1185 : call icepack_load_ocean_bio_array(max_nbtrcr=max_nbtrcr,&
1186 : max_algae = max_algae, max_don = max_don, &
1187 : max_doc = max_doc, max_dic = max_dic, &
1188 : max_aero = max_aero, max_fe = max_fe, &
1189 27360 : nit = nit(i), amm = amm(i), &
1190 27360 : sil = sil(i), dmsp = dmsp(i), &
1191 27360 : dms = dms(i), algalN = algalN(i,:), &
1192 : doc = doc(i,:), don = don(i,:), &
1193 : dic = dic(i,:), fed = fed(i,:), &
1194 : fep = fep(i,:), zaeros = zaeros(i,:), &
1195 : ocean_bio_all=ocean_bio_all(i,:), &
1196 88848 : hum=hum(i))
1197 : ! call icepack_warnings_flush(nu_diag)
1198 : ! if (icepack_warnings_aborted()) call icedrv_system_abort(i, istep1, subname, &
1199 : ! file=__FILE__,line= __LINE__)
1200 :
1201 1832784 : do mm = 1,nbtrcr
1202 1832784 : ocean_bio(i,mm) = ocean_bio_all(i,bio_index_o(mm))
1203 : enddo ! mm
1204 88848 : if (tr_zaero) then
1205 564144 : do mm = 1, n_zaero ! update aerosols
1206 564144 : flux_bio_atm(i,nlt_zaero(mm)) = faero_atm(i,mm)
1207 : enddo ! mm
1208 : endif
1209 :
1210 : call icepack_biogeochemistry(dt=dt, ntrcr=ntrcr, nbtrcr=nbtrcr, &
1211 : ncat=ncat, nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, &
1212 : n_algae=n_algae, n_zaero=n_zaero, &
1213 : n_doc=n_doc, n_dic=n_dic, n_don=n_don, &
1214 : n_fed=n_fed, n_fep=n_fep, &
1215 : bgrid=bgrid, igrid=igrid, icgrid=icgrid, cgrid=cgrid, &
1216 27360 : upNO = upNO(i), &
1217 27360 : upNH = upNH(i), &
1218 : iDi = iDi(i,:,:), &
1219 : iki = iki(i,:,:), &
1220 : zfswin = zfswin(i,:,:), &
1221 27360 : zsal_tot = zsal_tot(i), &
1222 : darcy_V = darcy_V(i,:), &
1223 27360 : grow_net = grow_net(i), &
1224 27360 : PP_net = PP_net(i), &
1225 27360 : hbri = hbri(i), &
1226 : dhbr_bot = dhbr_bot(i,:), &
1227 : dhbr_top = dhbr_top(i,:), &
1228 : Zoo = Zoo(i,:,:), &
1229 : fbio_snoice = fbio_snoice(i,:), &
1230 : fbio_atmice = fbio_atmice(i,:), &
1231 0 : ocean_bio = ocean_bio(i,1:nbtrcr), &
1232 : first_ice = first_ice(i,:), &
1233 : fswpenln = fswpenln(i,:,:), &
1234 : bphi = bphi(i,:,:), &
1235 : bTiz = bTiz(i,:,:), &
1236 0 : ice_bio_net = ice_bio_net(i,1:nbtrcr), &
1237 0 : snow_bio_net = snow_bio_net(i,1:nbtrcr), &
1238 : fswthrun = fswthrun(i,:), &
1239 27360 : Rayleigh_criteria = Rayleigh_criteria(i), &
1240 : sice_rho = sice_rho(i,:), &
1241 27360 : fzsal = fzsal(i), &
1242 27360 : fzsal_g = fzsal_g(i), &
1243 : meltbn = meltbn(i,:), &
1244 : melttn = melttn(i,:), &
1245 : congeln = congeln(i,:), &
1246 : snoicen = snoicen(i,:), &
1247 27360 : sst = sst(i), &
1248 27360 : sss = sss(i), &
1249 27360 : fsnow = fsnow(i), &
1250 : meltsn = meltsn(i,:), &
1251 : hin_old = hin_old(i,:), &
1252 0 : flux_bio = flux_bio(i,1:nbtrcr), &
1253 0 : flux_bio_atm = flux_bio_atm(i,1:nbtrcr), &
1254 : aicen_init = aicen_init(i,:), &
1255 : vicen_init = vicen_init(i,:), &
1256 : aicen = aicen(i,:), &
1257 : vicen = vicen(i,:), &
1258 : vsnon = vsnon(i,:), &
1259 27360 : aice0 = aice0(i), &
1260 0 : trcrn = trcrn(i,1:ntrcr,:), &
1261 : vsnon_init = vsnon_init(i,:), &
1262 275220 : skl_bgc = skl_bgc)
1263 :
1264 : ! call icepack_warnings_flush(nu_diag)
1265 : ! if (icepack_warnings_aborted()) call icedrv_system_abort(i, istep1, subname, &
1266 : ! __FILE__, __LINE__)
1267 :
1268 : enddo ! i
1269 22212 : call icepack_warnings_flush(nu_diag)
1270 22212 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
1271 0 : file=__FILE__, line=__LINE__)
1272 :
1273 22212 : deallocate(nlt_zaero)
1274 22212 : deallocate(bio_index_o)
1275 :
1276 : endif ! tr_brine .or. skl_bgc
1277 :
1278 318408 : end subroutine biogeochemistry
1279 :
1280 : !=======================================================================
1281 :
1282 : end module icedrv_step
1283 :
1284 : !=======================================================================
|
