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 branches/UKMO/dev_r5518_GO6_package_text_diagnostics/NEMOGCM/NEMO/OPA_SRC/ICB – NEMO

source: branches/UKMO/dev_r5518_GO6_package_text_diagnostics/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90 @ 10892

Last change on this file since 10892 was 10892, checked in by andmirek, 5 years ago

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