My Project
Functions/Subroutines | Variables
ice_mechred Module Reference

Functions/Subroutines

subroutine init_mechred
 
subroutine ridge_ice (Delta, divu)
 
subroutine ice_strength (kstrngth)
 
subroutine ridge_prep
 
subroutine ridge_shift (opning, closing_gross, msnow_mlt, esnow_mlt)
 
subroutine asum_ridging
 

Variables

integer(kind=int_kind) kstrength
 
integer(kind=int_kind) krdg_partic
 
integer(kind=int_kind) krdg_redist
 
real(kind=dbl_kind), parameter cf = 17._dbl_kind
 
real(kind=dbl_kind), parameter cs = p25
 
real(kind=dbl_kind), parameter cp = p5*gravit*(rhow-rhoi)*rhoi/rhow
 
real(kind=dbl_kind), parameter fsnowrdg = p5
 
real(kind=dbl_kind), parameter gstar = p15
 
real(kind=dbl_kind), parameter astar = 0.05_dbl_kind
 
real(kind=dbl_kind), parameter maxraft = c1i
 
real(kind=dbl_kind), parameter hstar = c25
 
real(kind=dbl_kind), parameter mu_rdg = c4i
 
real(kind=dbl_kind), parameter pstar = 2.75e4_dbl_kind
 
real(kind=dbl_kind), parameter cstar = c20
 
real(kind=dbl_kind), dimension(:,:), allocatable, save dardg1dt
 
real(kind=dbl_kind), dimension(:,:), allocatable, save dardg2dt
 
real(kind=dbl_kind), dimension(:,:), allocatable, save dvirdgdt
 
real(kind=dbl_kind), dimension(:,:), allocatable, save opening
 
real(kind=dbl_kind), dimension(:,:), allocatable, save asum
 
real(kind=dbl_kind), dimension(:,:), allocatable, save aksum
 
real(kind=dbl_kind), dimension(:,:,:), allocatable, save apartic
 
real(kind=dbl_kind), dimension(:,:,:), allocatable, save hrmin
 
real(kind=dbl_kind), dimension(:,:,:), allocatable, save hrmax
 
real(kind=dbl_kind), dimension(:,:,:), allocatable, save hrexp
 
real(kind=dbl_kind), dimension(:,:,:), allocatable, save krdg
 
logical(kind=log_kind), parameter l_conservation_check = .true.
 

Function/Subroutine Documentation

◆ asum_ridging()

subroutine ice_mechred::asum_ridging ( )

Definition at line 1391 of file ice_mechred.f90.

1391 !
1392 ! !USES:
1393 !
1394 ! !INPUT/OUTPUT PARAMETERS:
1395 !
1396 !EOP
1397 !
1398  integer (kind=int_kind) :: i, j, ni
1399 
1400  !-----------------------------------------------------------------
1401  ! open water
1402  !-----------------------------------------------------------------
1403 
1404  do j = jlo, jhi
1405  do i = ilo, ihi
1406  asum(i,j) = aice0(i,j)
1407  enddo
1408  enddo
1409 
1410  !-----------------------------------------------------------------
1411  ! ice categories
1412  !-----------------------------------------------------------------
1413 
1414  do ni = 1, ncat
1415 !DIR$ CONCURRENT !Cray
1416 !cdir nodep !NEC
1417 !ocl novrec !Fujitsu
1418  do j = jlo, jhi
1419  do i = ilo, ihi
1420  asum(i,j) = asum(i,j) + aicen(i,j,ni)
1421  enddo ! i
1422  enddo ! j
1423  enddo ! ni
1424 
ice_domain::ihi
integer(kind=int_kind) ihi
Definition: ice_domain.f90:101
ice_domain::jlo
integer(kind=int_kind) jlo
Definition: ice_domain.f90:101
ice_domain::ilo
integer(kind=int_kind) ilo
Definition: ice_domain.f90:101
ice_domain::jhi
integer(kind=int_kind) jhi
Definition: ice_domain.f90:101
ice_state::aice0
real(kind=dbl_kind), dimension(:,:), allocatable, target, save aice0
Definition: ice_state.f90:105
ice_model_size::ncat
integer(kind=int_kind), parameter ncat
Definition: ice_model_size.f90:48
ice_state::aicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save aicen
Definition: ice_state.f90:97
Here is the caller graph for this function:

◆ ice_strength()

subroutine ice_mechred::ice_strength ( integer (kind=int_kind), intent(in)  kstrngth)

Definition at line 538 of file ice_mechred.f90.

538 !
539 ! !USES:
540 !
541 ! !INPUT/OUTPUT PARAMETERS:
542 !
543  integer (kind=int_kind), intent(in) :: &
544  kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979)
545 !
546 !EOP
547 !
548  integer (kind=int_kind) :: &
549  i,j & ! horizontal indices
550  , ni ! thickness category index
551 
552  real (kind=dbl_kind) :: &
553  hi & ! ice thickness (m)
554  , h2rdg & ! mean value of h^2 in new ridge
555  , dh2rdg ! change in mean value of h^2 per unit area
556  ! consumed by ridging
557 
558 
559  ! initialize
560  strength(:,:) = c0i
561 
562  !-----------------------------------------------------------------
563  ! Compute thickness distribution of ridging and ridged ice.
564  !-----------------------------------------------------------------
565  call ridge_prep
566 
567  if (kstrngth == 1) then
568 
569  !-----------------------------------------------------------------
570  ! Compute ice strength based on change in potential energy,
571  ! as in Rothrock (1975)
572  !-----------------------------------------------------------------
573 
574  if (krdg_redist==0) then ! Hibler redistribution function
575 
576  do ni = 1, ncat
577 !DIR$ CONCURRENT !Cray
578 !cdir nodep !NEC
579 !ocl novrec !Fujitsu
580  do j = jlo, jhi
581  do i = ilo, ihi
582 
583  if(aicen(i,j,ni) > puny .and. apartic(i,j,ni) > c0i) then
584  hi = vicen(i,j,ni) / aicen(i,j,ni)
585  h2rdg = p333 * (hrmax(i,j,ni)**3 - hrmin(i,j,ni)**3) &
586  / (hrmax(i,j,ni) - hrmin(i,j,ni))
587  dh2rdg = -hi*hi + h2rdg/krdg(i,j,ni)
588  strength(i,j) = strength(i,j) &
589  + apartic(i,j,ni) * dh2rdg
590  endif
591  enddo ! i
592  enddo ! j
593  enddo ! n
594 
595  elseif (krdg_redist==1) then ! exponential function
596 
597  do ni = 1, ncat
598 !DIR$ CONCURRENT !Cray
599 !cdir nodep !NEC
600 !ocl novrec !Fujitsu
601  do j = jlo, jhi
602  do i = ilo, ihi
603 
604  if(aicen(i,j,ni) > puny .and. apartic(i,j,ni) > c0i) then
605  hi = vicen(i,j,ni) / aicen(i,j,ni)
606  h2rdg = hrmin(i,j,ni)*hrmin(i,j,ni) &
607  + c2i*hrmin(i,j,ni)*hrexp(i,j,ni) &
608  + c2i*hrexp(i,j,ni)*hrexp(i,j,ni)
609  dh2rdg = -hi*hi + h2rdg/krdg(i,j,ni)
610  strength(i,j) = strength(i,j) &
611  + apartic(i,j,ni) * dh2rdg
612  endif
613  enddo ! i
614  enddo ! j
615  enddo ! n
616 
617  endif ! krdg_redist
618 
619 !DIR$ CONCURRENT !Cray
620 !cdir nodep !NEC
621 !ocl novrec !Fujitsu
622  do j = jlo, jhi
623  do i = ilo, ihi
624 
625  strength(i,j) = cf * cp * strength(i,j) / aksum(i,j)
626  ! Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow)
627  ! Cf accounts for frictional dissipation
628 
629  enddo ! j
630  enddo ! i
631 
632  else ! kstrngth ne 1: Hibler (1979) form
633 
634  !-----------------------------------------------------------------
635  ! Compute ice strength as in Hibler (1979)
636  !-----------------------------------------------------------------
637  do j = jlo, jhi
638  do i = ilo, ihi
639  strength(i,j) = pstar*vice(i,j)*exp(-cstar*(c1i-aice(i,j)))
640  enddo ! j
641  enddo ! i
642 
643  endif ! kstrngth
644 
ice_domain::ihi
integer(kind=int_kind) ihi
Definition: ice_domain.f90:101
ice_constants::c0i
real(kind=dbl_kind), parameter c0i
Definition: ice_constants.f90:150
ice_mechred::krdg_redist
integer(kind=int_kind) krdg_redist
Definition: ice_mechred.f90:81
ice_domain::jlo
integer(kind=int_kind) jlo
Definition: ice_domain.f90:101
ice_domain::ilo
integer(kind=int_kind) ilo
Definition: ice_domain.f90:101
ice_constants::puny
real(kind=dbl_kind), parameter puny
Definition: ice_constants.f90:150
ice_domain::jhi
integer(kind=int_kind) jhi
Definition: ice_domain.f90:101
ice_state::vicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save vicen
Definition: ice_state.f90:97
ice_state::aice
real(kind=dbl_kind), dimension(:,:), allocatable, target, save aice
Definition: ice_state.f90:82
ice_model_size::ncat
integer(kind=int_kind), parameter ncat
Definition: ice_model_size.f90:48
ice_constants::c2i
real(kind=dbl_kind), parameter c2i
Definition: ice_constants.f90:150
ice_state::aicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save aicen
Definition: ice_state.f90:97
ice_state::vice
real(kind=dbl_kind), dimension(:,:), allocatable, target, save vice
Definition: ice_state.f90:82
ice_constants::c1i
real(kind=dbl_kind), parameter c1i
Definition: ice_constants.f90:150
ice_constants::p333
real(kind=dbl_kind), parameter p333
Definition: ice_constants.f90:150
ice_state::strength
real(kind=dbl_kind), dimension(:,:), allocatable, save strength
Definition: ice_state.f90:120
Here is the call graph for this function:

