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

Last change on this file since 9950 was 9950, checked in by davestorkey, 3 years ago

UKMO/NEMO4_beta_mirror branch: remove SVN keywords

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