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/UKMO/NEMO4_beta_mirror/src/OCE/ICB – NEMO

source: NEMO/branches/UKMO/NEMO4_beta_mirror/src/OCE/ICB/icbdia.F90 @ 10011

Last change on this file since 10011 was 10011, checked in by davestorkey, 6 years ago

UKMO/NEMO4_beta_mirror branch: merging in changes from the trunk up to revision 10010.

File size: 32.6 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
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 licence     (./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      stored_heat_end           = 0._wp
128      floating_heat_end         = 0._wp
129      floating_mass_end         = 0._wp
130      bergs_mass_end            = 0._wp
131      bits_mass_end             = 0._wp
132      stored_heat_start         = 0._wp
133      floating_heat_start       = 0._wp
134      floating_mass_start       = 0._wp
135      bergs_mass_start          = 0._wp
136      bits_mass_start           = 0._wp
137      bits_mass_end             = 0._wp
138      calving_used_net          = 0._wp
139      calving_to_bergs_net      = 0._wp
140      heat_to_bergs_net         = 0._wp
141      heat_to_ocean_net         = 0._wp
142      calving_rcv_net           = 0._wp
143      calving_ret_net           = 0._wp
144      calving_src_net           = 0._wp
145      calving_out_net           = 0._wp
146      calving_src_heat_net      = 0._wp
147      calving_src_heat_used_net = 0._wp
148      calving_out_heat_net      = 0._wp
149      melt_net                  = 0._wp
150      berg_melt_net             = 0._wp
151      bits_melt_net             = 0._wp
152      bits_src_net              = 0._wp
153
154      floating_mass_start       = icb_utl_mass( first_berg )
155      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.TRUE. )
156      bits_mass_start           = icb_utl_mass( first_berg, justbits =.TRUE. )
157      IF( lk_mpp ) THEN
158         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp
159         ALLOCATE( nsumbuf(4+nclasses) )  ; nsumbuf(:) = 0
160         rsumbuf(1) = floating_mass_start
161         rsumbuf(2) = bergs_mass_start
162         rsumbuf(3) = bits_mass_start
163         CALL mpp_sum( rsumbuf(1:3), 3 )
164         floating_mass_start = rsumbuf(1)
165         bergs_mass_start = rsumbuf(2)
166         bits_mass_start = rsumbuf(3)
167      ENDIF
168      !
169   END SUBROUTINE icb_dia_init
170
171
172   SUBROUTINE icb_dia( ld_budge )
173      !!----------------------------------------------------------------------
174      !! sum all the things we've accumulated so far in the current processor
175      !! in MPP case then add these sums across all processors
176      !! for this we pack variables into buffer so we only need one mpp_sum
177      !!----------------------------------------------------------------------
178      LOGICAL, INTENT(in) ::   ld_budge   !
179      !
180      INTEGER ::   ik
181      REAL(wp)::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass
182      !!----------------------------------------------------------------------
183      !
184      IF( .NOT.ln_bergdia )   RETURN
185
186      zunused_calving      = SUM( berg_grid%calving(:,:) )
187      ztmpsum              = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
188      melt_net             = melt_net + ztmpsum * berg_dt
189      calving_out_net      = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt
190      ztmpsum              = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
191      berg_melt_net        = berg_melt_net + ztmpsum * berg_dt
192      ztmpsum              = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) )
193      bits_src_net         = bits_src_net + ztmpsum * berg_dt
194      ztmpsum              = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
195      bits_melt_net        = bits_melt_net + ztmpsum * berg_dt
196      ztmpsum              = SUM( src_calving(:,:) * tmask_i(:,:) )
197      calving_ret_net      = calving_ret_net + ztmpsum * berg_dt
198      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) )
199      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J
200      !
201      IF( ld_budge ) THEN
202         stored_end        = SUM( berg_grid%stored_ice(:,:,:) )
203         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) )
204         floating_mass_end = icb_utl_mass( first_berg )
205         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.TRUE. )
206         bits_mass_end     = icb_utl_mass( first_berg,justbits =.TRUE. )
207         floating_heat_end = icb_utl_heat( first_berg )
208         !
209         nbergs_end        = icb_utl_count()
210         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
211         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
212         !
213         IF( lk_mpp ) THEN
214            rsumbuf( 1) = stored_end
215            rsumbuf( 2) = stored_heat_end
216            rsumbuf( 3) = floating_mass_end
217            rsumbuf( 4) = bergs_mass_end
218            rsumbuf( 5) = bits_mass_end
219            rsumbuf( 6) = floating_heat_end
220            rsumbuf( 7) = calving_ret_net
221            rsumbuf( 8) = calving_out_net
222            rsumbuf( 9) = calving_rcv_net
223            rsumbuf(10) = calving_src_net
224            rsumbuf(11) = calving_src_heat_net
225            rsumbuf(12) = calving_src_heat_used_net
226            rsumbuf(13) = calving_out_heat_net
227            rsumbuf(14) = calving_used_net
228            rsumbuf(15) = calving_to_bergs_net
229            rsumbuf(16) = heat_to_bergs_net
230            rsumbuf(17) = heat_to_ocean_net
231            rsumbuf(18) = melt_net
232            rsumbuf(19) = berg_melt_net
233            rsumbuf(20) = bits_src_net
234            rsumbuf(21) = bits_melt_net
235            rsumbuf(22) = zgrdd_berg_mass
236            rsumbuf(23) = zgrdd_bits_mass
237            !
238            CALL mpp_sum( rsumbuf(1:23), 23)
239            !
240            stored_end                = rsumbuf( 1)
241            stored_heat_end           = rsumbuf( 2)
242            floating_mass_end         = rsumbuf( 3)
243            bergs_mass_end            = rsumbuf( 4)
244            bits_mass_end             = rsumbuf( 5)
245            floating_heat_end         = rsumbuf( 6)
246            calving_ret_net           = rsumbuf( 7)
247            calving_out_net           = rsumbuf( 8)
248            calving_rcv_net           = rsumbuf( 9)
249            calving_src_net           = rsumbuf(10)
250            calving_src_heat_net      = rsumbuf(11)
251            calving_src_heat_used_net = rsumbuf(12)
252            calving_out_heat_net      = rsumbuf(13)
253            calving_used_net          = rsumbuf(14)
254            calving_to_bergs_net      = rsumbuf(15)
255            heat_to_bergs_net         = rsumbuf(16)
256            heat_to_ocean_net         = rsumbuf(17)
257            melt_net                  = rsumbuf(18)
258            berg_melt_net             = rsumbuf(19)
259            bits_src_net              = rsumbuf(20)
260            bits_melt_net             = rsumbuf(21)
261            zgrdd_berg_mass           = rsumbuf(22)
262            zgrdd_bits_mass           = rsumbuf(23)
263            !
264            nsumbuf(1) = nbergs_end
265            nsumbuf(2) = nbergs_calved
266            nsumbuf(3) = nbergs_melted
267            nsumbuf(4) = nspeeding_tickets
268            DO ik = 1, nclasses
269               nsumbuf(4+ik) = nbergs_calved_by_class(ik)
270            END DO
271            CALL mpp_sum( nsumbuf(1:nclasses+4), nclasses+4 )
272            !
273            nbergs_end        = nsumbuf(1)
274            nbergs_calved     = nsumbuf(2)
275            nbergs_melted     = nsumbuf(3)
276            nspeeding_tickets = nsumbuf(4)
277            DO ik = 1,nclasses
278               nbergs_calved_by_class(ik)= nsumbuf(4+ik)
279            END DO
280            !
281         ENDIF
282         !
283         CALL report_state  ( 'stored ice','kg','',stored_start,'',stored_end,'')
284         CALL report_state  ( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end )
285         CALL report_state  ( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'')
286         CALL report_state  ( 'bits','kg','',bits_mass_start,'',bits_mass_end,'')
287         CALL report_istate ( 'berg #','',nbergs_start,'',nbergs_end,'')
288         CALL report_ibudget( 'berg #','calved',nbergs_calved, &
289            &                          'melted',nbergs_melted, &
290            &                          '#',nbergs_start,nbergs_end)
291         CALL report_budget( 'stored mass','kg','calving used',calving_used_net, &
292            &                              'bergs',calving_to_bergs_net, &
293            &                              'stored mass',stored_start,stored_end)
294         CALL report_budget( 'floating mass','kg','calving used',calving_to_bergs_net, &
295            &                                'bergs',melt_net, &
296            &                                'stored mass',floating_mass_start,floating_mass_end)
297         CALL report_budget( 'berg mass','kg','calving',calving_to_bergs_net, &
298            &                                 'melt+eros',berg_melt_net, &
299            &                                 'berg mass',bergs_mass_start,bergs_mass_end)
300         CALL report_budget( 'bits mass','kg','eros used',bits_src_net, &
301            &                                 'bergs',bits_melt_net, &
302            &                                 'stored mass',bits_mass_start,bits_mass_end)
303         CALL report_budget( 'net mass','kg','recvd',calving_rcv_net, &
304            &                                'rtrnd',calving_ret_net, &
305            &                                'net mass',stored_start+floating_mass_start, &
306            &                                           stored_end+floating_mass_end)
307         CALL report_consistant( 'iceberg mass','kg','gridded',zgrdd_berg_mass,'bergs',bergs_mass_end)
308         CALL report_consistant( 'bits mass','kg','gridded',zgrdd_bits_mass,'bits',bits_mass_end)
309         CALL report_state( 'net heat','J','',stored_heat_start+floating_heat_start,'', &
310            &                                 stored_heat_end+floating_heat_end,'')
311         CALL report_state( 'stored heat','J','',stored_heat_start,'',stored_heat_end,'')
312         CALL report_state( 'floating heat','J','',floating_heat_start,'',floating_heat_end,'')
313         CALL report_budget( 'net heat','J','net heat',calving_src_heat_net, &
314            &                               'net heat',calving_out_heat_net, &
315            &                               'net heat',stored_heat_start+floating_heat_start, &
316            &                                          stored_heat_end+floating_heat_end)
317         CALL report_budget( 'stored heat','J','calving used',calving_src_heat_used_net, &
318            &                                  'bergs',heat_to_bergs_net, &
319            &                                  'net heat',stored_heat_start,stored_heat_end)
320         CALL report_budget( 'flting heat','J','calved',heat_to_bergs_net, &
321            &                                  'melt',heat_to_ocean_net, &
322            &                                  'net heat',floating_heat_start,floating_heat_end)
323         IF (nn_verbose_level >= 1) THEN
324            CALL report_consistant( 'top interface','kg','from SIS',calving_src_net, &
325               &                    'received',calving_rcv_net)
326            CALL report_consistant( 'bot interface','kg','sent',calving_out_net, &
327               &                    'returned',calving_ret_net)
328         ENDIF
329         WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
330         IF( nspeeding_tickets > 0 )   WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets
331         !
332         nbergs_start              = nbergs_end
333         stored_start              = stored_end
334         nbergs_melted             = 0
335         nbergs_calved             = 0
336         nbergs_calved_by_class(:) = 0
337         nspeeding_tickets         = 0
338         stored_heat_start         = stored_heat_end
339         floating_heat_start       = floating_heat_end
340         floating_mass_start       = floating_mass_end
341         bergs_mass_start          = bergs_mass_end
342         bits_mass_start           = bits_mass_end
343         calving_used_net          = 0._wp
344         calving_to_bergs_net      = 0._wp
345         heat_to_bergs_net         = 0._wp
346         heat_to_ocean_net         = 0._wp
347         calving_rcv_net           = 0._wp
348         calving_ret_net           = 0._wp
349         calving_src_net           = 0._wp
350         calving_out_net           = 0._wp
351         calving_src_heat_net      = 0._wp
352         calving_src_heat_used_net = 0._wp
353         calving_out_heat_net      = 0._wp
354         melt_net                  = 0._wp
355         berg_melt_net             = 0._wp
356         bits_melt_net             = 0._wp
357         bits_src_net              = 0._wp
358      ENDIF
359      !
360   END SUBROUTINE icb_dia
361
362
363   SUBROUTINE icb_dia_step
364      !!----------------------------------------------------------------------
365      !! things to reset at the beginning of each timestep
366      !!----------------------------------------------------------------------
367      !
368      IF( .NOT.ln_bergdia )   RETURN
369      berg_melt   (:,:)   = 0._wp
370      berg_melt_hcflx(:,:)   = 0._wp
371      berg_melt_qlat(:,:)   = 0._wp
372      buoy_melt   (:,:)   = 0._wp
373      eros_melt   (:,:)   = 0._wp
374      conv_melt   (:,:)   = 0._wp
375      bits_src    (:,:)   = 0._wp
376      bits_melt   (:,:)   = 0._wp
377      bits_mass   (:,:)   = 0._wp
378      berg_mass   (:,:)   = 0._wp
379      virtual_area(:,:)   = 0._wp
380      real_calving(:,:,:) = 0._wp
381      !
382   END SUBROUTINE icb_dia_step
383
384
385   SUBROUTINE icb_dia_put
386      !!----------------------------------------------------------------------
387      !!----------------------------------------------------------------------
388      !
389      IF( .NOT.ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not
390      !
391      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s]
392      !! NB. The berg_melt_hcflx field is currently always zero - see comment in icbthm.F90
393      CALL iom_put( "berg_melt_hcflx"  , berg_melt_hcflx(:,:))   ! Heat flux to ocean due to heat content of melting icebergs [J/m2/s]
394      CALL iom_put( "berg_melt_qlat"   , berg_melt_qlat(:,:) )   ! Heat flux to ocean due to latent heat of melting icebergs [J/m2/s]
395      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
396      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
397      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
398      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
399      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
400      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
401      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
402      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
403      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
404      !
405   END SUBROUTINE icb_dia_put
406
407
408   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
409      !!----------------------------------------------------------------------
410      !!----------------------------------------------------------------------
411      INTEGER , INTENT(in)  ::   ki, kj, kn
412      REAL(wp), INTENT(in)  ::   pcalved
413      REAL(wp), INTENT(in)  ::   pheated
414      !!----------------------------------------------------------------------
415      !
416      IF( .NOT. ln_bergdia ) RETURN
417      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
418      nbergs_calved              = nbergs_calved              + 1
419      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
420      calving_to_bergs_net       = calving_to_bergs_net + pcalved
421      heat_to_bergs_net          = heat_to_bergs_net    + pheated
422      !
423   END SUBROUTINE icb_dia_calve
424
425
426   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
427      !!----------------------------------------------------------------------
428      !!----------------------------------------------------------------------
429      INTEGER ,                 INTENT(in)  :: kt
430      REAL(wp),                 INTENT(in)  :: pcalving_used
431      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
432      !!----------------------------------------------------------------------
433      !
434      IF( .NOT.ln_bergdia )   RETURN
435      !
436      IF( kt == nit000 ) THEN
437         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
438         IF( lk_mpp ) CALL mpp_sum( stored_start )
439         WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
440         !
441         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
442         IF( lk_mpp ) CALL mpp_sum( stored_heat_start )
443         WRITE(numicb,'(a,es13.6,a)')    'icb_dia_income: initial stored heat=',stored_heat_start,' J'
444      ENDIF
445      !
446      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
447      calving_src_net = calving_rcv_net
448      calving_src_heat_net = calving_src_heat_net +  &
449         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
450      calving_used_net = calving_used_net + pcalving_used * berg_dt
451      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
452      !
453   END SUBROUTINE icb_dia_income
454
455
456   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
457      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
458      !!----------------------------------------------------------------------
459      !!----------------------------------------------------------------------
460      INTEGER , INTENT(in) ::   ki, kj
461      REAL(wp), INTENT(in) ::   pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
462      !!----------------------------------------------------------------------
463      !
464      IF( .NOT.ln_bergdia )   RETURN
465      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
466      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
467      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
468      !
469   END SUBROUTINE icb_dia_size
470
471
472   SUBROUTINE icb_dia_speed()
473      !!----------------------------------------------------------------------
474      !!----------------------------------------------------------------------
475      !
476      IF( .NOT.ln_bergdia )   RETURN
477      nspeeding_tickets = nspeeding_tickets + 1
478      !
479   END SUBROUTINE icb_dia_speed
480
481
482   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     &
483      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
484      &                    pdMv, pz1_dt_e1e2 )
485      !!----------------------------------------------------------------------
486      !!----------------------------------------------------------------------
487      INTEGER , INTENT(in) ::   ki, kj
488      REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale
489      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
490      !!----------------------------------------------------------------------
491      !
492      IF( .NOT.ln_bergdia )   RETURN
493      !
494      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
495      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s
496      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s
497      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
498      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
499      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
500      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
501      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
502      heat_to_ocean_net = heat_to_ocean_net + (pheat_hcflux + pheat_latent) * pmass_scale * berg_dt         ! J
503      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
504      !
505   END SUBROUTINE icb_dia_melt
506
507
508   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
509      &                     pendval, cd_delstr, kbergs )
510      !!----------------------------------------------------------------------
511      !!----------------------------------------------------------------------
512      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
513      REAL(wp),      INTENT(in)           :: pstartval, pendval
514      INTEGER,       INTENT(in), OPTIONAL :: kbergs
515      !!----------------------------------------------------------------------
516      !
517      IF( PRESENT(kbergs) ) THEN
518         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
519            &              cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
520            &              cd_endstr    // ' end',    pendval,           cd_budgetunits, &
521            &              'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
522            &              '# of bergs', kbergs
523      ELSE
524         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
525            &              cd_startstr  // ' start', pstartval,         cd_budgetunits, &
526            &              cd_endstr    // ' end',   pendval,           cd_budgetunits, &
527            &              cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
528      ENDIF
529100   FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
530      !
531   END SUBROUTINE report_state
532
533
534   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
535      !!----------------------------------------------------------------------
536      !!----------------------------------------------------------------------
537      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
538      REAL(wp),      INTENT(in) :: pstartval, pendval
539      !!----------------------------------------------------------------------
540      !
541      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
542         &              cd_startstr,    pstartval, cd_budgetunits, &
543         &              cd_endstr,      pendval,   cd_budgetunits, &
544         &              'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
545200   FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
546      !
547   END SUBROUTINE report_consistant
548
549
550   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
551      &                      poutval, cd_delstr, pstartval, pendval)
552      !!----------------------------------------------------------------------
553      !!----------------------------------------------------------------------
554      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
555      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
556      !
557      REAL(wp) ::   zval
558      !!----------------------------------------------------------------------
559      !
560      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
561         &   MAX( 1.e-30, MAX( ABS( pendval - pstartval ) , ABS( pinval - poutval ) ) )
562         !
563      WRITE(numicb,200) cd_budgetstr // ' budget:', &
564         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
565         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
566         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
567         &              'error',        zval,                       'nd'
568  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
569      !
570   END SUBROUTINE report_budget
571
572
573   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
574      !!----------------------------------------------------------------------
575      !!----------------------------------------------------------------------
576      CHARACTER*(*), INTENT(in) ::   cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
577      INTEGER      , INTENT(in) ::   pstartval, pendval
578      !!----------------------------------------------------------------------
579      !
580      WRITE(numicb,100) cd_budgetstr // ' state:',           &
581         &              cd_startstr  // ' start', pstartval, &
582         &              cd_endstr    // ' end',   pendval,   &
583         &              cd_delstr    // 'Delta',  pendval-pstartval
584  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
585      !
586   END SUBROUTINE report_istate
587
588
589   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
590      &                       cd_delstr, pstartval, pendval)
591      !!----------------------------------------------------------------------
592      !!----------------------------------------------------------------------
593      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
594      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
595      !!----------------------------------------------------------------------
596      !
597      WRITE(numicb,200) cd_budgetstr // ' budget:', &
598         &              cd_instr     // ' in',      pinval, &
599         &              cd_outstr    // ' out',     poutval, &
600         &              'Delta '     // cd_delstr,  pinval-poutval, &
601         &              'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
602200   FORMAT(a19,10(a18,"=",i14,x,:,","))
603      !
604   END SUBROUTINE report_ibudget
605
606   !!======================================================================
607END MODULE icbdia
Note: See TracBrowser for help on using the repository browser.