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 @ 3372

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

NEMO branch dev_r3337_NOCS10_ICB: change all routine names and create more Gurvanistic havoc
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_dia_end  : end        iceberg budgeting
17   !! icb_dia_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_dia_end       ! routine called in icbrun.F90 module
31   PUBLIC   icb_dia_init      ! routine called in icbini.F90 module
32   PUBLIC   icb_dia           ! routine called in icbrun.F90 module
33   PUBLIC   icb_dia_step      ! routine called in icbrun.F90 module
34   PUBLIC   icb_dia_put       ! routine called in icbrun.F90 module
35   PUBLIC   icb_dia_melt      ! routine called in icbthm.F90 module
36   PUBLIC   icb_dia_size      ! routine called in icbthm.F90 module
37   PUBLIC   icb_dia_speed     ! routine called in icbdyn.F90 module
38   PUBLIC   icb_dia_calve     ! routine called in icbclv.F90 module
39   PUBLIC   icb_dia_income    ! 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_dia_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_dia_end
106
107
108   SUBROUTINE icb_dia_init( )
109      !!----------------------------------------------------------------------
110      !!----------------------------------------------------------------------
111      !
112      IF( .NOT. ln_bergdia ) RETURN
113      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)   = 0._wp
114      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)   = 0._wp
115      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)   = 0._wp
116      ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt   (:,:)   = 0._wp
117      ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:)   = 0._wp
118      ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:)   = 0._wp
119      ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:)   = 0._wp
120      ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area(:,:)   = 0._wp
121      ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass   (:,:)   = 0._wp
122      ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving(:,:,:) = 0._wp
123      ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc        (:,:)   = 0._wp
124
125      nbergs_start              = 0
126      nbergs_end                = 0
127      stored_end                = 0._wp
128      nbergs_start              = 0._wp
129      stored_start              = 0._wp
130      nbergs_melted             = 0
131      nbergs_calved             = 0
132      nbergs_calved_by_class(:) = 0
133      nspeeding_tickets         = 0
134      stored_heat_end           = 0._wp
135      floating_heat_end         = 0._wp
136      floating_mass_end         = 0._wp
137      bergs_mass_end            = 0._wp
138      bits_mass_end             = 0._wp
139      stored_heat_start         = 0._wp
140      floating_heat_start       = 0._wp
141      floating_mass_start       = 0._wp
142      bergs_mass_start          = 0._wp
143      bits_mass_start           = 0._wp
144      bits_mass_end             = 0._wp
145      calving_used_net          = 0._wp
146      calving_to_bergs_net      = 0._wp
147      heat_to_bergs_net         = 0._wp
148      heat_to_ocean_net         = 0._wp
149      calving_rcv_net           = 0._wp
150      calving_ret_net           = 0._wp
151      calving_src_net           = 0._wp
152      calving_out_net           = 0._wp
153      calving_src_heat_net      = 0._wp
154      calving_src_heat_used_net = 0._wp
155      calving_out_heat_net      = 0._wp
156      melt_net                  = 0._wp
157      berg_melt_net             = 0._wp
158      bits_melt_net             = 0._wp
159      bits_src_net              = 0._wp
160
161      floating_mass_start       = icb_utl_mass( first_berg )
162      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.true. )
163      bits_mass_start           = icb_utl_mass( first_berg, justbits=.true. )
164      IF( lk_mpp ) THEN
165         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp
166         ALLOCATE( nsumbuf(4+nclasses) )  ; nsumbuf(:) = 0
167         rsumbuf(1) = floating_mass_start
168         rsumbuf(2) = bergs_mass_start
169         rsumbuf(3) = bits_mass_start
170         CALL mpp_sum( rsumbuf(1:3), 3 )
171         floating_mass_start = rsumbuf(1)
172         bergs_mass_start = rsumbuf(2)
173         bits_mass_start = rsumbuf(3)
174      ENDIF
175      !
176   END SUBROUTINE icb_dia_init
177
178
179   SUBROUTINE icb_dia( ld_budge )
180      !!----------------------------------------------------------------------
181      !!----------------------------------------------------------------------
182      LOGICAL, INTENT(in) ::   ld_budge
183      !
184      INTEGER             ::   ik
185      REAL(wp)            ::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass
186      !!----------------------------------------------------------------------
187      !
188      IF( .NOT. ln_bergdia )   RETURN
189
190      zunused_calving      = SUM( berg_grid%calving(:,:) )
191      ztmpsum              = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
192      melt_net             = melt_net + ztmpsum * berg_dt
193      calving_out_net      = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt
194      ztmpsum              = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
195      berg_melt_net        = berg_melt_net + ztmpsum * berg_dt
196      ztmpsum              = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) )
197      bits_src_net         = bits_src_net + ztmpsum * berg_dt
198      ztmpsum              = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
199      bits_melt_net        = bits_melt_net + ztmpsum * berg_dt
200      ztmpsum              = SUM( src_calving(:,:) * tmask_i(:,:) )
201      calving_ret_net      = calving_ret_net + ztmpsum * berg_dt
202      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) )
203      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J
204
205      IF( ld_budge ) THEN
206         stored_end        = SUM( berg_grid%stored_ice(:,:,:) )
207         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) )
208         floating_mass_end = icb_utl_mass( first_berg )
209         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.true. )
210         bits_mass_end     = icb_utl_mass( first_berg,justbits=.true. )
211         floating_heat_end = icb_utl_heat( first_berg )
212
213         nbergs_end        = icb_utl_count()
214         zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) )
215         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
216
217         IF( lk_mpp ) THEN
218            rsumbuf( 1) = stored_end
219            rsumbuf( 2) = stored_heat_end
220            rsumbuf( 3) = floating_mass_end
221            rsumbuf( 4) = bergs_mass_end
222            rsumbuf( 5) = bits_mass_end
223            rsumbuf( 6) = floating_heat_end
224            rsumbuf( 7) = calving_ret_net
225            rsumbuf( 8) = calving_out_net
226            rsumbuf( 9) = calving_rcv_net
227            rsumbuf(10) = calving_src_net
228            rsumbuf(11) = calving_src_heat_net
229            rsumbuf(12) = calving_src_heat_used_net
230            rsumbuf(13) = calving_out_heat_net
231            rsumbuf(14) = calving_used_net
232            rsumbuf(15) = calving_to_bergs_net
233            rsumbuf(16) = heat_to_bergs_net
234            rsumbuf(17) = heat_to_ocean_net
235            rsumbuf(18) = melt_net
236            rsumbuf(19) = berg_melt_net
237            rsumbuf(20) = bits_src_net
238            rsumbuf(21) = bits_melt_net
239            rsumbuf(22) = zgrdd_berg_mass
240            rsumbuf(23) = zgrdd_bits_mass
241
242            CALL mpp_sum( rsumbuf(1:23), 23)
243
244            stored_end                = rsumbuf( 1)
245            stored_heat_end           = rsumbuf( 2)
246            floating_mass_end         = rsumbuf( 3)
247            bergs_mass_end            = rsumbuf( 4)
248            bits_mass_end             = rsumbuf( 5)
249            floating_heat_end         = rsumbuf( 6)
250            calving_ret_net           = rsumbuf( 7)
251            calving_out_net           = rsumbuf( 8)
252            calving_rcv_net           = rsumbuf( 9)
253            calving_src_net           = rsumbuf(10)
254            calving_src_heat_net      = rsumbuf(11)
255            calving_src_heat_used_net = rsumbuf(12)
256            calving_out_heat_net      = rsumbuf(13)
257            calving_used_net          = rsumbuf(14)
258            calving_to_bergs_net      = rsumbuf(15)
259            heat_to_bergs_net         = rsumbuf(16)
260            heat_to_ocean_net         = rsumbuf(17)
261            melt_net                  = rsumbuf(18)
262            berg_melt_net             = rsumbuf(19)
263            bits_src_net              = rsumbuf(20)
264            bits_melt_net             = rsumbuf(21)
265            zgrdd_berg_mass           = rsumbuf(22)
266            zgrdd_bits_mass           = rsumbuf(23)
267
268            nsumbuf(1) = nbergs_end
269            nsumbuf(2) = nbergs_calved
270            nsumbuf(3) = nbergs_melted
271            nsumbuf(4) = nspeeding_tickets
272            DO ik = 1, nclasses
273               nsumbuf(4+ik) = nbergs_calved_by_class(ik)
274            END DO
275
276            CALL mpp_sum( nsumbuf(1:nclasses+4), nclasses+4 )
277
278            nbergs_end        = nsumbuf(1)
279            nbergs_calved     = nsumbuf(2)
280            nbergs_melted     = nsumbuf(3)
281            nspeeding_tickets = nsumbuf(4)
282            DO ik = 1,nclasses
283               nbergs_calved_by_class(ik)= nsumbuf(4+ik)
284            ENDDO
285
286         ENDIF
287
288         CALL report_state( 'stored ice','kg','',stored_start,'',stored_end,'')
289         CALL report_state( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end)
290         CALL report_state( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'')
291         CALL report_state( 'bits','kg','',bits_mass_start,'',bits_mass_end,'')
292         CALL report_istate( 'berg #','',nbergs_start,'',nbergs_end,'')
293         CALL report_ibudget( 'berg #','calved',nbergs_calved, &
294                                       'melted',nbergs_melted, &
295                                       '#',nbergs_start,nbergs_end)
296         CALL report_budget( 'stored mass','kg','calving used',calving_used_net, &
297                                           'bergs',calving_to_bergs_net, &
298                                           'stored mass',stored_start,stored_end)
299         CALL report_budget( 'floating mass','kg','calving used',calving_to_bergs_net, &
300                                             'bergs',melt_net, &
301                                             'stored mass',floating_mass_start,floating_mass_end)
302         CALL report_budget( 'berg mass','kg','calving',calving_to_bergs_net, &
303                                              'melt+eros',berg_melt_net, &
304                                              'berg mass',bergs_mass_start,bergs_mass_end)
305         CALL report_budget( 'bits mass','kg','eros used',bits_src_net, &
306                                              'bergs',bits_melt_net, &
307                                              'stored mass',bits_mass_start,bits_mass_end)
308         CALL report_budget( 'net mass','kg','recvd',calving_rcv_net, &
309                                             'rtrnd',calving_ret_net, &
310                                             'net mass',stored_start+floating_mass_start, &
311                                                        stored_end+floating_mass_end)
312         CALL report_consistant( 'iceberg mass','kg','gridded',zgrdd_berg_mass,'bergs',bergs_mass_end)
313         CALL report_consistant( 'bits mass','kg','gridded',zgrdd_bits_mass,'bits',bits_mass_end)
314         CALL report_state( 'net heat','J','',stored_heat_start+floating_heat_start,'', &
315                                              stored_heat_end+floating_heat_end,'')
316         CALL report_state( 'stored heat','J','',stored_heat_start,'',stored_heat_end,'')
317         CALL report_state( 'floating heat','J','',floating_heat_start,'',floating_heat_end,'')
318         CALL report_budget( 'net heat','J','net heat',calving_src_heat_net, &
319                                            'net heat',calving_out_heat_net, &
320                                            'net heat',stored_heat_start+floating_heat_start, &
321                                                       stored_heat_end+floating_heat_end)
322         CALL report_budget( 'stored heat','J','calving used',calving_src_heat_used_net, &
323                                               'bergs',heat_to_bergs_net, &
324                                               'net heat',stored_heat_start,stored_heat_end)
325         CALL report_budget( 'flting heat','J','calved',heat_to_bergs_net, &
326                                               'melt',heat_to_ocean_net, &
327                                               'net heat',floating_heat_start,floating_heat_end)
328         IF (nn_verbose_level >= 1) THEN
329            CALL report_consistant( 'top interface','kg','from SIS',calving_src_net, &
330                                    'received',calving_rcv_net)
331            CALL report_consistant( 'bot interface','kg','sent',calving_out_net, &
332                                    'returned',calving_ret_net)
333         ENDIF
334         WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
335         IF ( nspeeding_tickets > 0 ) WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets
336
337         nbergs_start              = nbergs_end
338         stored_start              = stored_end
339         nbergs_melted             = 0
340         nbergs_calved             = 0
341         nbergs_calved_by_class(:) = 0
342         nspeeding_tickets         = 0
343         stored_heat_start         = stored_heat_end
344         floating_heat_start       = floating_heat_end
345         floating_mass_start       = floating_mass_end
346         bergs_mass_start          = bergs_mass_end
347         bits_mass_start           = bits_mass_end
348         calving_used_net          = 0._wp
349         calving_to_bergs_net      = 0._wp
350         heat_to_bergs_net         = 0._wp
351         heat_to_ocean_net         = 0._wp
352         calving_rcv_net           = 0._wp
353         calving_ret_net           = 0._wp
354         calving_src_net           = 0._wp
355         calving_out_net           = 0._wp
356         calving_src_heat_net      = 0._wp
357         calving_src_heat_used_net = 0._wp
358         calving_out_heat_net      = 0._wp
359         melt_net                  = 0._wp
360         berg_melt_net             = 0._wp
361         bits_melt_net             = 0._wp
362         bits_src_net              = 0._wp
363      ENDIF
364      !
365   END SUBROUTINE icb_dia
366
367
368   SUBROUTINE icb_dia_step
369      !!----------------------------------------------------------------------
370      !! things to reset at the beginning of each timestep
371      !! this probably screws up fields going to diawri, so needs to be looked at - sga
372      !!----------------------------------------------------------------------
373      !
374      IF( .NOT. ln_bergdia ) RETURN
375      berg_melt    (:,:)   = 0._wp
376      buoy_melt    (:,:)   = 0._wp
377      eros_melt    (:,:)   = 0._wp
378      conv_melt    (:,:)   = 0._wp
379      bits_src     (:,:)   = 0._wp
380      bits_melt    (:,:)   = 0._wp
381      bits_mass    (:,:)   = 0._wp
382      berg_mass    (:,:)   = 0._wp
383      virtual_area (:,:)   = 0._wp
384      real_calving (:,:,:) = 0._wp
385      !
386   END SUBROUTINE icb_dia_step
387
388
389   SUBROUTINE icb_dia_put
390      !!----------------------------------------------------------------------
391      !!----------------------------------------------------------------------
392      !
393      IF( .NOT. ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not
394      !
395      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s]
396      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
397      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
398      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
399      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
400      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
401      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
402      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
403      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
404      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
405      !
406   END SUBROUTINE icb_dia_put
407
408
409   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
410      !!----------------------------------------------------------------------
411      !!----------------------------------------------------------------------
412      INTEGER,  INTENT(in)  ::   ki, kj, kn
413      REAL(wp), INTENT(in)  ::   pcalved
414      REAL(wp), INTENT(in)  ::   pheated
415      !!----------------------------------------------------------------------
416      !
417      IF( .NOT. ln_bergdia ) RETURN
418      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
419      nbergs_calved              = nbergs_calved              + 1
420      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
421      calving_to_bergs_net       = calving_to_bergs_net + pcalved
422      heat_to_bergs_net          = heat_to_bergs_net    + pheated
423      !
424   END SUBROUTINE icb_dia_calve
425
426
427   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
428      !!----------------------------------------------------------------------
429      !!----------------------------------------------------------------------
430      INTEGER ,                 INTENT(in)  :: kt
431      REAL(wp),                 INTENT(in)  :: pcalving_used
432      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
433      !!----------------------------------------------------------------------
434      !
435      IF( .NOT. ln_bergdia ) RETURN
436      !
437      IF( kt == nit000 ) THEN
438         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
439         IF( lk_mpp ) CALL mpp_sum( stored_start )
440         WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
441         !
442         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
443         IF( lk_mpp ) CALL mpp_sum( stored_heat_start )
444         WRITE(numicb,'(a,es13.6,a)')    'icb_dia_income: initial stored heat=',stored_heat_start,' J'
445      ENDIF
446      !
447      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
448      calving_src_net = calving_rcv_net
449      calving_src_heat_net = calving_src_heat_net +  &
450         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
451      calving_used_net = calving_used_net + pcalving_used * berg_dt
452      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
453      !
454   END SUBROUTINE icb_dia_income
455
456
457   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
458      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
459      !!----------------------------------------------------------------------
460      !!----------------------------------------------------------------------
461      INTEGER,  INTENT(in) :: ki, kj
462      REAL(wp), INTENT(in) :: pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
463      !!----------------------------------------------------------------------
464      !
465      IF( .NOT. ln_bergdia ) RETURN
466      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
467      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
468      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
469      !
470   END SUBROUTINE icb_dia_size
471
472
473   SUBROUTINE icb_dia_speed()
474      !!----------------------------------------------------------------------
475      !!----------------------------------------------------------------------
476      !
477      IF( .NOT. ln_bergdia ) RETURN
478      nspeeding_tickets = nspeeding_tickets + 1
479      !
480   END SUBROUTINE icb_dia_speed
481
482
483   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,   &
484      &                   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
485      &                   pdMv, pz1_dt_e1e2 )
486      !!----------------------------------------------------------------------
487      !!----------------------------------------------------------------------
488      INTEGER , INTENT(in) ::   ki, kj
489      REAL(wp), INTENT(in) ::   pmnew, pheat, pmass_scale
490      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
491      !!----------------------------------------------------------------------
492      !
493      IF( .NOT. ln_bergdia ) RETURN
494
495      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
496      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
497      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
498      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
499      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
500      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
501      heat_to_ocean_net = heat_to_ocean_net + pheat * pmass_scale * berg_dt         ! J
502      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
503      !
504   END SUBROUTINE icb_dia_melt
505
506
507   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
508      &                     pendval, cd_delstr, kbergs )
509      !!----------------------------------------------------------------------
510      !!----------------------------------------------------------------------
511      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
512      REAL(wp),      INTENT(in)           :: pstartval, pendval
513      INTEGER,       INTENT(in), OPTIONAL :: kbergs
514      !!----------------------------------------------------------------------
515      !
516      IF ( PRESENT(kbergs) ) THEN
517         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
518                           cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
519                           cd_endstr    // ' end',    pendval,           cd_budgetunits, &
520                           'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
521                           '# of bergs', kbergs
522      ELSE
523         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
524                           cd_startstr  // ' start', pstartval,         cd_budgetunits, &
525                           cd_endstr    // ' end',   pendval,           cd_budgetunits, &
526                           cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
527      ENDIF
528      100 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
529   END SUBROUTINE report_state
530
531
532   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
533      !!----------------------------------------------------------------------
534      !!----------------------------------------------------------------------
535      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
536      REAL(wp),      INTENT(in) :: pstartval, pendval
537      !!----------------------------------------------------------------------
538      !
539      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
540                        cd_startstr,    pstartval, cd_budgetunits, &
541                        cd_endstr,      pendval,   cd_budgetunits, &
542                        'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
543      200 FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
544   END SUBROUTINE report_consistant
545
546
547   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
548      &                      poutval, cd_delstr, pstartval, pendval)
549      !!----------------------------------------------------------------------
550      !!----------------------------------------------------------------------
551      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
552      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
553      !
554      REAL(wp)                  :: zval
555      !!----------------------------------------------------------------------
556      !
557      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
558         &   MAX( 1.e-30, MAX( abs( pendval - pstartval ) , ABS( pinval - poutval ) ) )
559
560      WRITE(numicb,200) cd_budgetstr // ' budget:', &
561         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
562         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
563         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
564         &              'error',        zval,                       'nd'
565  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
566      !
567   END SUBROUTINE report_budget
568
569
570   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
571      !!----------------------------------------------------------------------
572      !!----------------------------------------------------------------------
573      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
574      INTEGER,       INTENT(in) :: pstartval, pendval
575      !
576      WRITE(numicb,100) cd_budgetstr // ' state:',           &
577         &              cd_startstr  // ' start', pstartval, &
578         &              cd_endstr    // ' end',   pendval,   &
579         &              cd_delstr    // 'Delta',  pendval-pstartval
580  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
581      !
582   END SUBROUTINE report_istate
583
584
585   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
586      &                       cd_delstr, pstartval, pendval)
587      !!----------------------------------------------------------------------
588      !!----------------------------------------------------------------------
589      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
590      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
591      !!----------------------------------------------------------------------
592      !
593      WRITE(numicb,200) cd_budgetstr // ' budget:', &
594                        cd_instr     // ' in',      pinval, &
595                        cd_outstr    // ' out',     poutval, &
596                        'Delta '     // cd_delstr,  pinval-poutval, &
597                        'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
598      200 FORMAT(a19,10(a18,"=",i14,x,:,","))
599   END SUBROUTINE report_ibudget
600
601   !!======================================================================
602END MODULE icbdia
Note: See TracBrowser for help on using the repository browser.