◆ init_mechred()

subroutine ice_mechred::init_mechred ( )

Definition at line 173 of file ice_mechred.f90.

173 !
174 ! !USES:
175 !
176 ! !INPUT/OUTPUT PARAMETERS:
177 !
178 !
179 !EOP
180 !
181  integer (kind=int_kind) :: i,j
182 
183  !-----------------------------------------------------------------
184  ! Initialize history fields.
185  !-----------------------------------------------------------------
186 
187  dardg1dt(:,:) = c0i
188  dardg2dt(:,:) = c0i
189  dvirdgdt(:,:) = c0i
190  opening(:,:) = c0i
191 
ice_constants::c0i
real(kind=dbl_kind), parameter c0i
Definition: ice_constants.f90:150

◆ ridge_ice()

subroutine ice_mechred::ridge_ice ( real (kind=dbl_kind), dimension (imt_local,jmt_local), intent(in)  Delta,
real (kind=dbl_kind), dimension (imt_local,jmt_local), intent(in)  divu 
)

Definition at line 211 of file ice_mechred.f90.

211 !
212 ! !USES:
213 !
214 ! use ice_timers
215 
216  use ice_flux
217 ! use ice_exit
218 !
219 ! !INPUT/OUTPUT PARAMETERS:
220 !
221  real (kind=dbl_kind), &
222  dimension (imt_local,jmt_local), intent(in) :: &
223  delta & ! term in the denominator of zeta, eta (1/s)
224  ! = sqrt (epsI^2 + (1/e^2)*epsII^2)
225  , divu ! strain rate I component, velocity divergence (1/s)
226 !
227 !EOP
228 !
229  integer (kind=int_kind), parameter :: &
230  nitermax = 20 ! max number of ridging iterations
231 
232  integer (kind=int_kind) :: &
233  i,j &! horizontal indices
234  , ni &! thickness category index
235  , niter ! iteration counter
236 
237  real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi) :: &
238  closing_net &! net rate at which area is removed (1/s)
239  ! (ridging ice area - area of new ridges) / dyn_dt
240  , divu_adv &! divu as implied by transport scheme (1/s)
241  , opning &! rate of opening due to divergence/shear
242  , closing_gross &! rate at which area removed, not counting
243  ! area of new ridges
244  , msnow_mlt &! mass of snow added to ocean (kg m-2)
245  , esnow_mlt ! energy needed to melt snow in ocean (J m-2)
246 
247  real (kind=dbl_kind) :: &
248  w1 & ! temporary variable
249  , tmpfac & ! factor by which opening/closing rates are cut
250 ! , dti ! 1 / dyn_dt
251  , dti_ice ! 1 / dyn_dt ! conflict with main dti
252 ! ggao
253 
254  logical (kind=log_kind) :: &
255  iterate_ridging ! if true, repeat the ridging
256 
257  real (kind=dbl_kind), parameter :: &
258  big = 1.0e+8_dbl_kind
259 
260  logical (kind=log_kind) :: &
261  asum_error ! flag for asum .ne. 1
262 
263 ! call ice_timer_start(6) ! ridging
264 
265  !-----------------------------------------------------------------
266  ! Set hin_max(ncat) to a big value to ensure that all ridged ice
267  ! is thinner than hin_max(ncat).
268  !-----------------------------------------------------------------
269  hin_max(ncat) = big
270 
271  !-----------------------------------------------------------------
272  ! Compute the ice strength, the thickness distribution of ridging
273  ! ice, and various quantities associated with the new ridged ice.
274  !-----------------------------------------------------------------
275  call ridge_prep
276 
277  !-----------------------------------------------------------------
278  ! Compute total area of ice plus open water.
279  ! This may not be equal to one because of divergence during
280  ! transport.
281  !-----------------------------------------------------------------
282  call asum_ridging
283 
284  !-----------------------------------------------------------------
285  ! Initialize arrays.
286  !-----------------------------------------------------------------
287 
288  msnow_mlt(:,:) = c0i
289  esnow_mlt(:,:) = c0i
290  dardg1dt(:,:) = c0i
291  dardg2dt(:,:) = c0i
292  dvirdgdt(:,:) = c0i
293  opening(:,:) = c0i
294 
295 !DIR$ CONCURRENT !Cray
296 !cdir nodep !NEC
297 !ocl novrec !Fujitsu
298  do j = jlo, jhi
299  do i = ilo, ihi
300 
301  !-----------------------------------------------------------------
302  ! Compute the net rate of closing due to convergence and shear,
303  ! based on Flato and Hibler (1995).
304  !
305  ! The energy dissipation rate is equal to the net closing rate
306  ! times the ice strength.
307  !
308  ! NOTE: The NET closing rate is equal to the rate that open water
309  ! area is removed, plus the rate at which ice area is removed by
310  ! ridging, minus the rate at which area is added in new ridges.
311  ! The GROSS closing rate is equal to the first two terms (open
312  ! water closing and thin ice ridging) without the third term
313  ! (thick, newly ridged ice).
314  !-----------------------------------------------------------------
315 
316  closing_net(i,j) = &
317  cs*p5*(delta(i,j)-abs(divu(i,j))) - min(divu(i,j),c0i)
318 
319  !-----------------------------------------------------------------
320  ! Compute divu_adv, the divergence rate given by the transport/
321  ! advection scheme, which may not be equal to divu as computed
322  ! from the velocity field.
323  !
324  ! If divu_adv < 0, make sure the closing rate is large enough
325  ! to give asum = 1.0 after ridging.
326  !-----------------------------------------------------------------
327 
328  divu_adv(i,j) = (c1i-asum(i,j)) / dyn_dt
329 
330  if (divu_adv(i,j) < c0i) &
331  closing_net(i,j) = max(closing_net(i,j), -divu_adv(i,j))
332 
333  !-----------------------------------------------------------------
334  ! Compute the (non-negative) opening rate that will give
335  ! asum = 1.0 after ridging.
336  !-----------------------------------------------------------------
337  opning(i,j) = closing_net(i,j) + divu_adv(i,j)
338  enddo
339  enddo
340 
341 
342  do niter = 1, nitermax ! iteration counter
343 
344 !DIR$ CONCURRENT !Cray
345 !cdir nodep !NEC
346 !ocl novrec !Fujitsu
347  do j = jlo, jhi
348  do i = ilo, ihi
349 
350  !-----------------------------------------------------------------
351  ! Based on the ITD of ridging and ridged ice, convert the net
352  ! closing rate to a gross closing rate.
353  ! NOTE: 0 < aksum <= 1
354  !-----------------------------------------------------------------
355 
356 
357  closing_gross(i,j) = closing_net(i,j) / aksum(i,j)
358 
359  !-----------------------------------------------------------------
360  ! Reduce the closing rate if more than 100% of the open water
361  ! would be removed. Reduce the opening rate proportionately.
362  !-----------------------------------------------------------------
363 
364  if (apartic(i,j,0) > c0i) then
365  w1 = apartic(i,j,0) * closing_gross(i,j) * dyn_dt
366  if (w1 > aice0(i,j)) then
367  tmpfac = aice0(i,j) / w1
368  closing_gross(i,j) = closing_gross(i,j) * tmpfac
369  opning(i,j) = opning(i,j) * tmpfac
370  endif
371  endif
372  enddo ! i
373  enddo ! j
374 
375  !-----------------------------------------------------------------
376  ! Reduce the closing rate if more than 100% of any ice category
377  ! would be removed. Reduce the opening rate proportionately.
378  !-----------------------------------------------------------------
379  do ni = 1, ncat
380 !DIR$ CONCURRENT !Cray
381 !cdir nodep !NEC
382 !ocl novrec !Fujitsu
383  do j = jlo, jhi
384  do i = ilo, ihi
385 
386  if (aicen(i,j,ni) > puny .and. apartic(i,j,ni) > c0i) then
387  w1 = apartic(i,j,ni) * closing_gross(i,j) * dyn_dt
388  if (w1 > aicen(i,j,ni)) then
389  tmpfac = aicen(i,j,ni) / w1
390  closing_gross(i,j) = closing_gross(i,j) * tmpfac
391  opning(i,j) = opning(i,j) * tmpfac
392  endif
393  endif
394 
395  enddo ! i
396  enddo ! j
397  enddo ! n
398 
399  !-----------------------------------------------------------------
400  ! Redistribute area, volume, and energy.
401  !-----------------------------------------------------------------
402  call ridge_shift (opning, closing_gross, &
403  msnow_mlt, esnow_mlt)
404 
405  !-----------------------------------------------------------------
406  ! Compute total area of ice plus open water after ridging.
407  !-----------------------------------------------------------------
408  call asum_ridging
409 
410  !-----------------------------------------------------------------
411  ! Check whether asum = 1. If not (because the closing and opening
412  ! rates were reduced above), ridge again with new rates.
413  !-----------------------------------------------------------------
414 
415  iterate_ridging = .false.
416 
417  do j = jlo, jhi
418  do i = ilo, ihi
419  if (abs(asum(i,j) - c1i) < puny) then
420  closing_net(i,j) = c0i ! no ridging the next time through
421  opning(i,j) = c0i
422  else
423  iterate_ridging = .true.
424  divu_adv(i,j) = (c1i - asum(i,j)) / dyn_dt
425  closing_net(i,j) = max(c0i, -divu_adv(i,j))
426  opning(i,j) = max(c0i, divu_adv(i,j))
427  endif
428  enddo
429  enddo
430 
431  !-----------------------------------------------------------------
432  ! Repeat if necessary.
433  !-----------------------------------------------------------------
434 
435  if (iterate_ridging) then
436  if (niter > nitermax) then
437  write(nu_diag,*) 'istep1, my_task, nitermax =', &
438  istep1, my_task, nitermax
439 ! call abort_ice('Exceeded max number of ridging iterations')
440  endif
441 ! write(nu_diag,*) 'REPEAT RIDGING, istep1, my_task, niter =', &
442 ! istep1, my_task, niter
443  call ridge_prep
444  else
445  exit
446  endif
447 
448  enddo ! niter
449 
450  !-----------------------------------------------------------------
451  ! Convert ridging rate diagnostics to correct units.
452  !
453  ! Update fresh water and heat fluxes due to snow melt.
454  !-----------------------------------------------------------------
455 
456  dti_ice = c1i/dyn_dt
457 
458  asum_error = .false.
459 
460 !DIR$ CONCURRENT !Cray
461 !cdir nodep !NEC
462 !ocl novrec !Fujitsu
463  do j = jlo, jhi
464  do i = ilo, ihi
465 
466  if (abs(asum(i,j) - c1i) > puny) asum_error = .true.
467 
468  dardg1dt(i,j) = dardg1dt(i,j) * dti_ice
469  dardg2dt(i,j) = dardg2dt(i,j) * dti_ice
470  dvirdgdt(i,j) = dvirdgdt(i,j) * dti_ice
471  opening(i,j) = opening(i,j) * dti_ice
472 
473  ! fresh water source for ocean
474  fresh(i,j) = fresh(i,j) + msnow_mlt(i,j)*dti_ice
475  fresh_hist(i,j) = fresh_hist(i,j) + msnow_mlt(i,j)*dti_ice
476 
477  ! heat sink for ocean
478  fhnet(i,j) = fhnet(i,j) + esnow_mlt(i,j)*dti_ice
479  fhnet_hist(i,j) = fhnet_hist(i,j) + esnow_mlt(i,j)*dti_ice
480 
481  enddo
482  enddo
483 
484  !-----------------------------------------------------------------
485  ! Abort if area does not add up to one.
486  !-----------------------------------------------------------------
487 
488  if (asum_error) then
489  do j = jlo, jhi
490  do i = ilo, ihi
491  if (abs(asum(i,j) - c1i) > puny) then ! there is a bug
492  write(nu_diag,*) ' '
493  write(nu_diag,*) 'Ridging error: total area =', asum(i,j)
494  write(nu_diag,*) 'istep1, my_task, i, j:', &
495  istep1, my_task, i, j
496  ! istep1, my_task, i, ngid(j),aice(i,j)
497  write(nu_diag,*) 'n, aicen, apartic:'
498  write(nu_diag,*) 0, aice0(i,j), apartic(i,j,0)
499  do ni = 1, ncat
500  write(nu_diag,*) ni, aicen(i,j,ni), apartic(i,j,ni)
501  enddo
502 ! call abort_ice('ridging: total area must be <= 1')
503  endif
504  enddo
505  enddo
506  endif
507 
508 ! call ice_timer_stop(6) ! ridging
509 
mod_time::abs
Definition: mod_time.f90:64
ice_domain::ihi
integer(kind=int_kind) ihi
Definition: ice_domain.f90:101
ice_constants::c0i
real(kind=dbl_kind), parameter c0i
Definition: ice_constants.f90:150
ice_flux::fhnet_hist
real(kind=dbl_kind), dimension(:,:), allocatable, save fhnet_hist
Definition: ice_flux.f90:140
ice_flux::fresh
real(kind=dbl_kind), dimension(:,:), allocatable, save fresh
Definition: ice_flux.f90:120
ice_domain::jlo
integer(kind=int_kind) jlo
Definition: ice_domain.f90:101
ice_domain::ilo
integer(kind=int_kind) ilo
Definition: ice_domain.f90:101
ice_constants::p5
real(kind=dbl_kind), parameter p5
Definition: ice_constants.f90:150
ice_constants::puny
real(kind=dbl_kind), parameter puny
Definition: ice_constants.f90:150
ice_domain::jhi
integer(kind=int_kind) jhi
Definition: ice_domain.f90:101
ice_flux::fresh_hist
real(kind=dbl_kind), dimension(:,:), allocatable, save fresh_hist
Definition: ice_flux.f90:140
ice_state::aice0
real(kind=dbl_kind), dimension(:,:), allocatable, target, save aice0
Definition: ice_state.f90:105
ice_model_size::ncat
integer(kind=int_kind), parameter ncat
Definition: ice_model_size.f90:48
ice_state::aicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save aicen
Definition: ice_state.f90:97
ice_domain::my_task
integer(kind=int_kind), save my_task
Definition: ice_domain.f90:95
ice_constants::c1i
real(kind=dbl_kind), parameter c1i
Definition: ice_constants.f90:150
ice_flux
Definition: ice_flux.f90:36
ice_flux::fhnet
real(kind=dbl_kind), dimension(:,:), allocatable, save fhnet
Definition: ice_flux.f90:120
Here is the call graph for this function:

