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/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB – NEMO

source: branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90 @ 3370

Last change on this file since 3370 was 3370, checked in by sga, 12 years ago

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