mod_import.F90

#if defined (USE_NUOPC_CESMBETA) || (ESPC_COUPLE)
#define USE_NUOPC_GENERIC 1
#endif
      module mod_import

      use mod_xc         ! HYCOM communication interface
      use mod_cb_arrays  ! HYCOM saved arrays

      implicit none

      public hycom_imp_reset
      public hycom_imp_mrg_diag
      public hycom_imp_mrg
      public hycom_imp_mrg_latflx
      public hycom_imp_mrg_sensflx

      contains

! --- reset imp_merge flag
      subroutine hycom_imp_reset(reset)
      logical :: reset
      character(*),parameter :: rname = 'hycom_imp_reset'

#if defined (USE_NUOPC_GENERIC)
        if(reset) then
          imp_merge = 1.d0
        else
          imp_merge = 0.d0
        endif
        cpl_merge = reset
#endif
      end subroutine hycom_imp_reset

! --- print merge import data diagnostics
      subroutine hycom_imp_mrg_diag()
      character(*),parameter :: rname = 'hycom_imp_mrg_diag'
      integer                :: i,j,jja
      real                   :: mrg_cnt
      integer                :: tlb(2), tub(2)

#if defined (USE_NUOPC_GENERIC)
#if defined(ARCTIC)
!   arctic (tripole) domain, top row is replicated (ignore it)
        jja=min(jj,(jtdm-1-j0))
#else
        jja=jj
#endif

        ! count merge cells ignoring halos
        mrg_cnt=0
        do j=1, jja
        do i=1, ii
          if (imp_merge(i,j).ne.0) mrg_cnt=mrg_cnt+1
        enddo
        enddo
        call xcsumr(mrg_cnt,1)
        if (mnproc.eq.1) then
          write(*,'(A,L1)') rname//',cpl_merge=',cpl_merge
          write(*,'(A,E23.15)') rname//',imp_merge_cnt=',mrg_cnt
          if(cpl_taux) write(*,'(A)') rname//" merge imp_taux"
          if(cpl_tauy) write(*,'(A)') rname//" merge imp_tauy"
          if(cpl_wndspd.or.calc_wndspd) &
            write(*,'(A)') rname//" merge imp_wndspd"
          if(cpl_ustara) write(*,'(A)') rname//" merge imp_ustara"
          if(cpl_airtmp) write(*,'(A)') rname//" merge imp_airtmp"
          if(cpl_vapmix) write(*,'(A)') rname//" merge imp_vapmix"
          if(cpl_precip) write(*,'(A)') rname//" merge imp_precip"
          if(cpl_surtmp) write(*,'(A)') rname//" merge imp_surtmp"
          if(cpl_seatmp) write(*,'(A)') rname//" merge imp_seatmp"
          if(cpl_swflx_net.or.cpl_swflx_net2down.or.cpl_swflxd) &
            write(*,'(A)') rname//" merge imp_swflx"
          if(cpl_lwflx_net.or.cpl_lwflx_net2down.or.cpl_lwflxd) &
            write(*,'(A)') rname//" merge imp_lwdflx"
          if(cpl_u10) write(*,'(A)') rname//" merge imp_wndspx"
          if(cpl_v10) write(*,'(A)') rname//" merge imp_wndspy"
          if(cpl_mslprs) write(*,'(A)') rname//" merge imp_mslprs"
          if(calc_radflx) write(*,'(A)') rname//" merge imp_radflx"
          if(cpl_latflx) write(*,'(A)') rname//" merge imp_latflx"
          if(cpl_sensflx) write(*,'(A)') rname//" merge imp_sensflx"
        endif
#else
        write(lp,'(/ a,a /)') 'error - ', &
          rname//' merge requires USE_NUOPC_CESMBETA or ESPC_COUPLE'
        call flush(lp)
        call xcstop(rname)
               stop rname
#endif
      end subroutine hycom_imp_mrg_diag

! --- merge import data where imp_merge is true
      subroutine hycom_imp_mrg()
      character(*),parameter :: rname = 'hycom_imp_mrg'
      integer                :: i,j,jja
      integer                :: tlb(2), tub(2)

#if defined (USE_NUOPC_GENERIC)
#if defined(ARCTIC)
!   arctic (tripole) domain, top row is replicated (ignore it)
        jja=min(jj,(jtdm-1-j0))
