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