!  SVN:$Id: ice_flux.F90 915 2015-02-08 02:50:33Z tcraig $
!=======================================================================

! Flux variable declarations; these include fields sent from the coupler
! ("in"), sent to the coupler ("out"), written to diagnostic history files
! ("diagnostic"), and used internally ("internal").
!
! author Elizabeth C. Hunke, LANL
!
! 2004: Block structure added by William Lipscomb
!       Swappped, revised, and added some subroutines
! 2006: Converted to free source form (F90) by Elizabeth Hunke

      module ice_flux

      use ice_kinds_mod
      use ice_fileunits, only: nu_diag
      use ice_blocks, only: nx_block, ny_block
      use ice_domain_size, only: max_blocks, ncat, max_aero, max_iso, max_nstrm, nilyr
      use ice_constants, only: c0, c1, c5, c10, c20, c180, dragio, &
          depressT, stefan_boltzmann, Tffresh, emissivity

      implicit none
      private
      public :: init_coupler_flux, init_history_therm, init_history_dyn, &
                init_flux_ocn, init_flux_atm, scale_fluxes, merge_fluxes, &
                set_sfcflux

      !-----------------------------------------------------------------
      ! Dynamics component
      !-----------------------------------------------------------------

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &

       ! in from atmos (if .not.calc_strair)  
         strax   , & ! wind stress components (N/m^2)
         stray   , & ! 

       ! in from ocean
         uocn    , & ! ocean current, x-direction (m/s)
         vocn    , & ! ocean current, y-direction (m/s)
         ss_tltx , & ! sea surface slope, x-direction (m/m)
         ss_tlty , & ! sea surface slope, y-direction

       ! out to atmosphere
         strairxT, & ! stress on ice by air, x-direction
         strairyT, & ! stress on ice by air, y-direction

       ! out to ocean          T-cell (kg/m s^2)
       ! Note, CICE_IN_NEMO uses strocnx and strocny for coupling
         strocnxT, & ! ice-ocean stress, x-direction
         strocnyT    ! ice-ocean stress, y-direction

       ! diagnostic

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         sig1    , & ! principal stress component
         sig2    , & ! principal stress component
         strairx , & ! stress on ice by air, x-direction
         strairy , & ! stress on ice by air, y-direction
         strocnx , & ! ice-ocean stress, x-direction
         strocny , & ! ice-ocean stress, y-direction
         strtltx , & ! stress due to sea surface slope, x-direction
         strtlty , & ! stress due to sea surface slope, y-direction
         strintx , & ! divergence of internal ice stress, x (N/m^2)
         strinty , & ! divergence of internal ice stress, y (N/m^2)
         daidtd  , & ! ice area tendency due to transport   (1/s)
         dvidtd  , & ! ice volume tendency due to transport (m/s)
!jd
         dvsdtd  , & ! snow volume tendency due to transport (m/s)