#else
        jja=jj
#endif

        if(natm.eq.2) then
          tlb(1)=lbound(imp_merge,1)
          tlb(2)=lbound(imp_merge,2)
          tub(1)=ubound(imp_merge,1)
          tub(2)=ubound(imp_merge,2)
          if(cpl_taux) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                taux(i,j,:) = imp_taux(i,j,1)
            enddo
            enddo
          endif
          if(cpl_tauy) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                tauy(i,j,:) = imp_tauy(i,j,1)
            enddo
            enddo
          endif
          if(cpl_wndspd.or.calc_wndspd) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                wndspd(i,j,:) = imp_wndspd(i,j,1)
            enddo
            enddo
          endif
          if(cpl_ustara) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                ustara(i,j,:) = imp_ustara(i,j,1)
            enddo
            enddo
          endif
          if(cpl_airtmp) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                airtmp(i,j,:) = imp_airtmp(i,j,1)
            enddo
            enddo
          endif
          if(cpl_vapmix) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                vapmix(i,j,:) = imp_vapmix(i,j,1)
            enddo
            enddo
          endif
          if(cpl_precip) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                precip(i,j,:) = imp_precip(i,j,1)
            enddo
            enddo
          endif
          if(cpl_surtmp) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                surtmp(i,j,:) = imp_surtmp(i,j,1)
            enddo
            enddo
          endif
          if(cpl_seatmp) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                seatmp(i,j,:) = imp_seatmp(i,j,1)
            enddo
            enddo
          endif
          if(cpl_swflx_net.or.cpl_swflx_net2down.or.cpl_swflxd) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                swflx(i,j,:) = imp_swflx(i,j,1)
            enddo
            enddo
          endif
          if(cpl_lwflx_net.or.cpl_lwflx_net2down.or.cpl_lwflxd) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                lwflx(i,j,:) = imp_lwdflx(i,j,1)
            enddo
            enddo
          endif
          if(cpl_u10) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                wndspx(i,j,:) = imp_wndspx(i,j,1)
            enddo
            enddo
          endif
          if(cpl_v10) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                wndspy(i,j,:) = imp_wndspy(i,j,1)
            enddo
            enddo
          endif
          if(cpl_mslprs) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                mslprs(i,j,:) = imp_mslprs(i,j,1)
            enddo
            enddo
          endif
          if(calc_radflx) then
            do j=tlb(2), tub(2)
            do i=tlb(1), tub(1)
              if (imp_merge(i,j).ne.0) &
                radflx(i,j,:) = imp_radflx(i,j,1)
            enddo
            enddo
          endif
        else
          write(lp,'(/ a,a /)') 'error - ', &
             rname//' merge natm.ne.2 is not implemented'
          call flush(lp)
          call xcstop(rname)
                 stop rname
        end if

!   check CICE feedback
      if ((.not.cpl_sic) .or.(.not.cpl_sitx).or.(.not.cpl_sity).or. &
        (.not.cpl_siqs).or.(.not.cpl_sifh).or.(.not.cpl_sifs).or. &
        (.not.cpl_sifw).or.(.not.cpl_sit) .or.(.not.cpl_sih) .or. &
        (.not.cpl_siu) .or.(.not.cpl_siv)) then
        if (mnproc.eq.1) print *, &
          'warning... no feedback from CICE to HYCOM('//rname//')'
        else
