Line data Source code
1 : !=======================================================================
2 :
3 : ! Snow tracer history output
4 :
5 : module ice_history_snow
6 :
7 : use ice_kinds_mod
8 : use ice_constants, only: c0, c1, mps_to_cmpdy
9 : use ice_domain_size, only: max_nstrm, nslyr
10 : use ice_fileunits, only: nu_nml, nml_filename, &
11 : get_fileunit, release_fileunit
12 : use ice_fileunits, only: nu_diag
13 : use ice_exit, only: abort_ice
14 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
15 : use icepack_intfc, only: icepack_query_parameters, &
16 : icepack_query_tracer_flags, icepack_query_tracer_indices
17 :
18 : implicit none
19 : private
20 : public :: accum_hist_snow, init_hist_snow_2D, init_hist_snow_3Dc
21 :
22 : !---------------------------------------------------------------
23 : ! flags: write to output file if true or histfreq value
24 : !---------------------------------------------------------------
25 :
26 : character (len=max_nstrm), public :: &
27 : f_smassice = 'm', f_smassicen = 'x', & ! LCOV_EXCL_LINE
28 : f_smassliq = 'm', f_smassliqn = 'x', & ! LCOV_EXCL_LINE
29 : f_rhos_cmp = 'm', f_rhos_cmpn = 'x', & ! LCOV_EXCL_LINE
30 : f_rhos_cnt = 'm', f_rhos_cntn = 'x', & ! LCOV_EXCL_LINE
31 : f_rsnw = 'm', f_rsnwn = 'x', & ! LCOV_EXCL_LINE
32 : f_meltsliq = 'm', f_fsloss = 'x'
33 :
34 : !---------------------------------------------------------------
35 : ! namelist variables
36 : !---------------------------------------------------------------
37 :
38 : namelist / icefields_snow_nml / &
39 : f_smassice, f_smassicen, & ! LCOV_EXCL_LINE
40 : f_smassliq, f_smassliqn, & ! LCOV_EXCL_LINE
41 : f_rhos_cmp, f_rhos_cmpn, & ! LCOV_EXCL_LINE
42 : f_rhos_cnt, f_rhos_cntn, & ! LCOV_EXCL_LINE
43 : f_rsnw, f_rsnwn, & ! LCOV_EXCL_LINE
44 : f_meltsliq, f_fsloss
45 :
46 : !---------------------------------------------------------------
47 : ! field indices
48 : !---------------------------------------------------------------
49 :
50 : integer (kind=int_kind), dimension(max_nstrm), public :: &
51 : n_smassice, n_smassicen, & ! LCOV_EXCL_LINE
52 : n_smassliq, n_smassliqn, & ! LCOV_EXCL_LINE
53 : n_rhos_cmp, n_rhos_cmpn, & ! LCOV_EXCL_LINE
54 : n_rhos_cnt, n_rhos_cntn, & ! LCOV_EXCL_LINE
55 : n_rsnw, n_rsnwn, & ! LCOV_EXCL_LINE
56 : n_meltsliq, n_fsloss
57 :
58 : !=======================================================================
59 :
60 : contains
61 :
62 : !=======================================================================
63 :
64 37 : subroutine init_hist_snow_2D (dt)
65 :
66 : use ice_broadcast, only: broadcast_scalar
67 : use ice_calendar, only: nstreams, histfreq
68 : use ice_communicate, only: my_task, master_task
69 : use ice_history_shared, only: tstr2D, tcstr, define_hist_field
70 : use ice_fileunits, only: nu_nml, nml_filename, &
71 : get_fileunit, release_fileunit
72 : use ice_fileunits, only: goto_nml
73 :
74 : real (kind=dbl_kind), intent(in) :: &
75 : dt ! time step
76 :
77 : integer (kind=int_kind) :: ns
78 : integer (kind=int_kind) :: nml_error ! namelist i/o error flag
79 8 : real (kind=dbl_kind) :: rhofresh, secday
80 : logical (kind=log_kind) :: tr_snow
81 : character(len=char_len_long) :: tmpstr2 ! for namelist check
82 : character(len=char_len) :: nml_name ! for namelist check
83 :
84 : character(len=*), parameter :: subname = '(init_hist_snow_2D)'
85 :
86 37 : call icepack_query_tracer_flags(tr_snow_out=tr_snow)
87 37 : call icepack_query_parameters(rhofresh_out=rhofresh,secday_out=secday)
88 37 : call icepack_warnings_flush(nu_diag)
89 37 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
90 0 : file=__FILE__, line=__LINE__)
91 :
92 37 : if (tr_snow) then
93 :
94 : !-----------------------------------------------------------------
95 : ! read namelist
96 : !-----------------------------------------------------------------
97 :
98 0 : if (my_task == master_task) then
99 0 : nml_name = 'icefields_snow_nml'
100 0 : write(nu_diag,*) subname,' Reading ', trim(nml_name)
101 :
102 : ! open namelist file
103 0 : call get_fileunit(nu_nml)
104 0 : open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
105 0 : if (nml_error /= 0) then
106 : call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// &
107 : trim(nml_filename), & ! LCOV_EXCL_LINE
108 0 : file=__FILE__, line=__LINE__)
109 : endif
110 :
111 : ! goto namelist in file
112 0 : call goto_nml(nu_nml,trim(nml_name),nml_error)
113 0 : if (nml_error /= 0) then
114 : call abort_ice(subname//'ERROR: searching for '// trim(nml_name), &
115 0 : file=__FILE__, line=__LINE__)
116 : endif
117 :
118 : ! read namelist
119 0 : nml_error = 1
120 0 : do while (nml_error > 0)
121 0 : read(nu_nml, nml=icefields_snow_nml,iostat=nml_error)
122 : ! check if error
123 0 : if (nml_error /= 0) then
124 : ! backspace and re-read erroneous line
125 0 : backspace(nu_nml)
126 0 : read(nu_nml,fmt='(A)') tmpstr2
127 : call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // &
128 0 : trim(tmpstr2), file=__FILE__, line=__LINE__)
129 : endif
130 : end do
131 :
132 0 : close(nu_nml)
133 0 : call release_fileunit(nu_nml)
134 :
135 : endif
136 :
137 : else ! .not. tr_snow
138 37 : f_smassice = 'x'
139 37 : f_smassliq = 'x'
140 37 : f_rhos_cmp = 'x'
141 37 : f_rhos_cnt = 'x'
142 37 : f_rsnw = 'x'
143 37 : f_smassicen= 'x'
144 37 : f_smassliqn= 'x'
145 37 : f_rhos_cmpn= 'x'
146 37 : f_rhos_cntn= 'x'
147 37 : f_rsnwn = 'x'
148 37 : f_meltsliq = 'x'
149 37 : f_fsloss = 'x'
150 : endif
151 :
152 37 : call broadcast_scalar (f_smassice, master_task)
153 37 : call broadcast_scalar (f_smassliq, master_task)
154 37 : call broadcast_scalar (f_rhos_cmp, master_task)
155 37 : call broadcast_scalar (f_rhos_cnt, master_task)
156 37 : call broadcast_scalar (f_rsnw, master_task)
157 37 : call broadcast_scalar (f_smassicen,master_task)
158 37 : call broadcast_scalar (f_smassliqn,master_task)
159 37 : call broadcast_scalar (f_rhos_cmpn,master_task)
160 37 : call broadcast_scalar (f_rhos_cntn,master_task)
161 37 : call broadcast_scalar (f_rsnwn, master_task)
162 37 : call broadcast_scalar (f_meltsliq, master_task)
163 37 : call broadcast_scalar (f_fsloss, master_task)
164 :
165 37 : if (tr_snow) then
166 :
167 : ! 2D variables
168 0 : do ns = 1, nstreams
169 0 : if (histfreq(ns) /= 'x') then
170 :
171 0 : if (f_smassice(1:1) /= 'x') &
172 : call define_hist_field(n_smassice,"smassice","kg/m^2",tstr2D, tcstr, & ! LCOV_EXCL_LINE
173 : "ice mass per unit area in snow", & ! LCOV_EXCL_LINE
174 : "none", c1, c0, & ! LCOV_EXCL_LINE
175 0 : ns, f_smassice)
176 :
177 0 : if (f_smassliq(1:1) /= 'x') &
178 : call define_hist_field(n_smassliq,"smassliq","kg/m^2",tstr2D, tcstr, & ! LCOV_EXCL_LINE
179 : "liquid mass per unit area in snow", & ! LCOV_EXCL_LINE
180 : "none", c1, c0, & ! LCOV_EXCL_LINE
181 0 : ns, f_smassliq)
182 :
183 0 : if (f_rhos_cmp(1:1) /= 'x') &
184 : call define_hist_field(n_rhos_cmp,"rhos_cmp","kg/m^3",tstr2D, tcstr, & ! LCOV_EXCL_LINE
185 : "snow density: compaction", & ! LCOV_EXCL_LINE
186 : "none", c1, c0, & ! LCOV_EXCL_LINE
187 0 : ns, f_rhos_cmp)
188 :
189 0 : if (f_rhos_cnt(1:1) /= 'x') &
190 : call define_hist_field(n_rhos_cnt,"rhos_cnt","kg/m^3",tstr2D, tcstr, & ! LCOV_EXCL_LINE
191 : "snow density: content", & ! LCOV_EXCL_LINE
192 : "none", c1, c0, & ! LCOV_EXCL_LINE
193 0 : ns, f_rhos_cnt)
194 :
195 0 : if (f_rsnw(1:1) /= 'x') &
196 : call define_hist_field(n_rsnw,"rsnw","10^-6 m",tstr2D, tcstr, & ! LCOV_EXCL_LINE
197 : "average snow grain radius", & ! LCOV_EXCL_LINE
198 : "none", c1, c0, & ! LCOV_EXCL_LINE
199 0 : ns, f_rsnw)
200 :
201 0 : if (f_meltsliq(1:1) /= 'x') &
202 : call define_hist_field(n_meltsliq,"meltsliq","kg/m^2/s",tstr2D, tcstr, & ! LCOV_EXCL_LINE
203 : "snow liquid contribution to meltponds", & ! LCOV_EXCL_LINE
204 : "none", c1/dt, c0, & ! LCOV_EXCL_LINE
205 0 : ns, f_meltsliq)
206 :
207 0 : if (f_fsloss(1:1) /= 'x') &
208 : call define_hist_field(n_fsloss,"fsloss","kg/m^2/s",tstr2D, tcstr, & ! LCOV_EXCL_LINE
209 : "rate of snow loss to leads (liquid)", & ! LCOV_EXCL_LINE
210 : "none", c1, c0, & ! LCOV_EXCL_LINE
211 0 : ns, f_fsloss)
212 :
213 : endif ! histfreq(ns) /= 'x'
214 : enddo ! nstreams
215 : endif ! tr_snow
216 :
217 37 : end subroutine init_hist_snow_2D
218 :
219 : !=======================================================================
220 :
221 37 : subroutine init_hist_snow_3Dc
222 :
223 : use ice_calendar, only: nstreams, histfreq
224 : use ice_history_shared, only: tstr3Dc, tcstr, define_hist_field
225 :
226 : integer (kind=int_kind) :: ns
227 : logical (kind=log_kind) :: tr_snow
228 : character(len=*), parameter :: subname = '(init_hist_pond_3Dc)'
229 :
230 37 : call icepack_query_tracer_flags(tr_snow_out=tr_snow)
231 37 : call icepack_warnings_flush(nu_diag)
232 37 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
233 0 : file=__FILE__, line=__LINE__)
234 :
235 37 : if (tr_snow) then
236 :
237 : ! 3D (category) variables must be looped separately
238 0 : do ns = 1, nstreams
239 0 : if (histfreq(ns) /= 'x') then
240 :
241 0 : if (f_smassicen(1:1) /= 'x') &
242 : call define_hist_field(n_smassicen,"smassicen","kg/m^2",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
243 : "ice mass per unit area in snow, category", & ! LCOV_EXCL_LINE
244 : "none", c1, c0, & ! LCOV_EXCL_LINE
245 0 : ns, f_smassicen)
246 :
247 0 : if (f_smassliqn(1:1) /= 'x') &
248 : call define_hist_field(n_smassliqn,"smassliqn","kg/m^2",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
249 : "liquid mass per unit area in snow, category", & ! LCOV_EXCL_LINE
250 : "none", c1, c0, & ! LCOV_EXCL_LINE
251 0 : ns, f_smassliqn)
252 :
253 0 : if (f_rhos_cmpn(1:1) /= 'x') &
254 : call define_hist_field(n_rhos_cmpn,"rhos_cmpn","kg/m^3",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
255 : "snow density: compaction, category", & ! LCOV_EXCL_LINE
256 : "none", c1, c0, & ! LCOV_EXCL_LINE
257 0 : ns, f_rhos_cmpn)
258 :
259 0 : if (f_rhos_cntn(1:1) /= 'x') &
260 : call define_hist_field(n_rhos_cntn,"rhos_cntn","kg/m^3",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
261 : "snow density: content, category", & ! LCOV_EXCL_LINE
262 : "none", c1, c0, & ! LCOV_EXCL_LINE
263 0 : ns, f_rhos_cntn)
264 :
265 0 : if (f_rsnwn(1:1) /= 'x') &
266 : call define_hist_field(n_rsnwn,"rsnwn","10^-6 m",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
267 : "average snow grain radius, category", & ! LCOV_EXCL_LINE
268 : "none", c1, c0, & ! LCOV_EXCL_LINE
269 0 : ns, f_rsnwn)
270 :
271 : endif ! histfreq(ns) /= 'x'
272 : enddo ! ns
273 :
274 : endif ! tr_snow
275 :
276 37 : end subroutine init_hist_snow_3Dc
277 :
278 : !=======================================================================
279 :
280 : ! accumulate average ice quantities or snapshots
281 :
282 23104 : subroutine accum_hist_snow (iblk)
283 :
284 : use ice_arrays_column, only: meltsliq
285 : use ice_blocks, only: block, nx_block, ny_block
286 : use ice_flux, only: fsloss
287 : use ice_history_shared, only: n2D, a2D, a3Dc, ncat_hist, &
288 : accum_hist_field, nzslyr
289 : use ice_state, only: vsno, vsnon, trcr, trcrn
290 :
291 : integer (kind=int_kind), intent(in) :: &
292 : iblk ! block index
293 :
294 : ! local variables
295 :
296 : integer (kind=int_kind) :: &
297 : k, n
298 :
299 : integer (kind=int_kind) :: &
300 : nt_smice, nt_smliq, nt_rhos, nt_rsnw
301 :
302 : logical (kind=log_kind) :: tr_snow
303 :
304 : real (kind=dbl_kind), dimension (nx_block,ny_block) :: &
305 5067872 : worka
306 :
307 : real (kind=dbl_kind), dimension (nx_block,ny_block,ncat_hist) :: &
308 25206656 : workb
309 :
310 : character(len=*), parameter :: subname = '(accum_hist_snow)'
311 :
312 : !---------------------------------------------------------------
313 : ! increment field
314 : !---------------------------------------------------------------
315 :
316 23104 : call icepack_query_tracer_flags(tr_snow_out=tr_snow)
317 : call icepack_query_tracer_indices(nt_smice_out=nt_smice, &
318 23104 : nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw)
319 23104 : call icepack_warnings_flush(nu_diag)
320 23104 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
321 0 : file=__FILE__, line=__LINE__)
322 :
323 23104 : if (allocated(a2D)) then
324 23104 : if (tr_snow) then
325 :
326 0 : if (f_smassice(1:1)/= 'x') then
327 0 : worka(:,:) = c0
328 0 : do k = 1, nzslyr
329 0 : worka(:,:) = worka(:,:) &
330 0 : + trcr(:,:,nt_smice+k-1,iblk)
331 : enddo
332 0 : worka(:,:) = worka(:,:) * vsno(:,:,iblk) / real(nslyr,kind=dbl_kind)
333 0 : call accum_hist_field(n_smassice, iblk, worka, a2D)
334 : endif
335 0 : if (f_smassliq(1:1)/= 'x') then
336 0 : worka(:,:) = c0
337 0 : do k = 1, nzslyr
338 0 : worka(:,:) = worka(:,:) &
339 0 : + trcr(:,:,nt_smliq+k-1,iblk)
340 : enddo
341 0 : worka(:,:) = worka(:,:) * vsno(:,:,iblk) / real(nslyr,kind=dbl_kind)
342 0 : call accum_hist_field(n_smassliq, iblk, worka, a2D)
343 : endif
344 0 : if (f_rhos_cmp(1:1)/= 'x') then
345 0 : worka(:,:) = c0
346 0 : do k = 1, nzslyr
347 0 : worka(:,:) = worka(:,:) &
348 0 : + trcr(:,:,nt_rhos+k-1,iblk)
349 : enddo
350 0 : worka(:,:) = worka(:,:) / real(nslyr,kind=dbl_kind)
351 0 : call accum_hist_field(n_rhos_cmp, iblk, worka, a2D)
352 : endif
353 0 : if (f_rhos_cnt(1:1)/= 'x') then
354 0 : worka(:,:) = c0
355 0 : do k = 1, nzslyr
356 0 : worka(:,:) = worka(:,:) &
357 : + trcr(:,:,nt_smice+k-1,iblk) & ! LCOV_EXCL_LINE
358 0 : + trcr(:,:,nt_smliq+k-1,iblk)
359 : enddo
360 0 : worka(:,:) = worka(:,:) / real(nslyr,kind=dbl_kind)
361 0 : call accum_hist_field(n_rhos_cnt, iblk, worka, a2D)
362 : endif
363 0 : if (f_rsnw(1:1)/= 'x') then
364 0 : worka(:,:) = c0
365 0 : do k = 1, nzslyr
366 0 : worka(:,:) = worka(:,:) &
367 0 : + trcr(:,:,nt_rsnw+k-1,iblk)
368 : enddo
369 0 : worka(:,:) = worka(:,:) / real(nslyr,kind=dbl_kind)
370 0 : call accum_hist_field(n_rsnw, iblk, worka, a2D)
371 : endif
372 0 : if (f_meltsliq(1:1)/= 'x') &
373 : call accum_hist_field(n_meltsliq, iblk, & ! LCOV_EXCL_LINE
374 0 : meltsliq(:,:,iblk), a2D)
375 0 : if (f_fsloss(1:1)/= 'x') &
376 : call accum_hist_field(n_fsloss, iblk, & ! LCOV_EXCL_LINE
377 0 : fsloss(:,:,iblk), a2D)
378 :
379 : endif ! allocated(a2D)
380 :
381 : ! 3D category fields
382 23104 : if (allocated(a3Dc)) then
383 0 : if (f_smassicen(1:1)/= 'x') then
384 0 : workb(:,:,:) = c0
385 0 : do n = 1, ncat_hist
386 0 : do k = 1, nzslyr
387 0 : workb(:,:,n) = workb(:,:,n) &
388 0 : + trcrn(:,:,nt_smice+k-1,n,iblk)
389 : enddo
390 0 : workb(:,:,n) = workb(:,:,n) &
391 0 : * vsnon(:,:,n,iblk) / real(nslyr,kind=dbl_kind)
392 : enddo
393 0 : call accum_hist_field(n_smassicen-n2D, iblk, ncat_hist, workb, a3Dc)
394 : endif
395 0 : if (f_smassliqn(1:1)/= 'x') then
396 0 : workb(:,:,:) = c0
397 0 : do n = 1, ncat_hist
398 0 : do k = 1, nzslyr
399 0 : workb(:,:,n) = workb(:,:,n) &
400 0 : + trcrn(:,:,nt_smliq+k-1,n,iblk)
401 : enddo
402 0 : workb(:,:,n) = workb(:,:,n) &
403 0 : * vsnon(:,:,n,iblk) / real(nslyr,kind=dbl_kind)
404 : enddo
405 0 : call accum_hist_field(n_smassliqn-n2D, iblk, ncat_hist, workb, a3Dc)
406 : endif
407 0 : if (f_rhos_cmpn(1:1)/= 'x') then
408 0 : workb(:,:,:) = c0
409 0 : do n = 1, ncat_hist
410 0 : do k = 1, nzslyr
411 0 : workb(:,:,n) = workb(:,:,n) &
412 0 : + trcrn(:,:,nt_rhos+k-1,n,iblk)
413 : enddo
414 0 : workb(:,:,n) = workb(:,:,n) / real(nslyr,kind=dbl_kind)
415 : enddo
416 0 : call accum_hist_field(n_rhos_cmpn-n2D, iblk, ncat_hist, workb, a3Dc)
417 : endif
418 0 : if (f_rhos_cntn(1:1)/= 'x') then
419 0 : workb(:,:,:) = c0
420 0 : do n = 1, ncat_hist
421 0 : do k = 1, nzslyr
422 0 : workb(:,:,n) = workb(:,:,n) &
423 : + trcrn(:,:,nt_smice+k-1,n,iblk) & ! LCOV_EXCL_LINE
424 0 : + trcrn(:,:,nt_smliq+k-1,n,iblk)
425 : enddo
426 0 : workb(:,:,n) = workb(:,:,n) / real(nslyr,kind=dbl_kind)
427 : enddo
428 0 : call accum_hist_field(n_rhos_cntn-n2D, iblk, ncat_hist, workb, a3Dc)
429 : endif
430 0 : if (f_rsnwn(1:1)/= 'x') then
431 0 : workb(:,:,:) = c0
432 0 : do n = 1, ncat_hist
433 0 : do k = 1, nzslyr
434 0 : workb(:,:,n) = workb(:,:,n) &
435 0 : + trcrn(:,:,nt_rsnw+k-1,n,iblk)
436 : enddo
437 0 : workb(:,:,n) = workb(:,:,n) / real(nslyr,kind=dbl_kind)
438 : enddo
439 0 : call accum_hist_field(n_rsnwn-n2D, iblk, ncat_hist, workb, a3Dc)
440 : endif
441 : endif ! allocated(a3Dc)
442 :
443 : endif ! tr_snow
444 :
445 23104 : end subroutine accum_hist_snow
446 :
447 : !=======================================================================
448 :
449 : end module ice_history_snow
450 :
451 : !=======================================================================
|