◆ ridge_prep()

subroutine ice_mechred::ridge_prep ( )

Definition at line 673 of file ice_mechred.f90.

673 !
674 ! !USES:
675 !
676 ! !INPUT/OUTPUT PARAMETERS:
677 !
678 !EOP
679 !
680  integer (kind=int_kind) :: &
681  i,j &! horizontal indices
682  , ni ! thickness category index
683 
684  real (kind=dbl_kind) , parameter :: &
685  gstari = c1i/gstar &
686  , astari = c1i/astar
687 
688  real (kind=dbl_kind) , dimension(ilo:ihi,jlo:jhi,-1:ncat) :: &
689  gsum ! Gsum(n) = sum of areas in categories 0 to n
690 
691  real (kind=dbl_kind) :: &
692  hi &! ice thickness for each cat (m)
693  , hieff &! effective ice thickness (m) (krdg_redist = 2)
694  , hrmean &! mean ridge thickness (m)
695  , xtmp ! temporary variable
696 
697  !-----------------------------------------------------------------
698  ! Initialize
699  !-----------------------------------------------------------------
700 
701  aksum(:,:) = c0i
702 
703  do ni = 0, ncat
704  apartic(:,:,ni) = c0i
705  enddo
706 
707  do ni = 1, ncat
708  hrmin(:,:,ni) = c0i
709  hrmax(:,:,ni) = c0i
710  hrexp(:,:,ni) = c0i
711  krdg(:,:,ni) = c1i
712  enddo
713 
714  !-----------------------------------------------------------------
715  ! Compute the thickness distribution of ice participating in ridging.
716  !-----------------------------------------------------------------
717 
718  !-----------------------------------------------------------------
719  ! First compute the cumulative thickness distribution function Gsum,
720  ! where Gsum(n) is the fractional area in categories 0 to n.
721  ! Ignore categories with very small areas.
722  !-----------------------------------------------------------------
723 
724  gsum(:,:,-1) = c0i
725 
726 !DIR$ CONCURRENT !Cray
727 !cdir nodep !NEC
728 !ocl novrec !Fujitsu
729  do j = jlo, jhi
730  do i = ilo, ihi
731  if (aice0(i,j) > puny) then
732  gsum(i,j,0) = aice0(i,j)
733  else
734  gsum(i,j,0) = gsum(i,j,-1)
735  endif
736  enddo
737  enddo
738 
739  do ni = 1, ncat
740 !DIR$ CONCURRENT !Cray
741 !cdir nodep !NEC
742 !ocl novrec !Fujitsu
743  do j = jlo, jhi
744  do i = ilo, ihi
745  if (aicen(i,j,ni) > puny) then
746  gsum(i,j,ni) = gsum(i,j,ni-1) + aicen(i,j,ni)
747  else
748  gsum(i,j,ni) = gsum(i,j,ni-1)
749  endif
750  enddo
751  enddo
752  enddo
753 
754  ! normalize
755 
756  worka(:,:) = c1i / gsum(:,:,ncat)
757 
758  do ni = 0, ncat
759 !DIR$ CONCURRENT !Cray
760 !cdir nodep !NEC
761 !ocl novrec !Fujitsu
762  do j = jlo, jhi
763  do i = ilo, ihi
764  gsum(i,j,ni) = gsum(i,j,ni) * worka(i,j)
765  enddo
766  enddo
767  enddo
768 
769  !-----------------------------------------------------------------
770  ! Compute the participation function apartic; this is analogous to
771  ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
772  !
773  ! area lost from category n due to ridging/closing
774  ! apartic(n) = ---------------------------------------------------
775  ! total area lost due to ridging/closing
776  !
777  !-----------------------------------------------------------------
778 
779  if (krdg_partic==0) then ! Thorndike et al. 1975
780 
781  !-----------------------------------------------------------------
782  ! b(h) = (2/Gstar) * (1 - G(h)/Gstar).
783  ! The expressions for apartic are found by integrating b(h)g(h)
784  ! between the category boundaries.
785  !-----------------------------------------------------------------
786 
787  do ni = 0, ncat
788  do j = jlo, jhi
789  do i = ilo, ihi
790 
791  if (gsum(i,j,ni) < gstar) then
792  apartic(i,j,ni) = gstari * (gsum(i,j,ni)-gsum(i,j,ni-1)) &
793  * (c2i - (gsum(i,j,ni-1)+gsum(i,j,ni))*gstari)
794  elseif (gsum(i,j,ni-1) < gstar) then
795  apartic(i,j,ni) = gstari * (gstar-gsum(i,j,ni-1)) &
796  * (c2i - (gsum(i,j,ni-1)+gstar)*gstari)
797  endif
798 
799  enddo ! i
800  enddo ! j
801  enddo ! ni
802 
803  elseif (krdg_partic==1) then ! exponential dependence on G(h)
804 
805  !-----------------------------------------------------------------
806  ! b(h) = exp(-G(h)/astar)
807  ! apartic(n) = [exp(-G(ni-1)/astar - exp(-G(n)/astar] / [1-exp(-1/astar)].
808  ! The expression for apartic is found by integrating b(h)g(h)
809  ! between the category boundaries.
810  !-----------------------------------------------------------------
811 
812  ! precompute exponential terms using Gsum as work array
813 
814  xtmp = c1i / (c1i-exp(-astari))
815 
816  do ni = -1, ncat
817 !DIR$ CONCURRENT !Cray
818 !cdir nodep !NEC
819 !ocl novrec !Fujitsu
820  do j = jlo, jhi
821  do i = ilo, ihi
822  gsum(i,j,ni) = exp(-gsum(i,j,ni)*astari) * xtmp
823  enddo ! i
824  enddo ! j
825  enddo ! n
826 
827  ! compute apartic
828 
829  do ni = 0, ncat
830 !DIR$ CONCURRENT !Cray
831 !cdir nodep !NEC
832 !ocl novrec !Fujitsu
833  do j = jlo, jhi
834  do i = ilo, ihi
835  apartic(i,j,ni) = gsum(i,j,ni-1) - gsum(i,j,ni)
836  enddo ! i
837  enddo ! j
838  enddo ! n
839 
840  endif ! krdg_partic
841 
842  !-----------------------------------------------------------------
843  ! Compute variables related to ITD of ridged ice:
844  !
845  ! krdg = mean ridge thickness / thickness of ridging ice
846  ! hrmin = min ridge thickness
847  ! hrmax = max ridge thickness (krdg_redist = 0)
848  ! hrexp = ridge e-folding scale (krdg_redist = 1)
849  !----------------------------------------------------------------
850 
851  if (krdg_redist == 0) then ! Hibler 1980 formulation
852 
853  !-----------------------------------------------------------------
854  ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
855  !
856  ! This parameterization is a modified version of Hibler (1980).
857  ! In the original paper the min ridging thickness is hrmin = 2*hi,
858  ! and the max thickness is hrmax = 2*sqrt(hi*Hstar).
859  !
860  ! Here the min thickness is hrmin = min(2*hi, hi+maxraft),
861  ! so thick ridging ice is not required to raft.
862  !
863  !-----------------------------------------------------------------
864 
865  do ni = 1, ncat
866  do j = jlo, jhi
867  do i = ilo, ihi
868 
869  if (aicen(i,j,ni) > puny) then
870  hi = vicen(i,j,ni) / aicen(i,j,ni)
871  hrmin(i,j,ni) = min(c2i*hi, hi + maxraft)
872  hrmax(i,j,ni) = c2i*sqrt(hstar*hi)
873  hrmax(i,j,ni) = max(hrmax(i,j,ni), hrmin(i,j,ni)+puny)
874  hrmean = p5 * (hrmin(i,j,ni) + hrmax(i,j,ni))
875  krdg(i,j,ni) = hrmean / hi
876  endif
877 
878  enddo ! i
879  enddo ! j
880  enddo ! n
881 
882  else ! krdg_redist = 1; exponential redistribution
883 
884  !-----------------------------------------------------------------
885  ! The ridge ITD is a negative exponential:
886  !
887  ! g(h) ~ exp[-(h-hrmin)/hrexp], h >= hrmin
888  !
889  ! where hrmin is the minimum thickness of ridging ice and
890  ! hrexp is the e-folding thickness.
891  !
892  ! Here, assume as above that hrmin = min(2*hi, hi+maxraft).
893  ! That is, the minimum ridge thickness results from rafting,
894  ! unless the ice is thicker than maxraft.
895  !
896  ! Also, assume that hrexp = mu_rdg*sqrt(hi).
897  ! The parameter mu_rdg is tuned to give e-folding scales mostly
898  ! in the range 2-4 m as observed by upward-looking sonar.
899  !
900  ! Values of mu_rdg in the right column give ice strengths
901  ! roughly equal to values of Hstar in the left column
902  ! (within ~10 kN/m for typical ITDs):
903  !
904  ! Hstar mu_rdg
905  !
906  ! 25 3.0
907  ! 50 4.0
908  ! 75 5.0
909  ! 100 6.0
910  !-----------------------------------------------------------------
911 
912  do ni = 1, ncat
913  do j = jlo, jhi
914  do i = ilo, ihi
915  if (aicen(i,j,ni) > puny) then
916  hi = vicen(i,j,ni) / aicen(i,j,ni)
917  hrmin(i,j,ni) = min(c2i*hi, hi + maxraft)
918  hrexp(i,j,ni) = mu_rdg * sqrt(hi)
919  krdg(i,j,ni) = (hrmin(i,j,ni) + hrexp(i,j,ni)) / hi
920  endif
921  enddo
922  enddo
923  enddo
924 
925  endif ! krdg_redist
926 
927  !----------------------------------------------------------------
928  ! Compute aksum = net ice area removed / total area participating.
929  ! For instance, if a unit area of ice with h = 1 participates in
930  ! ridging to form a ridge with a = 1/3 and h = 3, then
931  ! aksum = 1 - 1/3 = 2/3.
932  !----------------------------------------------------------------
933 
934  do j = jlo, jhi
935  do i = ilo, ihi
936  aksum(i,j) = apartic(i,j,0) ! area participating = area removed
937  enddo
938  enddo
939 
940  do ni = 1, ncat
941  do j = jlo, jhi
942  do i = ilo, ihi
943  ! area participating > area removed
944  aksum(i,j) = aksum(i,j) &
945  + apartic(i,j,ni) * (c1i - c1i/krdg(i,j,ni))
946  enddo
947  enddo
948  enddo
949 
ice_domain::ihi
integer(kind=int_kind) ihi
Definition: ice_domain.f90:101
ice_constants::c0i
real(kind=dbl_kind), parameter c0i
Definition: ice_constants.f90:150
ice_mechred::krdg_partic
integer(kind=int_kind) krdg_partic
Definition: ice_mechred.f90:81
ice_mechred::krdg_redist
integer(kind=int_kind) krdg_redist
Definition: ice_mechred.f90:81
ice_domain::jlo
integer(kind=int_kind) jlo
Definition: ice_domain.f90:101
ice_domain::ilo
integer(kind=int_kind) ilo
Definition: ice_domain.f90:101
ice_constants::p5
real(kind=dbl_kind), parameter p5
Definition: ice_constants.f90:150
ice_constants::puny
real(kind=dbl_kind), parameter puny
Definition: ice_constants.f90:150
ice_domain::jhi
integer(kind=int_kind) jhi
Definition: ice_domain.f90:101
ice_work::worka
real(kind=dbl_kind), dimension(:,:), allocatable worka
Definition: ice_work.f90:61
ice_state::vicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save vicen
Definition: ice_state.f90:97
ice_state::aice0
real(kind=dbl_kind), dimension(:,:), allocatable, target, save aice0
Definition: ice_state.f90:105
ice_model_size::ncat
integer(kind=int_kind), parameter ncat
Definition: ice_model_size.f90:48
ice_constants::c2i
real(kind=dbl_kind), parameter c2i
Definition: ice_constants.f90:150
ice_state::aicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save aicen
Definition: ice_state.f90:97
ice_constants::c1i
real(kind=dbl_kind), parameter c1i
Definition: ice_constants.f90:150
Here is the caller graph for this function:

◆ ridge_shift()

subroutine ice_mechred::ridge_shift ( real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi), intent(in)  opning,
real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi), intent(in)  closing_gross,
real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi), intent(inout)  msnow_mlt,
real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi), intent(inout)  esnow_mlt 
)

