! 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) 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) ! 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) Tsnic , & ! 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 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 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 fsurf (:,:,:) = c0 fcondtop(:,:,:)= c0 fcondbot(:,:,:)= c0 congel (:,:,:) = c0 frazil (:,:,:) = c0 frazil_diag (:,:,:) = c0 snoice (:,:,:) = c0 dsnow (:,:,:) = c0 meltt (:,:,:) = c0 melts (:,:,:) = c0 meltb (:,:,:) = c0 meltl (:,:,:) = c0 Tbot (:,:,:) = c0 Tsnic (:,:,:) = 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 if (formdrag) then Cdn_atm_rdg (:,:,:) = c0 Cd_atm(:,:,:)= 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 use ice_state, only: aice, vice, 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 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, & Trefn, Qrefn, & Tbotn, Tsnicn, & freshn, fsaltn, & fhocnn, fswthrun, & strairxT, strairyT, & Cd_atm, & fsurf, fcondtop, & fcondbot, & fsens, flat, & fswabs, flwout, & evap, & Tref, Qref, & Tbot, Tsnic, & fresh, fsalt, & fhocn, fswthru, & melttn, meltsn, meltbn, congeln, snoicen, & meltt, melts, & meltb, & congel, snoice, & 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) Trefn , & ! air tmp reference level (K) Tbotn , & ! ice bottom temperature (C) Tsnicn , & ! 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) 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) Tref , & ! air tmp reference level (K) Tbot , & ! sea ice bottom temperature (C) Tsnic , & ! 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) 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) Tref (i,j) = Tref (i,j) + Trefn (i,j)*aicen(i,j) Tbot (i,j) = Tbot (i,j) + Tbotn (i,j)*aicen(i,j) Tsnic (i,j) = Tsnic (i,j) + Tsnicn (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) 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) = -stefan_boltzmann *(Tf(i,j) + Tffresh)**4 ! to make upward longwave over ocean reasonable for history file evap (i,j) = c0 Tref (i,j) = Tair(i,j) Qref (i,j) = Qa (i,j) if (present(Uref) .and. present(wind)) then Uref (i,j) = wind(i,j) endif if (present(Qref_iso)) then Qref_iso(i,j,:) = Qa(i,j) 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 !=======================================================================