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.3_icb_speed_limit2/src/OCE/ICB – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.3_icb_speed_limit2/src/OCE/ICB/icbdia.F90 @ 14274

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

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