!jd
         dagedtd , & ! ice age tendency due to transport (s/s)
         dardg1dt, & ! rate of area loss by ridging ice (1/s)
         dardg2dt, & ! rate of area gain by new ridges (1/s)
         dvirdgdt, & ! rate of ice volume ridged (m/s)
         opening     ! rate of opening due to divergence/shear (1/s)

      real (kind=dbl_kind), & 
         dimension (nx_block,ny_block,ncat,max_blocks), public :: &
       ! ridging diagnostics in categories
         dardg1ndt, & ! rate of area loss by ridging ice (1/s)
         dardg2ndt, & ! rate of area gain by new ridges (1/s)
         dvirdgndt, & ! rate of ice volume ridged (m/s)
         aparticn,  & ! participation function
         krdgn,     & ! mean ridge thickness/thickness of ridging ice
         ardgn,     & ! fractional area of ridged ice
         vrdgn,     & ! volume of ridged ice
         araftn,    & ! rafting ice area
         vraftn,    & ! rafting ice volume 
         aredistn,  & ! redistribution function: fraction of new ridge area
         vredistn     ! redistribution function: fraction of new ridge volume

       ! restart

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
       ! ice stress tensor in each corner of T cell (kg/s^2)
         stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22
         stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22
         stress12_1,stress12_2,stress12_3,stress12_4    ! sigma12

      logical (kind=log_kind), &
         dimension (nx_block,ny_block,max_blocks), public :: &
         iceumask   ! ice extent mask (U-cell)

       ! internal

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         prs_sig  , & ! replacement pressure, for stress calc
         fm           ! Coriolis param. * mass in U-cell (kg/s)

      !-----------------------------------------------------------------
      ! Thermodynamic component
      !-----------------------------------------------------------------

       ! in from atmosphere (if calc_Tsfc)

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         zlvl    , & ! atm level height (m)
         uatm    , & ! wind velocity components (m/s)
         vatm    , &
         wind    , & ! wind speed (m/s)
         potT    , & ! air potential temperature  (K)
         Tair    , & ! air temperature  (K)
         Qa      , & ! specific humidity (kg/kg)
         rhoa    , & ! air density (kg/m^3)
         swvdr   , & ! sw down, visible, direct  (W/m^2)
         swvdf   , & ! sw down, visible, diffuse (W/m^2)
         swidr   , & ! sw down, near IR, direct  (W/m^2)
         swidf   , & ! sw down, near IR, diffuse (W/m^2)
         flw         ! incoming longwave radiation (W/m^2)

       ! in from atmosphere (if .not. Tsfc_calc)
       ! required for coupling to HadGEM3
       ! NOTE: when in CICE_IN_NEMO mode, these are gridbox mean fields,
       ! not per ice area. When in standalone mode, these are per ice area.

      real (kind=dbl_kind), & 
         dimension (nx_block,ny_block,ncat,max_blocks), public :: &
         fsurfn_f   , & ! net flux to top surface, excluding fcondtop
         fcondtopn_f, & ! downward cond flux at top surface (W m-2)
         fsensn_f   , & ! sensible heat flux (W m-2)
         flatn_f        ! latent heat flux (W m-2)

       ! in from atmosphere

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         frain   , & ! rainfall rate (kg/m^2 s)
         fsnow       ! snowfall rate (kg/m^2 s)

      real (kind=dbl_kind), &
         dimension (nx_block,ny_block,max_aero,max_blocks), public :: &
         faero_atm   ! aerosol deposition rate (kg/m^2 s)

      real (kind=dbl_kind), &
         dimension (nx_block,ny_block,max_iso,max_blocks), public :: &
         fiso_atm, &   ! isotope deposition rate (kg/m^2 s)
         Qa_iso,   &   ! isotope surface specfic humidity (kg/kg)
         fiso_rain     ! isotope rainfall rate (kg/m^2 s)

       ! in from ocean

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         sss     , & ! sea surface salinity (ppt)
         sst     , & ! sea surface temperature (C)
         frzmlt  , & ! freezing/melting potential (W/m^2)
         frzmlt_init, & ! frzmlt used in current time step (W/m^2)
         Tf      , & ! freezing temperature (C)
         qdp     , & ! deep ocean heat flux (W/m^2), negative upward
         hmix    , & ! mixed layer depth (m)
         daice_da    ! data assimilation concentration increment rate 
                     ! (concentration s-1)(only used in hadgem drivers)

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         HDO_ocn    , & ! isotopes
         H2_16O_ocn , & ! isotopes
         H2_18O_ocn     ! isotopes

       ! out to atmosphere (if calc_Tsfc)
       ! note Tsfc is in ice_state.F

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         fsens   , & ! sensible heat flux (W/m^2)
         flat    , & ! latent heat flux   (W/m^2)
         fswabs  , & ! shortwave flux absorbed in ice and ocean (W/m^2)
         fswint_ai, & ! SW absorbed in ice interior below surface (W/m^2)
         flwout  , & ! outgoing longwave radiation (W/m^2)
         Tref    , & ! 2m atm reference temperature (K)
         Qref    , & ! 2m atm reference spec humidity (kg/kg)
         Uref    , & ! 10m atm reference wind speed (m/s)
         evap    , & ! evaporative water flux (kg/m^2/s)
         evapi   , & ! evaporative water flux over ice (kg/m^2/s)
         evaps       ! evaporative water flux over snow (kg/m^2/s)

       ! albedos aggregated over categories (if calc_Tsfc)
      real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), public :: &
         alvdr   , & ! visible, direct   (fraction)
         alidr   , & ! near-ir, direct   (fraction)
         alvdf   , & ! visible, diffuse  (fraction)
         alidf   , & ! near-ir, diffuse  (fraction)
         ! grid-box-mean versions
         alvdr_ai, & ! visible, direct   (fraction)
         alidr_ai, & ! near-ir, direct   (fraction)
         alvdf_ai, & ! visible, diffuse  (fraction)
         alidf_ai, & ! near-ir, diffuse  (fraction)
         ! grid-box-mean versions
         alvdr_init, & ! visible, direct   (fraction)
         alidr_init, & ! near-ir, direct   (fraction)
         alvdf_init, & ! visible, diffuse  (fraction)
         alidf_init, & ! near-ir, diffuse  (fraction)
         ! components for history
         albice   , & ! bare ice albedo
         albsno   , & ! snow albedo
         albpnd   , & ! melt pond albedo
         apeff_ai , & ! effective pond area used for radiation calculation
         snowfrac     ! snow fraction used in radiation

      real (kind=dbl_kind), &
         dimension(nx_block,ny_block,max_blocks,max_nstrm), public :: &
         albcnt       ! counter for zenith angle

      real (kind=dbl_kind), &
        dimension (nx_block,ny_block,max_iso,max_blocks), public :: &
         fiso_evap, & ! isotope evaporation to atm (kg/m^2/s)
         Qref_iso     ! 2m atm reference spec humidity (kg/kg)

       ! out to ocean 
       ! (Note CICE_IN_NEMO does not use these for coupling.  
       !  It uses fresh_ai,fsalt_ai,fhocn_ai and fswthru_ai)
      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         fpond   , & ! fresh water flux to ponds (kg/m^2/s)
         fresh   , & ! fresh water flux to ocean (kg/m^2/s)
         fsalt   , & ! salt flux to ocean (kg/m^2/s)
         fhocn   , & ! net heat flux to ocean (W/m^2)
         fswthru     ! shortwave penetrating to ocean (W/m^2)

      logical (kind=log_kind), public :: &
         send_i2x_per_cat = .false. ! if true, pass select per ice thickness category fields to the coupler
            ! do not move this initialization to a init subroutine, because non-default
            ! values are set in ice_cpl_indices_set in drivers/cesm/ice_cpl_indices.F90
            ! which is called before other init subroutines

      real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: &
         fswthrun_ai ! per-category fswthru * ai (W/m^2)

      real (kind=dbl_kind), &
        dimension (nx_block,ny_block,max_aero,max_blocks), public :: &
         faero_ocn   ! aerosol flux to ocean  (kg/m^2/s)

      real (kind=dbl_kind), &
        dimension (nx_block,ny_block,max_iso,max_blocks), public :: &
         fiso_ocn    ! isotope flux to ocean  (kg/m^2/s)

       ! internal

      real (kind=dbl_kind), &
         dimension (nx_block,ny_block,max_blocks), public :: &
         fswfac  , & ! for history
         scale_factor! scaling factor for shortwave components

      logical (kind=log_kind), public :: &
         update_ocn_f, & ! if true, update fresh water and salt fluxes
         l_mpond_fresh   ! if true, include freshwater feedback from meltponds
                         ! when running in ice-ocean or coupled configuration

      real (kind=dbl_kind), dimension (nx_block,ny_block,ncat,max_blocks), public :: &
         meltsn      , & ! snow melt in category n (m)
         melttn      , & ! top melt in category n (m)
         meltbn      , & ! bottom melt in category n (m)
         congeln     , & ! congelation ice formation in category n (m)
         snoicen         ! snow-ice formation in category n (m)

      real (kind=dbl_kind), dimension (nx_block,ny_block,ncat,max_blocks), public :: &
         keffn_top       ! effective thermal conductivity of the top ice layer 
                         ! on categories (W/m^2/K)

      ! for biogeochemistry
      real (kind=dbl_kind), dimension (nx_block,ny_block,ncat,max_blocks), public :: &
         hin_old     , & ! old ice thickness
         dsnown          ! change in snow thickness in category n (m)

      !-----------------------------------------------------------------
      ! quantities passed from ocean mixed layer to atmosphere
      ! (for running with CAM)
      !-----------------------------------------------------------------

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         strairx_ocn , & ! stress on ocean by air, x-direction
         strairy_ocn , & ! stress on ocean by air, y-direction
         fsens_ocn   , & ! sensible heat flux (W/m^2)
         flat_ocn    , & ! latent heat flux   (W/m^2)
         flwout_ocn  , & ! outgoing longwave radiation (W/m^2)
         evap_ocn    , & ! evaporative water flux (kg/m^2/s)
         alvdr_ocn   , & ! visible, direct   (fraction)
         alidr_ocn   , & ! near-ir, direct   (fraction)
         alvdf_ocn   , & ! visible, diffuse  (fraction)
         alidf_ocn   , & ! near-ir, diffuse  (fraction)
         Tref_ocn    , & ! 2m atm reference temperature (K)
         Qref_ocn        ! 2m atm reference spec humidity (kg/kg)

      !-----------------------------------------------------------------
      ! diagnostic
      !-----------------------------------------------------------------

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         fsurf , & ! net surface heat flux (excluding fcondtop)(W/m^2)
         fcondtop,&! top surface conductive flux        (W/m^2)
         fcondbot,&! bottom surface conductive flux        (W/m^2)
         congel, & ! basal ice growth         (m/step-->cm/day)
         frazil, & ! frazil ice growth        (m/step-->cm/day)
         frazil_diag, & ! frazil ice growth diagnostic (m/step-->cm/day)
         snoice, & ! snow-ice formation       (m/step-->cm/day)
         meltt , & ! top ice melt             (m/step-->cm/day)
         melts , & ! snow melt                (m/step-->cm/day)
         meltb , & ! basal ice melt           (m/step-->cm/day)
         meltl , & ! lateral ice melt         (m/step-->cm/day)
         Tbot  , & ! ice bottom temperature   (C)
         Tsnice , & ! snow ice interface temperature   (C)
         dsnow,  & ! change in snow thickness (m/step-->cm/day)
         daidtt, & ! ice area tendency thermo.   (s^-1)
         dvidtt, & ! ice volume tendency thermo. (m/s)
         dagedtt,& ! ice age tendency thermo.    (s/s)
         mlt_onset, &! day of year that sfc melting begins
         frz_onset   ! day of year that freezing begins (congel or frazil)
         
      real (kind=dbl_kind), & 
         dimension (nx_block,ny_block,ncat,max_blocks), public :: &
         fsurfn,   & ! category fsurf
         fcondtopn,& ! category fcondtop
         fcondbotn,& ! category fcondbot
         fsensn,   & ! category sensible heat flux
         flatn       ! category latent heat flux

      ! As above but these remain grid box mean values i.e. they are not
      ! divided by aice at end of ice_dynamics.  These are used in
      ! CICE_IN_NEMO for coupling and also for generating
      ! ice diagnostics and history files as these are more accurate. 
      ! (The others suffer from problem of incorrect values at grid boxes
      !  that change from an ice free state to an icy state.)
    
      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         fresh_ai, & ! fresh water flux to ocean (kg/m^2/s)
         fsalt_ai, & ! salt flux to ocean (kg/m^2/s)
         fhocn_ai, & ! net heat flux to ocean (W/m^2)
         fswthru_ai  ! shortwave penetrating to ocean (W/m^2)

      ! Used with data assimilation in hadgem drivers
      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: &
         fresh_da, & ! fresh water flux to ocean due to data assim (kg/m^2/s)
         fsalt_da    ! salt flux to ocean due to data assimilation(kg/m^2/s)

      !-----------------------------------------------------------------
      ! internal
      !-----------------------------------------------------------------

      real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), public :: &
         rside   , & ! fraction of ice that melts laterally
         fsw     , & ! incoming shortwave radiation (W/m^2)
         coszen  , & ! cosine solar zenith angle, < 0 for sun below horizon 
         rdg_conv, & ! convergence term for ridging (1/s)
         rdg_shear   ! shear term for ridging (1/s)
 
      real (kind=dbl_kind), dimension(nx_block,ny_block,nilyr+1,max_blocks), public :: &
         salinz    ,&   ! initial salinity  profile (ppt)   
         Tmltz          ! initial melting temperature (^oC)