!       copy import data to sea ice
        do j=1, jja
        do i=1, ii
          if (imp_merge(i,j).ne.0) then
            if (ishlf(i,j).eq.1) then !standard ocean point
              if ((iceflg.ge.2).and.(icmflg.ne.3)) then
                covice(i,j)=sic_import(i,j) !Sea Ice Concentration
                si_c(i,j)=sic_import(i,j) !Sea Ice Concentration
                if (covice(i,j).gt.0.0) then
                   si_tx(i,j) = -sitx_import(i,j) !Sea Ice X-Stress into ocean
                   si_ty(i,j) = -sity_import(i,j) !Sea Ice Y-Stress into ocean
                  fswice(i,j) =  siqs_import(i,j) !Solar Heat Flux thru Ice to Ocean
                  flxice(i,j) =  fswice(i,j) + &
                                 sifh_import(i,j) !Ice Freezing/Melting Heat Flux
                  sflice(i,j) =  sifs_import(i,j)*1.e3 !Ice Salt Flux
                  wflice(i,j) =  sifw_import(i,j) !Ice freshwater Flux
                  temice(i,j) =   sit_import(i,j) !Sea Ice Temperature
                    si_t(i,j) =   sit_import(i,j) !Sea Ice Temperature
                  thkice(i,j) =   sih_import(i,j) !Sea Ice Thickness
                    si_h(i,j) =   sih_import(i,j) !Sea Ice Thickness
                    si_u(i,j) =   siu_import(i,j) !Sea Ice X-Velocity
                    si_v(i,j) =   siv_import(i,j) !Sea Ice Y-Velocity
                else
                   si_tx(i,j) = 0.0
                   si_ty(i,j) = 0.0
                  fswice(i,j) = 0.0
                  flxice(i,j) = 0.0
                  sflice(i,j) = 0.0
                  wflice(i,j) = 0.0
                  temice(i,j) = 0.0
                    si_t(i,j) = 0.0
                  thkice(i,j) = 0.0
                    si_h(i,j) = 0.0
                    si_u(i,j) = 0.0
                    si_v(i,j) = 0.0
                endif !covice
              elseif ((iceflg.ge.2).and.(icmflg.eq.3)) then
                si_c(i,j)=sic_import(i,j) !Sea Ice Concentration
                if (si_c(i,j).gt.0.0) then
                  si_tx(i,j) = -sitx_import(i,j) !Sea Ice X-Stress into ocean
                  si_ty(i,j) = -sity_import(i,j) !Sea Ice Y-Stress into ocean
                   si_h(i,j) =   sih_import(i,j) !Sea Ice Thickness
                   si_t(i,j) =   sit_import(i,j) !Sea Ice Temperature
                   si_u(i,j) =   siu_import(i,j) !Sea Ice X-Velocity
                   si_v(i,j) =   siv_import(i,j) !Sea Ice Y-Velocity
                else
                  si_tx(i,j) = 0.0
                  si_ty(i,j) = 0.0
                   si_h(i,j) = 0.0
                   si_t(i,j) = 0.0
                   si_u(i,j) = 0.0
                   si_v(i,j) = 0.0
                endif !covice
              endif !iceflg>=2 (icmflg)
            endif !ishlf
          endif !imp_merge
        enddo
        enddo

#if defined(ARCTIC)
!       update last active row of array
!jcx    call xctila( sic_import,1,1,halo_ps) !Sea Ice Concentration
!jcx    call xctila(sitx_import,1,1,halo_pv) !Sea Ice X-Stress
!jcx    call xctila(sity_import,1,1,halo_pv) !Sea Ice Y-Stress
!jcx    call xctila(siqs_import,1,1,halo_ps) !Solar Heat Flux thru Ice to Ocean
!jcx    call xctila(sifh_import,1,1,halo_ps) !Ice Freezing/Melting Heat Flux
!jcx    call xctila(sifs_import,1,1,halo_ps) !Ice Freezing/Melting Salt Flux
!jcx    call xctila(sifw_import,1,1,halo_ps) !Ice Net Water Flux
!jcx    call xctila( sit_import,1,1,halo_ps) !Sea Ice Temperature
!jcx    call xctila( sih_import,1,1,halo_ps) !Sea Ice Thickness
!jcx    call xctila( siu_import,1,1,halo_pv) !Sea Ice X-Velocity
!jcx    call xctila( siv_import,1,1,halo_pv) !Sea Ice Y-Velocity
        if ((iceflg.ge.2).and.(icmflg.ne.3)) then
          call xctila(covice,1,1,halo_ps) !Sea Ice Concentration
          call xctila(  si_c,1,1,halo_ps) !Sea Ice Concentration
          call xctila( si_tx,1,1,halo_pv) !Sea Ice X-Stress into ocean
          call xctila( si_ty,1,1,halo_pv) !Sea Ice Y-Stress into ocean
          call xctila(fswice,1,1,halo_ps) !Solar Heat Flux thru Ice to Ocean
          call xctila(flxice,1,1,halo_ps) !Ice Freezing/Melting Heat Flux
          call xctila(sflice,1,1,halo_ps) !Ice Salt Flux
          call xctila(wflice,1,1,halo_ps) !Ice Freshwater Flux
          call xctila(temice,1,1,halo_ps) !Sea Ice Temperature
          call xctila(  si_t,1,1,halo_ps) !Sea Ice Temperature
          call xctila(thkice,1,1,halo_ps) !Sea Ice Thickness
          call xctila(  si_h,1,1,halo_ps) !Sea Ice Thickness
          call xctila(  si_u,1,1,halo_pv) !Sea Ice X-Velocity
          call xctila(  si_v,1,1,halo_pv) !Sea Ice Y-Velocity
        elseif ((iceflg.ge.2).and.(icmflg.eq.3)) then
          call xctila(  si_c,1,1,halo_ps) !Sea Ice Concentration
          call xctila( si_tx,1,1,halo_pv) !Sea Ice X-Stress into ocean
          call xctila( si_ty,1,1,halo_pv) !Sea Ice Y-Stress into ocean
          call xctila(  si_h,1,1,halo_ps) !Sea Ice Thickness
          call xctila(  si_t,1,1,halo_ps) !Sea Ice Temperature
          call xctila(  si_u,1,1,halo_pv) !Sea Ice X-Velocity
          call xctila(  si_v,1,1,halo_pv) !Sea Ice Y-Velocity
        endif
