LCOV - code coverage report
Current view: top level - columnphysics - icepack_flux.F90 (source / functions) Hit Total Coverage
Test: 200804-015008:4c42a82e3d:3:base,travis,quick Lines: 46 54 85.19 %
Date: 2020-08-03 20:10:57 Functions: 1 2 50.00 %

          Line data    Source code
       1             : !=======================================================================
       2             : 
       3             : ! Flux manipulation routines for column package
       4             : !
       5             : ! author Elizabeth C. Hunke, LANL
       6             : !
       7             : ! 2014: Moved subroutines merge_fluxes, set_sfcflux from ice_flux.F90
       8             : 
       9             :       module icepack_flux
      10             : 
      11             :       use icepack_kinds
      12             :       use icepack_parameters, only: c1, emissivity
      13             :       use icepack_warnings, only: warnstr, icepack_warnings_add
      14             :       use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted
      15             :       use icepack_tracers, only: tr_iso
      16             : 
      17             :       implicit none
      18             :       private
      19             :       public :: merge_fluxes, set_sfcflux               
      20             : 
      21             : !=======================================================================
      22             : 
      23             :       contains
      24             : 
      25             : !=======================================================================
      26             : 
      27             : ! Aggregate flux information from all ice thickness categories
      28             : !
      29             : ! author: Elizabeth C. Hunke and William H. Lipscomb, LANL
      30             : 
      31     4360794 :       subroutine merge_fluxes (aicen,                &    
      32             :                                flw, &
      33             :                                strairxn, strairyn,   &
      34             :                                Cdn_atm_ratio_n,      &
      35             :                                fsurfn,   fcondtopn,  &  
      36             :                                fcondbotn,            &
      37             :                                fsensn,   flatn,      & 
      38             :                                fswabsn,  flwoutn,    &
      39             :                                evapn,                &
      40             :                                evapsn,   evapin,     &
      41             :                                Trefn,    Qrefn,      &
      42             :                                freshn,   fsaltn,     &
      43             :                                fhocnn,   fswthrun,   &
      44             :                                fswthrun_vdr, fswthrun_vdf,&
      45             :                                fswthrun_idr, fswthrun_idf,&
      46             :                                strairxT, strairyT,   &  
      47             :                                Cdn_atm_ratio,        &
      48             :                                fsurf,    fcondtop,   &
      49             :                                fcondbot,             &
      50             :                                fsens,    flat,       & 
      51             :                                fswabs,   flwout,     &
      52             :                                evap,                 & 
      53             :                                evaps,    evapi,      &
      54             :                                Tref,     Qref,       &
      55             :                                fresh,    fsalt,      & 
      56             :                                fhocn,    fswthru,    &
      57             :                                fswthru_vdr, fswthru_vdf,&
      58             :                                fswthru_idr, fswthru_idf,&
      59             :                                melttn, meltsn, meltbn, congeln, snoicen, &
      60             :                                meltt,  melts,        &
      61             :                                meltb,                &
      62             :                                congel,  snoice,      &
      63             :                                Uref,     Urefn,      &
      64     4360794 :                                Qref_iso, Qrefn_iso,  &
      65     4360794 :                                fiso_ocn, fiso_ocnn,  &
      66     4360794 :                                fiso_evap, fiso_evapn)
      67             : 
      68             :       ! single category fluxes
      69             :       real (kind=dbl_kind), intent(in) :: &
      70             :           aicen   , & ! concentration of ice
      71             :           flw     , & ! downward longwave flux          (W/m**2)
      72             :           strairxn, & ! air/ice zonal  strss,           (N/m**2)
      73             :           strairyn, & ! air/ice merdnl strss,           (N/m**2)
      74             :           Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag  
      75             :           fsurfn  , & ! net heat flux to top surface    (W/m**2)
      76             :           fcondtopn,& ! downward cond flux at top sfc   (W/m**2)
      77             :           fcondbotn,& ! downward cond flux at bottom sfc   (W/m**2)
      78             :           fsensn  , & ! sensible heat flx               (W/m**2)
      79             :           flatn   , & ! latent   heat flx               (W/m**2)
      80             :           fswabsn , & ! shortwave absorbed heat flx     (W/m**2)
      81             :           flwoutn , & ! upwd lw emitted heat flx        (W/m**2)
      82             :           evapn   , & ! evaporation                     (kg/m2/s)
      83             :           evapsn  , & ! evaporation over snow           (kg/m2/s)
      84             :           evapin  , & ! evaporation over ice            (kg/m2/s)
      85             :           Trefn   , & ! air tmp reference level         (K)
      86             :           Qrefn   , & ! air sp hum reference level      (kg/kg)
      87             :           freshn  , & ! fresh water flux to ocean       (kg/m2/s)
      88             :           fsaltn  , & ! salt flux to ocean              (kg/m2/s)
      89             :           fhocnn  , & ! actual ocn/ice heat flx         (W/m**2)
      90             :           fswthrun, & ! sw radiation through ice bot    (W/m**2)
      91             :           fswthrun_vdr, & ! vis dir sw radiation through ice bot    (W/m**2)
      92             :           fswthrun_vdf, & ! vis dif sw radiation through ice bot    (W/m**2)
      93             :           fswthrun_idr, & ! nir dir sw radiation through ice bot    (W/m**2)
      94             :           fswthrun_idf, & ! nir dif sw radiation through ice bot    (W/m**2)
      95             :           melttn  , & ! top ice melt                    (m)
      96             :           meltbn  , & ! bottom ice melt                 (m)
      97             :           meltsn  , & ! snow melt                       (m)
      98             :           congeln , & ! congelation ice growth          (m)
      99             :           snoicen     ! snow-ice growth                 (m)
     100             :            
     101             :       real (kind=dbl_kind), optional, intent(in):: &
     102             :           Urefn       ! air speed reference level       (m/s)
     103             : 
     104             :       ! cumulative fluxes
     105             :       real (kind=dbl_kind), intent(inout) :: &
     106             :           strairxT, & ! air/ice zonal  strss,           (N/m**2)
     107             :           strairyT, & ! air/ice merdnl strss,           (N/m**2)
     108             :           Cdn_atm_ratio, & ! ratio of total drag over neutral drag
     109             :           fsurf   , & ! net heat flux to top surface    (W/m**2)
     110             :           fcondtop, & ! downward cond flux at top sfc   (W/m**2)
     111             :           fcondbot, & ! downward cond flux at bottom sfc   (W/m**2)
     112             :           fsens   , & ! sensible heat flx               (W/m**2)
     113             :           flat    , & ! latent   heat flx               (W/m**2)
     114             :           fswabs  , & ! shortwave absorbed heat flx     (W/m**2)
     115             :           flwout  , & ! upwd lw emitted heat flx        (W/m**2)
     116             :           evap    , & ! evaporation                     (kg/m2/s)
     117             :           evaps   , & ! evaporation over snow           (kg/m2/s)
     118             :           evapi   , & ! evaporation over ice            (kg/m2/s)
     119             :           Tref    , & ! air tmp reference level         (K)
     120             :           Qref    , & ! air sp hum reference level      (kg/kg)
     121             :           fresh   , & ! fresh water flux to ocean       (kg/m2/s)
     122             :           fsalt   , & ! salt flux to ocean              (kg/m2/s)
     123             :           fhocn   , & ! actual ocn/ice heat flx         (W/m**2)
     124             :           fswthru , & ! sw radiation through ice bot    (W/m**2)
     125             :           meltt   , & ! top ice melt                    (m)
     126             :           meltb   , & ! bottom ice melt                 (m)
     127             :           melts   , & ! snow melt                       (m)
     128             :           congel  , & ! congelation ice growth          (m)
     129             :           snoice      ! snow-ice growth                 (m)
     130             : 
     131             :       real (kind=dbl_kind), intent(inout), optional :: &
     132             :           fswthru_vdr , & ! vis dir sw radiation through ice bot    (W/m**2)
     133             :           fswthru_vdf , & ! vis dif sw radiation through ice bot    (W/m**2)
     134             :           fswthru_idr , & ! nir dir sw radiation through ice bot    (W/m**2)
     135             :           fswthru_idf     ! nir dif sw radiation through ice bot    (W/m**2)
     136             : 
     137             :       real (kind=dbl_kind), optional, intent(inout):: &
     138             :           Uref        ! air speed reference level       (m/s)
     139             : 
     140             :       real (kind=dbl_kind), optional, dimension(:), intent(inout):: &
     141             :           Qref_iso, & ! isotope air sp hum reference level (kg/kg)
     142             :           fiso_ocn, & ! isotope fluxes to ocean (kg/m2/s)
     143             :           fiso_evap   ! isotope evaporation (kg/m2/s)
     144             : 
     145             :       real (kind=dbl_kind), optional, dimension(:), intent(in):: &
     146             :           Qrefn_iso, & ! isotope air sp hum reference level (kg/kg)
     147             :           fiso_ocnn, & ! isotope fluxes to ocean (kg/m2/s)
     148             :           fiso_evapn   ! isotope evaporation (kg/m2/s)
     149             : 
     150             :       character(len=*),parameter :: subname='(merge_fluxes)'
     151             : 
     152             :       !-----------------------------------------------------------------
     153             :       ! Merge fluxes
     154             :       ! NOTE: The albedo is aggregated only in cells where ice exists
     155             :       !       and (for the delta-Eddington scheme) where the sun is above
     156             :       !       the horizon. 
     157             :       !-----------------------------------------------------------------
     158             : 
     159             :       ! atmo fluxes
     160             : 
     161     4360794 :       strairxT   = strairxT + strairxn  * aicen
     162     4360794 :       strairyT   = strairyT + strairyn  * aicen
     163             :       Cdn_atm_ratio = Cdn_atm_ratio + &
     164     4360794 :                       Cdn_atm_ratio_n   * aicen
     165     4360794 :       fsurf      = fsurf    + fsurfn    * aicen
     166     4360794 :       fcondtop   = fcondtop + fcondtopn * aicen 
     167     4360794 :       fcondbot   = fcondbot + fcondbotn * aicen 
     168     4360794 :       fsens      = fsens    + fsensn    * aicen
     169     4360794 :       flat       = flat     + flatn     * aicen
     170     4360794 :       fswabs     = fswabs   + fswabsn   * aicen
     171             :       flwout     = flwout   &
     172     4360794 :            + (flwoutn - (c1-emissivity)*flw) * aicen
     173     4360794 :       evap       = evap     + evapn     * aicen
     174     4360794 :       evaps      = evaps    + evapsn    * aicen
     175     4360794 :       evapi      = evapi    + evapin    * aicen
     176     4360794 :       Tref       = Tref     + Trefn     * aicen
     177     4360794 :       Qref       = Qref     + Qrefn     * aicen
     178             : 
     179             :       ! Isotopes
     180     4360794 :       if (tr_iso) then
     181      229760 :          if (present(Qrefn_iso) .and. present(Qref_iso)) then
     182      919040 :             Qref_iso (:) = Qref_iso (:) + Qrefn_iso (:) * aicen
     183             :          endif
     184      229760 :          if (present(fiso_ocnn) .and. present(fiso_ocn)) then
     185      919040 :             fiso_ocn (:) = fiso_ocn (:) + fiso_ocnn (:) * aicen
     186             :          endif
     187      229760 :          if (present(fiso_evapn) .and. present(fiso_evap)) then
     188      919040 :             fiso_evap(:) = fiso_evap(:) + fiso_evapn(:) * aicen
     189             :          endif
     190             :       endif
     191             : 
     192             :       ! ocean fluxes
     193     4360794 :       if (present(Urefn) .and. present(Uref)) then
     194     4360794 :          Uref = Uref     + Urefn     * aicen
     195             :       endif
     196             : 
     197     4360794 :       fresh     = fresh     + freshn    * aicen
     198     4360794 :       fsalt     = fsalt     + fsaltn    * aicen
     199     4360794 :       fhocn     = fhocn     + fhocnn    * aicen
     200     4360794 :       fswthru   = fswthru   + fswthrun  * aicen
     201     4360794 :       if (present(fswthru_vdr)) &
     202     4360794 :          fswthru_vdr   = fswthru_vdr   + fswthrun_vdr  * aicen
     203     4360794 :       if (present(fswthru_vdf)) &
     204     4360794 :          fswthru_vdf   = fswthru_vdf   + fswthrun_vdf  * aicen
     205     4360794 :       if (present(fswthru_idr)) &
     206     4360794 :          fswthru_idr   = fswthru_idr   + fswthrun_idr  * aicen
     207     4360794 :       if (present(fswthru_idf)) &
     208     4360794 :          fswthru_idf   = fswthru_idf   + fswthrun_idf  * aicen
     209             : 
     210             :       ! ice/snow thickness
     211             : 
     212     4360794 :       meltt     = meltt     + melttn    * aicen
     213     4360794 :       meltb     = meltb     + meltbn    * aicen
     214     4360794 :       melts     = melts     + meltsn    * aicen
     215     4360794 :       congel    = congel    + congeln   * aicen
     216     4360794 :       snoice    = snoice    + snoicen   * aicen
     217             :       
     218     4360794 :       end subroutine merge_fluxes
     219             : 
     220             : !=======================================================================
     221             : 
     222             : ! If model is not calculating surface temperature, set the surface
     223             : ! flux values using values read in from forcing data or supplied via
     224             : ! coupling (stored in ice_flux).
     225             : !
     226             : ! If CICE is running in NEMO environment, convert fluxes from GBM values 
     227             : ! to per unit ice area values. If model is not running in NEMO environment, 
     228             : ! the forcing is supplied as per unit ice area values.
     229             : !
     230             : ! authors Alison McLaren, Met Office
     231             : 
     232           0 :       subroutine set_sfcflux (aicen,               &
     233             :                               flatn_f,             &
     234             :                               fsensn_f,            &
     235             :                               fsurfn_f,            &
     236             :                               fcondtopn_f,         &
     237             :                               flatn,               &
     238             :                               fsensn,              &
     239             :                               fsurfn,              &
     240             :                               fcondtopn)
     241             : 
     242             :       ! ice state variables
     243             :       real (kind=dbl_kind), &
     244             :          intent(in) :: &
     245             :          aicen       , & ! concentration of ice
     246             :          flatn_f     , & ! latent heat flux   (W/m^2) 
     247             :          fsensn_f    , & ! sensible heat flux (W/m^2) 
     248             :          fsurfn_f    , & ! net flux to top surface, not including fcondtopn
     249             :          fcondtopn_f     ! downward cond flux at top surface (W m-2)
     250             : 
     251             :       real (kind=dbl_kind), intent(out):: &
     252             :          flatn       , & ! latent heat flux   (W/m^2) 
     253             :          fsensn      , & ! sensible heat flux   (W/m^2) 
     254             :          fsurfn      , & ! net flux to top surface, not including fcondtopn
     255             :          fcondtopn       ! downward cond flux at top surface (W m-2)
     256             : 
     257             :       ! local variables
     258             : 
     259             :       real (kind=dbl_kind)  :: &
     260           0 :          raicen          ! 1 or 1/aicen
     261             : 
     262             :       logical (kind=log_kind) :: &
     263             :          extreme_flag    ! flag for extreme forcing values
     264             : 
     265             :       logical (kind=log_kind), parameter :: & 
     266             :          extreme_test=.false. ! test and write out extreme forcing data
     267             : 
     268             :       character(len=*),parameter :: subname='(set_sfcflux)'
     269             : 
     270           0 :       raicen        = c1
     271             : 
     272             : #ifdef CICE_IN_NEMO
     273             : !----------------------------------------------------------------------
     274             : ! Convert fluxes from GBM values to per ice area values when 
     275             : ! running in NEMO environment.  (When in standalone mode, fluxes
     276             : ! are input as per ice area.)
     277             : !----------------------------------------------------------------------
     278             :       raicen        = c1 / aicen
     279             : #endif
     280           0 :       fsurfn   = fsurfn_f*raicen
     281           0 :       fcondtopn= fcondtopn_f*raicen
     282           0 :       flatn    = flatn_f*raicen
     283           0 :       fsensn   = fsensn_f*raicen
     284             : 
     285             : !----------------------------------------------------------------
     286             : ! Flag up any extreme fluxes
     287             : !---------------------------------------------------------------
     288             : 
     289             :       if (extreme_test) then
     290             :          extreme_flag = .false.
     291             : 
     292             :          if (fcondtopn < -100.0_dbl_kind & 
     293             :               .or. fcondtopn > 20.0_dbl_kind) then
     294             :             extreme_flag = .true.
     295             :          endif
     296             :          
     297             :          if (fsurfn < -100.0_dbl_kind & 
     298             :               .or. fsurfn > 80.0_dbl_kind) then
     299             :             extreme_flag = .true.
     300             :          endif
     301             :          
     302             :          if (flatn < -20.0_dbl_kind & 
     303             :               .or. flatn > 20.0_dbl_kind) then
     304             :             extreme_flag = .true.
     305             :          endif
     306             : 
     307             :          if (extreme_flag) then
     308             : 
     309             :             if (fcondtopn < -100.0_dbl_kind & 
     310             :                  .or. fcondtopn > 20.0_dbl_kind) then
     311             :                write(warnstr,*) subname, & 
     312             :                     'Extreme forcing: -100 > fcondtopn > 20'
     313             :                call icepack_warnings_add(warnstr)
     314             :                write(warnstr,*) subname, & 
     315             :                     'aicen,fcondtopn = ', & 
     316             :                     aicen,fcondtopn
     317             :                call icepack_warnings_add(warnstr)
     318             :             endif
     319             :             
     320             :             if (fsurfn < -100.0_dbl_kind & 
     321             :                  .or. fsurfn > 80.0_dbl_kind) then
     322             :                write(warnstr,*) subname, & 
     323             :                     'Extreme forcing: -100 > fsurfn > 40'
     324             :                call icepack_warnings_add(warnstr)
     325             :                write(warnstr,*) subname, & 
     326             :                     'aicen,fsurfn = ', & 
     327             :                     aicen,fsurfn
     328             :                call icepack_warnings_add(warnstr)
     329             :             endif
     330             :             
     331             :             if (flatn < -20.0_dbl_kind & 
     332             :                  .or. flatn > 20.0_dbl_kind) then
     333             :                write(warnstr,*) subname, & 
     334             :                     'Extreme forcing: -20 > flatn > 20'
     335             :                call icepack_warnings_add(warnstr)
     336             :                write(warnstr,*) subname, & 
     337             :                     'aicen,flatn = ', & 
     338             :                     aicen,flatn
     339             :                call icepack_warnings_add(warnstr)
     340             :             endif
     341             :             
     342             :          endif  ! extreme_flag
     343             :       endif     ! extreme_test    
     344             :          
     345           0 :       end subroutine set_sfcflux 
     346             : 
     347             : !=======================================================================
     348             : 
     349             :       end module icepack_flux
     350             : 
     351             : !=======================================================================

Generated by: LCOV version 1.14-6-g40580cd