Definition at line 970 of file ice_mechred.f90.

970 !
971 ! !USES:
972 !
973 ! use ice_exit
974 ! ggao
975 
976 !
977 ! !INPUT/OUTPUT PARAMETERS:
978 !
979  real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi), intent(in) :: &
980  opning & ! rate of opening due to divergence/shear
981  , closing_gross ! rate at which area removed, not counting
982  ! area of new ridges
983 
984  real (kind=dbl_kind), dimension(ilo:ihi,jlo:jhi), intent(inout) :: &
985  msnow_mlt & ! mass of snow added to ocean (kg m-2)
986  , esnow_mlt ! energy needed to melt snow in ocean (J m-2)
987 !
988 !EOP
989 !
990  integer (kind=int_kind) :: &
991  i,j & ! horizontal indices
992  , ni, n1, n2 & ! thickness category indices
993  , k & ! ice layer index
994  , ij & ! horizontal index, combines i and j loops
995  , icells ! number of cells with aicen > puny
996 
997  integer (kind=int_kind), dimension(1:(ihi-ilo+1)*(jhi-jlo+1)) :: &
998  indxi, indxj ! compressed indices
999 
1000  real (kind=dbl_kind), dimension (imt_local,jmt_local) :: &
1001  vice_init, vice_final & ! ice volume summed over categories
1002  , eice_init, eice_final ! ice energy summed over layers
1003 
1004  real (kind=dbl_kind), dimension (imt_local,jmt_local,ncat) :: &
1005  aicen_init & ! ice area before ridging
1006  , vicen_init & ! ice volume before ridging
1007  , vsnon_init & ! snow volume before ridging
1008  , esnon_init ! snow energy before ridging
1009 
1010  real (kind=dbl_kind), dimension (imt_local,jmt_local,ntilay) :: &
1011  eicen_init ! ice energy before ridging
1012 
1013  real (kind=dbl_kind), dimension (ilo:ihi,jlo:jhi) :: &
1014  afrac & ! fraction of category area ridged
1015  , ardg1 & ! area of ice ridged
1016  , ardg2 & ! area of new ridges
1017  , virdg & ! ice volume of ridging ice
1018  , vsrdg & ! snow volume of ridging ice
1019  , esrdg & ! snow energy of ridging ice
1020  , dhr & ! hrmax - hrmin
1021  , dhr2 & ! hrmax^2 - hrmin^2
1022  , farea & ! fraction of new ridge area going to n2
1023  , fvol ! fraction of new ridge volume going to n2
1024 
1025  real (kind=dbl_kind), dimension (ilo:ihi,jlo:jhi,nilyr) :: &
1026  eirdg ! ice energy of ridging ice
1027 
1028  real (kind=dbl_kind) :: &
1029  hi1 & ! thickness of ridging ice
1030  , hexp & ! ridge e-folding thickness
1031  , hl, hr & ! left and right limits of integration
1032  , expl, expr ! exponentials involving hL, hR
1033 
1034  character (len=char_len) :: &
1035  fieldid ! field identifier
1036 
1037  logical (kind=log_kind) :: &
1038  neg_aice0 & ! flag for aice0(i,j) < -puny
1039  , large_ardg ! flag for ardg > aicen_init
1040 
1041  !-----------------------------------------------------------------
1042  ! Compute quantities that ridging should conserve
1043  ! (not done for snow because snow may be dumped in ocean)
1044  !-----------------------------------------------------------------
1045 
1046  if (l_conservation_check) then
1047  call column_sum (ncat, vicen, vice_init)
1048  call column_sum (ntilay, eicen, eice_init)
1049  endif
1050 
1051  !-----------------------------------------------------------------
1052  ! Compute change in open water area due to closing and opening.
1053  !-----------------------------------------------------------------
1054 
1055  neg_aice0 = .false.
1056 
1057 !DIR$ CONCURRENT !Cray
1058 !cdir nodep !NEC
1059 !ocl novrec !Fujitsu
1060  do j = jlo, jhi
1061  do i = ilo, ihi
1062  aice0(i,j) = aice0(i,j) &
1063  - apartic(i,j,0)*closing_gross(i,j)*dyn_dt &
1064  + opning(i,j)*dyn_dt
1065 
1066  if (aice0(i,j) < -puny) then
1067  neg_aice0 = .true.
1068  aice0(i,j)= c0i
1069  elseif (aice0(i,j) < c0i) then ! roundoff error
1070  aice0(i,j) = c0i
1071  endif
1072  enddo
1073  enddo
1074 
1075  IF(.false.)THEN
1076  if (neg_aice0) then ! there is a bug
1077  do j = jlo, jhi
1078  do i = ilo, ihi
1079  if (aice0(i,j) < -puny) then
1080  write (nu_diag,*) ' '
1081  write (nu_diag,*) 'Ridging error: aice0 < 0'
1082  write (nu_diag,*) 'istep1, my_task, i, j:', &
1083  istep1, my_task, i, j
1084  ! istep1, my_task, i, ngid(j),aice(i,j)
1085  write (nu_diag,*) 'aice0:', aice0(i,j)
1086 ! call abort_ice('ridging: aice0 must be >= 0')
1087  endif ! aice0 < -puny
1088  enddo ! i
1089  enddo ! j
1090  endif ! neg_aice0
1091  ENDIF
1092 
1093  !-----------------------------------------------------------------
1094  ! Save initial state variables
1095  !-----------------------------------------------------------------
1096 
1097  aicen_init(:,:,:) = aicen(:,:,:)
1098  vicen_init(:,:,:) = vicen(:,:,:)
1099  vsnon_init(:,:,:) = vsnon(:,:,:)
1100  aicen_init(:,:,:) = aicen(:,:,:)
1101  esnon_init(:,:,:) = esnon(:,:,:)
1102  eicen_init(:,:,:) = eicen(:,:,:)
1103 
1104  !-----------------------------------------------------------------
1105  ! Compute the area, volume, and energy of ice ridging in each
1106  ! category, along with the area of the resulting ridge.
1107  !-----------------------------------------------------------------
1108 
1109  do n1 = 1, ncat
1110 
1111  !-----------------------------------------------------------------
1112  ! Identify grid cells with nonzero ridging
1113  !-----------------------------------------------------------------
1114 
1115  icells = 0
1116  do j = jlo, jhi
1117  do i = ilo, ihi
1118  if (aicen_init(i,j,n1) > puny .and. apartic(i,j,n1) > c0i &
1119  .and. closing_gross(i,j) > c0i) then
1120  icells = icells + 1
1121  indxi(icells) = i
1122  indxj(icells) = j
1123  endif
1124  enddo ! i
1125  enddo ! j
1126 
1127  large_ardg = .false.
1128 
1129 !DIR$ CONCURRENT !Cray
1130 !cdir nodep !NEC
1131 !ocl novrec !Fujitsu
1132  do ij = 1, icells
1133  i = indxi(ij)
1134  j = indxj(ij)
1135 
1136  !-----------------------------------------------------------------
1137  ! Compute area of ridging ice (ardg1) and of new ridge (ardg2).
1138  ! Make sure ardg1 <= aiceninit.
1139  !-----------------------------------------------------------------
1140 
1141  ardg1(i,j) = apartic(i,j,n1)*closing_gross(i,j)*dyn_dt
1142 
1143  if (ardg1(i,j) > aicen_init(i,j,n1) + puny) then
1144  large_ardg = .true.
1145  else ! correct for roundoff error
1146  ardg1(i,j) = min(ardg1(i,j),aicen_init(i,j,n1))
1147  endif
1148 
1149  ardg2(i,j) = ardg1(i,j) / krdg(i,j,n1)
1150  afrac(i,j) = ardg1(i,j) / aicen_init(i,j,n1)
1151 
1152  !-----------------------------------------------------------------
1153  ! Subtract area, volume, and energy from ridging category n1.
1154  ! (Ice energy in separate loop for vector friendliness)
1155  !-----------------------------------------------------------------
1156 
1157  virdg(i,j) = vicen_init(i,j,n1) * afrac(i,j)
1158  vsrdg(i,j) = vsnon_init(i,j,n1) * afrac(i,j)
1159  esrdg(i,j) = esnon_init(i,j,n1) * afrac(i,j)
1160 
1161  aicen(i,j,n1) = aicen(i,j,n1) - ardg1(i,j)
1162  vicen(i,j,n1) = vicen(i,j,n1) - virdg(i,j)
1163  vsnon(i,j,n1) = vsnon(i,j,n1) - vsrdg(i,j)
1164  esnon(i,j,n1) = esnon(i,j,n1) - esrdg(i,j)
1165 
1166  !-----------------------------------------------------------------
1167  ! Increment ridging diagnostics
1168  !-----------------------------------------------------------------
1169 
1170  dardg1dt(i,j) = dardg1dt(i,j) + ardg1(i,j)
1171  dardg2dt(i,j) = dardg2dt(i,j) + ardg2(i,j)
1172  dvirdgdt(i,j) = dvirdgdt(i,j) + virdg(i,j)
1173  opening(i,j) = opening(i,j) + opning(i,j)*dyn_dt
1174 
1175  !-----------------------------------------------------------------
1176  ! Place part of the snow lost by ridging into the ocean.
1177  ! Note that esnow_mlt < 0; the ocean must cool to melt snow.
1178  ! If the ocean temp = Tf already, new ice must grow.
1179  !-----------------------------------------------------------------
1180 
1181  msnow_mlt(i,j) = msnow_mlt(i,j) &
1182  + rhos*vsrdg(i,j)*(c1i-fsnowrdg)
1183  esnow_mlt(i,j) = esnow_mlt(i,j) &
1184  + esrdg(i,j)*(c1i-fsnowrdg)
1185 
1186  !-----------------------------------------------------------------
1187  ! Compute quantities used to apportion ice among categories
1188  ! in the n2 loop below
1189  !-----------------------------------------------------------------
1190 
1191  dhr(i,j) = hrmax(i,j,n1) - hrmin(i,j,n1)
1192  dhr2(i,j) = hrmax(i,j,n1) * hrmax(i,j,n1) &
1193  - hrmin(i,j,n1) * hrmin(i,j,n1)
1194 
1195  enddo ! ij
1196 
1197  !-----------------------------------------------------------------
1198  ! Subtract ice energy from ridging category n1.
1199  !-----------------------------------------------------------------
1200 
1201  do k = 1, nilyr
1202 !DIR$ CONCURRENT !Cray
1203 !cdir nodep !NEC
1204 !ocl novrec !Fujitsu
1205  do ij = 1, icells
1206  i = indxi(ij)
1207  j = indxj(ij)
1208 
1209  eirdg(i,j,k) = eicen_init(i,j,ilyr1(n1)+k-1) * afrac(i,j)
1210  eicen(i,j,ilyr1(n1)+k-1) = eicen(i,j,ilyr1(n1)+k-1) &
1211  - eirdg(i,j,k)
1212  enddo
1213  enddo
1214 
1215  if (large_ardg) then ! there is a bug
1216  do ij = 1, icells
1217  i = indxi(ij)
1218  j = indxj(ij)
1219  if (ardg1(i,j) > aicen_init(i,j,n1) + puny) then
1220  write (nu_diag,*) ''
1221  write (nu_diag,*) 'ardg > aicen'
1222  write (nu_diag,*) 'istep1, my_task, i, j, n:', &
1223  istep1, my_task, i, j, n1
1224  write (nu_diag,*) 'ardg, aicen_init:', &
1225  ardg1(i,j), aicen_init(i,j,n1)
1226 ! call abort_ice ('ridging: ardg must be <= aicen')
1227  endif ! ardg1 > aicen_init
1228  enddo ! ij
1229  endif ! large_ardg
1230 
1231  !-----------------------------------------------------------------
1232  ! Add area, volume, and energy of new ridge to each category n2.
1233  !-----------------------------------------------------------------
1234 
1235  do n2 = 1, ncat
1236 
1237  if (krdg_redist == 0) then ! Hibler 1980 formulation
1238 
1239  do ij = 1, icells
1240  i = indxi(ij)
1241  j = indxj(ij)
1242 
1243  !-----------------------------------------------------------------
1244  ! Compute the fraction of ridged ice area and volume going to
1245  ! thickness category n2.
1246  !-----------------------------------------------------------------
1247 
1248  if (hrmin(i,j,n1) >= hin_max(n2) .or. &
1249  hrmax(i,j,n1) <= hin_max(n2-1)) then
1250  hl = c0i
1251  hr = c0i
1252  else
1253  hl = max(hrmin(i,j,n1), hin_max(n2-1))
1254  hr = min(hrmax(i,j,n1), hin_max(n2))
1255  endif
1256 
1257  ! fraction of ridged ice area and volume going to n2
1258  farea(i,j) = (hr-hl) / dhr(i,j)
1259  fvol(i,j) = (hr*hr - hl*hl) / dhr2(i,j)
1260 
1261  enddo ! ij
1262 
1263  else ! krdg_redist = 1; exponential formulation
1264 
1265  !-----------------------------------------------------------------
1266  ! Compute the fraction of ridged ice area and volume going to
1267  ! thickness category n2.
1268  !-----------------------------------------------------------------
1269 
1270  if (n2 < ncat) then
1271 
1272  do ij = 1, icells
1273  i = indxi(ij)
1274  j = indxj(ij)
1275 
1276  hi1 = hrmin(i,j,n1)
1277  hexp = hrexp(i,j,n1)
1278 
1279  if (hi1 >= hin_max(n2)) then
1280  farea(i,j) = c0i
1281  fvol(i,j) = c0i
1282  else
1283  hl = max(hi1, hin_max(n2-1))
1284  hr = hin_max(n2)
1285  expl = exp(-(hl-hi1)/hexp)
1286  expr = exp(-(hr-hi1)/hexp)
1287  farea(i,j) = expl - expr
1288  fvol(i,j) = ((hl + hexp)*expl &
1289  - (hr + hexp)*expr) / (hi1 + hexp)
1290  endif
1291  enddo ! ij
1292 
1293  else ! n2 = ncat
1294 
1295  do ij = 1, icells
1296  i = indxi(ij)
1297  j = indxj(ij)
1298 
1299  hi1 = hrmin(i,j,n1)
1300  hexp = hrexp(i,j,n1)
1301 
1302  hl = max(hi1, hin_max(n2-1))
1303  expl = exp(-(hl-hi1)/hexp)
1304  farea(i,j) = expl
1305  fvol(i,j) = (hl + hexp)*expl / (hi1 + hexp)
1306 
1307  enddo
1308 
1309  endif ! n2 < ncat
1310 
1311  endif ! krdg_redist
1312 
1313  !-----------------------------------------------------------------
1314  ! Transfer ice area, ice and snow volume, and snow energy to
1315  ! category n2.
1316  !-----------------------------------------------------------------
1317 
1318 !DIR$ CONCURRENT !Cray
1319 !cdir nodep !NEC
1320 !ocl novrec !Fujitsu
1321  do ij = 1, icells
1322  i = indxi(ij)
1323  j = indxj(ij)
1324  aicen(i,j,n2) = aicen(i,j,n2) + farea(i,j)*ardg2(i,j)
1325  vicen(i,j,n2) = vicen(i,j,n2) + fvol(i,j) *virdg(i,j)
1326  vsnon(i,j,n2) = vsnon(i,j,n2) &
1327  + fvol(i,j)*vsrdg(i,j)*fsnowrdg
1328  esnon(i,j,n2) = esnon(i,j,n2) &
1329  + fvol(i,j)*esrdg(i,j)*fsnowrdg
1330 
1331  enddo
1332 
1333  !-----------------------------------------------------------------
1334  ! Transfer ice energy to category n2
1335  !-----------------------------------------------------------------
1336  do k = 1, nilyr
1337 !DIR$ CONCURRENT !Cray
1338 !cdir nodep !NEC
1339 !ocl novrec !Fujitsu
1340  do ij = 1, icells
1341  i = indxi(ij)
1342  j = indxj(ij)
1343  eicen(i,j,ilyr1(n2)+k-1) = eicen(i,j,ilyr1(n2)+k-1) &
1344  + fvol(i,j)*eirdg(i,j,k)
1345  enddo ! ij
1346  enddo ! k
1347 
1348  enddo ! n2 (new ridges)
1349  enddo ! n1 (ridging categories)
1350 
1351  !-----------------------------------------------------------------
1352  ! Check volume and energy conservation
1353  !-----------------------------------------------------------------
1354 
1355  if (l_conservation_check) then
1356 
1357  call column_sum (ncat, vicen, vice_final)
1358  fieldid = 'vice, ridging'
1359  call column_conservation_check (vice_init, vice_final, &
1360  puny, fieldid)
1361 
1362  call column_sum (ntilay, eicen, eice_final)
1363  fieldid = 'eice, ridging'
1364  call column_conservation_check (eice_init, eice_final, &
1365  puny*lfresh*rhoi, fieldid)
1366 
1367  endif
1368 
ice_model_size::nilyr
integer(kind=int_kind), parameter nilyr
Definition: ice_model_size.f90:48
ice_state::esnon
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save esnon
Definition: ice_state.f90:97
ice_domain::ihi
integer(kind=int_kind) ihi
Definition: ice_domain.f90:101
ice_constants::c0i
real(kind=dbl_kind), parameter c0i
Definition: ice_constants.f90:150
ice_constants::rhos
real(kind=dbl_kind), parameter rhos
Definition: ice_constants.f90:118
ice_constants::lfresh
real(kind=dbl_kind), parameter lfresh
Definition: ice_constants.f90:85
ice_mechred::krdg_redist
integer(kind=int_kind) krdg_redist
Definition: ice_mechred.f90:81
ice_domain::jlo
integer(kind=int_kind) jlo
Definition: ice_domain.f90:101
ice_domain::ilo
integer(kind=int_kind) ilo
Definition: ice_domain.f90:101
ice_constants::puny
real(kind=dbl_kind), parameter puny
Definition: ice_constants.f90:150
ice_domain::jhi
integer(kind=int_kind) jhi
Definition: ice_domain.f90:101
ice_state::vicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save vicen
Definition: ice_state.f90:97
ice_state::eicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save eicen
Definition: ice_state.f90:108
ice_state::aice0
real(kind=dbl_kind), dimension(:,:), allocatable, target, save aice0
Definition: ice_state.f90:105
ice_model_size::ncat
integer(kind=int_kind), parameter ncat
Definition: ice_model_size.f90:48
ice_state::aicen
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save aicen
Definition: ice_state.f90:97
ice_domain::my_task
integer(kind=int_kind), save my_task
Definition: ice_domain.f90:95
ice_constants::c1i
real(kind=dbl_kind), parameter c1i
Definition: ice_constants.f90:150
ice_constants::rhoi
real(kind=dbl_kind), parameter rhoi
Definition: ice_constants.f90:85
ice_model_size::ntilay
integer(kind=int_kind), parameter ntilay
Definition: ice_model_size.f90:48
ice_state::vsnon
real(kind=dbl_kind), dimension(:,:,:), allocatable, target, save vsnon
Definition: ice_state.f90:97
Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ aksum

