ecearth3/sources/nemo-3.6/NEMO/OPA_SRC/ICB/icbdia.F90

MODULE icbdia

   !!======================================================================
   !!                       ***  MODULE  icbdia  ***
   !! Icebergs:  initialise variables for iceberg budgets and diagnostics
   !!======================================================================
   !! History : 3.3 !  2010-01  (Martin, Adcroft) Original code
   !!            -  !  2011-03  (Madec)          Part conversion to NEMO form
   !!            -  !                            Removal of mapping from another grid
   !!            -  !  2011-04  (Alderson)       Split into separate modules
   !!            -  !  2011-05  (Alderson)       Budgets are now all here with lots
   !!            -  !                            of silly routines to call to get values in
   !!            -  !                            from the right points in the code
   !!----------------------------------------------------------------------
   !!----------------------------------------------------------------------
   !! icb_dia_init : initialise iceberg budgeting
   !!----------------------------------------------------------------------
   USE par_oce        ! ocean parameters
   USE dom_oce        ! ocean domain
   USE in_out_manager ! nemo IO
   USE lib_mpp        ! MPP library
   USE iom            ! I/O library
   USE icb_oce        ! iceberg variables
   USE icbutl         ! iceberg utility routines

   IMPLICIT NONE
   PRIVATE

   PUBLIC   icb_dia_init      ! routine called in icbini.F90 module
   PUBLIC   icb_dia           ! routine called in icbstp.F90 module
   PUBLIC   icb_dia_step      ! routine called in icbstp.F90 module
   PUBLIC   icb_dia_put       ! routine called in icbstp.F90 module
   PUBLIC   icb_dia_melt      ! routine called in icbthm.F90 module
   PUBLIC   icb_dia_size      ! routine called in icbthm.F90 module
   PUBLIC   icb_dia_speed     ! routine called in icbdyn.F90 module
   PUBLIC   icb_dia_calve     ! routine called in icbclv.F90 module
   PUBLIC   icb_dia_income    ! routine called in icbclv.F90 module

   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_melt       ! Melting+erosion rate of icebergs     [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   buoy_melt       ! Buoyancy component of melting rate   [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   eros_melt       ! Erosion component of melting rate    [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   conv_melt       ! Convective component of melting rate [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_src        ! Mass flux from berg erosion into bergy bits [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_melt       ! Melting rate of bergy bits           [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_mass       ! Mass distribution of bergy bits      [kg/s/m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   virtual_area    ! Virtual surface coverage by icebergs [m2]
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_mass       ! Mass distribution                    [kg/m2]
   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PUBLIC  ::   real_calving    ! Calving rate into iceberg class at
   !                                                                          ! calving locations                    [kg/s]
   
   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmpc                     ! Temporary work space
   REAL(wp), DIMENSION(:)    , ALLOCATABLE ::   rsumbuf                  ! Temporary work space to reduce mpp exchanges
   INTEGER , DIMENSION(:)    , ALLOCATABLE ::   nsumbuf                  ! Temporary work space to reduce mpp exchanges

   REAL(wp)                      ::  berg_melt_net
   REAL(wp)                      ::  bits_src_net
   REAL(wp)                      ::  bits_melt_net
   REAL(wp)                      ::  bits_mass_start     , bits_mass_end
   REAL(wp)                      ::  floating_heat_start , floating_heat_end
   REAL(wp)                      ::  floating_mass_start , floating_mass_end
   REAL(wp)                      ::  bergs_mass_start    , bergs_mass_end
   REAL(wp)                      ::  stored_start        , stored_heat_start
   REAL(wp)                      ::  stored_end          , stored_heat_end
   REAL(wp)                      ::  calving_src_net     , calving_out_net
   REAL(wp)                      ::  calving_src_heat_net, calving_out_heat_net
   REAL(wp)                      ::  calving_src_heat_used_net
   REAL(wp)                      ::  calving_rcv_net  , calving_ret_net  , calving_used_net
   REAL(wp)                      ::  heat_to_bergs_net, heat_to_ocean_net, melt_net
   REAL(wp)                      ::  calving_to_bergs_net

   INTEGER                       ::  nbergs_start, nbergs_end, nbergs_calved
   INTEGER                       ::  nbergs_melted
   INTEGER                       ::  nspeeding_tickets
   INTEGER , DIMENSION(nclasses) ::  nbergs_calved_by_class

   !!----------------------------------------------------------------------
   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
   !! $Id: icbdia.F90 2355 2015-05-20 07:11:50Z ufla $
   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
CONTAINS

   SUBROUTINE icb_dia_init( )
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN

      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)   = 0._wp
      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)   = 0._wp
      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)   = 0._wp
      ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt   (:,:)   = 0._wp
      ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:)   = 0._wp
      ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:)   = 0._wp
      ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:)   = 0._wp
      ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area(:,:)   = 0._wp
      ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass   (:,:)   = 0._wp
      ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving(:,:,:) = 0._wp
      ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc        (:,:)   = 0._wp

      nbergs_start              = 0
      nbergs_end                = 0
      stored_end                = 0._wp
      nbergs_start              = 0._wp
      stored_start              = 0._wp
      nbergs_melted             = 0
      nbergs_calved             = 0
      nbergs_calved_by_class(:) = 0
      nspeeding_tickets         = 0
      stored_heat_end           = 0._wp
      floating_heat_end         = 0._wp
      floating_mass_end         = 0._wp
      bergs_mass_end            = 0._wp
      bits_mass_end             = 0._wp
      stored_heat_start         = 0._wp
      floating_heat_start       = 0._wp
      floating_mass_start       = 0._wp
      bergs_mass_start          = 0._wp
      bits_mass_start           = 0._wp
      bits_mass_end             = 0._wp
      calving_used_net          = 0._wp
      calving_to_bergs_net      = 0._wp
      heat_to_bergs_net         = 0._wp
      heat_to_ocean_net         = 0._wp
      calving_rcv_net           = 0._wp
      calving_ret_net           = 0._wp
      calving_src_net           = 0._wp
      calving_out_net           = 0._wp
      calving_src_heat_net      = 0._wp
      calving_src_heat_used_net = 0._wp
      calving_out_heat_net      = 0._wp
      melt_net                  = 0._wp
      berg_melt_net             = 0._wp
      bits_melt_net             = 0._wp
      bits_src_net              = 0._wp

      floating_mass_start       = icb_utl_mass( first_berg )
      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.true. )
      bits_mass_start           = icb_utl_mass( first_berg, justbits=.true. )
      IF( lk_mpp ) THEN
         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp
         ALLOCATE( nsumbuf(4+nclasses) )  ; nsumbuf(:) = 0
         rsumbuf(1) = floating_mass_start
         rsumbuf(2) = bergs_mass_start
         rsumbuf(3) = bits_mass_start
         CALL mpp_sum( rsumbuf(1:3), 3 )
         floating_mass_start = rsumbuf(1)
         bergs_mass_start = rsumbuf(2)
         bits_mass_start = rsumbuf(3)
      ENDIF
      !
   END SUBROUTINE icb_dia_init


   SUBROUTINE icb_dia( ld_budge )
      !!----------------------------------------------------------------------
      !! sum all the things we've accumulated so far in the current processor
      !! in MPP case then add these sums across all processors
      !! for this we pack variables into buffer so we only need one mpp_sum
      !!----------------------------------------------------------------------
      LOGICAL, INTENT(in) ::   ld_budge
      !
      INTEGER             ::   ik
      REAL(wp)            ::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia )   RETURN

      zunused_calving      = SUM( berg_grid%calving(:,:) )
      ztmpsum              = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
      melt_net             = melt_net + ztmpsum * berg_dt
      calving_out_net      = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt
      ztmpsum              = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
      berg_melt_net        = berg_melt_net + ztmpsum * berg_dt
      ztmpsum              = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) )
      bits_src_net         = bits_src_net + ztmpsum * berg_dt
      ztmpsum              = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
      bits_melt_net        = bits_melt_net + ztmpsum * berg_dt
      ztmpsum              = SUM( src_calving(:,:) * tmask_i(:,:) )
      calving_ret_net      = calving_ret_net + ztmpsum * berg_dt
      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) )
      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J

      IF( ld_budge ) THEN
         stored_end        = SUM( berg_grid%stored_ice(:,:,:) )
         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) )
         floating_mass_end = icb_utl_mass( first_berg )
         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.true. )
         bits_mass_end     = icb_utl_mass( first_berg,justbits=.true. )
         floating_heat_end = icb_utl_heat( first_berg )

         nbergs_end        = icb_utl_count()
         zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) )
         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )

         IF( lk_mpp ) THEN
            rsumbuf( 1) = stored_end
            rsumbuf( 2) = stored_heat_end
            rsumbuf( 3) = floating_mass_end
            rsumbuf( 4) = bergs_mass_end
            rsumbuf( 5) = bits_mass_end
            rsumbuf( 6) = floating_heat_end
            rsumbuf( 7) = calving_ret_net
            rsumbuf( 8) = calving_out_net
            rsumbuf( 9) = calving_rcv_net
            rsumbuf(10) = calving_src_net
            rsumbuf(11) = calving_src_heat_net
            rsumbuf(12) = calving_src_heat_used_net
            rsumbuf(13) = calving_out_heat_net
            rsumbuf(14) = calving_used_net
            rsumbuf(15) = calving_to_bergs_net
            rsumbuf(16) = heat_to_bergs_net
            rsumbuf(17) = heat_to_ocean_net
            rsumbuf(18) = melt_net
            rsumbuf(19) = berg_melt_net
            rsumbuf(20) = bits_src_net
            rsumbuf(21) = bits_melt_net
            rsumbuf(22) = zgrdd_berg_mass
            rsumbuf(23) = zgrdd_bits_mass

            CALL mpp_sum( rsumbuf(1:23), 23)

            stored_end                = rsumbuf( 1)
            stored_heat_end           = rsumbuf( 2)
            floating_mass_end         = rsumbuf( 3)
            bergs_mass_end            = rsumbuf( 4)
            bits_mass_end             = rsumbuf( 5)
            floating_heat_end         = rsumbuf( 6)
            calving_ret_net           = rsumbuf( 7)
            calving_out_net           = rsumbuf( 8)
            calving_rcv_net           = rsumbuf( 9)
            calving_src_net           = rsumbuf(10)
            calving_src_heat_net      = rsumbuf(11)
            calving_src_heat_used_net = rsumbuf(12)
            calving_out_heat_net      = rsumbuf(13)
            calving_used_net          = rsumbuf(14)
            calving_to_bergs_net      = rsumbuf(15)
            heat_to_bergs_net         = rsumbuf(16)
            heat_to_ocean_net         = rsumbuf(17)
            melt_net                  = rsumbuf(18)
            berg_melt_net             = rsumbuf(19)
            bits_src_net              = rsumbuf(20)
            bits_melt_net             = rsumbuf(21)
            zgrdd_berg_mass           = rsumbuf(22)
            zgrdd_bits_mass           = rsumbuf(23)

            nsumbuf(1) = nbergs_end
            nsumbuf(2) = nbergs_calved
            nsumbuf(3) = nbergs_melted
            nsumbuf(4) = nspeeding_tickets
            DO ik = 1, nclasses
               nsumbuf(4+ik) = nbergs_calved_by_class(ik)
            END DO

            CALL mpp_sum( nsumbuf(1:nclasses+4), nclasses+4 )

            nbergs_end        = nsumbuf(1)
            nbergs_calved     = nsumbuf(2)
            nbergs_melted     = nsumbuf(3)
            nspeeding_tickets = nsumbuf(4)
            DO ik = 1,nclasses
               nbergs_calved_by_class(ik)= nsumbuf(4+ik)
            ENDDO

         ENDIF

         CALL report_state( 'stored ice','kg','',stored_start,'',stored_end,'')
         CALL report_state( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end)
         CALL report_state( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'')
         CALL report_state( 'bits','kg','',bits_mass_start,'',bits_mass_end,'')
         CALL report_istate( 'berg #','',nbergs_start,'',nbergs_end,'')
         CALL report_ibudget( 'berg #','calved',nbergs_calved, &
                                       'melted',nbergs_melted, &
                                       '#',nbergs_start,nbergs_end)
         CALL report_budget( 'stored mass','kg','calving used',calving_used_net, &
                                           'bergs',calving_to_bergs_net, &
                                           'stored mass',stored_start,stored_end)
         CALL report_budget( 'floating mass','kg','calving used',calving_to_bergs_net, &
                                             'bergs',melt_net, &
                                             'stored mass',floating_mass_start,floating_mass_end)
         CALL report_budget( 'berg mass','kg','calving',calving_to_bergs_net, &
                                              'melt+eros',berg_melt_net, &
                                              'berg mass',bergs_mass_start,bergs_mass_end)
         CALL report_budget( 'bits mass','kg','eros used',bits_src_net, &
                                              'bergs',bits_melt_net, &
                                              'stored mass',bits_mass_start,bits_mass_end)
         CALL report_budget( 'net mass','kg','recvd',calving_rcv_net, &
                                             'rtrnd',calving_ret_net, &
                                             'net mass',stored_start+floating_mass_start, &
                                                        stored_end+floating_mass_end)
         CALL report_consistant( 'iceberg mass','kg','gridded',zgrdd_berg_mass,'bergs',bergs_mass_end)
         CALL report_consistant( 'bits mass','kg','gridded',zgrdd_bits_mass,'bits',bits_mass_end)
         CALL report_state( 'net heat','J','',stored_heat_start+floating_heat_start,'', &
                                              stored_heat_end+floating_heat_end,'')
         CALL report_state( 'stored heat','J','',stored_heat_start,'',stored_heat_end,'')
         CALL report_state( 'floating heat','J','',floating_heat_start,'',floating_heat_end,'')
         CALL report_budget( 'net heat','J','net heat',calving_src_heat_net, &
                                            'net heat',calving_out_heat_net, &
                                            'net heat',stored_heat_start+floating_heat_start, &
                                                       stored_heat_end+floating_heat_end)
         CALL report_budget( 'stored heat','J','calving used',calving_src_heat_used_net, &
                                               'bergs',heat_to_bergs_net, &
                                               'net heat',stored_heat_start,stored_heat_end)
         CALL report_budget( 'flting heat','J','calved',heat_to_bergs_net, &
                                               'melt',heat_to_ocean_net, &
                                               'net heat',floating_heat_start,floating_heat_end)
         IF (nn_verbose_level >= 1) THEN
            CALL report_consistant( 'top interface','kg','from SIS',calving_src_net, &
                                    'received',calving_rcv_net)
            CALL report_consistant( 'bot interface','kg','sent',calving_out_net, &
                                    'returned',calving_ret_net)
         ENDIF
         WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
         IF ( nspeeding_tickets > 0 ) WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets

         nbergs_start              = nbergs_end
         stored_start              = stored_end
         nbergs_melted             = 0
         nbergs_calved             = 0
         nbergs_calved_by_class(:) = 0
         nspeeding_tickets         = 0
         stored_heat_start         = stored_heat_end
         floating_heat_start       = floating_heat_end
         floating_mass_start       = floating_mass_end
         bergs_mass_start          = bergs_mass_end
         bits_mass_start           = bits_mass_end
         calving_used_net          = 0._wp
         calving_to_bergs_net      = 0._wp
         heat_to_bergs_net         = 0._wp
         heat_to_ocean_net         = 0._wp
         calving_rcv_net           = 0._wp
         calving_ret_net           = 0._wp
         calving_src_net           = 0._wp
         calving_out_net           = 0._wp
         calving_src_heat_net      = 0._wp
         calving_src_heat_used_net = 0._wp
         calving_out_heat_net      = 0._wp
         melt_net                  = 0._wp
         berg_melt_net             = 0._wp
         bits_melt_net             = 0._wp
         bits_src_net              = 0._wp
      ENDIF
      !
   END SUBROUTINE icb_dia


   SUBROUTINE icb_dia_step
      !!----------------------------------------------------------------------
      !! things to reset at the beginning of each timestep
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN
      berg_melt    (:,:)   = 0._wp
      buoy_melt    (:,:)   = 0._wp
      eros_melt    (:,:)   = 0._wp
      conv_melt    (:,:)   = 0._wp
      bits_src     (:,:)   = 0._wp
      bits_melt    (:,:)   = 0._wp
      bits_mass    (:,:)   = 0._wp
      berg_mass    (:,:)   = 0._wp
      virtual_area (:,:)   = 0._wp
      real_calving (:,:,:) = 0._wp
      !
   END SUBROUTINE icb_dia_step


   SUBROUTINE icb_dia_put
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not
      !
      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s]
      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
      !
   END SUBROUTINE icb_dia_put


   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      INTEGER,  INTENT(in)  ::   ki, kj, kn
      REAL(wp), INTENT(in)  ::   pcalved
      REAL(wp), INTENT(in)  ::   pheated
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN
      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
      nbergs_calved              = nbergs_calved              + 1
      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
      calving_to_bergs_net       = calving_to_bergs_net + pcalved
      heat_to_bergs_net          = heat_to_bergs_net    + pheated
      !
   END SUBROUTINE icb_dia_calve


   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      INTEGER ,                 INTENT(in)  :: kt
      REAL(wp),                 INTENT(in)  :: pcalving_used
      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN
      !
      IF( kt == nit000 ) THEN
         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
         IF( lk_mpp ) CALL mpp_sum( stored_start )
         WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
         !
         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
         IF( lk_mpp ) CALL mpp_sum( stored_heat_start )
         WRITE(numicb,'(a,es13.6,a)')    'icb_dia_income: initial stored heat=',stored_heat_start,' J'
      ENDIF
      !
      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
      calving_src_net = calving_rcv_net
      calving_src_heat_net = calving_src_heat_net +  &
         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
      calving_used_net = calving_used_net + pcalving_used * berg_dt
      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
      !
   END SUBROUTINE icb_dia_income


   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      INTEGER,  INTENT(in) :: ki, kj
      REAL(wp), INTENT(in) :: pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN
      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
      !
   END SUBROUTINE icb_dia_size


   SUBROUTINE icb_dia_speed()
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN
      nspeeding_tickets = nspeeding_tickets + 1
      !
   END SUBROUTINE icb_dia_speed


   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,   &
      &                   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
      &                   pdMv, pz1_dt_e1e2 )
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      INTEGER , INTENT(in) ::   ki, kj
      REAL(wp), INTENT(in) ::   pmnew, pheat, pmass_scale
      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
      !!----------------------------------------------------------------------
      !
      IF( .NOT. ln_bergdia ) RETURN

      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
      heat_to_ocean_net = heat_to_ocean_net + pheat * pmass_scale * berg_dt         ! J
      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
      !
   END SUBROUTINE icb_dia_melt


   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
      &                     pendval, cd_delstr, kbergs )
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
      REAL(wp),      INTENT(in)           :: pstartval, pendval
      INTEGER,       INTENT(in), OPTIONAL :: kbergs
      !!----------------------------------------------------------------------
      !
      IF ( PRESENT(kbergs) ) THEN
         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
                           cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
                           cd_endstr    // ' end',    pendval,           cd_budgetunits, &
                           'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
                           '# of bergs', kbergs
      ELSE
         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
                           cd_startstr  // ' start', pstartval,         cd_budgetunits, &
                           cd_endstr    // ' end',   pendval,           cd_budgetunits, &
                           cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
      ENDIF
      100 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
   END SUBROUTINE report_state


   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
      REAL(wp),      INTENT(in) :: pstartval, pendval
      !!----------------------------------------------------------------------
      !
      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
                        cd_startstr,    pstartval, cd_budgetunits, &
                        cd_endstr,      pendval,   cd_budgetunits, &
                        'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
      200 FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
   END SUBROUTINE report_consistant


   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
      &                      poutval, cd_delstr, pstartval, pendval)
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
      !
      REAL(wp)                  :: zval
      !!----------------------------------------------------------------------
      !
      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
         &   MAX( 1.e-30, MAX( abs( pendval - pstartval ) , ABS( pinval - poutval ) ) )

      WRITE(numicb,200) cd_budgetstr // ' budget:', &
         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
         &              'error',        zval,                       'nd'
  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
      !
   END SUBROUTINE report_budget


   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
      INTEGER,       INTENT(in) :: pstartval, pendval
      !
      WRITE(numicb,100) cd_budgetstr // ' state:',           &
         &              cd_startstr  // ' start', pstartval, &
         &              cd_endstr    // ' end',   pendval,   &
         &              cd_delstr    // 'Delta',  pendval-pstartval
  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
      !
   END SUBROUTINE report_istate


   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
      &                       cd_delstr, pstartval, pendval)
      !!----------------------------------------------------------------------
      !!----------------------------------------------------------------------
      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
      !!----------------------------------------------------------------------
      !
      WRITE(numicb,200) cd_budgetstr // ' budget:', &
                        cd_instr     // ' in',      pinval, &
                        cd_outstr    // ' out',     poutval, &
                        'Delta '     // cd_delstr,  pinval-poutval, &
                        'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
      200 FORMAT(a19,10(a18,"=",i14,x,:,","))
   END SUBROUTINE report_ibudget

   !!======================================================================
END MODULE icbdia