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

source: NEMO/branches/UKMO/icebergs_ocean_heat_fluxes/src/OCE/ICB/icbdia.F90 @ 9959

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

UKMO icebergs_ocean_heat_fluxes branch : science changes
  • Property svn:keywords set to Id
File size: 32.5 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      CALL iom_put( "berg_melt_hcflx"  , berg_melt_hcflx(:,:))   ! Heat flux to ocean due to heat content of melting icebergs [J/m2/s]
393      CALL iom_put( "berg_melt_qlat"   , berg_melt_qlat(:,:) )   ! Heat flux to ocean due to latent heat of melting icebergs [J/m2/s]
394      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
395      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
396      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
397      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
398      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
399      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
400      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
401      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
402      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
403      !
404   END SUBROUTINE icb_dia_put
405
406
407   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
408      !!----------------------------------------------------------------------
409      !!----------------------------------------------------------------------
410      INTEGER , INTENT(in)  ::   ki, kj, kn
411      REAL(wp), INTENT(in)  ::   pcalved
412      REAL(wp), INTENT(in)  ::   pheated
413      !!----------------------------------------------------------------------
414      !
415      IF( .NOT. ln_bergdia ) RETURN
416      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
417      nbergs_calved              = nbergs_calved              + 1
418      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
419      calving_to_bergs_net       = calving_to_bergs_net + pcalved
420      heat_to_bergs_net          = heat_to_bergs_net    + pheated
421      !
422   END SUBROUTINE icb_dia_calve
423
424
425   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
426      !!----------------------------------------------------------------------
427      !!----------------------------------------------------------------------
428      INTEGER ,                 INTENT(in)  :: kt
429      REAL(wp),                 INTENT(in)  :: pcalving_used
430      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
431      !!----------------------------------------------------------------------
432      !
433      IF( .NOT.ln_bergdia )   RETURN
434      !
435      IF( kt == nit000 ) THEN
436         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
437         IF( lk_mpp ) CALL mpp_sum( stored_start )
438         WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
439         !
440         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
441         IF( lk_mpp ) CALL mpp_sum( stored_heat_start )
442         WRITE(numicb,'(a,es13.6,a)')    'icb_dia_income: initial stored heat=',stored_heat_start,' J'
443      ENDIF
444      !
445      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
446      calving_src_net = calving_rcv_net
447      calving_src_heat_net = calving_src_heat_net +  &
448         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
449      calving_used_net = calving_used_net + pcalving_used * berg_dt
450      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
451      !
452   END SUBROUTINE icb_dia_income
453
454
455   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
456      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
457      !!----------------------------------------------------------------------
458      !!----------------------------------------------------------------------
459      INTEGER , INTENT(in) ::   ki, kj
460      REAL(wp), INTENT(in) ::   pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
461      !!----------------------------------------------------------------------
462      !
463      IF( .NOT.ln_bergdia )   RETURN
464      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
465      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
466      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
467      !
468   END SUBROUTINE icb_dia_size
469
470
471   SUBROUTINE icb_dia_speed()
472      !!----------------------------------------------------------------------
473      !!----------------------------------------------------------------------
474      !
475      IF( .NOT.ln_bergdia )   RETURN
476      nspeeding_tickets = nspeeding_tickets + 1
477      !
478   END SUBROUTINE icb_dia_speed
479
480
481   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     &
482      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
483      &                    pdMv, pz1_dt_e1e2 )
484      !!----------------------------------------------------------------------
485      !!----------------------------------------------------------------------
486      INTEGER , INTENT(in) ::   ki, kj
487      REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale
488      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
489      !!----------------------------------------------------------------------
490      !
491      IF( .NOT.ln_bergdia )   RETURN
492      !
493      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
494      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s
495      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s
496      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
497      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
498      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
499      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
500      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
501      heat_to_ocean_net = heat_to_ocean_net + (pheat_hcflux + pheat_latent) * pmass_scale * berg_dt         ! J
502      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
503      !
504   END SUBROUTINE icb_dia_melt
505
506
507   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
508      &                     pendval, cd_delstr, kbergs )
509      !!----------------------------------------------------------------------
510      !!----------------------------------------------------------------------
511      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
512      REAL(wp),      INTENT(in)           :: pstartval, pendval
513      INTEGER,       INTENT(in), OPTIONAL :: kbergs
514      !!----------------------------------------------------------------------
515      !
516      IF( PRESENT(kbergs) ) THEN
517         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
518            &              cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
519            &              cd_endstr    // ' end',    pendval,           cd_budgetunits, &
520            &              'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
521            &              '# of bergs', kbergs
522      ELSE
523         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
524            &              cd_startstr  // ' start', pstartval,         cd_budgetunits, &
525            &              cd_endstr    // ' end',   pendval,           cd_budgetunits, &
526            &              cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
527      ENDIF
528100   FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
529      !
530   END SUBROUTINE report_state
531
532
533   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
534      !!----------------------------------------------------------------------
535      !!----------------------------------------------------------------------
536      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
537      REAL(wp),      INTENT(in) :: pstartval, pendval
538      !!----------------------------------------------------------------------
539      !
540      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
541         &              cd_startstr,    pstartval, cd_budgetunits, &
542         &              cd_endstr,      pendval,   cd_budgetunits, &
543         &              'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
544200   FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
545      !
546   END SUBROUTINE report_consistant
547
548
549   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
550      &                      poutval, cd_delstr, pstartval, pendval)
551      !!----------------------------------------------------------------------
552      !!----------------------------------------------------------------------
553      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
554      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
555      !
556      REAL(wp) ::   zval
557      !!----------------------------------------------------------------------
558      !
559      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
560         &   MAX( 1.e-30, MAX( ABS( pendval - pstartval ) , ABS( pinval - poutval ) ) )
561         !
562      WRITE(numicb,200) cd_budgetstr // ' budget:', &
563         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
564         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
565         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
566         &              'error',        zval,                       'nd'
567  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
568      !
569   END SUBROUTINE report_budget
570
571
572   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
573      !!----------------------------------------------------------------------
574      !!----------------------------------------------------------------------
575      CHARACTER*(*), INTENT(in) ::   cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
576      INTEGER      , INTENT(in) ::   pstartval, pendval
577      !!----------------------------------------------------------------------
578      !
579      WRITE(numicb,100) cd_budgetstr // ' state:',           &
580         &              cd_startstr  // ' start', pstartval, &
581         &              cd_endstr    // ' end',   pendval,   &
582         &              cd_delstr    // 'Delta',  pendval-pstartval
583  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
584      !
585   END SUBROUTINE report_istate
586
587
588   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
589      &                       cd_delstr, pstartval, pendval)
590      !!----------------------------------------------------------------------
591      !!----------------------------------------------------------------------
592      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
593      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
594      !!----------------------------------------------------------------------
595      !
596      WRITE(numicb,200) cd_budgetstr // ' budget:', &
597         &              cd_instr     // ' in',      pinval, &
598         &              cd_outstr    // ' out',     poutval, &
599         &              'Delta '     // cd_delstr,  pinval-poutval, &
600         &              'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
601200   FORMAT(a19,10(a18,"=",i14,x,:,","))
602      !
603   END SUBROUTINE report_ibudget
604
605   !!======================================================================
606END MODULE icbdia
Note: See TracBrowser for help on using the repository browser.