real (kind=dbl_kind), dimension (:,:), allocatable, save ice_mechred::aksum

Definition at line 133 of file ice_mechred.f90.

◆ apartic

real (kind=dbl_kind), dimension (:,:,:), allocatable, save ice_mechred::apartic

Definition at line 138 of file ice_mechred.f90.

138  real (kind=dbl_kind), dimension (:,:,:) ,allocatable,save:: &
139  apartic ! participation function; fraction of ridging/

◆ astar

real (kind=dbl_kind), parameter ice_mechred::astar = 0.05_dbl_kind

Definition at line 89 of file ice_mechred.f90.

◆ asum

real (kind=dbl_kind), dimension (:,:), allocatable, save ice_mechred::asum

Definition at line 133 of file ice_mechred.f90.

133  real (kind=dbl_kind), dimension (:,:),allocatable,save :: &
134  asum & ! sum of total ice and open water area
135  , aksum ! ratio of area removed to area ridged

◆ cf

real (kind=dbl_kind), parameter ice_mechred::cf = 17._dbl_kind

Definition at line 89 of file ice_mechred.f90.

89  real (kind=dbl_kind), parameter :: &
90  cf = 17._dbl_kind & ! ratio of ridging work to PE change in ridging
91  , cs = p25 & ! fraction of shear energy contrbtng to ridging
92  , cp = p5*gravit*(rhow-rhoi)*rhoi/rhow &! proport const for PE
93  , fsnowrdg = p5 &! snow fraction that survives in ridging
94  , gstar = p15 &! max value of G(h) that participates
95  ! (krdg_partic = 0)
96  , astar = 0.05_dbl_kind &! e-folding scale for G(h) participation
97  ! (krdg_partic = 1)
98  , maxraft = c1i &! max value of hrmin - hi = max thickness
99  ! of ice that rafts (m)
100  , hstar = c25 &! determines mean thickness of ridged ice (m)
101  ! (krdg_redist = 0)
102  ! Flato & Hibler (1995) have Hstar = 100
103  , mu_rdg = c4i &! gives e-folding scale of ridged ice (m^.5)
104  ! (krdg_redist = 1)
105  , pstar = 2.75e4_dbl_kind &! constant in Hibler strength formula
106  ! (kstrength = 0)
107  , cstar = c20 ! constant in Hibler strength formula
ice_constants::c4i
real(kind=dbl_kind), parameter c4i
Definition: ice_constants.f90:150
ice_constants::p25
real(kind=dbl_kind), parameter p25
Definition: ice_constants.f90:150
ice_constants::c20
real(kind=dbl_kind), parameter c20
Definition: ice_constants.f90:150
ice_constants::c25
real(kind=dbl_kind), parameter c25
Definition: ice_constants.f90:150
ice_constants::p5
real(kind=dbl_kind), parameter p5
Definition: ice_constants.f90:150
ice_constants::rhow
real(kind=dbl_kind), parameter rhow
Definition: ice_constants.f90:85
ice_constants::gravit
real(kind=dbl_kind), parameter gravit
Definition: ice_constants.f90:85
ice_constants::c1i
real(kind=dbl_kind), parameter c1i
Definition: ice_constants.f90:150
ice_constants::rhoi
real(kind=dbl_kind), parameter rhoi
Definition: ice_constants.f90:85
ice_constants::p15
real(kind=dbl_kind), parameter p15
Definition: ice_constants.f90:150