#endif

!       smooth sea ice velocity fields
        call psmooth(si_u,0,0,ishlf,util1)
        call psmooth(si_v,0,0,ishlf,util1)
#if defined(ARCTIC)
        call xctila(si_u,1,1,halo_pv)
        call xctila(si_v,1,1,halo_pv)
#endif
!       call xctilr(si_u,1,1, nbdy,nbdy, halo_pv)
!       call xctilr(si_v,1,1, nbdy,nbdy, halo_pv)

!       copy back from si_ to _import for archive_ice
        do j=1, jja
        do i=1, ii
          if (imp_merge(i,j).ne.0) then
            if (si_c(i,j).gt.0.0) then
              siu_import(i,j)=si_u(i,j) !Sea Ice X-Velocity
              siv_import(i,j)=si_v(i,j) !Sea Ice Y-Velocity
            endif !si_c
          endif
        enddo !i
        enddo !j
      endif !feedback from CICE to HYCOM
#else
        write(lp,'(/ a,a /)') 'error - ', &
          rname//' merge requires USE_NUOPC_CESMBETA or ESPC_COUPLE'
        call flush(lp)
        call xcstop(rname)
               stop rname
#endif
      end subroutine hycom_imp_mrg

! --- return imp_latflx if imp_merge(i,j) is true
      real function hycom_imp_mrg_latflx(i,j,fval)
      integer :: i,j
      real :: fval
      character(*),parameter :: rname = 'hycom_imp_mrg_latflx'

#if defined (USE_NUOPC_GENERIC)
        if (cpl_latflx.and.(imp_merge(i,j).ne.0)) then
          hycom_imp_mrg_latflx=imp_latflx(i,j,1)
        else
          hycom_imp_mrg_latflx=fval
        endif
#else
        hycom_imp_mrg_latflx=fval
        write(lp,'(/ a,a /)') 'error - ', &
          rname//' merge requires USE_NUOPC_CESMBETA or ESPC_COUPLE'
        call flush(lp)
        call xcstop(rname)
               stop rname
#endif
      end function hycom_imp_mrg_latflx

! --- return imp_sensflx if imp_merge(i,j) is true
      real function hycom_imp_mrg_sensflx(i,j,fval)
      integer :: i,j
      real :: fval
      character(*),parameter :: rname = 'hycom_imp_mrg_sensflx'

#if defined (USE_NUOPC_GENERIC)
        if (cpl_sensflx.and.(imp_merge(i,j).ne.0)) then
          hycom_imp_mrg_sensflx=imp_sensflx(i,j,1)
        else
          hycom_imp_mrg_sensflx=fval
        endif
#else
        hycom_imp_mrg_sensflx=fval
        write(lp,'(/ a,a /)') 'error - ', &
          rname//' merge requires USE_NUOPC_CESMBETA or ESPC_COUPLE'
        call flush(lp)
        call xcstop(rname)
               stop rname
#endif
      end function hycom_imp_mrg_sensflx

      end module mod_import