New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9959 for NEMO/branches/UKMO – NEMO

Changeset 9959 for NEMO/branches/UKMO


Ignore:
Timestamp:
2018-07-17T13:54:44+02:00 (6 years ago)
Author:
davestorkey
Message:

UKMO icebergs_ocean_heat_fluxes branch : science changes

Location:
NEMO/branches/UKMO/icebergs_ocean_heat_fluxes
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/icebergs_ocean_heat_fluxes/cfgs/SHARED/field_def_nemo-oce.xml

    r9934 r9959  
    531531      <field_group id="icbvar" domain_ref="grid_T"  >  
    532532        <field id="berg_melt"          long_name="icb melt rate of icebergs"                       unit="kg/m2/s"                    /> 
     533        <field id="berg_melt_hcflx"    long_name="icb heat flux to ocean due to melting heat content"   unit="J/m2/s"                /> 
     534        <field id="berg_melt_qlat"     long_name="icb heat flux to ocean due to melting latent heat"    unit="J/m2/s"                /> 
    533535        <field id="berg_buoy_melt"     long_name="icb buoyancy component of iceberg melt rate"     unit="kg/m2/s"                    /> 
    534536        <field id="berg_eros_melt"     long_name="icb erosion component of iceberg melt rate"      unit="kg/m2/s"                    /> 
  • NEMO/branches/UKMO/icebergs_ocean_heat_fluxes/src/OCE/ICB/icbdia.F90

    r9598 r9959  
    5151 
    5252   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_melt       ! Melting+erosion rate of icebergs     [kg/s/m2] 
     53   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_melt_hcflx ! Heat flux to ocean due to heat content of melting icebergs [J/s/m2] 
     54   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_melt_qlat  ! Heat flux to ocean due to latent heat of melting icebergs [J/s/m2] 
    5355   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   buoy_melt       ! Buoyancy component of melting rate   [kg/s/m2] 
    5456   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   eros_melt       ! Erosion component of melting rate    [kg/s/m2] 
     
    101103 
    102104      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)   = 0._wp 
     105      ALLOCATE( berg_melt_hcflx(jpi,jpj) )           ;   berg_melt_hcflx(:,:)   = 0._wp 
     106      ALLOCATE( berg_melt_qlat(jpi,jpj)  )           ;   berg_melt_qlat(:,:)   = 0._wp 
    103107      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)   = 0._wp 
    104108      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)   = 0._wp 
     
    364368      IF( .NOT.ln_bergdia )   RETURN 
    365369      berg_melt   (:,:)   = 0._wp 
     370      berg_melt_hcflx(:,:)   = 0._wp 
     371      berg_melt_qlat(:,:)   = 0._wp 
    366372      buoy_melt   (:,:)   = 0._wp 
    367373      eros_melt   (:,:)   = 0._wp 
     
    384390      ! 
    385391      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s] 
     392      CALL iom_put( "berg_melt_hcflx"  , berg_melt_hcflx(:,:))   ! Heat flux to ocean due to heat content of melting icebergs [J/m2/s] 
     393      CALL iom_put( "berg_melt_qlat"   , berg_melt_qlat(:,:) )   ! Heat flux to ocean due to latent heat of melting icebergs [J/m2/s] 
    386394      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s] 
    387395      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s] 
     
    471479 
    472480 
    473    SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,     & 
     481   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     & 
    474482      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   & 
    475483      &                    pdMv, pz1_dt_e1e2 ) 
     
    477485      !!---------------------------------------------------------------------- 
    478486      INTEGER , INTENT(in) ::   ki, kj 
    479       REAL(wp), INTENT(in) ::   pmnew, pheat, pmass_scale 
     487      REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale 
    480488      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2 
    481489      !!---------------------------------------------------------------------- 
     
    484492      ! 
    485493      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s 
     494      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s 
     495      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s 
    486496      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s 
    487497      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s 
     
    489499      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s 
    490500      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s 
    491       heat_to_ocean_net = heat_to_ocean_net + pheat * pmass_scale * berg_dt         ! J 
     501      heat_to_ocean_net = heat_to_ocean_net + (pheat_hcflux + pheat_latent) * pmass_scale * berg_dt         ! J 
    492502      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted 
    493503      ! 
  • NEMO/branches/UKMO/icebergs_ocean_heat_fluxes/src/OCE/ICB/icbthm.F90

    r9940 r9959  
    5050      REAL(wp) ::   zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn 
    5151      REAL(wp) ::   zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv 
    52       REAL(wp) ::   zMnew, zMnew1, zMnew2, zheat, z1_12 
     52      REAL(wp) ::   zMnew, zMnew1, zMnew2, zheat_hcflux, zheat_latent, z1_12 
    5353      REAL(wp) ::   zMbits, znMbits, zdMbitsE, zdMbitsM, zLbits, zAbits, zMbb 
    5454      REAL(wp) ::   zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2 
     
    6868      ! 
    6969      berg_grid%floating_melt(:,:) = 0._wp 
     70      ! calving_hflx re-used here as temporary workspace for the heat flux associated with melting 
    7071      berg_grid%calving_hflx(:,:)  = 0._wp 
    7172      ! 
     
    166167            zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s 
    167168            berg_grid%floating_melt(ii,ij) = berg_grid%floating_melt(ii,ij) + zmelt    * z1_e1e2    ! kg/m2/s 
    168             zheat = zmelt * pt%heat_density              ! kg/s x J/kg = J/s 
    169             berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + zheat    * z1_e1e2    ! W/m2 
    170             CALL icb_dia_melt( ii, ij, zMnew, zheat, this%mass_scaling,       & 
     169            zheat_hcflux = zmelt * pt%heat_density       ! heat content flux : kg/s x J/kg = J/s 
     170            zheat_latent = zmelt * rLfus                 ! latent heat flux:  kg/s x J/kg = J/s 
     171            berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + ( zheat_hcflux + zheat_latent ) * z1_e1e2    ! W/m2 
     172            CALL icb_dia_melt( ii, ij, zMnew, zheat_hcflux, zheat_latent, this%mass_scaling,       & 
    171173               &                       zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
    172174               &                       zdMv, z1_dt_e1e2 ) 
     
    214216      IF(.NOT. ln_passive_mode ) THEN 
    215217         emp (:,:) = emp (:,:) - berg_grid%floating_melt(:,:) 
    216 !!       qns (:,:) = qns (:,:) + berg_grid%calving_hflx (:,:)  !!gm heat flux not yet properly coded ==>> need it, SOLVE that! 
     218         qns (:,:) = qns (:,:) + berg_grid%calving_hflx (:,:)   
    217219      ENDIF 
    218220      ! 
Note: See TracChangeset for help on using the changeset viewer.