◆ cp

real (kind=dbl_kind), parameter ice_mechred::cp = p5*gravit*(rhow-rhoi)*rhoi/rhow

Definition at line 89 of file ice_mechred.f90.

◆ cs

real (kind=dbl_kind), parameter ice_mechred::cs = p25

Definition at line 89 of file ice_mechred.f90.

◆ cstar

real (kind=dbl_kind), parameter ice_mechred::cstar = c20

Definition at line 89 of file ice_mechred.f90.

◆ dardg1dt

real (kind=dbl_kind), dimension(:,:), allocatable, save ice_mechred::dardg1dt

Definition at line 120 of file ice_mechred.f90.

120  real (kind=dbl_kind), dimension(:,:),allocatable,save :: &
121  dardg1dt & ! rate of fractional area loss by ridging ice (1/s)
122  , dardg2dt & ! rate of fractional area gain by new ridges (1/s)
123  , dvirdgdt & ! rate of ice volume ridged (m/s)
124  , opening ! rate of opening due to divergence/shear (1/s)

◆ dardg2dt

real (kind=dbl_kind), dimension(:,:), allocatable, save ice_mechred::dardg2dt

Definition at line 120 of file ice_mechred.f90.

◆ dvirdgdt

real (kind=dbl_kind), dimension(:,:), allocatable, save ice_mechred::dvirdgdt

