Line data Source code
1 : !=======================================================================
2 : !
3 : ! Reads and interpolates forcing data for atmosphere and ocean quantities.
4 : !
5 : ! authors: Elizabeth C. Hunke, LANL
6 :
7 : module ice_restoring
8 :
9 : use ice_kinds_mod
10 : use ice_blocks, only: nx_block, ny_block
11 : use ice_constants, only: c0, c1, c2, p2
12 : use ice_domain_size, only: ncat, max_blocks
13 : use ice_forcing, only: trestore, trest
14 : use ice_state, only: aicen, vicen, vsnon, trcrn
15 : use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound
16 : use ice_exit, only: abort_ice
17 : use ice_fileunits, only: nu_diag
18 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
19 : use icepack_intfc, only: icepack_init_trcr
20 : use icepack_intfc, only: icepack_query_parameters, &
21 : icepack_query_tracer_sizes, icepack_query_tracer_flags, & ! LCOV_EXCL_LINE
22 : icepack_query_tracer_indices
23 :
24 : implicit none
25 : private
26 : public :: ice_HaloRestore_init, ice_HaloRestore
27 :
28 : logical (kind=log_kind), public :: &
29 : restore_ice ! restore ice state if true
30 :
31 : !-----------------------------------------------------------------
32 : ! state of the ice for each category
33 : !-----------------------------------------------------------------
34 :
35 : real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: &
36 : aicen_rest , & ! concentration of ice ! LCOV_EXCL_LINE
37 : vicen_rest , & ! volume per unit area of ice (m) ! LCOV_EXCL_LINE
38 : vsnon_rest ! volume per unit area of snow (m)
39 :
40 : real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: &
41 : trcrn_rest ! tracers
42 :
43 : !=======================================================================
44 :
45 : contains
46 :
47 : !=======================================================================
48 :
49 : ! Allocates and initializes arrays needed for restoring the ice state
50 : ! in cells surrounding the grid.
51 :
52 :
53 37 : subroutine ice_HaloRestore_init
54 :
55 : use ice_blocks, only: block, get_block, nblocks_x, nblocks_y
56 : use ice_communicate, only: my_task, master_task
57 : use ice_domain, only: ew_boundary_type, ns_boundary_type, &
58 : nblocks, blocks_ice
59 : use ice_grid, only: tmask, hm
60 : use ice_flux, only: Tf, Tair, salinz, Tmltz
61 : use ice_restart_shared, only: restart_ext
62 :
63 : integer (int_kind) :: &
64 : i,j,iblk,nt,n, &! dummy loop indices ! LCOV_EXCL_LINE
65 : ilo,ihi,jlo,jhi, &! beginning and end of physical domain ! LCOV_EXCL_LINE
66 : iglob(nx_block), &! global indices ! LCOV_EXCL_LINE
67 : jglob(ny_block), &! global indices ! LCOV_EXCL_LINE
68 : iblock, jblock, &! block indices ! LCOV_EXCL_LINE
69 : ibc, &! ghost cell column or row ! LCOV_EXCL_LINE
70 : ntrcr, &! ! LCOV_EXCL_LINE
71 : npad ! padding column/row counter
72 :
73 : character (len=7), parameter :: &
74 : ! restore_ic = 'defined' ! otherwise restore to initial ice state
75 : restore_ic = 'initial' ! restore to initial ice state
76 :
77 : type (block) :: &
78 : this_block ! block info for current block
79 :
80 : character(len=*), parameter :: subname = '(ice_HaloRestore_init)'
81 :
82 37 : if (.not. restore_ice) return
83 :
84 0 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
85 0 : call icepack_warnings_flush(nu_diag)
86 0 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
87 0 : file=__FILE__, line=__LINE__)
88 :
89 : if ((ew_boundary_type == 'open' .or. &
90 0 : ns_boundary_type == 'open') .and. .not.(restart_ext)) then
91 0 : if (my_task == master_task) write (nu_diag,*) 'ERROR: restart_ext=F and open boundaries'
92 : call abort_ice(error_message=subname//'open boundary and restart_ext=F', &
93 0 : file=__FILE__, line=__LINE__)
94 : endif
95 :
96 0 : allocate (aicen_rest(nx_block,ny_block,ncat,max_blocks), &
97 : vicen_rest(nx_block,ny_block,ncat,max_blocks), & ! LCOV_EXCL_LINE
98 : vsnon_rest(nx_block,ny_block,ncat,max_blocks), & ! LCOV_EXCL_LINE
99 0 : trcrn_rest(nx_block,ny_block,ntrcr,ncat,max_blocks))
100 :
101 0 : aicen_rest(:,:,:,:) = c0
102 0 : vicen_rest(:,:,:,:) = c0
103 0 : vsnon_rest(:,:,:,:) = c0
104 0 : trcrn_rest(:,:,:,:,:) = c0
105 :
106 : !-----------------------------------------------------------------------
107 : ! initialize
108 : ! halo cells have to be filled manually at this stage
109 : ! these arrays could be set to values read from a file...
110 : !-----------------------------------------------------------------------
111 :
112 : if (trim(restore_ic) == 'defined') then
113 :
114 : ! restore to defined ice state
115 : !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block, &
116 : !$OMP iglob,jglob,iblock,jblock)
117 : do iblk = 1, nblocks
118 : this_block = get_block(blocks_ice(iblk),iblk)
119 : ilo = this_block%ilo
120 : ihi = this_block%ihi
121 : jlo = this_block%jlo
122 : jhi = this_block%jhi
123 : iglob = this_block%i_glob
124 : jglob = this_block%j_glob
125 : iblock = this_block%iblock
126 : jblock = this_block%jblock
127 :
128 : call set_restore_var (nx_block, ny_block, &
129 : ilo, ihi, jlo, jhi, & ! LCOV_EXCL_LINE
130 : iglob, jglob, & ! LCOV_EXCL_LINE
131 : iblock, jblock, & ! LCOV_EXCL_LINE
132 : Tair (:,:, iblk), & ! LCOV_EXCL_LINE
133 : Tf (:,:, iblk), & ! LCOV_EXCL_LINE
134 : salinz(:,:,:, iblk), Tmltz(:,:,:, iblk), & ! LCOV_EXCL_LINE
135 : tmask(:,:, iblk), & ! LCOV_EXCL_LINE
136 : aicen_rest(:,:, :,iblk), & ! LCOV_EXCL_LINE
137 : trcrn_rest(:,:,:,:,iblk), ntrcr, & ! LCOV_EXCL_LINE
138 : vicen_rest(:,:, :,iblk), & ! LCOV_EXCL_LINE
139 : vsnon_rest(:,:, :,iblk))
140 : enddo ! iblk
141 : !$OMP END PARALLEL DO
142 :
143 : else ! restore_ic
144 :
145 : ! restore to initial ice state
146 :
147 : ! the easy way
148 : ! aicen_rest(:,:,:,:) = aicen(:,:,:,:)
149 : ! vicen_rest(:,:,:,:) = vicen(:,:,:,:)
150 : ! vsnon_rest(:,:,:,:) = vsnon(:,:,:,:)
151 : ! trcrn_rest(:,:,:,:,:) = trcrn(:,:,:,:,:)
152 :
153 : ! the more precise way
154 : !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block, &
155 0 : !$OMP i,j,n,nt,ibc,npad)
156 0 : do iblk = 1, nblocks
157 0 : this_block = get_block(blocks_ice(iblk),iblk)
158 0 : ilo = this_block%ilo
159 0 : ihi = this_block%ihi
160 0 : jlo = this_block%jlo
161 0 : jhi = this_block%jhi
162 :
163 0 : if (this_block%iblock == 1) then ! west edge
164 0 : if (trim(ew_boundary_type) /= 'cyclic') then
165 0 : do n = 1, ncat
166 0 : do j = 1, ny_block
167 0 : do i = 1, ilo
168 0 : aicen_rest(i,j,n,iblk) = aicen(ilo,j,n,iblk)
169 0 : vicen_rest(i,j,n,iblk) = vicen(ilo,j,n,iblk)
170 0 : vsnon_rest(i,j,n,iblk) = vsnon(ilo,j,n,iblk)
171 0 : do nt = 1, ntrcr
172 0 : trcrn_rest(i,j,nt,n,iblk) = trcrn(ilo,j,nt,n,iblk)
173 : enddo
174 : enddo
175 : enddo
176 : enddo
177 : endif
178 : endif
179 :
180 0 : if (this_block%iblock == nblocks_x) then ! east edge
181 0 : if (trim(ew_boundary_type) /= 'cyclic') then
182 : ! locate ghost cell column (avoid padding)
183 0 : ibc = nx_block
184 0 : do i = nx_block, 1, -1
185 0 : npad = 0
186 0 : if (this_block%i_glob(i) == 0) then
187 0 : do j = 1, ny_block
188 0 : npad = npad + this_block%j_glob(j)
189 : enddo
190 : endif
191 0 : if (npad /= 0) ibc = ibc - 1
192 : enddo
193 :
194 0 : do n = 1, ncat
195 0 : do j = 1, ny_block
196 0 : do i = ihi, ibc
197 0 : aicen_rest(i,j,n,iblk) = aicen(ihi,j,n,iblk)
198 0 : vicen_rest(i,j,n,iblk) = vicen(ihi,j,n,iblk)
199 0 : vsnon_rest(i,j,n,iblk) = vsnon(ihi,j,n,iblk)
200 0 : do nt = 1, ntrcr
201 0 : trcrn_rest(i,j,nt,n,iblk) = trcrn(ihi,j,nt,n,iblk)
202 : enddo
203 : enddo
204 : enddo
205 : enddo
206 : endif
207 : endif
208 :
209 0 : if (this_block%jblock == 1) then ! south edge
210 0 : if (trim(ns_boundary_type) /= 'cyclic') then
211 0 : do n = 1, ncat
212 0 : do j = 1, jlo
213 0 : do i = 1, nx_block
214 0 : aicen_rest(i,j,n,iblk) = aicen(i,jlo,n,iblk)
215 0 : vicen_rest(i,j,n,iblk) = vicen(i,jlo,n,iblk)
216 0 : vsnon_rest(i,j,n,iblk) = vsnon(i,jlo,n,iblk)
217 0 : do nt = 1, ntrcr
218 0 : trcrn_rest(i,j,nt,n,iblk) = trcrn(ilo,j,nt,n,iblk)
219 : enddo
220 : enddo
221 : enddo
222 : enddo
223 : endif
224 : endif
225 :
226 0 : if (this_block%jblock == nblocks_y) then ! north edge
227 : if (trim(ns_boundary_type) /= 'cyclic' .and. &
228 : trim(ns_boundary_type) /= 'tripole' .and. & ! LCOV_EXCL_LINE
229 : trim(ns_boundary_type) /= 'tripoleT') then
230 : ! locate ghost cell row (avoid padding)
231 0 : ibc = ny_block
232 0 : do j = ny_block, 1, -1
233 0 : npad = 0
234 0 : if (this_block%j_glob(j) == 0) then
235 0 : do i = 1, nx_block
236 0 : npad = npad + this_block%i_glob(i)
237 : enddo
238 : endif
239 0 : if (npad /= 0) ibc = ibc - 1
240 : enddo
241 :
242 0 : do n = 1, ncat
243 0 : do j = jhi, ibc
244 0 : do i = 1, nx_block
245 0 : aicen_rest(i,j,n,iblk) = aicen(i,jhi,n,iblk)
246 0 : vicen_rest(i,j,n,iblk) = vicen(i,jhi,n,iblk)
247 0 : vsnon_rest(i,j,n,iblk) = vsnon(i,jhi,n,iblk)
248 0 : do nt = 1, ntrcr
249 0 : trcrn_rest(i,j,nt,n,iblk) = trcrn(ihi,j,nt,n,iblk)
250 : enddo
251 : enddo
252 : enddo
253 : enddo
254 : endif
255 : endif
256 :
257 : enddo ! iblk
258 : !$OMP END PARALLEL DO
259 :
260 : endif ! restore_ic
261 :
262 : !-----------------------------------------------------------------
263 : ! Impose land mask
264 : !-----------------------------------------------------------------
265 :
266 0 : do iblk = 1, nblocks
267 0 : do n = 1, ncat
268 0 : do j = 1, ny_block
269 0 : do i = 1, nx_block
270 0 : aicen_rest(i,j,n,iblk) = aicen_rest(i,j,n,iblk) * hm(i,j,iblk)
271 0 : vicen_rest(i,j,n,iblk) = vicen_rest(i,j,n,iblk) * hm(i,j,iblk)
272 0 : vsnon_rest(i,j,n,iblk) = vsnon_rest(i,j,n,iblk) * hm(i,j,iblk)
273 0 : do nt = 1, ntrcr
274 0 : trcrn_rest(i,j,nt,n,iblk) = trcrn_rest(i,j,nt,n,iblk) &
275 0 : * hm(i,j,iblk)
276 : enddo
277 : enddo
278 : enddo
279 : enddo
280 : enddo
281 :
282 0 : if (my_task == master_task) &
283 0 : write (nu_diag,*) 'ice restoring timescale = ',trestore,' days'
284 :
285 0 : end subroutine ice_HaloRestore_init
286 :
287 : !=======================================================================
288 :
289 : ! initialize restoring variables, based on set_state_var
290 : ! this routine assumes boundaries are not cyclic
291 :
292 0 : subroutine set_restore_var (nx_block, ny_block, &
293 : ilo, ihi, jlo, jhi, & ! LCOV_EXCL_LINE
294 : iglob, jglob, & ! LCOV_EXCL_LINE
295 : iblock, jblock, & ! LCOV_EXCL_LINE
296 : Tair, & ! LCOV_EXCL_LINE
297 : Tf, & ! LCOV_EXCL_LINE
298 : salinz, Tmltz, & ! LCOV_EXCL_LINE
299 : tmask, aicen, & ! LCOV_EXCL_LINE
300 : trcrn, ntrcr, & ! LCOV_EXCL_LINE
301 0 : vicen, vsnon)
302 :
303 : ! authors: E. C. Hunke, LANL
304 :
305 : use ice_arrays_column, only: hin_max
306 : use ice_blocks, only: nblocks_x, nblocks_y
307 : use ice_domain_size, only: nilyr, nslyr, ncat
308 :
309 : integer (kind=int_kind), intent(in) :: &
310 : nx_block, ny_block, & ! block dimensions ! LCOV_EXCL_LINE
311 : ilo, ihi , & ! physical domain indices ! LCOV_EXCL_LINE
312 : jlo, jhi , & ! ! LCOV_EXCL_LINE
313 : iglob(nx_block) , & ! global indices ! LCOV_EXCL_LINE
314 : jglob(ny_block) , & ! ! LCOV_EXCL_LINE
315 : iblock , & ! block indices ! LCOV_EXCL_LINE
316 : jblock , & ! ! LCOV_EXCL_LINE
317 : ntrcr ! number of tracers in use
318 :
319 : real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: &
320 : Tair , & ! air temperature (K) ! LCOV_EXCL_LINE
321 : Tf ! freezing temperature (C)
322 :
323 : real (kind=dbl_kind), dimension (nx_block,ny_block,nilyr), intent(in) :: &
324 : salinz , & ! initial salinity profile ! LCOV_EXCL_LINE
325 : Tmltz ! initial melting temperature profile
326 :
327 : logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: &
328 : tmask ! true for ice/ocean cells
329 :
330 : real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(out) :: &
331 : aicen , & ! concentration of ice ! LCOV_EXCL_LINE
332 : vicen , & ! volume per unit area of ice (m) ! LCOV_EXCL_LINE
333 : vsnon ! volume per unit area of snow (m)
334 :
335 : real (kind=dbl_kind), dimension (nx_block,ny_block,ntrcr,ncat), intent(out) :: &
336 : trcrn ! ice tracers
337 : ! 1: surface temperature of ice/snow (C)
338 :
339 : ! local variables
340 :
341 : integer (kind=int_kind) :: &
342 : i, j , & ! horizontal indices ! LCOV_EXCL_LINE
343 : ij , & ! horizontal index, combines i and j loops ! LCOV_EXCL_LINE
344 : ibc , & ! ghost cell column or row ! LCOV_EXCL_LINE
345 : npad , & ! padding column/row counter ! LCOV_EXCL_LINE
346 : k , & ! ice layer index ! LCOV_EXCL_LINE
347 : n , & ! thickness category index ! LCOV_EXCL_LINE
348 : it , & ! tracer index ! LCOV_EXCL_LINE
349 : nt_Tsfc , & ! ! LCOV_EXCL_LINE
350 : nt_fbri , & ! ! LCOV_EXCL_LINE
351 : nt_qice , & ! ! LCOV_EXCL_LINE
352 : nt_sice , & ! ! LCOV_EXCL_LINE
353 : nt_qsno , & ! ! LCOV_EXCL_LINE
354 : icells ! number of cells initialized with ice
355 :
356 : logical (kind=log_kind) :: &
357 : tr_brine
358 :
359 : integer (kind=int_kind), dimension(nx_block*ny_block) :: &
360 0 : indxi, indxj ! compressed indices for cells with restoring
361 :
362 : real (kind=dbl_kind) :: &
363 : Tsfc, hbar, & ! LCOV_EXCL_LINE
364 0 : hsno_init ! initial snow thickness
365 :
366 : real (kind=dbl_kind), dimension(ncat) :: &
367 0 : ainit, hinit ! initial area, thickness
368 :
369 : real (kind=dbl_kind), dimension(nilyr) :: &
370 0 : qin ! ice enthalpy (J/m3)
371 :
372 : real (kind=dbl_kind), dimension(nslyr) :: &
373 0 : qsn ! snow enthalpy (J/m3)
374 :
375 : character(len=*), parameter :: subname = '(set_restore_var)'
376 :
377 0 : call icepack_query_tracer_flags(tr_brine_out=tr_brine)
378 : call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_fbri_out=nt_fbri, &
379 0 : nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_qsno_out=nt_qsno)
380 0 : call icepack_warnings_flush(nu_diag)
381 0 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
382 0 : file=__FILE__, line=__LINE__)
383 :
384 0 : indxi(:) = 0
385 0 : indxj(:) = 0
386 :
387 : !-----------------------------------------------------------------
388 : ! Initialize restoring variables everywhere on grid
389 : !-----------------------------------------------------------------
390 :
391 0 : do n = 1, ncat
392 0 : do j = 1, ny_block
393 0 : do i = 1, nx_block
394 0 : aicen(i,j,n) = c0
395 0 : vicen(i,j,n) = c0
396 0 : vsnon(i,j,n) = c0
397 0 : if (tmask(i,j)) then
398 0 : trcrn(i,j,nt_Tsfc,n) = Tf(i,j) ! surface temperature
399 : else
400 0 : trcrn(i,j,nt_Tsfc,n) = c0 ! on land gridcells
401 : endif
402 0 : if (ntrcr >= 2) then
403 0 : do it = 2, ntrcr
404 0 : trcrn(i,j,it,n) = c0
405 : enddo
406 : endif
407 0 : if (tr_brine) trcrn(i,j,nt_fbri,n) = c1
408 : enddo
409 : enddo
410 : enddo
411 :
412 : !-----------------------------------------------------------------
413 : ! initial area and thickness in ice-occupied restoring cells
414 : !-----------------------------------------------------------------
415 :
416 0 : hbar = c2 ! initial ice thickness
417 0 : hsno_init = 0.20_dbl_kind ! initial snow thickness (m)
418 0 : do n = 1, ncat
419 0 : hinit(n) = c0
420 0 : ainit(n) = c0
421 0 : if (hbar > hin_max(n-1) .and. hbar < hin_max(n)) then
422 0 : hinit(n) = hbar
423 0 : ainit(n) = 0.95_dbl_kind ! initial ice concentration
424 : endif
425 : enddo
426 :
427 : !-----------------------------------------------------------------
428 : ! Define cells where ice is placed (or other values are used)
429 : ! Edges using initial values (zero, above) are commented out
430 : !-----------------------------------------------------------------
431 :
432 0 : icells = 0
433 0 : if (iblock == 1) then ! west edge
434 0 : do j = 1, ny_block
435 0 : do i = 1, ilo
436 0 : if (tmask(i,j)) then
437 : ! icells = icells + 1
438 : ! indxi(icells) = i
439 : ! indxj(icells) = j
440 : endif
441 : enddo
442 : enddo
443 : endif
444 :
445 0 : if (iblock == nblocks_x) then ! east edge
446 : ! locate ghost cell column (avoid padding)
447 0 : ibc = nx_block
448 0 : do i = nx_block, 1, -1
449 0 : npad = 0
450 0 : if (iglob(i) == 0) then
451 0 : do j = 1, ny_block
452 0 : npad = npad + jglob(j)
453 : enddo
454 : endif
455 0 : if (npad /= 0) ibc = ibc - 1
456 : enddo
457 :
458 0 : do j = 1, ny_block
459 0 : do i = ihi, ibc
460 0 : if (tmask(i,j)) then
461 0 : icells = icells + 1
462 0 : indxi(icells) = i
463 0 : indxj(icells) = j
464 : endif
465 : enddo
466 : enddo
467 : endif
468 :
469 0 : if (jblock == 1) then ! south edge
470 0 : do j = 1, jlo
471 0 : do i = 1, nx_block
472 0 : if (tmask(i,j)) then
473 : ! icells = icells + 1
474 : ! indxi(icells) = i
475 : ! indxj(icells) = j
476 : endif
477 : enddo
478 : enddo
479 : endif
480 :
481 0 : if (jblock == nblocks_y) then ! north edge
482 : ! locate ghost cell row (avoid padding)
483 0 : ibc = ny_block
484 0 : do j = ny_block, 1, -1
485 0 : npad = 0
486 0 : if (jglob(j) == 0) then
487 0 : do i = 1, nx_block
488 0 : npad = npad + iglob(i)
489 : enddo
490 : endif
491 0 : if (npad /= 0) ibc = ibc - 1
492 : enddo
493 :
494 0 : do j = jhi, ibc
495 0 : do i = 1, nx_block
496 0 : if (tmask(i,j)) then
497 : ! icells = icells + 1
498 : ! indxi(icells) = i
499 : ! indxj(icells) = j
500 : endif
501 : enddo
502 : enddo
503 : endif
504 :
505 : !-----------------------------------------------------------------
506 : ! Set restoring variables
507 : !-----------------------------------------------------------------
508 :
509 0 : do n = 1, ncat
510 :
511 0 : do ij = 1, icells
512 0 : i = indxi(ij)
513 0 : j = indxj(ij)
514 :
515 : ! ice volume, snow volume
516 0 : aicen(i,j,n) = ainit(n)
517 0 : vicen(i,j,n) = hinit(n) * ainit(n) ! m
518 0 : vsnon(i,j,n) = min(aicen(i,j,n)*hsno_init,p2*vicen(i,j,n))
519 :
520 0 : call icepack_init_trcr(Tair=Tair(i,j), Tf=Tf(i,j), &
521 : Sprofile=salinz(i,j,:), & ! LCOV_EXCL_LINE
522 : Tprofile=Tmltz(i,j,:), & ! LCOV_EXCL_LINE
523 : Tsfc=Tsfc, & ! LCOV_EXCL_LINE
524 : nilyr=nilyr, nslyr=nslyr, & ! LCOV_EXCL_LINE
525 0 : qin=qin(:), qsn=qsn(:))
526 :
527 : ! surface temperature
528 0 : trcrn(i,j,nt_Tsfc,n) = Tsfc ! deg C
529 : ! ice enthalpy, salinity
530 0 : do k = 1, nilyr
531 0 : trcrn(i,j,nt_qice+k-1,n) = qin(k)
532 0 : trcrn(i,j,nt_sice+k-1,n) = salinz(i,j,k)
533 : enddo
534 : ! snow enthalpy
535 0 : do k = 1, nslyr
536 0 : trcrn(i,j,nt_qsno+k-1,n) = qsn(k)
537 : enddo ! nslyr
538 :
539 : enddo ! ij
540 : enddo ! ncat
541 :
542 0 : call icepack_warnings_flush(nu_diag)
543 0 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
544 0 : file=__FILE__, line=__LINE__)
545 :
546 0 : end subroutine set_restore_var
547 :
548 : !=======================================================================
549 :
550 : ! This subroutine is intended for restoring the ice state to desired
551 : ! values in cells surrounding the grid.
552 : ! Note: This routine will need to be modified for nghost > 1.
553 : ! We assume padding occurs only on east and north edges.
554 :
555 0 : subroutine ice_HaloRestore
556 :
557 : use ice_blocks, only: block, get_block, nblocks_x, nblocks_y
558 : use ice_calendar, only: dt
559 : use ice_domain, only: ew_boundary_type, ns_boundary_type, &
560 : nblocks, blocks_ice
561 :
562 : !-----------------------------------------------------------------------
563 : !
564 : ! local variables
565 : !
566 : !-----------------------------------------------------------------------
567 :
568 : integer (int_kind) :: &
569 : i,j,iblk,nt,n, &! dummy loop indices ! LCOV_EXCL_LINE
570 : ilo,ihi,jlo,jhi, &! beginning and end of physical domain ! LCOV_EXCL_LINE
571 : ibc, &! ghost cell column or row ! LCOV_EXCL_LINE
572 : ntrcr, &! ! LCOV_EXCL_LINE
573 : npad ! padding column/row counter
574 :
575 : type (block) :: &
576 : this_block ! block info for current block
577 :
578 : real (dbl_kind) :: &
579 : secday, &! ! LCOV_EXCL_LINE
580 0 : ctime ! dt/trest
581 :
582 : character(len=*), parameter :: subname = '(ice_HaloRestore)'
583 :
584 0 : call ice_timer_start(timer_bound)
585 0 : call icepack_query_parameters(secday_out=secday)
586 0 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
587 0 : call icepack_warnings_flush(nu_diag)
588 0 : if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
589 0 : file=__FILE__, line=__LINE__)
590 :
591 : !-----------------------------------------------------------------------
592 : !
593 : ! Initialize
594 : !
595 : !-----------------------------------------------------------------------
596 :
597 : ! for now, use same restoring constant as for SST
598 0 : if (trestore == 0) then
599 0 : trest = dt ! use data instantaneously
600 : else
601 0 : trest = real(trestore,kind=dbl_kind) * secday ! seconds
602 : endif
603 0 : ctime = dt/trest
604 :
605 : !-----------------------------------------------------------------------
606 : !
607 : ! Restore values in cells surrounding the grid
608 : !
609 : !-----------------------------------------------------------------------
610 :
611 : !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block, &
612 0 : !$OMP i,j,n,nt,ibc,npad)
613 0 : do iblk = 1, nblocks
614 0 : this_block = get_block(blocks_ice(iblk),iblk)
615 0 : ilo = this_block%ilo
616 0 : ihi = this_block%ihi
617 0 : jlo = this_block%jlo
618 0 : jhi = this_block%jhi
619 :
620 0 : if (this_block%iblock == 1) then ! west edge
621 0 : if (trim(ew_boundary_type) /= 'cyclic') then
622 0 : do n = 1, ncat
623 0 : do j = 1, ny_block
624 0 : do i = 1, ilo
625 : aicen(i,j,n,iblk) = aicen(i,j,n,iblk) &
626 0 : + (aicen_rest(i,j,n,iblk)-aicen(i,j,n,iblk))*ctime
627 : vicen(i,j,n,iblk) = vicen(i,j,n,iblk) &
628 0 : + (vicen_rest(i,j,n,iblk)-vicen(i,j,n,iblk))*ctime
629 : vsnon(i,j,n,iblk) = vsnon(i,j,n,iblk) &
630 0 : + (vsnon_rest(i,j,n,iblk)-vsnon(i,j,n,iblk))*ctime
631 0 : do nt = 1, ntrcr
632 : trcrn(i,j,nt,n,iblk) = trcrn(i,j,nt,n,iblk) &
633 0 : + (trcrn_rest(i,j,nt,n,iblk)-trcrn(i,j,nt,n,iblk))*ctime
634 : enddo
635 : enddo
636 : enddo
637 : enddo
638 : endif
639 : endif
640 :
641 0 : if (this_block%iblock == nblocks_x) then ! east edge
642 0 : if (trim(ew_boundary_type) /= 'cyclic') then
643 : ! locate ghost cell column (avoid padding)
644 0 : ibc = nx_block
645 0 : do i = nx_block, 1, -1
646 0 : npad = 0
647 0 : if (this_block%i_glob(i) == 0) then
648 0 : do j = 1, ny_block
649 0 : npad = npad + this_block%j_glob(j)
650 : enddo
651 : endif
652 0 : if (npad /= 0) ibc = ibc - 1
653 : enddo
654 :
655 0 : do n = 1, ncat
656 0 : do j = 1, ny_block
657 0 : do i = ihi, ibc
658 : aicen(i,j,n,iblk) = aicen(i,j,n,iblk) &
659 0 : + (aicen_rest(i,j,n,iblk)-aicen(i,j,n,iblk))*ctime
660 : vicen(i,j,n,iblk) = vicen(i,j,n,iblk) &
661 0 : + (vicen_rest(i,j,n,iblk)-vicen(i,j,n,iblk))*ctime
662 : vsnon(i,j,n,iblk) = vsnon(i,j,n,iblk) &
663 0 : + (vsnon_rest(i,j,n,iblk)-vsnon(i,j,n,iblk))*ctime
664 0 : do nt = 1, ntrcr
665 : trcrn(i,j,nt,n,iblk) = trcrn(i,j,nt,n,iblk) &
666 0 : + (trcrn_rest(i,j,nt,n,iblk)-trcrn(i,j,nt,n,iblk))*ctime
667 : enddo
668 : enddo
669 : enddo
670 : enddo
671 : endif
672 : endif
673 :
674 0 : if (this_block%jblock == 1) then ! south edge
675 0 : if (trim(ns_boundary_type) /= 'cyclic') then
676 0 : do n = 1, ncat
677 0 : do j = 1, jlo
678 0 : do i = 1, nx_block
679 : aicen(i,j,n,iblk) = aicen(i,j,n,iblk) &
680 0 : + (aicen_rest(i,j,n,iblk)-aicen(i,j,n,iblk))*ctime
681 : vicen(i,j,n,iblk) = vicen(i,j,n,iblk) &
682 0 : + (vicen_rest(i,j,n,iblk)-vicen(i,j,n,iblk))*ctime
683 : vsnon(i,j,n,iblk) = vsnon(i,j,n,iblk) &
684 0 : + (vsnon_rest(i,j,n,iblk)-vsnon(i,j,n,iblk))*ctime
685 0 : do nt = 1, ntrcr
686 : trcrn(i,j,nt,n,iblk) = trcrn(i,j,nt,n,iblk) &
687 0 : + (trcrn_rest(i,j,nt,n,iblk)-trcrn(i,j,nt,n,iblk))*ctime
688 : enddo
689 : enddo
690 : enddo
691 : enddo
692 : endif
693 : endif
694 :
695 0 : if (this_block%jblock == nblocks_y) then ! north edge
696 : if (trim(ns_boundary_type) /= 'cyclic' .and. &
697 : trim(ns_boundary_type) /= 'tripole' .and. & ! LCOV_EXCL_LINE
698 : trim(ns_boundary_type) /= 'tripoleT') then
699 : ! locate ghost cell row (avoid padding)
700 0 : ibc = ny_block
701 0 : do j = ny_block, 1, -1
702 0 : npad = 0
703 0 : if (this_block%j_glob(j) == 0) then
704 0 : do i = 1, nx_block
705 0 : npad = npad + this_block%i_glob(i)
706 : enddo
707 : endif
708 0 : if (npad /= 0) ibc = ibc - 1
709 : enddo
710 :
711 0 : do n = 1, ncat
712 0 : do j = jhi, ibc
713 0 : do i = 1, nx_block
714 : aicen(i,j,n,iblk) = aicen(i,j,n,iblk) &
715 0 : + (aicen_rest(i,j,n,iblk)-aicen(i,j,n,iblk))*ctime
716 : vicen(i,j,n,iblk) = vicen(i,j,n,iblk) &
717 0 : + (vicen_rest(i,j,n,iblk)-vicen(i,j,n,iblk))*ctime
718 : vsnon(i,j,n,iblk) = vsnon(i,j,n,iblk) &
719 0 : + (vsnon_rest(i,j,n,iblk)-vsnon(i,j,n,iblk))*ctime
720 0 : do nt = 1, ntrcr
721 : trcrn(i,j,nt,n,iblk) = trcrn(i,j,nt,n,iblk) &
722 0 : + (trcrn_rest(i,j,nt,n,iblk)-trcrn(i,j,nt,n,iblk))*ctime
723 : enddo
724 : enddo
725 : enddo
726 : enddo
727 : endif
728 : endif
729 :
730 : enddo ! iblk
731 : !$OMP END PARALLEL DO
732 :
733 0 : call ice_timer_stop(timer_bound)
734 :
735 0 : end subroutine ice_HaloRestore
736 :
737 : !=======================================================================
738 :
739 : end module ice_restoring
740 :
741 : !=======================================================================
|
