LCOV - code coverage report
Current view: top level - cicecore/cicedyn/infrastructure - ice_restoring.F90 (source / functions) Hit Total Coverage
Test: 231018-211459:8916b9ff2c:1:quick Lines: 2 250 0.80 %
Date: 2023-10-18 15:30:36 Functions: 1 3 33.33 %

          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             : !=======================================================================

Generated by: LCOV version 1.14-6-g40580cd