Definition at line 120 of file ice_mechred.f90.

◆ fsnowrdg

real (kind=dbl_kind), parameter ice_mechred::fsnowrdg = p5

Definition at line 89 of file ice_mechred.f90.

◆ gstar

real (kind=dbl_kind), parameter ice_mechred::gstar = p15

Definition at line 89 of file ice_mechred.f90.

◆ hrexp

real (kind=dbl_kind), dimension (:,:,:), allocatable, save ice_mechred::hrexp

Definition at line 143 of file ice_mechred.f90.

◆ hrmax

real (kind=dbl_kind), dimension (:,:,:), allocatable, save ice_mechred::hrmax

Definition at line 143 of file ice_mechred.f90.

◆ hrmin

real (kind=dbl_kind), dimension (:,:,:), allocatable, save ice_mechred::hrmin

Definition at line 143 of file ice_mechred.f90.

143  real (kind=dbl_kind), dimension (:,:,:),allocatable,save :: &
144  hrmin & ! minimum ridge thickness
145  , hrmax & ! maximum ridge thickness
146  , hrexp & ! ridge e-folding thickness (krdg_redist = 1)
147  , krdg ! mean ridge thickness/thickness of ridging ice

◆ hstar

real (kind=dbl_kind), parameter ice_mechred::hstar = c25