!=======================================================================

      contains

!=======================================================================

! Initialize all fluxes exchanged with flux coupler
! and some data-derived fields
!
! author Elizabeth C. Hunke, LANL

      subroutine init_coupler_flux

      use ice_constants, only: p001,vonkar,zref,iceruf
      use ice_therm_shared, only: ktherm
      use ice_zbgc_shared, only: flux_bio
      use ice_atmo, only: Cdn_atm

      integer (kind=int_kind) :: n

#ifdef CESMCOUPLED
      logical (kind=log_kind), parameter ::     & 
         l_winter = .false.  , &  ! winter/summer default switch
         l_spring = .false.      ! spring example
#else
      logical (kind=log_kind), parameter ::     & 
         l_winter = .true.  , &  ! winter/summer default switch
         l_spring = .false.      ! spring example
#endif

      real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6)

      data fcondtopn_d / -50.0_dbl_kind,-17.0_dbl_kind,-12.0_dbl_kind, &
                          -9.0_dbl_kind, -7.0_dbl_kind, -3.0_dbl_kind /
      data fsurfn_d    /  0.20_dbl_kind, 0.15_dbl_kind, 0.10_dbl_kind, &
                          0.05_dbl_kind, 0.01_dbl_kind, 0.01_dbl_kind /

      !-----------------------------------------------------------------
      ! fluxes received from atmosphere
      !-----------------------------------------------------------------
      zlvl  (:,:,:) = c10             ! atm level height (m)
      rhoa  (:,:,:) = 1.3_dbl_kind    ! air density (kg/m^3)
      uatm  (:,:,:) = c5              ! wind velocity    (m/s)
      vatm  (:,:,:) = c5
      strax (:,:,:) = 0.05_dbl_kind
      stray (:,:,:) = 0.05_dbl_kind
      fsnow (:,:,:) = c0              ! snowfall rate (kg/m2/s)
                                      ! fsnow must be 0 for exact restarts
      if (l_spring) then
         !typical spring values
         potT  (:,:,:) = 263.15_dbl_kind ! air potential temp (K)
         Tair  (:,:,:) = 263.15_dbl_kind ! air temperature  (K)
         Qa    (:,:,:) = 0.001_dbl_kind  ! specific humidity (kg/kg)
         Qa_iso(:,:,:,:) = 0.001_dbl_kind  ! specific humidity (kg/kg)
         swvdr (:,:,:) = 25._dbl_kind    ! shortwave radiation (W/m^2)
         swvdf (:,:,:) = 25._dbl_kind    ! shortwave radiation (W/m^2)
         swidr (:,:,:) = 25._dbl_kind    ! shortwave radiation (W/m^2)
         swidf (:,:,:) = 25._dbl_kind    ! shortwave radiation (W/m^2)
         flw   (:,:,:) = 230.0_dbl_kind  ! incoming longwave rad (W/m^2)
         do n = 1, ncat                  ! surface heat flux (W/m^2)
            fsurfn_f(:,:,n,:) = fsurfn_d(n)
         enddo
         fcondtopn_f(:,:,:,:) = 0.0_dbl_kind ! conductive heat flux (W/m^2)
         flatn_f(:,:,:,:) = -1.0_dbl_kind    ! latent heat flux (W/m^2)
         fsensn_f(:,:,:,:) = c0              ! sensible heat flux (W/m^2)
      elseif (l_winter) then
         !typical winter values
         potT  (:,:,:) = 253.0_dbl_kind  ! air potential temp (K)
         Tair  (:,:,:) = 253.0_dbl_kind  ! air temperature  (K)
         Qa    (:,:,:) = 0.0006_dbl_kind ! specific humidity (kg/kg)
         Qa_iso(:,:,:,:) = 0.0006_dbl_kind ! specific humidity (kg/kg)
         swvdr (:,:,:) = c0              ! shortwave radiation (W/m^2)
         swvdf (:,:,:) = c0              ! shortwave radiation (W/m^2)
         swidr (:,:,:) = c0              ! shortwave radiation (W/m^2)
         swidf (:,:,:) = c0              ! shortwave radiation (W/m^2)
         flw   (:,:,:) = c180            ! incoming longwave rad (W/m^2)
         frain (:,:,:) = c0              ! rainfall rate (kg/m2/s)
         do n = 1, ncat                  ! conductive heat flux (W/m^2)
            fcondtopn_f(:,:,n,:) = fcondtopn_d(n)
         enddo
         fsurfn_f = fcondtopn_f          ! surface heat flux (W/m^2)
         flatn_f(:,:,:,:) = c0           ! latent heat flux (kg/m2/s)
         fsensn_f(:,:,:,:) = c0              ! sensible heat flux (W/m^2)
      else
         !typical summer values
         potT  (:,:,:) = 273.0_dbl_kind  ! air potential temp (K)
         Tair  (:,:,:) = 273.0_dbl_kind  ! air temperature  (K)
         Qa    (:,:,:) = 0.0035_dbl_kind ! specific humidity (kg/kg)
         Qa_iso(:,:,:,:) = 0.0035_dbl_kind ! specific humidity (kg/kg)
         swvdr (:,:,:) = 50._dbl_kind    ! shortwave radiation (W/m^2)
         swvdf (:,:,:) = 50._dbl_kind    ! shortwave radiation (W/m^2)
         swidr (:,:,:) = 50._dbl_kind    ! shortwave radiation (W/m^2)
         swidf (:,:,:) = 50._dbl_kind    ! shortwave radiation (W/m^2)
         flw   (:,:,:) = 280.0_dbl_kind  ! incoming longwave rad (W/m^2)
         frain (:,:,:) = c0              ! rainfall rate (kg/m2/s)
         do n = 1, ncat                  ! surface heat flux (W/m^2)
            fsurfn_f(:,:,n,:) = fsurfn_d(n)
         enddo
         fcondtopn_f(:,:,:,:) = 0.0_dbl_kind ! conductive heat flux (W/m^2)
         flatn_f(:,:,:,:) = -2.0_dbl_kind    ! latent heat flux (W/m^2)
         fsensn_f(:,:,:,:) = c0              ! sensible heat flux (W/m^2)
      endif !     l_winter

      faero_atm (:,:,:,:) = c0           ! aerosol deposition rate (kg/m2/s)
      fiso_atm  (:,:,:,:) = c0           ! isotope deposition rate (kg/m2/s)
      fiso_rain (:,:,:,:) = c0           ! isotopic rain rate (kg/m2/s)

      !-----------------------------------------------------------------
      ! fluxes received from ocean
      !-----------------------------------------------------------------

      ss_tltx(:,:,:)= c0              ! sea surface tilt (m/m)
      ss_tlty(:,:,:)= c0
      uocn  (:,:,:) = c0              ! surface ocean currents (m/s)
      vocn  (:,:,:) = c0
      frzmlt(:,:,:) = c0              ! freezing/melting potential (W/m^2)
      sss   (:,:,:) = 34.0_dbl_kind   ! sea surface salinity (ppt)
      if (ktherm == 2) then           ! freezing temp (C)
         ! liquidus_temperature_mush(sss)
         Tf (:,:,:) = sss(:,:,:) / (-18.48_dbl_kind &
                                 + ((18.48_dbl_kind*p001)*sss(:,:,:)))
      else
         Tf (:,:,:) = -depressT*sss(:,:,:)
      endif
