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/NEMO_4.0.1_ICB_melting_temperature/src/OCE/ICB – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.1_ICB_melting_temperature/src/OCE/ICB/icbdia.F90 @ 11897

Last change on this file since 11897 was 11715, checked in by davestorkey, 4 years ago

UKMO/NEMO_4.0.1_mirror : Remove SVN keywords.

File size: 32.9 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 license (see ./LICENSE)
95   !!----------------------------------------------------------------------
96CONTAINS
97
98   SUBROUTINE icb_dia_init( )
99      !!----------------------------------------------------------------------
100      !!----------------------------------------------------------------------
101      !
102      IF( .NOT.ln_bergdia )   RETURN
103
104      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)   = 0._wp
105      ALLOCATE( berg_melt_hcflx(jpi,jpj) )           ;   berg_melt_hcflx(:,:)   = 0._wp
106      ALLOCATE( berg_melt_qlat(jpi,jpj)  )           ;   berg_melt_qlat(:,:)   = 0._wp
107      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)   = 0._wp
108      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)   = 0._wp
109      ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt   (:,:)   = 0._wp
110      ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:)   = 0._wp
111      ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:)   = 0._wp
112      ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:)   = 0._wp
113      ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area(:,:)   = 0._wp
114      ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass   (:,:)   = 0._wp
115      ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving(:,:,:) = 0._wp
116      ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc        (:,:)   = 0._wp
117
118      nbergs_start              = 0
119      nbergs_end                = 0
120      stored_end                = 0._wp
121      nbergs_start              = 0._wp
122      stored_start              = 0._wp
123      nbergs_melted             = 0
124      nbergs_calved             = 0
125      nbergs_calved_by_class(:) = 0
126      nspeeding_tickets         = 0
127      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( 'icbdia', 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( 'icbdia', 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( 'icbdia', 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         IF (nn_verbose_level > 0) THEN
330            WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
331            IF( nspeeding_tickets > 0 )   WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets
332         ENDIF
333         !
334         nbergs_start              = nbergs_end
335         stored_start              = stored_end
336         nbergs_melted             = 0
337         nbergs_calved             = 0
338         nbergs_calved_by_class(:) = 0
339         nspeeding_tickets         = 0
340         stored_heat_start         = stored_heat_end
341         floating_heat_start       = floating_heat_end
342         floating_mass_start       = floating_mass_end
343         bergs_mass_start          = bergs_mass_end
344         bits_mass_start           = bits_mass_end
345         calving_used_net          = 0._wp
346         calving_to_bergs_net      = 0._wp
347         heat_to_bergs_net         = 0._wp
348         heat_to_ocean_net         = 0._wp
349         calving_rcv_net           = 0._wp
350         calving_ret_net           = 0._wp
351         calving_src_net           = 0._wp
352         calving_out_net           = 0._wp
353         calving_src_heat_net      = 0._wp
354         calving_src_heat_used_net = 0._wp
355         calving_out_heat_net      = 0._wp
356         melt_net                  = 0._wp
357         berg_melt_net             = 0._wp
358         bits_melt_net             = 0._wp
359         bits_src_net              = 0._wp
360      ENDIF
361      !
362   END SUBROUTINE icb_dia
363
364
365   SUBROUTINE icb_dia_step
366      !!----------------------------------------------------------------------
367      !! things to reset at the beginning of each timestep
368      !!----------------------------------------------------------------------
369      !
370      IF( .NOT.ln_bergdia )   RETURN
371      berg_melt   (:,:)   = 0._wp
372      berg_melt_hcflx(:,:)   = 0._wp
373      berg_melt_qlat(:,:)   = 0._wp
374      buoy_melt   (:,:)   = 0._wp
375      eros_melt   (:,:)   = 0._wp
376      conv_melt   (:,:)   = 0._wp
377      bits_src    (:,:)   = 0._wp
378      bits_melt   (:,:)   = 0._wp
379      bits_mass   (:,:)   = 0._wp
380      berg_mass   (:,:)   = 0._wp
381      virtual_area(:,:)   = 0._wp
382      real_calving(:,:,:) = 0._wp
383      !
384   END SUBROUTINE icb_dia_step
385
386
387   SUBROUTINE icb_dia_put
388      !!----------------------------------------------------------------------
389      !!----------------------------------------------------------------------
390      !
391      IF( .NOT.ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not
392      !
393      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s]
394      !! NB. The berg_melt_hcflx field is currently always zero - see comment in icbthm.F90
395      CALL iom_put( "berg_melt_hcflx"  , berg_melt_hcflx(:,:))   ! Heat flux to ocean due to heat content of melting icebergs [J/m2/s]
396      CALL iom_put( "berg_melt_qlat"   , berg_melt_qlat(:,:) )   ! Heat flux to ocean due to latent heat of melting icebergs [J/m2/s]
397      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
398      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
399      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
400      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
401      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
402      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
403      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
404      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
405      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
406      !
407   END SUBROUTINE icb_dia_put
408
409
410   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
411      !!----------------------------------------------------------------------
412      !!----------------------------------------------------------------------
413      INTEGER , INTENT(in)  ::   ki, kj, kn
414      REAL(wp), INTENT(in)  ::   pcalved
415      REAL(wp), INTENT(in)  ::   pheated
416      !!----------------------------------------------------------------------
417      !
418      IF( .NOT. ln_bergdia ) RETURN
419      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
420      nbergs_calved              = nbergs_calved              + 1
421      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
422      calving_to_bergs_net       = calving_to_bergs_net + pcalved
423      heat_to_bergs_net          = heat_to_bergs_net    + pheated
424      !
425   END SUBROUTINE icb_dia_calve
426
427
428   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
429      !!----------------------------------------------------------------------
430      !!----------------------------------------------------------------------
431      INTEGER ,                 INTENT(in)  :: kt
432      REAL(wp),                 INTENT(in)  :: pcalving_used
433      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
434      !!----------------------------------------------------------------------
435      !
436      IF( .NOT.ln_bergdia )   RETURN
437      !
438      IF( kt == nit000 ) THEN
439         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
440         CALL mpp_sum( 'icbdia', stored_start )
441         !
442         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
443         CALL mpp_sum( 'icbdia', stored_heat_start )
444         IF (nn_verbose_level > 0) THEN
445            WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
446            WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored heat=',stored_heat_start,' J'
447         ENDIF
448      ENDIF
449      !
450      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
451      calving_src_net = calving_rcv_net
452      calving_src_heat_net = calving_src_heat_net +  &
453         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
454      calving_used_net = calving_used_net + pcalving_used * berg_dt
455      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
456      !
457   END SUBROUTINE icb_dia_income
458
459
460   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
461      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
462      !!----------------------------------------------------------------------
463      !!----------------------------------------------------------------------
464      INTEGER , INTENT(in) ::   ki, kj
465      REAL(wp), INTENT(in) ::   pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
466      !!----------------------------------------------------------------------
467      !
468      IF( .NOT.ln_bergdia )   RETURN
469      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
470      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
471      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
472      !
473   END SUBROUTINE icb_dia_size
474
475
476   SUBROUTINE icb_dia_speed()
477      !!----------------------------------------------------------------------
478      !!----------------------------------------------------------------------
479      !
480      IF( .NOT.ln_bergdia )   RETURN
481      nspeeding_tickets = nspeeding_tickets + 1
482      !
483   END SUBROUTINE icb_dia_speed
484
485
486   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     &
487      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
488      &                    pdMv, pz1_dt_e1e2 )
489      !!----------------------------------------------------------------------
490      !!----------------------------------------------------------------------
491      INTEGER , INTENT(in) ::   ki, kj
492      REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale
493      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
494      !!----------------------------------------------------------------------
495      !
496      IF( .NOT.ln_bergdia )   RETURN
497      !
498      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
499      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s
500      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s
501      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
502      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
503      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
504      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
505      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
506      heat_to_ocean_net = heat_to_ocean_net + (pheat_hcflux + pheat_latent) * pmass_scale * berg_dt         ! J
507      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
508      !
509   END SUBROUTINE icb_dia_melt
510
511
512   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
513      &                     pendval, cd_delstr, kbergs )
514      !!----------------------------------------------------------------------
515      !!----------------------------------------------------------------------
516      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
517      REAL(wp),      INTENT(in)           :: pstartval, pendval
518      INTEGER,       INTENT(in), OPTIONAL :: kbergs
519      !!----------------------------------------------------------------------
520      !
521      IF (nn_verbose_level == 0) RETURN
522      IF( PRESENT(kbergs) ) THEN
523         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
524            &              cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
525            &              cd_endstr    // ' end',    pendval,           cd_budgetunits, &
526            &              'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
527            &              '# of bergs', kbergs
528      ELSE
529         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
530            &              cd_startstr  // ' start', pstartval,         cd_budgetunits, &
531            &              cd_endstr    // ' end',   pendval,           cd_budgetunits, &
532            &              cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
533      ENDIF
534100   FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
535      !
536   END SUBROUTINE report_state
537
538
539   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
540      !!----------------------------------------------------------------------
541      !!----------------------------------------------------------------------
542      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
543      REAL(wp),      INTENT(in) :: pstartval, pendval
544      !!----------------------------------------------------------------------
545      !
546      IF (nn_verbose_level == 0) RETURN
547      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
548         &              cd_startstr,    pstartval, cd_budgetunits, &
549         &              cd_endstr,      pendval,   cd_budgetunits, &
550         &              'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
551200   FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
552      !
553   END SUBROUTINE report_consistant
554
555
556   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
557      &                      poutval, cd_delstr, pstartval, pendval)
558      !!----------------------------------------------------------------------
559      !!----------------------------------------------------------------------
560      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
561      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
562      !
563      REAL(wp) ::   zval
564      !!----------------------------------------------------------------------
565      !
566      IF (nn_verbose_level == 0) RETURN
567      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
568         &   MAX( 1.e-30, MAX( ABS( pendval - pstartval ) , ABS( pinval - poutval ) ) )
569         !
570      WRITE(numicb,200) cd_budgetstr // ' budget:', &
571         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
572         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
573         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
574         &              'error',        zval,                       'nd'
575  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
576      !
577   END SUBROUTINE report_budget
578
579
580   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
581      !!----------------------------------------------------------------------
582      !!----------------------------------------------------------------------
583      CHARACTER*(*), INTENT(in) ::   cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
584      INTEGER      , INTENT(in) ::   pstartval, pendval
585      !!----------------------------------------------------------------------
586      !
587      IF (nn_verbose_level == 0) RETURN
588      WRITE(numicb,100) cd_budgetstr // ' state:',           &
589         &              cd_startstr  // ' start', pstartval, &
590         &              cd_endstr    // ' end',   pendval,   &
591         &              cd_delstr    // 'Delta',  pendval-pstartval
592  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
593      !
594   END SUBROUTINE report_istate
595
596
597   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
598      &                       cd_delstr, pstartval, pendval)
599      !!----------------------------------------------------------------------
600      !!----------------------------------------------------------------------
601      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
602      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
603      !!----------------------------------------------------------------------
604      !
605      IF (nn_verbose_level == 0) RETURN
606      WRITE(numicb,200) cd_budgetstr // ' budget:', &
607         &              cd_instr     // ' in',      pinval, &
608         &              cd_outstr    // ' out',     poutval, &
609         &              'Delta '     // cd_delstr,  pinval-poutval, &
610         &              'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
611200   FORMAT(a19,10(a18,"=",i14,x,:,","))
612      !
613   END SUBROUTINE report_ibudget
614
615   !!======================================================================
616END MODULE icbdia
Note: See TracBrowser for help on using the repository browser.