Definition at line 89 of file ice_mechred.f90.

◆ krdg

real (kind=dbl_kind), dimension (:,:,:), allocatable, save ice_mechred::krdg

Definition at line 143 of file ice_mechred.f90.

◆ krdg_partic

integer (kind=int_kind) ice_mechred::krdg_partic

Definition at line 81 of file ice_mechred.f90.

◆ krdg_redist

integer (kind=int_kind) ice_mechred::krdg_redist

Definition at line 81 of file ice_mechred.f90.

◆ kstrength

integer (kind=int_kind) ice_mechred::kstrength

Definition at line 81 of file ice_mechred.f90.

81  integer (kind=int_kind) :: & ! defined in namelist
82  kstrength & ! 0 for simple Hibler (1979) formulation
83  ! 1 for Rothrock (1975) pressure formulation
84  , krdg_partic & ! 0 for Thorndike et al. (1975) formulation
85  ! 1 for exponential participation function
86  , krdg_redist ! 0 for Hibler (1980) formulation
ice_mechred::krdg_partic
integer(kind=int_kind) krdg_partic
Definition: ice_mechred.f90:81
ice_mechred::krdg_redist
integer(kind=int_kind) krdg_redist
Definition: ice_mechred.f90:81
ice_mechred::kstrength
integer(kind=int_kind) kstrength
Definition: ice_mechred.f90:81

◆ l_conservation_check

logical (kind=log_kind), parameter ice_mechred::l_conservation_check = .true.

Definition at line 149 of file ice_mechred.f90.

149  logical (kind=log_kind), parameter :: &
150  l_conservation_check = .true. ! if true, check conservation

◆ maxraft

real (kind=dbl_kind), parameter ice_mechred::maxraft = c1i

Definition at line 89 of file ice_mechred.f90.

◆ mu_rdg

real (kind=dbl_kind), parameter ice_mechred::mu_rdg = c4i

Definition at line 89 of file ice_mechred.f90.

◆ opening

real (kind=dbl_kind), dimension(:,:), allocatable, save ice_mechred::opening

Definition at line 120 of file ice_mechred.f90.

◆ pstar

real (kind=dbl_kind), parameter ice_mechred::pstar = 2.75e4_dbl_kind

Definition at line 89 of file ice_mechred.f90.

Generated by   doxygen 1.8.15