#ifndef CICE_IN_NEMO
      sst   (:,:,:) = Tf(:,:,:)       ! sea surface temp (C)
#endif
      qdp   (:,:,:) = c0              ! deep ocean heat flux (W/m^2)
      hmix  (:,:,:) = c20             ! ocean mixed layer depth
      daice_da(:,:,:) = c0            ! data assimilation increment rate

      !-----------------------------------------------------------------
      ! fluxes sent to atmosphere
      !-----------------------------------------------------------------

      strairxT(:,:,:) = c0            ! wind stress, T grid
      strairyT(:,:,:) = c0

      fsens   (:,:,:) = c0
      flat    (:,:,:) = c0
      fswabs  (:,:,:) = c0
      flwout  (:,:,:) = -stefan_boltzmann*Tffresh**4   
                        ! in case atm model diagnoses Tsfc from flwout
      evap    (:,:,:) = c0
      evapi   (:,:,:) = c0
      evaps   (:,:,:) = c0
      Tref    (:,:,:) = c0
      Qref    (:,:,:) = c0
      Uref    (:,:,:) = c0
      alvdr   (:,:,:) = c0
      alidr   (:,:,:) = c0
      alvdf   (:,:,:) = c0
      alidf   (:,:,:) = c0

      fiso_evap (:,:,:,:)   = c0  ! isotope evaporation to atm (kg/m2/s)
      Qref_iso (:,:,:,:)   = c0  ! 2m atm reference spec humidity (kg/kg)

      !-----------------------------------------------------------------
      ! fluxes sent to ocean
      !-----------------------------------------------------------------

      strocnxT(:,:,:) = c0    ! ice-ocean stress, x-direction (T-cell)
      strocnyT(:,:,:) = c0    ! ice-ocean stress, y-direction (T-cell)
      fresh   (:,:,:) = c0
      fsalt   (:,:,:) = c0
      fhocn   (:,:,:) = c0
      fswthru (:,:,:) = c0
      fresh_da(:,:,:) = c0    ! data assimilation
      fsalt_da(:,:,:) = c0
      flux_bio (:,:,:,:) = c0 ! bgc

      if (send_i2x_per_cat) then
         allocate(fswthrun_ai(nx_block,ny_block,ncat,max_blocks))
         fswthrun_ai(:,:,:,:) = c0
      endif

      !-----------------------------------------------------------------
      ! derived or computed fields
      !-----------------------------------------------------------------

      fsw     (:,:,:) = c0            ! shortwave radiation (W/m^2)
      scale_factor(:,:,:) = c1        ! shortwave scaling factor 
      wind    (:,:,:) = sqrt(uatm(:,:,:)**2 &
                           + vatm(:,:,:)**2)  ! wind speed, (m/s)
      Cdn_atm(:,:,:) = (vonkar/log(zref/iceruf)) &
                     * (vonkar/log(zref/iceruf)) ! atmo drag for RASM

      end subroutine init_coupler_flux

!=======================================================================

! Initialize some fluxes sent to coupler for use by the atm model
!
! author: Elizabeth C. Hunke, LANL

      subroutine init_flux_atm

      !-----------------------------------------------------------------
      ! initialize albedo and fluxes
      !-----------------------------------------------------------------

      strairxT(:,:,:) = c0      ! wind stress, T grid
      strairyT(:,:,:) = c0
      ! for rectangular grid tests without thermo
      ! strairxT(:,:,:) = 0.15_dbl_kind
      ! strairyT(:,:,:) = 0.15_dbl_kind

      fsens   (:,:,:) = c0
      flat    (:,:,:) = c0
      fswabs  (:,:,:) = c0
      flwout  (:,:,:) = c0
      evap    (:,:,:) = c0
      evapi   (:,:,:) = c0
      evaps   (:,:,:) = c0
      Tref    (:,:,:) = c0
      Qref    (:,:,:) = c0
      Uref    (:,:,:) = c0

      end subroutine init_flux_atm

!=======================================================================
! Initialize some fluxes sent to coupler for use by the ocean model
!
! NOTE: These fluxes should be initialized immediately after the
!       call to the coupler.  The atmospheric fluxes can be initialized
!       at the beginning of the following time step because they are
!       not modified by any subroutines between the call to_coupler
!       and the end of the time step.
!
! author: Elizabeth C. Hunke, LANL

      subroutine init_flux_ocn

      use ice_zbgc_shared, only: flux_bio

      !-----------------------------------------------------------------
      ! fluxes sent
      !-----------------------------------------------------------------

      fresh    (:,:,:)   = c0
      fsalt    (:,:,:)   = c0
      fhocn    (:,:,:)   = c0
      fswthru  (:,:,:)   = c0
      faero_ocn(:,:,:,:) = c0
      fiso_ocn (:,:,:,:) = c0
 
      flux_bio (:,:,:,:) = c0  ! bgc

      if (send_i2x_per_cat) then
         fswthrun_ai(:,:,:,:) = c0
      endif

      end subroutine init_flux_ocn

!=======================================================================

! Initialize thermodynamic fields written to history files.
!
! authors: William H. Lipscomb, LANL
!          Elizabeth C. Hunke, LANL

      subroutine init_history_therm

      use ice_atmo, only: hfreebd, hdraft, hridge, distrdg, hkeel, &
                          dkeel, lfloe, dfloe, Cdn_atm, Cdn_atm_rdg, &
                          Cdn_atm_floe, Cdn_atm_pond, Cdn_atm_skin, &
                          Cd_atm, Cdn_ocn, Cdn_ocn_keel, &
                          Cdn_ocn_floe, Cdn_ocn_skin, formdrag
      use ice_state, only: aice, vice, trcr, tr_iage, nt_iage
      use ice_constants, only: vonkar,zref,iceruf
