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 3370 for branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90 – NEMO

Ignore:
Timestamp:
2012-04-30T10:27:44+02:00 (12 years ago)
Author:
sga
Message:

NEMO branch dev_r3337_NOCS10_ICB: lots of cosmetic Gurvanistic changes (the odd space or exclamation mark!)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

    r3361 r3370  
    33   !!====================================================================== 
    44   !!                       ***  MODULE  icbdia  *** 
    5    !! Ocean physics:  initialise variables for iceberg budgets and diagnostics 
     5   !! Icebergs:  initialise variables for iceberg budgets and diagnostics 
    66   !!====================================================================== 
    7    !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code 
    8    !!            -    !  2011-03  (Madec)          Part conversion to NEMO form 
    9    !!            -    !                            Removal of mapping from another grid 
    10    !!            -    !  2011-04  (Alderson)       Split into separate modules 
    11    !!            -    !  2011-05  (Alderson)       Budgets are now all here with lots 
    12    !!            -    !                            of silly routines to call to get values in 
    13    !!            -    !                            from the right points in the code 
     7   !! History : 3.3 !  2010-01  (Martin, Adcroft) Original code 
     8   !!            -  !  2011-03  (Madec)          Part conversion to NEMO form 
     9   !!            -  !                            Removal of mapping from another grid 
     10   !!            -  !  2011-04  (Alderson)       Split into separate modules 
     11   !!            -  !  2011-05  (Alderson)       Budgets are now all here with lots 
     12   !!            -  !                            of silly routines to call to get values in 
     13   !!            -  !                            from the right points in the code 
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    … …  
    1717   !! icb_budget_init : initialise iceberg budgeting 
    1818   !!---------------------------------------------------------------------- 
    19    USE par_oce        ! nemo parameters 
     19   USE par_oce        ! ocean parameters 
    2020   USE dom_oce        ! ocean domain 
    2121   USE in_out_manager ! nemo IO 
    22    USE lib_mpp 
    23    USE iom 
    24  
    25    USE icb_oce        ! define iceberg arrays 
     22   USE lib_mpp        ! MPP library 
     23   USE iom            ! I/O library 
     24   USE icb_oce        ! iceberg variables 
    2625   USE icbutl         ! iceberg utility routines 
    2726 
    … …  
    2928   PRIVATE 
    3029 
    31    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: berg_melt=>NULL()    ! Melting+erosion rate of icebergs (kg/s/m^2) 
    32    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: buoy_melt=>NULL()    ! Buoyancy component of melting rate (kg/s/m^2) 
    33    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: eros_melt=>NULL()    ! Erosion component of melting rate (kg/s/m^2) 
    34    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: conv_melt=>NULL()    ! Convective component of melting rate (kg/s/m^2) 
    35    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: bits_src=>NULL()     ! Mass flux from berg erosion into bergy bits (kg/s/m^2) 
    36    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: bits_melt=>NULL()    ! Melting rate of bergy bits (kg/s/m^2) 
    37    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: bits_mass=>NULL()    ! Mass distribution of bergy bits (kg/s/m^2) 
    38    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: virtual_area=>NULL() ! Virtual surface coverage by icebergs (m^2) 
    39    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  :: berg_mass=>NULL()    ! Mass distribution (kg/m^2) 
    40    REAL(wp), DIMENSION(:,:,:), POINTER, PUBLIC  :: real_calving=>NULL() ! Calving rate into iceberg class at calving locations (kg/s) 
    41    REAL(wp), DIMENSION(:,:)  , POINTER, PRIVATE :: tmpc=>NULL()         ! Temporary work space 
    42    REAL(wp), DIMENSION(:)    , POINTER, PRIVATE :: rsumbuf=>NULL()      ! Temporary work space to reduce mpp exchanges 
    43    INTEGER , DIMENSION(:)    , POINTER, PRIVATE :: nsumbuf=>NULL()      ! Temporary work space to reduce mpp exchanges 
    44  
    45    REAL(wp)                           , PRIVATE ::  berg_melt_net 
    46    REAL(wp)                           , PRIVATE ::  bits_src_net 
    47    REAL(wp)                           , PRIVATE ::  bits_melt_net 
    48    REAL(wp)                           , PRIVATE ::  bits_mass_start, bits_mass_end 
    49    REAL(wp)                           , PRIVATE ::  floating_heat_start, floating_heat_end 
    50    REAL(wp)                           , PRIVATE ::  floating_mass_start, floating_mass_end 
    51    REAL(wp)                           , PRIVATE ::  bergs_mass_start, bergs_mass_end 
    52    REAL(wp)                           , PRIVATE ::  stored_start, stored_heat_start 
    53    REAL(wp)                           , PRIVATE ::  stored_end  , stored_heat_end 
    54    REAL(wp)                           , PRIVATE ::  calving_src_net, calving_out_net 
    55    REAL(wp)                           , PRIVATE ::  calving_src_heat_net, calving_out_heat_net 
    56    REAL(wp)                           , PRIVATE ::  calving_src_heat_used_net 
    57    REAL(wp)                           , PRIVATE ::  calving_rcv_net, calving_ret_net, calving_used_net 
    58    REAL(wp)                           , PRIVATE ::  heat_to_bergs_net, heat_to_ocean_net, melt_net 
    59    REAL(wp)                           , PRIVATE ::  calving_to_bergs_net 
    60  
    61    INTEGER                            , PRIVATE ::  nbergs_start, nbergs_end, nbergs_calved 
    62    INTEGER                            , PRIVATE ::  nbergs_melted 
    63    INTEGER                            , PRIVATE ::  nspeeding_tickets 
    64    INTEGER , DIMENSION(nclasses)      , PRIVATE ::  nbergs_calved_by_class 
    65  
    66    PUBLIC   icb_budget_end  ! routine called in icbrun.F90 module 
    67    PUBLIC   icb_budget_init ! routine called in icbini.F90 module 
    68    PUBLIC   icb_budget      ! routine called in icbrun.F90 module 
    69    PUBLIC   icb_budget_step ! routine called in icbrun.F90 module 
    70    PUBLIC   icb_budget_put  ! routine called in icbrun.F90 module 
    71    PUBLIC   melt_budget     ! routine called in icbthm.F90 module 
    72    PUBLIC   size_budget     ! routine called in icbthm.F90 module 
    73    PUBLIC   speed_budget    ! routine called in icbdyn.F90 module 
    74    PUBLIC   calving_budget  ! routine called in icbclv.F90 module 
    75    PUBLIC   incoming_budget ! routine called in icbclv.F90 module 
    76  
     30   PUBLIC   icb_budget_end    ! routine called in icbrun.F90 module 
     31   PUBLIC   icb_budget_init   ! routine called in icbini.F90 module 
     32   PUBLIC   icb_budget        ! routine called in icbrun.F90 module 
     33   PUBLIC   icb_budget_step   ! routine called in icbrun.F90 module 
     34   PUBLIC   icb_budget_put    ! routine called in icbrun.F90 module 
     35   PUBLIC   melt_budget       ! routine called in icbthm.F90 module 
     36   PUBLIC   size_budget       ! routine called in icbthm.F90 module 
     37   PUBLIC   speed_budget      ! routine called in icbdyn.F90 module 
     38   PUBLIC   calving_budget    ! routine called in icbclv.F90 module 
     39   PUBLIC   incoming_budget   ! routine called in icbclv.F90 module 
     40 
     41   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   berg_melt    => NULL()   ! Melting+erosion rate of icebergs     [kg/s/m2] 
     42   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   buoy_melt    => NULL()   ! Buoyancy component of melting rate   [kg/s/m2] 
     43   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   eros_melt    => NULL()   ! Erosion component of melting rate    [kg/s/m2] 
     44   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   conv_melt    => NULL()   ! Convective component of melting rate [kg/s/m2] 
     45   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   bits_src     => NULL()   ! Mass flux from berg erosion into bergy bits [kg/s/m2] 
     46   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   bits_melt    => NULL()   ! Melting rate of bergy bits           [kg/s/m2] 
     47   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   bits_mass    => NULL()   ! Mass distribution of bergy bits      [kg/s/m2] 
     48   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   virtual_area => NULL()   ! Virtual surface coverage by icebergs [m2] 
     49   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   berg_mass    => NULL()   ! Mass distribution                    [kg/m2] 
     50   REAL(wp), DIMENSION(:,:,:), POINTER, PUBLIC  ::   real_calving => NULL()   ! Calving rate into iceberg class at 
     51   !                                                                          ! calving locations                    [kg/s] 
     52    
     53   REAL(wp), DIMENSION(:,:)  , POINTER ::   tmpc         => NULL()   ! Temporary work space 
     54   REAL(wp), DIMENSION(:)    , POINTER ::   rsumbuf      => NULL()   ! Temporary work space to reduce mpp exchanges 
     55   INTEGER , DIMENSION(:)    , POINTER ::   nsumbuf      => NULL()   ! Temporary work space to reduce mpp exchanges 
     56 
     57   REAL(wp)                      ::  berg_melt_net 
     58   REAL(wp)                      ::  bits_src_net 
     59   REAL(wp)                      ::  bits_melt_net 
     60   REAL(wp)                      ::  bits_mass_start     , bits_mass_end 
     61   REAL(wp)                      ::  floating_heat_start , floating_heat_end 
     62   REAL(wp)                      ::  floating_mass_start , floating_mass_end 
     63   REAL(wp)                      ::  bergs_mass_start    , bergs_mass_end 
     64   REAL(wp)                      ::  stored_start        , stored_heat_start 
     65   REAL(wp)                      ::  stored_end          , stored_heat_end 
     66   REAL(wp)                      ::  calving_src_net     , calving_out_net 
     67   REAL(wp)                      ::  calving_src_heat_net, calving_out_heat_net 
     68   REAL(wp)                      ::  calving_src_heat_used_net 
     69   REAL(wp)                      ::  calving_rcv_net  , calving_ret_net  , calving_used_net 
     70   REAL(wp)                      ::  heat_to_bergs_net, heat_to_ocean_net, melt_net 
     71   REAL(wp)                      ::  calving_to_bergs_net 
     72 
     73   INTEGER                       ::  nbergs_start, nbergs_end, nbergs_calved 
     74   INTEGER                       ::  nbergs_melted 
     75   INTEGER                       ::  nspeeding_tickets 
     76   INTEGER , DIMENSION(nclasses) ::  nbergs_calved_by_class 
     77 
     78   !!---------------------------------------------------------------------- 
     79   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
     80   !! $Id:$ 
     81   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     82   !!---------------------------------------------------------------------- 
    7783CONTAINS 
    7884 
    79    !!------------------------------------------------------------------------- 
    80  
    8185   SUBROUTINE icb_budget_end 
    82  
    83       IF( .NOT. ln_bergdia ) RETURN 
     86      !!---------------------------------------------------------------------- 
     87      ! 
     88      IF( .NOT. ln_bergdia )   RETURN 
    8489      DEALLOCATE( berg_melt ) 
    8590      DEALLOCATE( buoy_melt ) 
    … …  
    97102         DEALLOCATE( nsumbuf ) 
    98103      ENDIF 
    99  
     104      ! 
    100105   END SUBROUTINE icb_budget_end 
    101106 
    … …  
    103108 
    104109   SUBROUTINE icb_budget_init( ) 
    105  
     110      !!---------------------------------------------------------------------- 
     111      !!---------------------------------------------------------------------- 
     112      ! 
    106113      IF( .NOT. ln_bergdia ) RETURN 
    107       ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt    (:,:) = 0._wp 
    108       ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt    (:,:) = 0._wp 
    109       ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt    (:,:) = 0._wp 
    110       ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt    (:,:) = 0._wp 
    111       ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:) = 0._wp 
    112       ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:) = 0._wp 
    113       ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:) = 0._wp 
    114       ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area (:,:) = 0._wp 
    115       ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass    (:,:) = 0._wp 
    116       ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving (:,:,:)=0. 
    117       ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc(:,:)=0. 
     114      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)  = 0._wp 
     115      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)  = 0._wp 
     116      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)  = 0._wp 
     117      ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt   (:,:)  = 0._wp 
     118      ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:)   = 0._wp 
     119      ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:)   = 0._wp 
     120      ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:)   = 0._wp 
     121      ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area(:,:)  = 0._wp 
     122      ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass   (:,:)  = 0._wp 
     123      ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving(:,:,:) = 0._wp 
     124      ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc        (:,:)   = 0._wp 
    118125 
    119126      nbergs_start              = 0 
    … …  
    167174         bits_mass_start = rsumbuf(3) 
    168175      ENDIF 
    169  
     176      ! 
    170177   END SUBROUTINE icb_budget_init 
    171178 
    172    !!------------------------------------------------------------------------- 
    173179 
    174180   SUBROUTINE icb_budget( ld_budge ) 
    175       ! Arguments 
    176       LOGICAL, INTENT(in)             ::   ld_budge 
    177       ! Local variables 
    178       INTEGER                         ::   ik 
    179       REAL(wp)                        ::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass 
    180  
    181       IF( .NOT. ln_bergdia ) RETURN 
    182  
    183       zunused_calving           = SUM( berg_grid%calving(:,:) ) 
    184       ztmpsum                   = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
    185       melt_net                  = melt_net + ztmpsum * berg_dt 
    186       calving_out_net           = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt 
    187       ztmpsum                   = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
    188       berg_melt_net             = berg_melt_net + ztmpsum * berg_dt 
    189       ztmpsum                   = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
    190       bits_src_net              = bits_src_net + ztmpsum * berg_dt 
    191       ztmpsum                   = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
    192       bits_melt_net             = bits_melt_net + ztmpsum * berg_dt 
    193       ztmpsum                   = SUM( src_calving(:,:) * tmask_i(:,:) ) 
    194       calving_ret_net           = calving_ret_net + ztmpsum * berg_dt 
    195       ztmpsum                   = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
    196       calving_out_heat_net      = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J 
     181      !!---------------------------------------------------------------------- 
     182      !!---------------------------------------------------------------------- 
     183      LOGICAL, INTENT(in) ::   ld_budge 
     184      ! 
     185      INTEGER             ::   ik 
     186      REAL(wp)            ::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass 
     187      !!---------------------------------------------------------------------- 
     188      ! 
     189      IF( .NOT. ln_bergdia )   RETURN 
     190 
     191      zunused_calving      = SUM( berg_grid%calving(:,:) ) 
     192      ztmpsum              = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
     193      melt_net             = melt_net + ztmpsum * berg_dt 
     194      calving_out_net      = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt 
     195      ztmpsum              = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
     196      berg_melt_net        = berg_melt_net + ztmpsum * berg_dt 
     197      ztmpsum              = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
     198      bits_src_net         = bits_src_net + ztmpsum * berg_dt 
     199      ztmpsum              = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
     200      bits_melt_net        = bits_melt_net + ztmpsum * berg_dt 
     201      ztmpsum              = SUM( src_calving(:,:) * tmask_i(:,:) ) 
     202      calving_ret_net      = calving_ret_net + ztmpsum * berg_dt 
     203      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) ) 
     204      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J 
    197205 
    198206      IF( ld_budge ) THEN 
    199          stored_end             = SUM( berg_grid%stored_ice(:,:,:) ) 
    200          stored_heat_end        = SUM( berg_grid%stored_heat(:,:) ) 
    201          floating_mass_end      = sum_mass( first_berg ) 
    202          bergs_mass_end         = sum_mass( first_berg,justbergs=.true. ) 
    203          bits_mass_end          = sum_mass( first_berg,justbits=.true. ) 
    204          floating_heat_end      = sum_heat( first_berg ) 
    205  
    206          nbergs_end             = count_bergs() 
    207          zgrdd_berg_mass        = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    208          zgrdd_bits_mass        = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
     207         stored_end        = SUM( berg_grid%stored_ice(:,:,:) ) 
     208         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) ) 
     209         floating_mass_end = sum_mass( first_berg ) 
     210         bergs_mass_end    = sum_mass( first_berg,justbergs=.true. ) 
     211         bits_mass_end     = sum_mass( first_berg,justbits=.true. ) 
     212         floating_heat_end = sum_heat( first_berg ) 
     213 
     214         nbergs_end        = count_bergs() 
     215         zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
     216         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    209217 
    210218         IF( lk_mpp ) THEN 
    … …  
    263271            nsumbuf(3) = nbergs_melted 
    264272            nsumbuf(4) = nspeeding_tickets 
    265             DO ik = 1,nclasses 
     273            DO ik = 1, nclasses 
    266274               nsumbuf(4+ik) = nbergs_calved_by_class(ik) 
    267             ENDDO 
     275            END DO 
    268276 
    269277            CALL mpp_sum( nsumbuf(1:nclasses+4), nclasses+4 ) 
    … …  
    355363         bits_src_net              = 0._wp 
    356364      ENDIF 
    357  
     365      ! 
    358366   END SUBROUTINE icb_budget 
    359367 
    360    !!------------------------------------------------------------------------- 
    361368 
    362369   SUBROUTINE icb_budget_step 
     370      !!---------------------------------------------------------------------- 
    363371      !! things to reset at the beginning of each timestep 
    364372      !! this probably screws up fields going to diawri, so needs to be looked at - sga 
    365  
     373      !!---------------------------------------------------------------------- 
     374      ! 
    366375      IF( .NOT. ln_bergdia ) RETURN 
    367376      berg_melt    (:,:)   = 0._wp 
    … …  
    375384      virtual_area (:,:)   = 0._wp 
    376385      real_calving (:,:,:) = 0._wp 
    377  
     386      ! 
    378387   END SUBROUTINE icb_budget_step 
    379388 
    380    !!------------------------------------------------------------------------- 
    381389 
    382390   SUBROUTINE icb_budget_put 
    383  
    384       IF( .NOT. ln_bergdia ) RETURN 
    385       CALL iom_put( "berg_melt"         , berg_melt    (:,:)   )  ! 'Melt rate of icebergs'                    , 'kg/m2/s' 
    386       CALL iom_put( "berg_buoy_melt"    , buoy_melt    (:,:)   )  ! 'Buoyancy component of iceberg melt rate'  , 'kg/m2/s' 
    387       CALL iom_put( "berg_eros_melt"    , eros_melt    (:,:)   )  ! 'Erosion component of iceberg melt rate'   , 'kg/m2/s' 
    388       CALL iom_put( "berg_conv_melt"    , conv_melt    (:,:)   )  ! 'Convective component of iceberg melt rate', 'kg/m2/s' 
    389       CALL iom_put( "berg_virtual_area" , virtual_area (:,:)   )  ! 'Virtual coverage by icebergs'             , 'm2' 
    390       CALL iom_put( "bits_src"         , bits_src    (:,:)   )    ! 'Mass source of bergy bits'                , 'kg/m2/s' 
    391       CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )    ! 'Melt rate of bergy bits'                  , 'kg/m2/s' 
    392       CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )    ! 'Bergy bit density field'                  , 'kg/m2' 
    393       CALL iom_put( "berg_mass"         , berg_mass    (:,:)   )  ! 'Iceberg density field'                    , 'kg/m2' 
    394       CALL iom_put( "berg_real_calving" , real_calving (:,:,:) )  ! 'Calving into iceberg class'               , 'kg/s' 
    395  
     391      !!---------------------------------------------------------------------- 
     392      !!---------------------------------------------------------------------- 
     393      ! 
     394      IF( .NOT. ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not 
     395      ! 
     396      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s] 
     397      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s] 
     398      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s] 
     399      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s] 
     400      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2] 
     401      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s] 
     402      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s] 
     403      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2] 
     404      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2] 
     405      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s] 
     406      ! 
    396407   END SUBROUTINE icb_budget_put 
    397408 
    398    !!------------------------------------------------------------------------- 
    399409 
    400410   SUBROUTINE calving_budget( ki, kj, kn, pcalved, pheated ) 
     411      !!---------------------------------------------------------------------- 
     412      !!---------------------------------------------------------------------- 
    401413      INTEGER,  INTENT(in)  ::   ki, kj, kn 
    402414      REAL(wp), INTENT(in)  ::   pcalved 
    403415      REAL(wp), INTENT(in)  ::   pheated 
    404  
     416      !!---------------------------------------------------------------------- 
     417      ! 
    405418      IF( .NOT. ln_bergdia ) RETURN 
    406419      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt 
    … …  
    409422      calving_to_bergs_net       = calving_to_bergs_net + pcalved 
    410423      heat_to_bergs_net          = heat_to_bergs_net    + pheated 
    411  
     424      ! 
    412425   END SUBROUTINE calving_budget 
    413426 
    414    !!------------------------------------------------------------------------- 
    415427 
    416428   SUBROUTINE incoming_budget( kt,  pcalving_used, pheat_used ) 
     429      !!---------------------------------------------------------------------- 
     430      !!---------------------------------------------------------------------- 
    417431      INTEGER ,                 INTENT(in)  :: kt 
    418432      REAL(wp),                 INTENT(in)  :: pcalving_used 
    419433      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used 
    420  
     434      !!---------------------------------------------------------------------- 
     435      ! 
    421436      IF( .NOT. ln_bergdia ) RETURN 
    422  
     437      ! 
    423438      IF( kt == nit000 ) THEN 
    424439         stored_start = SUM( berg_grid%stored_ice(:,:,:) ) 
    425440         IF( lk_mpp ) CALL mpp_sum( stored_start ) 
    426441         WRITE(numicb,'(a,es13.6,a)')   'accumulate_calving: initial stored mass=',stored_start,' kg' 
    427  
     442         ! 
    428443         stored_heat_start = SUM( berg_grid%stored_heat(:,:) ) 
    429444         IF( lk_mpp ) CALL mpp_sum( stored_heat_start ) 
    430445         WRITE(numicb,'(a,es13.6,a)')    'accumulate_calving: initial stored heat=',stored_heat_start,' J' 
    431446      ENDIF 
    432  
     447      ! 
    433448      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt 
    434449      calving_src_net = calving_rcv_net 
    435450      calving_src_heat_net = calving_src_heat_net +  & 
    436                                   SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J 
     451         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J 
    437452      calving_used_net = calving_used_net + pcalving_used * berg_dt 
    438453      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) ) 
    439  
     454      ! 
    440455   END SUBROUTINE incoming_budget 
    441456 
    442    !!------------------------------------------------------------------------- 
    443457 
    444458   SUBROUTINE size_budget(ki, kj, pWn, pLn, pAbits,   & 
    445459      &                   pmass_scale, pMnew, pnMbits, pz1_e1e2) 
    446       INTEGER,  INTENT(in)           :: ki, kj 
    447       REAL(wp), INTENT(in)           :: pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2 
    448  
     460      !!---------------------------------------------------------------------- 
     461      !!---------------------------------------------------------------------- 
     462      INTEGER,  INTENT(in) :: ki, kj 
     463      REAL(wp), INTENT(in) :: pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2 
     464      !!---------------------------------------------------------------------- 
     465      ! 
    449466      IF( .NOT. ln_bergdia ) RETURN 
    450467      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2 
    451468      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2 
    452469      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2 
    453  
     470      ! 
    454471   END SUBROUTINE size_budget 
    455472 
    456    !!------------------------------------------------------------------------- 
    457473 
    458474   SUBROUTINE speed_budget() 
    459  
     475      !!---------------------------------------------------------------------- 
     476      !!---------------------------------------------------------------------- 
     477      ! 
    460478      IF( .NOT. ln_bergdia ) RETURN 
    461479      nspeeding_tickets = nspeeding_tickets + 1 
    462  
     480      ! 
    463481   END SUBROUTINE speed_budget 
    464482 
    465    !!------------------------------------------------------------------------- 
    466483 
    467484   SUBROUTINE melt_budget(ki, kj, pmnew, pheat, pmass_scale,   & 
    468485      &                   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   & 
    469       &                   pdMv, pz1_dt_e1e2) 
    470  
    471       INTEGER               ::  ki, kj 
    472       REAL(wp), INTENT(in)  ::  pmnew, pheat, pmass_scale 
    473       REAL(wp), INTENT(in)  ::  pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2 
    474  
     486      &                   pdMv, pz1_dt_e1e2 ) 
     487      !!---------------------------------------------------------------------- 
     488      !!---------------------------------------------------------------------- 
     489      INTEGER , INTENT(in) ::   ki, kj 
     490      REAL(wp), INTENT(in) ::   pmnew, pheat, pmass_scale 
     491      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2 
     492      !!---------------------------------------------------------------------- 
     493      ! 
    475494      IF( .NOT. ln_bergdia ) RETURN 
    476495 
    … …  
    483502      heat_to_ocean_net = heat_to_ocean_net + pheat * pmass_scale * berg_dt         ! J 
    484503      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted 
    485  
     504      ! 
    486505   END SUBROUTINE melt_budget 
    487506 
    488    !!------------------------------------------------------------------------- 
    489507 
    490508   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   & 
    491509      &                     pendval, cd_delstr, kbergs ) 
    492       ! Arguments 
     510      !!---------------------------------------------------------------------- 
     511      !!---------------------------------------------------------------------- 
    493512      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr 
    494513      REAL(wp),      INTENT(in)           :: pstartval, pendval 
    495514      INTEGER,       INTENT(in), OPTIONAL :: kbergs 
    496  
     515      !!---------------------------------------------------------------------- 
     516      ! 
    497517      IF ( PRESENT(kbergs) ) THEN 
    498518         WRITE(numicb,100) cd_budgetstr // ' state:',                                    & 
    … …  
    510530   END SUBROUTINE report_state 
    511531 
    512    !!------------------------------------------------------------------------- 
    513532 
    514533   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval) 
    515       ! Arguments 
     534      !!---------------------------------------------------------------------- 
     535      !!---------------------------------------------------------------------- 
    516536      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr 
    517537      REAL(wp),      INTENT(in) :: pstartval, pendval 
    518  
     538      !!---------------------------------------------------------------------- 
     539      ! 
    519540      WRITE(numicb,200) cd_budgetstr // ' check:',                 & 
    520541                        cd_startstr,    pstartval, cd_budgetunits, & 
    … …  
    524545   END SUBROUTINE report_consistant 
    525546 
    526    !!------------------------------------------------------------------------- 
    527547 
    528548   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   & 
    529549      &                      poutval, cd_delstr, pstartval, pendval) 
    530       ! Arguments 
     550      !!---------------------------------------------------------------------- 
     551      !!---------------------------------------------------------------------- 
    531552      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr 
    532553      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval 
    533       ! Local variables 
     554      ! 
    534555      REAL(wp)                  :: zval 
    535  
     556      !!---------------------------------------------------------------------- 
     557      ! 
    536558      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   & 
    537              MAX( 1.e-30, MAX( abs( pendval - pstartval ) , ABS( pinval - poutval ) ) ) 
     559         &   MAX( 1.e-30, MAX( abs( pendval - pstartval ) , ABS( pinval - poutval ) ) ) 
    538560 
    539561      WRITE(numicb,200) cd_budgetstr // ' budget:', & 
    540                         cd_instr     // ' in',      pinval,         cd_budgetunits, & 
    541                         cd_outstr    // ' out',     poutval,        cd_budgetunits, & 
    542                         'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, & 
    543                         'error',        zval,                       'nd' 
    544       200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2) 
     562         &              cd_instr     // ' in',      pinval,         cd_budgetunits, & 
     563         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, & 
     564         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, & 
     565         &              'error',        zval,                       'nd' 
     566  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2) 
     567      ! 
    545568   END SUBROUTINE report_budget 
    546569 
    547    !!------------------------------------------------------------------------- 
    548570 
    549571   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr) 
    550       ! Arguments 
     572      !!---------------------------------------------------------------------- 
     573      !!---------------------------------------------------------------------- 
    551574      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_startstr, cd_endstr, cd_delstr 
    552575      INTEGER,       INTENT(in) :: pstartval, pendval 
    553  
     576      ! 
    554577      WRITE(numicb,100) cd_budgetstr // ' state:',           & 
    555                         cd_startstr  // ' start', pstartval, & 
    556                         cd_endstr    // ' end',   pendval,   & 
    557                         cd_delstr    // 'Delta',  pendval-pstartval 
    558       100 FORMAT(a19,3(a18,"=",i14,x,:,",")) 
     578         &              cd_startstr  // ' start', pstartval, & 
     579         &              cd_endstr    // ' end',   pendval,   & 
     580         &              cd_delstr    // 'Delta',  pendval-pstartval 
     581  100 FORMAT(a19,3(a18,"=",i14,x,:,",")) 
     582      ! 
    559583   END SUBROUTINE report_istate 
    560584 
    561    !!------------------------------------------------------------------------- 
    562585 
    563586   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   & 
    564587      &                       cd_delstr, pstartval, pendval) 
    565       ! Arguments 
     588      !!---------------------------------------------------------------------- 
     589      !!---------------------------------------------------------------------- 
    566590      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr 
    567591      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval 
    568  
     592      !!---------------------------------------------------------------------- 
     593      ! 
    569594      WRITE(numicb,200) cd_budgetstr // ' budget:', & 
    570595                        cd_instr     // ' in',      pinval, & 
    … …  
    574599      200 FORMAT(a19,10(a18,"=",i14,x,:,",")) 
    575600   END SUBROUTINE report_ibudget 
    576    !!------------------------------------------------------------------------- 
    577  
     601 
     602   !!====================================================================== 
    578603END MODULE icbdia 
Note: See TracChangeset for help on using the changeset viewer.