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.
icbdia.F90 in NEMO/branches/2021/ticket2581_trunk_icb_speeding_ticket/src/OCE/ICB – NEMO

source: NEMO/branches/2021/ticket2581_trunk_icb_speeding_ticket/src/OCE/ICB/icbdia.F90 @ 14382

Last change on this file since 14382 was 14382, checked in by mathiot, 3 years ago

ticket #2581: implement change made in v4 to trunk version

  • Property svn:keywords set to Id
File size: 33.2 KB
Line 
1MODULE icbdia
2   !!======================================================================
3   !!                       ***  MODULE  icbdia  ***
4   !! Icebergs:  initialise variables for iceberg budgets and diagnostics
5   !!======================================================================
6   !! History : 3.3 !  2010-01  (Martin, Adcroft) Original code
7   !!            -  !  2011-03  (Madec)          Part conversion to NEMO form
8   !!            -  !                            Removal of mapping from another grid
9   !!            -  !  2011-04  (Alderson)       Split into separate modules
10   !!            -  !  2011-05  (Alderson)       Budgets are now all here with lots
11   !!            -  !                            of silly routines to call to get values in
12   !!            -  !                            from the right points in the code
13   !!----------------------------------------------------------------------
14 
15   !!----------------------------------------------------------------------
16   !!   icb_dia_init  : initialise iceberg budgeting
17   !!   icb_dia       : global iceberg diagnostics
18   !!   icb_dia_step  : reset at the beginning of each timestep
19   !!   icb_dia_put   : output (via iom_put) iceberg fields
20   !!   icb_dia_calve :
21   !!   icb_dia_income:
22   !!   icb_dia_size  :
23   !!   icb_dia_speed :
24   !!   icb_dia_melt  :
25   !!   report_state  :
26   !!   report_consistant :
27   !!   report_budget :
28   !!   report_istate :
29   !!   report_ibudget:
30   !!----------------------------------------------------------------------
31   USE par_oce        ! ocean parameters
32   USE dom_oce        ! ocean domain
33   USE in_out_manager ! nemo IO
34   USE lib_mpp        ! MPP library
35   USE iom            ! I/O library
36   USE icb_oce        ! iceberg variables
37   USE icbutl         ! iceberg utility routines
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   icb_dia_init      ! routine called in icbini.F90 module
43   PUBLIC   icb_dia           ! routine called in icbstp.F90 module
44   PUBLIC   icb_dia_step      ! routine called in icbstp.F90 module
45   PUBLIC   icb_dia_put       ! routine called in icbstp.F90 module
46   PUBLIC   icb_dia_melt      ! routine called in icbthm.F90 module
47   PUBLIC   icb_dia_size      ! routine called in icbthm.F90 module
48   PUBLIC   icb_dia_speed     ! routine called in icbdyn.F90 module
49   PUBLIC   icb_dia_calve     ! routine called in icbclv.F90 module
50   PUBLIC   icb_dia_income    ! routine called in icbclv.F90 module
51
52   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]
55   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   buoy_melt       ! Buoyancy component of melting rate   [kg/s/m2]
56   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   eros_melt       ! Erosion component of melting rate    [kg/s/m2]
57   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   conv_melt       ! Convective component of melting rate [kg/s/m2]
58   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_src        ! Mass flux from berg erosion into bergy bits [kg/s/m2]
59   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_melt       ! Melting rate of bergy bits           [kg/s/m2]
60   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_mass       ! Mass distribution of bergy bits      [kg/s/m2]
61   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   virtual_area    ! Virtual surface coverage by icebergs [m2]
62   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_mass       ! Mass distribution                    [kg/m2]
63   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PUBLIC  ::   real_calving    ! Calving rate into iceberg class at
64   !                                                                          ! calving locations                    [kg/s]
65   
66   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmpc                     ! Temporary work space
67   REAL(wp), DIMENSION(:)    , ALLOCATABLE ::   rsumbuf                  ! Temporary work space to reduce mpp exchanges
68   INTEGER , DIMENSION(:)    , ALLOCATABLE ::   nsumbuf                  ! Temporary work space to reduce mpp exchanges
69
70   REAL(wp)                      ::  berg_melt_net
71   REAL(wp)                      ::  bits_src_net
72   REAL(wp)                      ::  bits_melt_net
73   REAL(wp)                      ::  bits_mass_start     , bits_mass_end
74   REAL(wp)                      ::  floating_heat_start , floating_heat_end
75   REAL(wp)                      ::  floating_mass_start , floating_mass_end
76   REAL(wp)                      ::  bergs_mass_start    , bergs_mass_end
77   REAL(wp)                      ::  stored_start        , stored_heat_start
78   REAL(wp)                      ::  stored_end          , stored_heat_end
79   REAL(wp)                      ::  calving_src_net     , calving_out_net
80   REAL(wp)                      ::  calving_src_heat_net, calving_out_heat_net
81   REAL(wp)                      ::  calving_src_heat_used_net
82   REAL(wp)                      ::  calving_rcv_net  , calving_ret_net  , calving_used_net
83   REAL(wp)                      ::  heat_to_bergs_net, heat_to_ocean_net, melt_net
84   REAL(wp)                      ::  calving_to_bergs_net
85
86   INTEGER                       ::  nbergs_start, nbergs_end, nbergs_calved
87   INTEGER                       ::  nbergs_melted
88   INTEGER                       ::  nspeeding_tickets, nspeeding_tickets_all
89   INTEGER , DIMENSION(nclasses) ::  nbergs_calved_by_class
90
91   !!----------------------------------------------------------------------
92   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
93   !! $Id$
94   !! Software governed by the CeCILL license (see ./LICENSE)
95   !!----------------------------------------------------------------------
96CONTAINS
97
98   SUBROUTINE icb_dia_init( )
99      !!----------------------------------------------------------------------
100      !!----------------------------------------------------------------------
101      !
102      IF( .NOT.ln_bergdia )   RETURN
103
104      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
107      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)   = 0._wp
108      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)   = 0._wp
109      ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt   (:,:)   = 0._wp
110      ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:)   = 0._wp
111      ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:)   = 0._wp
112      ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:)   = 0._wp
113      ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area(:,:)   = 0._wp
114      ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass   (:,:)   = 0._wp
115      ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving(:,:,:) = 0._wp
116      ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc        (:,:)   = 0._wp
117
118      nbergs_start              = 0
119      nbergs_end                = 0
120      stored_end                = 0._wp
121      nbergs_start              = 0._wp
122      stored_start              = 0._wp
123      nbergs_melted             = 0
124      nbergs_calved             = 0
125      nbergs_calved_by_class(:) = 0
126      nspeeding_tickets         = 0
127      nspeeding_tickets_all     = 0
128      stored_heat_end           = 0._wp
129      floating_heat_end         = 0._wp
130      floating_mass_end         = 0._wp
131      bergs_mass_end            = 0._wp
132      bits_mass_end             = 0._wp
133      stored_heat_start         = 0._wp
134      floating_heat_start       = 0._wp
135      floating_mass_start       = 0._wp
136      bergs_mass_start          = 0._wp
137      bits_mass_start           = 0._wp
138      bits_mass_end             = 0._wp
139      calving_used_net          = 0._wp
140      calving_to_bergs_net      = 0._wp
141      heat_to_bergs_net         = 0._wp
142      heat_to_ocean_net         = 0._wp
143      calving_rcv_net           = 0._wp
144      calving_ret_net           = 0._wp
145      calving_src_net           = 0._wp
146      calving_out_net           = 0._wp
147      calving_src_heat_net      = 0._wp
148      calving_src_heat_used_net = 0._wp
149      calving_out_heat_net      = 0._wp
150      melt_net                  = 0._wp
151      berg_melt_net             = 0._wp
152      bits_melt_net             = 0._wp
153      bits_src_net              = 0._wp
154
155      floating_mass_start       = icb_utl_mass( first_berg )
156      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.TRUE. )
157      bits_mass_start           = icb_utl_mass( first_berg, justbits =.TRUE. )
158      IF( lk_mpp ) THEN
159         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp
160         ALLOCATE( nsumbuf(4+nclasses) )  ; nsumbuf(:) = 0
161         rsumbuf(1) = floating_mass_start
162         rsumbuf(2) = bergs_mass_start
163         rsumbuf(3) = bits_mass_start
164         CALL mpp_sum( 'icbdia', rsumbuf(1:3), 3 )
165         floating_mass_start = rsumbuf(1)
166         bergs_mass_start = rsumbuf(2)
167         bits_mass_start = rsumbuf(3)
168      ENDIF
169      !
170   END SUBROUTINE icb_dia_init
171
172
173   SUBROUTINE icb_dia( ld_budge )
174      !!----------------------------------------------------------------------
175      !! sum all the things we've accumulated so far in the current processor
176      !! in MPP case then add these sums across all processors
177      !! for this we pack variables into buffer so we only need one mpp_sum
178      !!----------------------------------------------------------------------
179      LOGICAL, INTENT(in) ::   ld_budge   !
180      !
181      INTEGER ::   ik
182      REAL(wp)::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass
183      !!----------------------------------------------------------------------
184      !
185      IF( .NOT.ln_bergdia )   RETURN
186
187      zunused_calving      = SUM( berg_grid%calving(:,:) )
188      ztmpsum              = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
189      melt_net             = melt_net + ztmpsum * berg_dt
190      calving_out_net      = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt
191      ztmpsum              = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
192      berg_melt_net        = berg_melt_net + ztmpsum * berg_dt
193      ztmpsum              = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) )
194      bits_src_net         = bits_src_net + ztmpsum * berg_dt
195      ztmpsum              = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
196      bits_melt_net        = bits_melt_net + ztmpsum * berg_dt
197      ztmpsum              = SUM( src_calving(:,:) * tmask_i(:,:) )
198      calving_ret_net      = calving_ret_net + ztmpsum * berg_dt
199      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) )
200      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J
201      !
202      IF( ld_budge ) THEN
203         stored_end        = SUM( berg_grid%stored_ice(:,:,:) )
204         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) )
205         floating_mass_end = icb_utl_mass( first_berg )
206         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.TRUE. )
207         bits_mass_end     = icb_utl_mass( first_berg,justbits =.TRUE. )
208         floating_heat_end = icb_utl_heat( first_berg )
209         !
210         nbergs_end        = icb_utl_count()
211         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
212         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
213         !
214         IF( lk_mpp ) THEN
215            rsumbuf( 1) = stored_end
216            rsumbuf( 2) = stored_heat_end
217            rsumbuf( 3) = floating_mass_end
218            rsumbuf( 4) = bergs_mass_end
219            rsumbuf( 5) = bits_mass_end
220            rsumbuf( 6) = floating_heat_end
221            rsumbuf( 7) = calving_ret_net
222            rsumbuf( 8) = calving_out_net
223            rsumbuf( 9) = calving_rcv_net
224            rsumbuf(10) = calving_src_net
225            rsumbuf(11) = calving_src_heat_net
226            rsumbuf(12) = calving_src_heat_used_net
227            rsumbuf(13) = calving_out_heat_net
228            rsumbuf(14) = calving_used_net
229            rsumbuf(15) = calving_to_bergs_net
230            rsumbuf(16) = heat_to_bergs_net
231            rsumbuf(17) = heat_to_ocean_net
232            rsumbuf(18) = melt_net
233            rsumbuf(19) = berg_melt_net
234            rsumbuf(20) = bits_src_net
235            rsumbuf(21) = bits_melt_net
236            rsumbuf(22) = zgrdd_berg_mass
237            rsumbuf(23) = zgrdd_bits_mass
238            !
239            CALL mpp_sum( 'icbdia', rsumbuf(1:23), 23)
240            !
241            stored_end                = rsumbuf( 1)
242            stored_heat_end           = rsumbuf( 2)
243            floating_mass_end         = rsumbuf( 3)
244            bergs_mass_end            = rsumbuf( 4)
245            bits_mass_end             = rsumbuf( 5)
246            floating_heat_end         = rsumbuf( 6)
247            calving_ret_net           = rsumbuf( 7)
248            calving_out_net           = rsumbuf( 8)
249            calving_rcv_net           = rsumbuf( 9)
250            calving_src_net           = rsumbuf(10)
251            calving_src_heat_net      = rsumbuf(11)
252            calving_src_heat_used_net = rsumbuf(12)
253            calving_out_heat_net      = rsumbuf(13)
254            calving_used_net          = rsumbuf(14)
255            calving_to_bergs_net      = rsumbuf(15)
256            heat_to_bergs_net         = rsumbuf(16)
257            heat_to_ocean_net         = rsumbuf(17)
258            melt_net                  = rsumbuf(18)
259            berg_melt_net             = rsumbuf(19)
260            bits_src_net              = rsumbuf(20)
261            bits_melt_net             = rsumbuf(21)
262            zgrdd_berg_mass           = rsumbuf(22)
263            zgrdd_bits_mass           = rsumbuf(23)
264            !
265            nsumbuf(1) = nbergs_end
266            nsumbuf(2) = nbergs_calved
267            nsumbuf(3) = nbergs_melted
268            nsumbuf(4) = nspeeding_tickets
269            DO ik = 1, nclasses
270               nsumbuf(4+ik) = nbergs_calved_by_class(ik)
271            END DO
272            CALL mpp_sum( 'icbdia', nsumbuf(1:nclasses+4), nclasses+4 )
273            !
274            nbergs_end            = nsumbuf(1)
275            nbergs_calved         = nsumbuf(2)
276            nbergs_melted         = nsumbuf(3)
277            nspeeding_tickets_all = nsumbuf(4)
278            DO ik = 1,nclasses
279               nbergs_calved_by_class(ik)= nsumbuf(4+ik)
280            END DO
281            !
282         ENDIF
283         !
284         CALL report_state  ( 'stored ice','kg','',stored_start,'',stored_end,'')
285         CALL report_state  ( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end )
286         CALL report_state  ( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'')
287         CALL report_state  ( 'bits','kg','',bits_mass_start,'',bits_mass_end,'')
288         CALL report_istate ( 'berg #','',nbergs_start,'',nbergs_end,'')
289         CALL report_ibudget( 'berg #','calved',nbergs_calved, &
290            &                          'melted',nbergs_melted, &
291            &                          '#',nbergs_start,nbergs_end)
292         CALL report_budget( 'stored mass','kg','calving used',calving_used_net, &
293            &                              'bergs',calving_to_bergs_net, &
294            &                              'stored mass',stored_start,stored_end)
295         CALL report_budget( 'floating mass','kg','calving used',calving_to_bergs_net, &
296            &                                'bergs',melt_net, &
297            &                                'stored mass',floating_mass_start,floating_mass_end)
298         CALL report_budget( 'berg mass','kg','calving',calving_to_bergs_net, &
299            &                                 'melt+eros',berg_melt_net, &
300            &                                 'berg mass',bergs_mass_start,bergs_mass_end)
301         CALL report_budget( 'bits mass','kg','eros used',bits_src_net, &
302            &                                 'bergs',bits_melt_net, &
303            &                                 'stored mass',bits_mass_start,bits_mass_end)
304         CALL report_budget( 'net mass','kg','recvd',calving_rcv_net, &
305            &                                'rtrnd',calving_ret_net, &
306            &                                'net mass',stored_start+floating_mass_start, &
307            &                                           stored_end+floating_mass_end)
308         CALL report_consistant( 'iceberg mass','kg','gridded',zgrdd_berg_mass,'bergs',bergs_mass_end)
309         CALL report_consistant( 'bits mass','kg','gridded',zgrdd_bits_mass,'bits',bits_mass_end)
310         CALL report_state( 'net heat','J','',stored_heat_start+floating_heat_start,'', &
311            &                                 stored_heat_end+floating_heat_end,'')
312         CALL report_state( 'stored heat','J','',stored_heat_start,'',stored_heat_end,'')
313         CALL report_state( 'floating heat','J','',floating_heat_start,'',floating_heat_end,'')
314         CALL report_budget( 'net heat','J','net heat',calving_src_heat_net, &
315            &                               'net heat',calving_out_heat_net, &
316            &                               'net heat',stored_heat_start+floating_heat_start, &
317            &                                          stored_heat_end+floating_heat_end)
318         CALL report_budget( 'stored heat','J','calving used',calving_src_heat_used_net, &
319            &                                  'bergs',heat_to_bergs_net, &
320            &                                  'net heat',stored_heat_start,stored_heat_end)
321         CALL report_budget( 'flting heat','J','calved',heat_to_bergs_net, &
322            &                                  'melt',heat_to_ocean_net, &
323            &                                  'net heat',floating_heat_start,floating_heat_end)
324         IF (nn_verbose_level >= 1) THEN
325            CALL report_consistant( 'top interface','kg','from SIS',calving_src_net, &
326               &                    'received',calving_rcv_net)
327            CALL report_consistant( 'bot interface','kg','sent',calving_out_net, &
328               &                    'returned',calving_ret_net)
329         ENDIF
330         IF (nn_verbose_level > 0) THEN
331            WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
332            IF( nspeeding_tickets_all > 0 ) THEN
333                WRITE( numicb, '("speeding tickets issued (this domain)  = ",i6)') nspeeding_tickets
334                WRITE( numicb, '("speeding tickets issued (all domains)  = ",i6)') nspeeding_tickets_all
335            END IF
336         ENDIF
337         !
338         nbergs_start              = nbergs_end
339         stored_start              = stored_end
340         nbergs_melted             = 0
341         nbergs_calved             = 0
342         nbergs_calved_by_class(:) = 0
343         nspeeding_tickets         = 0
344         nspeeding_tickets_all     = 0
345         stored_heat_start         = stored_heat_end
346         floating_heat_start       = floating_heat_end
347         floating_mass_start       = floating_mass_end
348         bergs_mass_start          = bergs_mass_end
349         bits_mass_start           = bits_mass_end
350         calving_used_net          = 0._wp
351         calving_to_bergs_net      = 0._wp
352         heat_to_bergs_net         = 0._wp
353         heat_to_ocean_net         = 0._wp
354         calving_rcv_net           = 0._wp
355         calving_ret_net           = 0._wp
356         calving_src_net           = 0._wp
357         calving_out_net           = 0._wp
358         calving_src_heat_net      = 0._wp
359         calving_src_heat_used_net = 0._wp
360         calving_out_heat_net      = 0._wp
361         melt_net                  = 0._wp
362         berg_melt_net             = 0._wp
363         bits_melt_net             = 0._wp
364         bits_src_net              = 0._wp
365      ENDIF
366      !
367   END SUBROUTINE icb_dia
368
369
370   SUBROUTINE icb_dia_step
371      !!----------------------------------------------------------------------
372      !! things to reset at the beginning of each timestep
373      !!----------------------------------------------------------------------
374      !
375      IF( .NOT.ln_bergdia )   RETURN
376      berg_melt   (:,:)   = 0._wp
377      berg_melt_hcflx(:,:)   = 0._wp
378      berg_melt_qlat(:,:)   = 0._wp
379      buoy_melt   (:,:)   = 0._wp
380      eros_melt   (:,:)   = 0._wp
381      conv_melt   (:,:)   = 0._wp
382      bits_src    (:,:)   = 0._wp
383      bits_melt   (:,:)   = 0._wp
384      bits_mass   (:,:)   = 0._wp
385      berg_mass   (:,:)   = 0._wp
386      virtual_area(:,:)   = 0._wp
387      real_calving(:,:,:) = 0._wp
388      !
389   END SUBROUTINE icb_dia_step
390
391
392   SUBROUTINE icb_dia_put
393      !!----------------------------------------------------------------------
394      !!----------------------------------------------------------------------
395      !
396      IF( .NOT.ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not
397      !
398      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s]
399      !! NB. The berg_melt_hcflx field is currently always zero - see comment in icbthm.F90
400      CALL iom_put( "berg_melt_hcflx"  , berg_melt_hcflx(:,:))   ! Heat flux to ocean due to heat content of melting icebergs [J/m2/s]
401      CALL iom_put( "berg_melt_qlat"   , berg_melt_qlat(:,:) )   ! Heat flux to ocean due to latent heat of melting icebergs [J/m2/s]
402      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
403      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
404      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
405      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
406      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
407      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
408      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
409      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
410      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
411      !
412   END SUBROUTINE icb_dia_put
413
414
415   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
416      !!----------------------------------------------------------------------
417      !!----------------------------------------------------------------------
418      INTEGER , INTENT(in)  ::   ki, kj, kn
419      REAL(wp), INTENT(in)  ::   pcalved
420      REAL(wp), INTENT(in)  ::   pheated
421      !!----------------------------------------------------------------------
422      !
423      IF( .NOT. ln_bergdia ) RETURN
424      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
425      nbergs_calved              = nbergs_calved              + 1
426      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
427      calving_to_bergs_net       = calving_to_bergs_net + pcalved
428      heat_to_bergs_net          = heat_to_bergs_net    + pheated
429      !
430   END SUBROUTINE icb_dia_calve
431
432
433   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
434      !!----------------------------------------------------------------------
435      !!----------------------------------------------------------------------
436      INTEGER ,                 INTENT(in)  :: kt
437      REAL(wp),                 INTENT(in)  :: pcalving_used
438      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
439      !!----------------------------------------------------------------------
440      !
441      IF( .NOT.ln_bergdia )   RETURN
442      !
443      IF( kt == nit000 ) THEN
444         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
445         CALL mpp_sum( 'icbdia', stored_start )
446         !
447         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
448         CALL mpp_sum( 'icbdia', stored_heat_start )
449         IF (nn_verbose_level > 0) THEN
450            WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
451            WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored heat=',stored_heat_start,' J'
452         ENDIF
453      ENDIF
454      !
455      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
456      calving_src_net = calving_rcv_net
457      calving_src_heat_net = calving_src_heat_net +  &
458         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
459      calving_used_net = calving_used_net + pcalving_used * berg_dt
460      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
461      !
462   END SUBROUTINE icb_dia_income
463
464
465   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
466      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
467      !!----------------------------------------------------------------------
468      !!----------------------------------------------------------------------
469      INTEGER , INTENT(in) ::   ki, kj
470      REAL(wp), INTENT(in) ::   pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
471      !!----------------------------------------------------------------------
472      !
473      IF( .NOT.ln_bergdia )   RETURN
474      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
475      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
476      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
477      !
478   END SUBROUTINE icb_dia_size
479
480
481   SUBROUTINE icb_dia_speed()
482      !!----------------------------------------------------------------------
483      !!----------------------------------------------------------------------
484      !
485      IF( .NOT.ln_bergdia )   RETURN
486      nspeeding_tickets = nspeeding_tickets + 1
487      !
488   END SUBROUTINE icb_dia_speed
489
490
491   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     &
492      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
493      &                    pdMv, pz1_dt_e1e2 )
494      !!----------------------------------------------------------------------
495      !!----------------------------------------------------------------------
496      INTEGER , INTENT(in) ::   ki, kj
497      REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale
498      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
499      !!----------------------------------------------------------------------
500      !
501      IF( .NOT.ln_bergdia )   RETURN
502      !
503      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
504      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s
505      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s
506      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
507      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
508      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
509      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
510      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
511      heat_to_ocean_net = heat_to_ocean_net + (pheat_hcflux + pheat_latent) * pmass_scale * berg_dt         ! J
512      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
513      !
514   END SUBROUTINE icb_dia_melt
515
516
517   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
518      &                     pendval, cd_delstr, kbergs )
519      !!----------------------------------------------------------------------
520      !!----------------------------------------------------------------------
521      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
522      REAL(wp),      INTENT(in)           :: pstartval, pendval
523      INTEGER,       INTENT(in), OPTIONAL :: kbergs
524      !!----------------------------------------------------------------------
525      !
526      IF (nn_verbose_level == 0) RETURN
527      IF( PRESENT(kbergs) ) THEN
528         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
529            &              cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
530            &              cd_endstr    // ' end',    pendval,           cd_budgetunits, &
531            &              'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
532            &              '# of bergs', kbergs
533      ELSE
534         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
535            &              cd_startstr  // ' start', pstartval,         cd_budgetunits, &
536            &              cd_endstr    // ' end',   pendval,           cd_budgetunits, &
537            &              cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
538      ENDIF
539100   FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
540      !
541   END SUBROUTINE report_state
542
543
544   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
545      !!----------------------------------------------------------------------
546      !!----------------------------------------------------------------------
547      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
548      REAL(wp),      INTENT(in) :: pstartval, pendval
549      !!----------------------------------------------------------------------
550      !
551      IF (nn_verbose_level == 0) RETURN
552      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
553         &              cd_startstr,    pstartval, cd_budgetunits, &
554         &              cd_endstr,      pendval,   cd_budgetunits, &
555         &              'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
556200   FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
557      !
558   END SUBROUTINE report_consistant
559
560
561   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
562      &                      poutval, cd_delstr, pstartval, pendval)
563      !!----------------------------------------------------------------------
564      !!----------------------------------------------------------------------
565      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
566      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
567      !
568      REAL(wp) ::   zval
569      !!----------------------------------------------------------------------
570      !
571      IF (nn_verbose_level == 0) RETURN
572      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
573         &   MAX( 1.e-30, MAX( ABS( pendval - pstartval ) , ABS( pinval - poutval ) ) )
574         !
575      WRITE(numicb,200) cd_budgetstr // ' budget:', &
576         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
577         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
578         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
579         &              'error',        zval,                       'nd'
580  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
581      !
582   END SUBROUTINE report_budget
583
584
585   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
586      !!----------------------------------------------------------------------
587      !!----------------------------------------------------------------------
588      CHARACTER*(*), INTENT(in) ::   cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
589      INTEGER      , INTENT(in) ::   pstartval, pendval
590      !!----------------------------------------------------------------------
591      !
592      IF (nn_verbose_level == 0) RETURN
593      WRITE(numicb,100) cd_budgetstr // ' state:',           &
594         &              cd_startstr  // ' start', pstartval, &
595         &              cd_endstr    // ' end',   pendval,   &
596         &              cd_delstr    // 'Delta',  pendval-pstartval
597  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
598      !
599   END SUBROUTINE report_istate
600
601
602   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
603      &                       cd_delstr, pstartval, pendval)
604      !!----------------------------------------------------------------------
605      !!----------------------------------------------------------------------
606      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
607      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
608      !!----------------------------------------------------------------------
609      !
610      IF (nn_verbose_level == 0) RETURN
611      WRITE(numicb,200) cd_budgetstr // ' budget:', &
612         &              cd_instr     // ' in',      pinval, &
613         &              cd_outstr    // ' out',     poutval, &
614         &              'Delta '     // cd_delstr,  pinval-poutval, &
615         &              'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
616200   FORMAT(a19,10(a18,"=",i14,x,:,","))
617      !
618   END SUBROUTINE report_ibudget
619
620   !!======================================================================
621END MODULE icbdia
Note: See TracBrowser for help on using the repository browser.