!jd
      use ice_snowphys, only: snow2ocn, snowfonice
!jd

      fsurf  (:,:,:) = c0
      fcondtop(:,:,:)= c0
      fcondbot(:,:,:)= c0
      congel (:,:,:) = c0
      frazil (:,:,:) = c0
      frazil_diag (:,:,:) = c0
      snoice (:,:,:) = c0
!jd
      snow2ocn  (:,:,:) = c0
      snowfonice(:,:,:) = c0
!jd
      dsnow  (:,:,:) = c0
      meltt  (:,:,:) = c0
      melts  (:,:,:) = c0
      meltb  (:,:,:) = c0
      meltl  (:,:,:) = c0
      Tbot   (:,:,:) = c0
      Tsnice  (:,:,:) = c0
      daidtt (:,:,:) = aice(:,:,:) ! temporary initial area
      dvidtt (:,:,:) = vice(:,:,:) ! temporary initial volume
      if (tr_iage) then
         dagedtt(:,:,:) = trcr(:,:,nt_iage,:) ! temporary initial age
      else
         dagedtt(:,:,:) = c0
      endif
      fsurfn    (:,:,:,:) = c0
      fcondtopn (:,:,:,:) = c0
      fcondbotn (:,:,:,:) = c0
      flatn     (:,:,:,:) = c0
      fsensn    (:,:,:,:) = c0
      fpond     (:,:,:) = c0
      fresh_ai  (:,:,:) = c0
      fsalt_ai  (:,:,:) = c0
      fhocn_ai  (:,:,:) = c0
      fswthru_ai(:,:,:) = c0
      albice (:,:,:) = c0
      albsno (:,:,:) = c0
      albpnd (:,:,:) = c0
      apeff_ai (:,:,:) = c0
      snowfrac (:,:,:) = c0

      ! drag coefficients are computed prior to the atmo_boundary call, 
      ! during the thermodynamics section 
      Cdn_ocn(:,:,:) = dragio
      Cdn_atm(:,:,:) = (vonkar/log(zref/iceruf)) &
                     * (vonkar/log(zref/iceruf)) ! atmo drag for RASM

        Cd_atm(:,:,:)= c0
      if (formdrag) then
        Cdn_atm_rdg (:,:,:) = c0
        Cdn_atm_floe(:,:,:) = c0
        Cdn_atm_pond(:,:,:) = c0
        Cdn_atm_skin(:,:,:) = c0
        Cdn_ocn_skin(:,:,:) = c0
        Cdn_ocn_keel(:,:,:) = c0
        Cdn_ocn_floe(:,:,:) = c0
        hfreebd     (:,:,:) = c0
        hdraft      (:,:,:) = c0
        hridge      (:,:,:) = c0
        distrdg     (:,:,:) = c0
        hkeel       (:,:,:) = c0
        dkeel       (:,:,:) = c0
        lfloe       (:,:,:) = c0
        dfloe       (:,:,:) = c0
      endif

      end subroutine init_history_therm

!=======================================================================

! Initialize dynamic fields written to history files.
!
! authors: William H. Lipscomb, LANL
!          Elizabeth C. Hunke, LANL

      subroutine init_history_dyn

!jd      use ice_state, only: aice, vice, trcr, tr_iage, nt_iage
      use ice_state, only: aice, vice, vsno, trcr, tr_iage, nt_iage

      sig1    (:,:,:) = c0
      sig2    (:,:,:) = c0
      strocnx (:,:,:) = c0
      strocny (:,:,:) = c0
      strairx (:,:,:) = c0
      strairy (:,:,:) = c0
      strtltx (:,:,:) = c0
      strtlty (:,:,:) = c0
      strintx (:,:,:) = c0
      strinty (:,:,:) = c0
      dardg1dt(:,:,:) = c0
      dardg2dt(:,:,:) = c0
      dvirdgdt(:,:,:) = c0
      opening (:,:,:) = c0
      daidtd  (:,:,:) = aice(:,:,:) ! temporary initial area
      dvidtd  (:,:,:) = vice(:,:,:) ! temporary initial volume
!jd
      dvsdtd  (:,:,:) = vsno(:,:,:) ! temporary initial volume
!jd
      if (tr_iage) &
         dagedtd (:,:,:) = trcr(:,:,nt_iage,:) ! temporary initial age
      fm      (:,:,:) = c0
      prs_sig (:,:,:) = c0
      ardgn   (:,:,:,:) = c0
      vrdgn   (:,:,:,:) = c0
      krdgn   (:,:,:,:) = c1
      aparticn(:,:,:,:) = c0
      aredistn(:,:,:,:) = c0
      vredistn(:,:,:,:) = c0
      dardg1ndt(:,:,:,:) = c0
      dardg2ndt(:,:,:,:) = c0
      dvirdgndt(:,:,:,:) = c0

      end subroutine init_history_dyn

!=======================================================================

! Aggregate flux information from all ice thickness categories
!
! author: Elizabeth C. Hunke and William H. Lipscomb, LANL

      subroutine merge_fluxes (nx_block, ny_block,   &
                               icells,               &
                               indxi,    indxj,      &
                               aicen,                &    
                               flw,      coszn,      &
                               strairxn, strairyn,   &
                               Cd_atm_n,      &
                               fsurfn,   fcondtopn,  &  
                               fcondbotn, &
                               fsensn,   flatn,      & 
                               fswabsn,  flwoutn,    &
                               evapn,                &
                               evapin,   evapsn,     &
                               Trefn,    Qrefn,      &
                               Tbotn,    Tsnicen,      &
                               freshn,   fsaltn,     &
                               fhocnn,   fswthrun,   &
                               strairxT, strairyT,   &  
                               Cd_atm,        &
                               fsurf,    fcondtop,   &
                               fcondbot, &
                               fsens,    flat,       & 
                               fswabs,   flwout,     &
                               evap,                 & 
                               evapi,    evaps,      & 
                               Tref,     Qref,       &
                               Tbot,     Tsnice,       &
                               fresh,    fsalt,      & 
                               fhocn,    fswthru,    &
                               melttn, meltsn, meltbn, congeln, snoicen, &
                               meltt,  melts,        &
                               meltb,                &
                               congel,  snoice,      &
!jd
                               snow2ocnn, snow2ocn,  &
                               snowfonicen,snowfonice, &
!jd
                               Uref,     Urefn,      &
                               Qref_iso, Qrefn_iso,  &
                               fiso_evap,fiso_evapn, &
                               fiso_ocn, fiso_ocnn   )

                               
      integer (kind=int_kind), intent(in) :: &
          nx_block, ny_block, & ! block dimensions
          icells                ! number of cells with aicen > puny

      integer (kind=int_kind), dimension(nx_block*ny_block), &
          intent(in) :: &
          indxi, indxj    ! compressed indices for cells with aicen > puny

      ! single category fluxes
      real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: &
          aicen   , & ! concentration of ice
          flw     , & ! downward longwave flux          (W/m**2)
          coszn   , & ! cosine of solar zenith angle 
          strairxn, & ! air/ice zonal  strss,           (N/m**2)
          strairyn, & ! air/ice merdnl strss,           (N/m**2)
          Cd_atm_n, & ! ratio of total drag over neutral drag (atm)
          fsurfn  , & ! net heat flux to top surface    (W/m**2)
          fcondtopn,& ! downward cond flux at top sfc   (W/m**2)
          fcondbotn,& ! downward cond flux at bot sfc   (W/m**2)
          fsensn  , & ! sensible heat flx               (W/m**2)
          flatn   , & ! latent   heat flx               (W/m**2)
          fswabsn , & ! shortwave absorbed heat flx     (W/m**2)
          flwoutn , & ! upwd lw emitted heat flx        (W/m**2)
          evapn   , & ! evaporation                     (kg/m2/s)
          evapin   , & ! evaporation                     (kg/m2/s)
          evapsn   , & ! evaporation                     (kg/m2/s)
          Trefn   , & ! air tmp reference level         (K)
          Tbotn   , & ! ice bottom temperature          (C)
          Tsnicen  , & ! snow ice interface temperature  (C)
          Qrefn   , & ! air sp hum reference level      (kg/kg)
          freshn  , & ! fresh water flux to ocean       (kg/m2/s)
          fsaltn  , & ! salt flux to ocean              (kg/m2/s)
          fhocnn  , & ! actual ocn/ice heat flx         (W/m**2)
          fswthrun, & ! sw radiation through ice bot    (W/m**2)
          melttn  , & ! top ice melt                    (m)
          meltbn  , & ! bottom ice melt                 (m)
          meltsn  , & ! snow melt                       (m)
          congeln , & ! congelation ice growth          (m)
