Line data Source code
1 : !=======================================================================
2 :
3 : ! Melt pond history output
4 : !
5 : ! 2012 Elizabeth Hunke split code from ice_history.F90
6 :
7 : module ice_history_pond
8 :
9 : use ice_kinds_mod
10 : use ice_domain_size, only: max_nstrm
11 : use ice_constants, only: c0, c1
12 : use ice_fileunits, only: nu_nml, nml_filename, &
13 : get_fileunit, release_fileunit
14 : use ice_fileunits, only: nu_diag
15 : use ice_exit, only: abort_ice
16 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
17 : use icepack_intfc, only: icepack_query_parameters, &
18 : icepack_query_tracer_flags, icepack_query_tracer_indices
19 :
20 : implicit none
21 : private
22 : public :: accum_hist_pond, init_hist_pond_2D, init_hist_pond_3Dc
23 :
24 : !---------------------------------------------------------------
25 : ! flags: write to output file if true or histfreq value
26 : !---------------------------------------------------------------
27 :
28 : character (len=max_nstrm), public :: &
29 : f_apondn = 'm', f_apeffn = 'm', & ! LCOV_EXCL_LINE
30 : f_hpondn = 'm', & ! LCOV_EXCL_LINE
31 : f_apond = 'x', f_apond_ai = 'x', & ! LCOV_EXCL_LINE
32 : f_hpond = 'x', f_hpond_ai = 'x', & ! LCOV_EXCL_LINE
33 : f_ipond = 'x', f_ipond_ai = 'x', & ! LCOV_EXCL_LINE
34 : f_apeff = 'x', f_apeff_ai = 'x'
35 :
36 : !---------------------------------------------------------------
37 : ! namelist variables
38 : !---------------------------------------------------------------
39 :
40 : namelist / icefields_pond_nml / &
41 : f_apondn, f_apeffn , & ! LCOV_EXCL_LINE
42 : f_hpondn, & ! LCOV_EXCL_LINE
43 : f_apond, f_apond_ai , & ! LCOV_EXCL_LINE
44 : f_hpond, f_hpond_ai , & ! LCOV_EXCL_LINE
45 : f_ipond, f_ipond_ai , & ! LCOV_EXCL_LINE
46 : f_apeff, f_apeff_ai
47 :
48 : !---------------------------------------------------------------
49 : ! field indices
50 : !---------------------------------------------------------------
51 :
52 : integer (kind=int_kind), dimension(max_nstrm) :: &
53 : n_apondn , n_apeffn , & ! LCOV_EXCL_LINE
54 : n_hpondn , & ! LCOV_EXCL_LINE
55 : n_apond , n_apond_ai, & ! LCOV_EXCL_LINE
56 : n_hpond , n_hpond_ai, & ! LCOV_EXCL_LINE
57 : n_ipond , n_ipond_ai, & ! LCOV_EXCL_LINE
58 : n_apeff , n_apeff_ai
59 :
60 : !=======================================================================
61 :
62 : contains
63 :
64 : !=======================================================================
65 :
66 37 : subroutine init_hist_pond_2D
67 :
68 : use ice_broadcast, only: broadcast_scalar
69 : use ice_calendar, only: nstreams, histfreq
70 : use ice_communicate, only: my_task, master_task
71 : use ice_history_shared, only: tstr2D, tcstr, define_hist_field
72 : use ice_fileunits, only: goto_nml
73 :
74 : integer (kind=int_kind) :: ns
75 : integer (kind=int_kind) :: nml_error ! namelist i/o error flag
76 : logical (kind=log_kind) :: tr_pond
77 : character(len=char_len_long) :: tmpstr2 ! for namelist check
78 : character(len=char_len) :: nml_name ! text namelist name
79 :
80 : character(len=*), parameter :: subname = '(init_hist_pond_2D)'
81 :
82 37 : call icepack_query_tracer_flags(tr_pond_out=tr_pond)
83 37 : call icepack_warnings_flush(nu_diag)
84 37 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
85 0 : file=__FILE__, line=__LINE__)
86 :
87 : !-----------------------------------------------------------------
88 : ! read namelist
89 : !-----------------------------------------------------------------
90 :
91 37 : if (my_task == master_task) then
92 7 : nml_name = 'icefields_pond_nml'
93 7 : write(nu_diag,*) subname,' Reading ', trim(nml_name)
94 :
95 : ! open namelist file
96 7 : call get_fileunit(nu_nml)
97 7 : open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
98 7 : if (nml_error /= 0) then
99 : call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// &
100 : trim(nml_filename), & ! LCOV_EXCL_LINE
101 0 : file=__FILE__, line=__LINE__)
102 : endif
103 :
104 : ! goto this namelist in file
105 7 : call goto_nml(nu_nml,trim(nml_name),nml_error)
106 7 : if (nml_error /= 0) then
107 : call abort_ice(subname//'ERROR: searching for '// trim(nml_name), &
108 0 : file=__FILE__, line=__LINE__)
109 : endif
110 :
111 : ! read namelist
112 7 : nml_error = 1
113 14 : do while (nml_error > 0)
114 7 : read(nu_nml, nml=icefields_pond_nml,iostat=nml_error)
115 : ! check if error
116 7 : if (nml_error /= 0) then
117 : ! backspace and re-read erroneous line
118 0 : backspace(nu_nml)
119 0 : read(nu_nml,fmt='(A)') tmpstr2
120 : call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // &
121 0 : trim(tmpstr2), file=__FILE__, line=__LINE__)
122 : endif
123 : end do
124 :
125 7 : close(nu_nml)
126 7 : call release_fileunit(nu_nml)
127 : endif
128 :
129 37 : if (.not. tr_pond) then
130 0 : f_apondn = 'x'
131 0 : f_hpondn = 'x'
132 0 : f_apeffn = 'x'
133 0 : f_apond = 'x'
134 0 : f_hpond = 'x'
135 0 : f_ipond = 'x'
136 0 : f_apeff = 'x'
137 0 : f_apond_ai = 'x'
138 0 : f_hpond_ai = 'x'
139 0 : f_ipond_ai = 'x'
140 0 : f_apeff_ai = 'x'
141 : endif
142 :
143 37 : call broadcast_scalar (f_apondn, master_task)
144 37 : call broadcast_scalar (f_hpondn, master_task)
145 37 : call broadcast_scalar (f_apeffn, master_task)
146 37 : call broadcast_scalar (f_apond, master_task)
147 37 : call broadcast_scalar (f_hpond, master_task)
148 37 : call broadcast_scalar (f_ipond, master_task)
149 37 : call broadcast_scalar (f_apeff, master_task)
150 37 : call broadcast_scalar (f_apond_ai, master_task)
151 37 : call broadcast_scalar (f_hpond_ai, master_task)
152 37 : call broadcast_scalar (f_ipond_ai, master_task)
153 37 : call broadcast_scalar (f_apeff_ai, master_task)
154 :
155 37 : if (tr_pond) then
156 :
157 : ! 2D variables
158 74 : do ns = 1, nstreams
159 74 : if (histfreq(ns) /= 'x') then
160 :
161 37 : if (f_apond(1:1) /= 'x') &
162 : call define_hist_field(n_apond,"apond","1",tstr2D, tcstr, & ! LCOV_EXCL_LINE
163 : "melt pond fraction of sea ice", & ! LCOV_EXCL_LINE
164 : "none", c1, c0, & ! LCOV_EXCL_LINE
165 37 : ns, f_apond)
166 :
167 37 : if (f_apond_ai(1:1) /= 'x') &
168 : call define_hist_field(n_apond_ai,"apond_ai","1",tstr2D, tcstr, & ! LCOV_EXCL_LINE
169 : "melt pond fraction of grid cell", & ! LCOV_EXCL_LINE
170 : "weighted by ice area", c1, c0, & ! LCOV_EXCL_LINE
171 37 : ns, f_apond_ai)
172 :
173 37 : if (f_hpond(1:1) /= 'x') &
174 : call define_hist_field(n_hpond,"hpond","m",tstr2D, tcstr, & ! LCOV_EXCL_LINE
175 : "mean melt pond depth over sea ice", & ! LCOV_EXCL_LINE
176 : "none", c1, c0, & ! LCOV_EXCL_LINE
177 37 : ns, f_hpond)
178 :
179 37 : if (f_hpond_ai(1:1) /= 'x') &
180 : call define_hist_field(n_hpond_ai,"hpond_ai","m",tstr2D, tcstr, & ! LCOV_EXCL_LINE
181 : "mean melt pond depth over grid cell", & ! LCOV_EXCL_LINE
182 : "weighted by ice area", c1, c0, & ! LCOV_EXCL_LINE
183 37 : ns, f_hpond)
184 :
185 37 : if (f_ipond(1:1) /= 'x') &
186 : call define_hist_field(n_ipond,"ipond","m",tstr2D, tcstr, & ! LCOV_EXCL_LINE
187 : "mean pond ice thickness over sea ice", & ! LCOV_EXCL_LINE
188 : "none", c1, c0, & ! LCOV_EXCL_LINE
189 37 : ns, f_ipond)
190 :
191 37 : if (f_ipond_ai(1:1) /= 'x') &
192 : call define_hist_field(n_ipond_ai,"ipond_ai","m",tstr2D, tcstr, & ! LCOV_EXCL_LINE
193 : "mean pond ice thickness over grid cell", & ! LCOV_EXCL_LINE
194 : "weighted by ice area", c1, c0, & ! LCOV_EXCL_LINE
195 37 : ns, f_ipond_ai)
196 :
197 37 : if (f_apeff(1:1) /= 'x') &
198 : call define_hist_field(n_apeff,"apeff","1",tstr2D, tcstr, & ! LCOV_EXCL_LINE
199 : "radiation-effective pond area fraction of sea ice", & ! LCOV_EXCL_LINE
200 : "none", c1, c0, & ! LCOV_EXCL_LINE
201 37 : ns, f_apeff)
202 :
203 37 : if (f_apeff_ai(1:1) /= 'x') &
204 : call define_hist_field(n_apeff_ai,"apeff_ai","1",tstr2D, tcstr, & ! LCOV_EXCL_LINE
205 : "radiation-effective pond area fraction over grid cell", & ! LCOV_EXCL_LINE
206 : "weighted by ice area", c1, c0, & ! LCOV_EXCL_LINE
207 37 : ns, f_apeff_ai)
208 :
209 : endif ! histfreq(ns) /= 'x'
210 : enddo ! nstreams
211 :
212 : endif ! tr_pond
213 :
214 37 : end subroutine init_hist_pond_2D
215 :
216 : !=======================================================================
217 :
218 37 : subroutine init_hist_pond_3Dc
219 :
220 : use ice_calendar, only: nstreams, histfreq
221 : use ice_history_shared, only: tstr3Dc, tcstr, define_hist_field
222 :
223 : integer (kind=int_kind) :: ns
224 : logical (kind=log_kind) :: tr_pond
225 : character(len=*), parameter :: subname = '(init_hist_pond_3Dc)'
226 :
227 37 : call icepack_query_tracer_flags(tr_pond_out=tr_pond)
228 37 : call icepack_warnings_flush(nu_diag)
229 37 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
230 0 : file=__FILE__, line=__LINE__)
231 :
232 37 : if (tr_pond) then
233 :
234 : ! 3D (category) variables must be looped separately
235 74 : do ns = 1, nstreams
236 74 : if (histfreq(ns) /= 'x') then
237 :
238 37 : if (f_apondn(1:1) /= 'x') &
239 : call define_hist_field(n_apondn,"apondn","1",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
240 : "melt pond fraction, category","none", c1, c0, & ! LCOV_EXCL_LINE
241 0 : ns, f_apondn)
242 :
243 37 : if (f_hpondn(1:1) /= 'x') &
244 : call define_hist_field(n_hpondn,"hpondn","m",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
245 : "melt pond depth, category","none", c1, c0, & ! LCOV_EXCL_LINE
246 0 : ns, f_hpondn)
247 :
248 37 : if (f_apeffn(1:1) /= 'x') &
249 : call define_hist_field(n_apeffn,"apeffn","1",tstr3Dc, tcstr, & ! LCOV_EXCL_LINE
250 : "effective melt pond fraction, category", & ! LCOV_EXCL_LINE
251 : "none", c1, c0, & ! LCOV_EXCL_LINE
252 0 : ns, f_apeffn)
253 :
254 : endif ! histfreq(ns) /= 'x'
255 : enddo ! ns
256 :
257 : endif ! tr_pond
258 :
259 37 : end subroutine init_hist_pond_3Dc
260 :
261 : !=======================================================================
262 :
263 : ! accumulate average ice quantities or snapshots
264 :
265 23104 : subroutine accum_hist_pond (iblk)
266 :
267 : use ice_arrays_column, only: apeffn
268 : use ice_blocks, only: block, get_block, nx_block, ny_block
269 : use ice_domain, only: blocks_ice
270 : use ice_flux, only: apeff_ai
271 : use ice_history_shared, only: n2D, a2D, a3Dc, ncat_hist, &
272 : accum_hist_field
273 : use ice_state, only: aice, trcr, trcrn
274 :
275 : integer (kind=int_kind), intent(in) :: &
276 : iblk ! block index
277 :
278 : ! local variables
279 :
280 : integer (kind=int_kind) :: &
281 : i,j, & ! LCOV_EXCL_LINE
282 : ilo,ihi,jlo,jhi ! beginning and end of physical domain
283 :
284 : real (kind=dbl_kind), dimension (nx_block,ny_block) :: &
285 5067872 : worka
286 :
287 : integer (kind=int_kind) :: &
288 : nt_apnd, nt_hpnd, nt_alvl, nt_ipnd
289 : logical (kind=log_kind) :: &
290 : tr_pond_lvl, tr_pond_topo
291 :
292 : real (kind=dbl_kind) :: &
293 5792 : puny
294 :
295 : type (block) :: &
296 : this_block ! block information for current block
297 :
298 : character(len=*), parameter :: subname = '(accum_hist_pond)'
299 :
300 : !---------------------------------------------------------------
301 : ! increment field
302 : !---------------------------------------------------------------
303 :
304 23104 : call icepack_query_parameters(puny_out=puny)
305 : call icepack_query_tracer_flags(tr_pond_lvl_out=tr_pond_lvl, &
306 23104 : tr_pond_topo_out=tr_pond_topo)
307 : call icepack_query_tracer_indices(nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, &
308 23104 : nt_alvl_out=nt_alvl, nt_ipnd_out=nt_ipnd)
309 23104 : call icepack_warnings_flush(nu_diag)
310 23104 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
311 0 : file=__FILE__, line=__LINE__)
312 :
313 23104 : if (allocated(a2D)) then
314 :
315 23104 : if (tr_pond_lvl) then
316 :
317 23104 : if (f_apond(1:1)/= 'x') &
318 : call accum_hist_field(n_apond, iblk, & ! LCOV_EXCL_LINE
319 16297970 : trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk), a2D)
320 23104 : if (f_apond_ai(1:1)/= 'x') &
321 : call accum_hist_field(n_apond_ai, iblk, & ! LCOV_EXCL_LINE
322 : aice(:,:,iblk) & ! LCOV_EXCL_LINE
323 16297970 : * trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk), a2D)
324 23104 : if (f_hpond(1:1)/= 'x') &
325 : call accum_hist_field(n_hpond, iblk, & ! LCOV_EXCL_LINE
326 : trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
327 16297970 : * trcr(:,:,nt_hpnd,iblk), a2D)
328 23104 : if (f_hpond_ai(1:1)/= 'x') &
329 : call accum_hist_field(n_hpond_ai, iblk, & ! LCOV_EXCL_LINE
330 : aice(:,:,iblk) & ! LCOV_EXCL_LINE
331 : * trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
332 16297970 : * trcr(:,:,nt_hpnd,iblk), a2D)
333 23104 : if (f_ipond(1:1)/= 'x') &
334 : call accum_hist_field(n_ipond, iblk, & ! LCOV_EXCL_LINE
335 : trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
336 16297970 : * trcr(:,:,nt_ipnd,iblk), a2D)
337 23104 : if (f_ipond_ai(1:1)/= 'x') &
338 : call accum_hist_field(n_ipond_ai, iblk, & ! LCOV_EXCL_LINE
339 : aice(:,:,iblk) & ! LCOV_EXCL_LINE
340 : * trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
341 16297970 : * trcr(:,:,nt_ipnd,iblk), a2D)
342 :
343 0 : elseif (tr_pond_topo) then
344 :
345 0 : if (f_apond(1:1)/= 'x') &
346 : call accum_hist_field(n_apond, iblk, & ! LCOV_EXCL_LINE
347 0 : trcr(:,:,nt_apnd,iblk), a2D)
348 0 : if (f_apond_ai(1:1)/= 'x') &
349 : call accum_hist_field(n_apond_ai, iblk, & ! LCOV_EXCL_LINE
350 0 : aice(:,:,iblk) * trcr(:,:,nt_apnd,iblk), a2D)
351 0 : if (f_hpond(1:1)/= 'x') &
352 : call accum_hist_field(n_hpond, iblk, & ! LCOV_EXCL_LINE
353 : trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
354 0 : * trcr(:,:,nt_hpnd,iblk), a2D)
355 0 : if (f_hpond_ai(1:1)/= 'x') &
356 : call accum_hist_field(n_hpond_ai, iblk, & ! LCOV_EXCL_LINE
357 : aice(:,:,iblk) * trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
358 0 : * trcr(:,:,nt_hpnd,iblk), a2D)
359 0 : if (f_ipond(1:1)/= 'x') &
360 : call accum_hist_field(n_ipond, iblk, & ! LCOV_EXCL_LINE
361 : trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
362 0 : * trcr(:,:,nt_ipnd,iblk), a2D)
363 0 : if (f_ipond_ai(1:1)/= 'x') &
364 : call accum_hist_field(n_ipond_ai, iblk, & ! LCOV_EXCL_LINE
365 : aice(:,:,iblk) * trcr(:,:,nt_apnd,iblk) & ! LCOV_EXCL_LINE
366 0 : * trcr(:,:,nt_ipnd,iblk), a2D)
367 : endif ! ponds
368 :
369 23104 : this_block = get_block(blocks_ice(iblk),iblk)
370 23104 : ilo = this_block%ilo
371 23104 : ihi = this_block%ihi
372 23104 : jlo = this_block%jlo
373 23104 : jhi = this_block%jhi
374 :
375 23104 : if (f_apeff (1:1) /= 'x') then
376 16297970 : worka(:,:) = c0
377 712671 : do j = jlo, jhi
378 13922534 : do i = ilo, ihi
379 13209863 : if (aice(i,j,iblk) > puny) worka(i,j) = apeff_ai(i,j,iblk) &
380 7546698 : / aice(i,j,iblk)
381 : enddo
382 : enddo
383 23104 : call accum_hist_field(n_apeff, iblk, worka(:,:), a2D)
384 : endif
385 23104 : if (f_apeff_ai(1:1) /= 'x') &
386 23104 : call accum_hist_field(n_apeff_ai, iblk, apeff_ai(:,:,iblk), a2D)
387 :
388 : endif ! allocated(a2D)
389 :
390 : ! 3D category fields
391 23104 : if (allocated(a3Dc)) then
392 0 : if (f_apondn (1:1) /= 'x') &
393 : call accum_hist_field(n_apondn-n2D, iblk, ncat_hist, & ! LCOV_EXCL_LINE
394 0 : trcrn(:,:,nt_apnd,1:ncat_hist,iblk), a3Dc)
395 0 : if (f_apeffn (1:1) /= 'x') &
396 : call accum_hist_field(n_apeffn-n2D, iblk, ncat_hist, & ! LCOV_EXCL_LINE
397 0 : apeffn(:,:,1:ncat_hist,iblk), a3Dc)
398 0 : if (f_hpondn (1:1) /= 'x') &
399 : call accum_hist_field(n_hpondn-n2D, iblk, ncat_hist, & ! LCOV_EXCL_LINE
400 : trcrn(:,:,nt_apnd,1:ncat_hist,iblk) & ! LCOV_EXCL_LINE
401 0 : * trcrn(:,:,nt_hpnd,1:ncat_hist,iblk), a3Dc)
402 : endif ! allocated(a3Dc)
403 :
404 23104 : end subroutine accum_hist_pond
405 :
406 : !=======================================================================
407 :
408 : end module ice_history_pond
409 :
410 : !=======================================================================
|