!jd
          snow2ocnn,  &! snow blowing of ice            
          snowfonicen,&! fraction of snow kept on ice
!jd 
          snoicen     ! snow-ice growth                 (m)
           
      real (kind=dbl_kind), dimension(nx_block,ny_block), optional, intent(in):: &
          Urefn       ! air speed reference level       (m/s)

      real (kind=dbl_kind), dimension(nx_block,ny_block,max_iso), optional, intent(in):: &
          Qrefn_iso, &
          fiso_evapn,&
          fiso_ocnn

      ! cumulative fluxes
      real (kind=dbl_kind), dimension(nx_block,ny_block), &
          intent(inout):: &
          strairxT, & ! air/ice zonal  strss,           (N/m**2)
          strairyT, & ! air/ice merdnl strss,           (N/m**2)
          Cd_atm, & ! ratio of total drag over neutral drag (atm)
          fsurf   , & ! net heat flux to top surface    (W/m**2)
          fcondtop, & ! downward cond flux at top sfc   (W/m**2)
          fcondbot, & ! downward cond flux at top sfc   (W/m**2)
          fsens   , & ! sensible heat flx               (W/m**2)
          flat    , & ! latent   heat flx               (W/m**2)
          fswabs  , & ! shortwave absorbed heat flx     (W/m**2)
          flwout  , & ! upwd lw emitted heat flx        (W/m**2)
          evap    , & ! evaporation                     (kg/m2/s)
          evapi   , & ! evaporation                     (kg/m2/s)
          evaps   , & ! evaporation                     (kg/m2/s)
          Tref    , & ! air tmp reference level         (K)
          Tbot    , & ! sea ice bottom temperature      (C)
          Tsnice   , & ! snow ice interface temperature  (C)
          Qref    , & ! air sp hum reference level      (kg/kg)
          fresh   , & ! fresh water flux to ocean       (kg/m2/s)
          fsalt   , & ! salt flux to ocean              (kg/m2/s)
          fhocn   , & ! actual ocn/ice heat flx         (W/m**2)
          fswthru , & ! sw radiation through ice bot    (W/m**2)
          meltt   , & ! top ice melt                    (m)
          meltb   , & ! bottom ice melt                 (m)
          melts   , & ! snow melt                       (m)
          congel  , & ! congelation ice growth          (m)
!jd
          snow2ocn,  &! snow blowing of ice            
          snowfonice,&! fraction of snow kept on ice
!jd 
          snoice      ! snow-ice growth                 (m)

      real (kind=dbl_kind), dimension(nx_block,ny_block), optional, &
          intent(inout):: &
          Uref        ! air speed reference level       (m/s)

      real (kind=dbl_kind), dimension(nx_block,ny_block,max_iso), optional, &
          intent(inout):: &
          Qref_iso, &
          fiso_evap, &
          fiso_ocn

      integer (kind=int_kind) :: &
          ij, i, j    ! horizontal indices

      !-----------------------------------------------------------------
      ! Merge fluxes
      ! NOTE: The albedo is aggregated only in cells where ice exists
      !       and (for the delta-Eddington scheme) where the sun is above
      !       the horizon. 
      !-----------------------------------------------------------------

!DIR$ CONCURRENT !Cray
!cdir nodep      !NEC
!ocl novrec      !Fujitsu
      do ij = 1, icells
         i = indxi(ij)
         j = indxj(ij)

         ! atmo fluxes

         strairxT (i,j)  = strairxT(i,j) + strairxn(i,j)*aicen(i,j)
         strairyT (i,j)  = strairyT(i,j) + strairyn(i,j)*aicen(i,j)
         Cd_atm (i,j) = Cd_atm (i,j) + &
                                   Cd_atm_n (i,j)*aicen(i,j)
         fsurf    (i,j)  = fsurf   (i,j) + fsurfn  (i,j)*aicen(i,j)
         fcondtop (i,j)  = fcondtop(i,j) + fcondtopn(i,j)*aicen(i,j) 
         fcondbot (i,j)  = fcondbot(i,j) + fcondbotn(i,j)*aicen(i,j) 
         fsens    (i,j)  = fsens   (i,j) + fsensn  (i,j)*aicen(i,j)
         flat     (i,j)  = flat    (i,j) + flatn   (i,j)*aicen(i,j)
         fswabs   (i,j)  = fswabs  (i,j) + fswabsn (i,j)*aicen(i,j)
         flwout   (i,j)  = flwout  (i,j) &
             + (flwoutn(i,j) - (c1-emissivity)*flw(i,j))*aicen(i,j)
         evap     (i,j)  = evap    (i,j) + evapn   (i,j)*aicen(i,j)
         evapi     (i,j)  = evapi    (i,j) + evapin   (i,j)*aicen(i,j)
         evaps     (i,j)  = evaps    (i,j) + evapsn   (i,j)*aicen(i,j)
         Tref     (i,j)  = Tref    (i,j) + Trefn   (i,j)*aicen(i,j)
         Tbot     (i,j)  = Tbot    (i,j) + Tbotn   (i,j)*aicen(i,j)
         Tsnice    (i,j)  = Tsnice   (i,j) + Tsnicen  (i,j)*aicen(i,j)
         Qref     (i,j)  = Qref    (i,j) + Qrefn   (i,j)*aicen(i,j)
         if (present(Urefn) .and. present(Uref)) then
            Uref  (i,j)  = Uref    (i,j) + Urefn   (i,j)*aicen(i,j)
         endif
         if (present(Qrefn_iso) .and. present(Qref_iso)) then
            Qref_iso(i,j,:)  = Qref_iso(i,j,:) + Qrefn_iso(i,j,:)*aicen(i,j)
         endif
         if (present(fiso_evapn) .and. present(fiso_evap)) then
            fiso_evap(i,j,:)  = fiso_evap(i,j,:) + fiso_evapn(i,j,:)*aicen(i,j)
         endif
         if (present(fiso_ocnn) .and. present(fiso_ocn)) then
            fiso_ocn (i,j,:)  = fiso_ocn (i,j,:) + fiso_ocnn (i,j,:)*aicen(i,j)
         endif

         ! ocean fluxes

         fresh    (i,j) = fresh    (i,j) + freshn  (i,j)*aicen(i,j)
         fsalt    (i,j) = fsalt    (i,j) + fsaltn  (i,j)*aicen(i,j)
         fhocn    (i,j) = fhocn    (i,j) + fhocnn  (i,j)*aicen(i,j)
         fswthru  (i,j) = fswthru  (i,j) + fswthrun(i,j)*aicen(i,j)

         ! ice/snow thickness

         meltt    (i,j) = meltt    (i,j) + melttn  (i,j)*aicen(i,j)
         meltb    (i,j) = meltb    (i,j) + meltbn  (i,j)*aicen(i,j)
         melts    (i,j) = melts    (i,j) + meltsn  (i,j)*aicen(i,j)
         congel   (i,j) = congel   (i,j) + congeln (i,j)*aicen(i,j)
         snoice   (i,j) = snoice   (i,j) + snoicen (i,j)*aicen(i,j)

         ! Blowing snow 
         snow2ocn (i,j) = snow2ocn (i,j) + snow2ocnn(i,j)*aicen(i,j)
         snowfonice(i,j)= snowfonice(i,j)+snowfonicen(i,j)*aicen(i,j)
      enddo                     ! ij
      
      end subroutine merge_fluxes

!=======================================================================

!  Divide ice fluxes by ice area before sending them to the
!  coupler, since the coupler multiplies by ice area.
!
! authors: C.M.Bitz, William H. Lipscomb

      subroutine scale_fluxes (nx_block, ny_block, &
                               tmask,    nbtrcr,   &
                               aice,     Tf,       &
                               Tair,     Qa,       &
                               strairxT, strairyT, &
                               fsens,    flat,     &
                               fswabs,   flwout,   &
                               evap,               &
                               Tref,     Qref,     &
                               fresh,    fsalt,    &
                               fhocn,    fswthru,  &
                               faero_ocn,          &
                               alvdr,    alidr,    &
                               alvdf,    alidf,    &
                               flux_bio,           &
                               fsurf,    fcondtop, &
                               Uref,     wind,     &
                               Qref_iso,           &
                               fiso_evap,          &
                               fiso_ocn)


      integer (kind=int_kind), intent(in) :: &
          nx_block, ny_block, &    ! block dimensions
          nbtrcr                   ! number of biology tracers

      logical (kind=log_kind), dimension (nx_block,ny_block), &
          intent(in) :: &
          tmask     ! land/boundary mask, thickness (T-cell)


      real (kind=dbl_kind), dimension(nx_block,ny_block), &
          intent(in):: &
          aice    , & ! fractional ice area
          Tf      , & ! freezing temperature            (C)
          Tair    , & ! surface air temperature         (K)
          Qa          ! sfc air specific humidity       (kg/kg)

      real (kind=dbl_kind), dimension(nx_block,ny_block), optional, &
          intent(in):: &
          wind        ! wind speed                      (m/s)

      real (kind=dbl_kind), dimension(nx_block,ny_block), &
          intent(inout):: &
          strairxT, & ! air/ice zonal  stress           (N/m**2)
          strairyT, & ! air/ice merdnl stress           (N/m**2)
          fsens   , & ! sensible heat flx               (W/m**2)
          flat    , & ! latent   heat flx               (W/m**2)
          fswabs  , & ! shortwave absorbed heat flx     (W/m**2)
          flwout  , & ! upwd lw emitted heat flx        (W/m**2)
          evap    , & ! evaporation                     (kg/m2/s)
          Tref    , & ! air tmp reference level         (K)
          Qref    , & ! air sp hum reference level      (kg/kg)
          fresh   , & ! fresh water flux to ocean       (kg/m2/s)
          fsalt   , & ! salt flux to ocean              (kg/m2/s)
          fhocn   , & ! actual ocn/ice heat flx         (W/m**2)
          fswthru , & ! sw radiation through ice bot    (W/m**2)
          alvdr   , & ! visible, direct   (fraction)
          alidr   , & ! near-ir, direct   (fraction)
          alvdf   , & ! visible, diffuse  (fraction)
          alidf       ! near-ir, diffuse  (fraction)

      real (kind=dbl_kind), dimension(nx_block,ny_block), optional, &
          intent(inout):: &
          Uref        ! air speed reference level       (m/s)

      real (kind=dbl_kind), dimension(nx_block,ny_block,max_iso), optional, &
          intent(inout):: &
          Qref_iso, &
          fiso_evap, &
          fiso_ocn

      real (kind=dbl_kind), dimension(nx_block,ny_block,nbtrcr), &
          intent(inout):: &
          flux_bio    ! tracer flux to ocean from biology (mmol/m2/s)

      real (kind=dbl_kind), dimension(nx_block,ny_block,max_aero), &
          intent(inout):: &
          faero_ocn   ! aersol flux to ocean            (kg/m2/s)

      ! For hadgem drivers. Assumes either both fields are passed or neither
      real (kind=dbl_kind), dimension(nx_block,ny_block), &
          intent(inout), optional :: &
          fsurf   , & ! surface heat flux               (W/m**2)
          fcondtop    ! top surface conductive flux     (W/m**2)

      ! local variables

      real (kind=dbl_kind) :: ar   ! 1/aice

      integer (kind=int_kind) :: &
          i, j    ! horizontal indices

!DIR$ CONCURRENT !Cray
!cdir nodep      !NEC
!ocl novrec      !Fujitsu
      do j = 1, ny_block
      do i = 1, nx_block
         if (tmask(i,j) .and. aice(i,j) > c0) then
            ar = c1 / aice(i,j)
            strairxT(i,j) = strairxT(i,j) * ar
            strairyT(i,j) = strairyT(i,j) * ar
            fsens   (i,j) = fsens   (i,j) * ar
            flat    (i,j) = flat    (i,j) * ar
            fswabs  (i,j) = fswabs  (i,j) * ar
            flwout  (i,j) = flwout  (i,j) * ar
            evap    (i,j) = evap    (i,j) * ar
            Tref    (i,j) = Tref    (i,j) * ar
            Qref    (i,j) = Qref    (i,j) * ar
            if (present(Uref)) then
               Uref    (i,j) = Uref    (i,j) * ar
            endif
            if (present(Qref_iso)) then
               Qref_iso(i,j,:) = Qref_iso(i,j,:) * ar
            endif
            if (present(fiso_evap)) then
               fiso_evap(i,j,:) = fiso_evap(i,j,:) * ar
            endif
            if (present(fiso_ocn)) then
               fiso_ocn(i,j,:) = fiso_ocn(i,j,:) * ar
            endif
            fresh   (i,j) = fresh   (i,j) * ar
            fsalt   (i,j) = fsalt   (i,j) * ar
            fhocn   (i,j) = fhocn   (i,j) * ar
            fswthru (i,j) = fswthru (i,j) * ar
            alvdr   (i,j) = alvdr   (i,j) * ar
            alidr   (i,j) = alidr   (i,j) * ar
            alvdf   (i,j) = alvdf   (i,j) * ar
            alidf   (i,j) = alidf   (i,j) * ar
            flux_bio (i,j,:) = flux_bio (i,j,:) * ar
            faero_ocn(i,j,:) = faero_ocn(i,j,:) * ar
         else                   ! zero out fluxes
            strairxT(i,j) = c0
            strairyT(i,j) = c0
            fsens   (i,j) = c0
            flat    (i,j) = c0
            fswabs  (i,j) = c0
            flwout  (i,j) = c0
               ! to make upward longwave over ocean reasonable for history file
            evap    (i,j) = c0
            Tref    (i,j) = c0
            Qref    (i,j) = c0
            if (present(Uref) .and. present(wind)) then
               Uref    (i,j) = wind(i,j)
            endif
            if (present(Qref_iso)) then
               Qref_iso(i,j,:) = c0
            endif
            if (present(fiso_evap)) then
               fiso_evap(i,j,:) = c0
            endif
            if (present(fiso_evap)) then
               fiso_ocn(i,j,:) = c0
            endif
            fresh   (i,j) = c0
            fsalt   (i,j) = c0
            fhocn   (i,j) = c0
            fswthru (i,j) = c0
            alvdr   (i,j) = c0  ! zero out albedo where ice is absent
            alidr   (i,j) = c0
            alvdf   (i,j) = c0 
            alidf   (i,j) = c0
            flux_bio (i,j,:) = c0
            faero_ocn(i,j,:) = c0
         endif                  ! tmask and aice > 0
      enddo                     ! i
      enddo                     ! j

      ! Scale fluxes for history output
      if (present(fsurf) .and. present(fcondtop) ) then 
     
!DIR$ CONCURRENT !Cray
!cdir nodep      !NEC
!ocl novrec      !Fujitsu
        do j = 1, ny_block
        do i = 1, nx_block
           if (tmask(i,j) .and. aice(i,j) > c0) then
              ar = c1 / aice(i,j)
              fsurf   (i,j) = fsurf   (i,j) * ar
              fcondtop(i,j) = fcondtop(i,j) * ar
           else                   ! zero out fluxes
              fsurf   (i,j) = c0
              fcondtop(i,j) = c0
           endif                  ! tmask and aice > 0
        enddo                     ! i
        enddo                     ! j
      
      endif                       ! present(fsurf & fcondtop)
      
      end subroutine scale_fluxes

!=======================================================================

! If model is not calculating surface temperature, set the surface
! flux values using values read in from forcing data or supplied via
! coupling (stored in ice_flux).
!
! If CICE is running in NEMO environment, convert fluxes from GBM values 
! to per unit ice area values. If model is not running in NEMO environment, 
! the forcing is supplied as per unit ice area values.
!
! authors Alison McLaren, Met Office

      subroutine set_sfcflux (nx_block,  ny_block, &
                              n,         iblk,     &
                              icells,              & 
                              indxi,     indxj,    &
                              aicen,               &
                              flatn,               &
                              fsensn,              &
                              fsurfn,              &
                              fcondtopn)

      use ice_fileunits, only: nu_diag

      integer (kind=int_kind), intent(in) :: &
         nx_block, ny_block, & ! block dimensions
         n,                  & ! thickness category index
         iblk,               & ! block index
         icells                ! number of cells with aicen > puny

      integer (kind=int_kind), dimension(nx_block*ny_block), &
         intent(in) :: &
         indxi, indxj    ! compressed indices for cells with aicen > puny

      ! ice state variables
      real (kind=dbl_kind), dimension (nx_block,ny_block), &
         intent(in) :: &
         aicen           ! concentration of ice

      real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out):: &
         flatn       , & ! latent heat flux   (W/m^2) 
         fsensn      , & ! sensible heat flux   (W/m^2) 
         fsurfn      , & ! net flux to top surface, not including fcondtopn
         fcondtopn       ! downward cond flux at top surface (W m-2)

      ! local variables

      integer (kind=int_kind) :: &
         i, j        , & ! horizontal indices
         ij              ! horizontal indices, combine i and j loops

      real (kind=dbl_kind)  :: &
         raicen          ! 1 or 1/aicen

      logical (kind=log_kind) :: &
         extreme_flag    ! flag for extreme forcing values

      logical (kind=log_kind), parameter :: & 
         extreme_test=.false. ! test and write out extreme forcing data

         raicen        = c1
         do ij = 1, icells
            i = indxi(ij)
            j = indxj(ij)

#ifdef CICE_IN_NEMO
!----------------------------------------------------------------------
! Convert fluxes from GBM values to per ice area values when 
! running in NEMO environment.  (When in standalone mode, fluxes
! are input as per ice area.)
!----------------------------------------------------------------------
            raicen        = c1 / aicen(i,j)
#endif
            fsurfn(i,j)   = fsurfn_f(i,j,n,iblk)*raicen
            fcondtopn(i,j)= fcondtopn_f(i,j,n,iblk)*raicen
            flatn(i,j)    = flatn_f(i,j,n,iblk)*raicen
            fsensn(i,j)   = fsensn_f(i,j,n,iblk)*raicen

         enddo

!----------------------------------------------------------------
! Flag up any extreme fluxes
!---------------------------------------------------------------

         if (extreme_test) then
            extreme_flag = .false.

            do ij = 1, icells
               i = indxi(ij)
               j = indxj(ij)         

               if (fcondtopn(i,j) < -100.0_dbl_kind & 
                     .or. fcondtopn(i,j) > 20.0_dbl_kind) then
                  extreme_flag = .true.
               endif

               if (fsurfn(i,j) < -100.0_dbl_kind & 
                    .or. fsurfn(i,j) > 80.0_dbl_kind) then
                  extreme_flag = .true.
               endif

               if (flatn(i,j) < -20.0_dbl_kind & 
                     .or. flatn(i,j) > 20.0_dbl_kind) then
                  extreme_flag = .true.
               endif

            enddo  ! ij

            if (extreme_flag) then
               do ij = 1, icells
                  i = indxi(ij)
                  j = indxj(ij)         

                  if (fcondtopn(i,j) < -100.0_dbl_kind & 
                       .or. fcondtopn(i,j) > 20.0_dbl_kind) then
                     write(nu_diag,*) & 
                       'Extreme forcing: -100 > fcondtopn > 20'
                     write(nu_diag,*) & 
                       'i,j,n,iblk,aicen,fcondtopn = ', & 
                       i,j,n,iblk,aicen(i,j),fcondtopn(i,j)
                  endif

                  if (fsurfn(i,j) < -100.0_dbl_kind & 
                       .or. fsurfn(i,j) > 80.0_dbl_kind) then
                     write(nu_diag,*) & 
                       'Extreme forcing: -100 > fsurfn > 40'
                     write(nu_diag,*) & 
                       'i,j,n,iblk,aicen,fsurfn = ', & 
                        i,j,n,iblk,aicen(i,j),fsurfn(i,j)
                  endif

                  if (flatn(i,j) < -20.0_dbl_kind & 
                       .or. flatn(i,j) > 20.0_dbl_kind) then
                     write(nu_diag,*) & 
                       'Extreme forcing: -20 > flatn > 20'
                     write(nu_diag,*) & 
                       'i,j,n,iblk,aicen,flatn = ', & 
                        i,j,n,iblk,aicen(i,j),flatn(i,j)
                  endif

               enddo  ! ij
      
            endif  ! extreme_flag
         endif     ! extreme_test    

      end subroutine set_sfcflux 

!=======================================================================

      end module ice_flux

!=======================================================================
