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

Context Navigation

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

Last change on this file since 3339 was 3339, checked in by sga, 12 years ago
NEMO branch dev_r3337_NOCS10_ICB: add new iceberg sub-directory ICB
File size: 29.4 KB

Line
1	MODULE icbdia
2
3	!!======================================================================
4	!! * MODULE icbdia *
5	!! Ocean physics: initialise variables for iceberg budgets and diagnostics
6	!!======================================================================
7	!! History : 3.3.1 ! 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 ! nemo parameters
20	USE dom_oce ! ocean domain
21	USE in_out_manager ! nemo IO
22	USE lib_mpp
23	USE iom
24
25	USE icb_oce ! define iceberg arrays
26	USE icbutl ! iceberg utility routines
27
28	IMPLICIT NONE
29	PRIVATE
30
31	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: berg_melt=>NULL() ! Melting+erosion rate of icebergs (kg/s/m^2)
32	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: melt_buoy=>NULL() ! Buoyancy component of melting rate (kg/s/m^2)
33	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: melt_eros=>NULL() ! Erosion component of melting rate (kg/s/m^2)
34	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: melt_conv=>NULL() ! Convective component of melting rate (kg/s/m^2)
35	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: bits_src=>NULL() ! Mass flux from berg erosion into bergy bits (kg/s/m^2)
36	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: bits_melt=>NULL() ! Melting rate of bergy bits (kg/s/m^2)
37	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: bits_mass=>NULL() ! Mass distribution of bergy bits (kg/s/m^2)
38	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: virtual_area=>NULL() ! Virtual surface coverage by icebergs (m^2)
39	REAL(wp), DIMENSION(:,:) , POINTER, PUBLIC :: berg_mass=>NULL() ! Mass distribution (kg/m^2)
40	REAL(wp), DIMENSION(:,:,:), POINTER, PUBLIC :: real_calving=>NULL() ! Calving rate into iceberg class at calving locations (kg/s)
41	REAL(wp), DIMENSION(:,:) , POINTER, PRIVATE :: tmpc=>NULL() ! Temporary work space
42	REAL(wp), DIMENSION(:) , POINTER, PRIVATE :: zsumbuf=>NULL() ! Temporary work space
43	INTEGER , DIMENSION(:) , POINTER, PRIVATE :: isumbuf=>NULL() ! Temporary work space
44
45	REAL(wp) , PRIVATE :: net_berg_melt
46	REAL(wp) , PRIVATE :: net_bits_src
47	REAL(wp) , PRIVATE :: net_bits_melt
48	REAL(wp) , PRIVATE :: bits_mass_start, bits_mass_end
49	REAL(wp) , PRIVATE :: floating_heat_start, floating_heat_end
50	REAL(wp) , PRIVATE :: floating_mass_start, floating_mass_end
51	REAL(wp) , PRIVATE :: icebergs_mass_start, icebergs_mass_end
52	REAL(wp) , PRIVATE :: stored_start, stored_heat_start
53	REAL(wp) , PRIVATE :: stored_end , stored_heat_end
54	REAL(wp) , PRIVATE :: net_incoming_calving, net_outgoing_calving
55	REAL(wp) , PRIVATE :: net_incoming_calving_heat, net_outgoing_calving_heat
56	REAL(wp) , PRIVATE :: net_incoming_calving_heat_used
57	REAL(wp) , PRIVATE :: net_calving_received, net_calving_returned, net_calving_used
58	REAL(wp) , PRIVATE :: net_heat_to_bergs, net_heat_to_ocean, net_melt
59	REAL(wp) , PRIVATE :: net_calving_to_bergs
60
61	INTEGER , PRIVATE :: nbergs_start, nbergs_end, nbergs_calved
62	INTEGER , PRIVATE :: nbergs_melted
63	INTEGER , PRIVATE :: nspeeding_tickets
64	INTEGER , DIMENSION(nclasses) , PRIVATE :: nbergs_calved_by_class
65
66	PUBLIC icb_budget_end ! routine called in xxx.F90 module
67	PUBLIC icb_budget_init ! routine called in xxx.F90 module
68	PUBLIC icb_budget ! routine called in xxx.F90 module
69	PUBLIC icb_budget_step ! routine called in xxx.F90 module
70	PUBLIC icb_budget_put ! routine called in xxx.F90 module
71	PUBLIC melt_budget ! routine called in xxx.F90 module
72	PUBLIC size_budget ! routine called in xxx.F90 module
73	PUBLIC speed_budget ! routine called in xxx.F90 module
74	PUBLIC calving_budget ! routine called in xxx.F90 module
75	PUBLIC incoming_budget ! routine called in xxx.F90 module
76
77	CONTAINS
78
79	!!-------------------------------------------------------------------------
80
81	SUBROUTINE icb_budget_end
82
83	IF( .NOT. ln_bergdia ) RETURN
84	DEALLOCATE( berg_melt )
85	DEALLOCATE( melt_buoy )
86	DEALLOCATE( melt_eros )
87	DEALLOCATE( melt_conv )
88	DEALLOCATE( bits_src )
89	DEALLOCATE( bits_melt )
90	DEALLOCATE( bits_mass )
91	DEALLOCATE( virtual_area )
92	DEALLOCATE( berg_mass )
93	DEALLOCATE( real_calving )
94	DEALLOCATE( tmpc )
95	IF( lk_mpp ) THEN
96	DEALLOCATE( zsumbuf )
97	DEALLOCATE( isumbuf )
98	ENDIF
99
100	END SUBROUTINE icb_budget_end
101
102	!!-------------------------------------------------------------------------
103
104	SUBROUTINE icb_budget_init( )
105
106	IF( .NOT. ln_bergdia ) RETURN
107	ALLOCATE( berg_melt (jpi,jpj) ) ; berg_melt (:,:) = 0._wp
108	ALLOCATE( melt_buoy (jpi,jpj) ) ; melt_buoy (:,:) = 0._wp
109	ALLOCATE( melt_eros (jpi,jpj) ) ; melt_eros (:,:) = 0._wp
110	ALLOCATE( melt_conv (jpi,jpj) ) ; melt_conv (:,:) = 0._wp
111	ALLOCATE( bits_src (jpi,jpj) ) ; bits_src (:,:) = 0._wp
112	ALLOCATE( bits_melt (jpi,jpj) ) ; bits_melt (:,:) = 0._wp
113	ALLOCATE( bits_mass (jpi,jpj) ) ; bits_mass (:,:) = 0._wp
114	ALLOCATE( virtual_area (jpi,jpj) ) ; virtual_area (:,:) = 0._wp
115	ALLOCATE( berg_mass (jpi,jpj) ) ; berg_mass (:,:) = 0._wp
116	ALLOCATE( real_calving (jpi,jpj,nclasses) ) ; real_calving (:,:,:)=0.
117	ALLOCATE( tmpc(jpi,jpj) ) ; tmpc(:,:)=0.
118
119	nbergs_start = 0
120	nbergs_end = 0
121	stored_end = 0._wp
122	nbergs_start = 0._wp
123	stored_start = 0._wp
124	nbergs_melted = 0
125	nbergs_calved = 0
126	nbergs_calved_by_class(:) = 0
127	nspeeding_tickets = 0
128	stored_heat_end = 0._wp
129	floating_heat_end = 0._wp
130	floating_mass_end = 0._wp
131	icebergs_mass_end = 0._wp
132	bits_mass_end = 0._wp
133	stored_heat_start = 0._wp
134	floating_heat_start = 0._wp
135	floating_mass_start = 0._wp
136	icebergs_mass_start = 0._wp
137	bits_mass_start = 0._wp
138	bits_mass_end = 0._wp
139	net_calving_used = 0._wp
140	net_calving_to_bergs = 0._wp
141	net_heat_to_bergs = 0._wp
142	net_heat_to_ocean = 0._wp
143	net_calving_received = 0._wp
144	net_calving_returned = 0._wp
145	net_incoming_calving = 0._wp
146	net_outgoing_calving = 0._wp
147	net_incoming_calving_heat = 0._wp
148	net_incoming_calving_heat_used = 0._wp
149	net_outgoing_calving_heat = 0._wp
150	net_melt = 0._wp
151	net_berg_melt = 0._wp
152	net_bits_melt = 0._wp
153	net_bits_src = 0._wp
154
155	floating_mass_start = sum_mass( first_berg )
156	icebergs_mass_start = sum_mass( first_berg, justbergs=.true. )
157	bits_mass_start = sum_mass( first_berg, justbits=.true. )
158	IF( lk_mpp ) THEN
159	ALLOCATE( zsumbuf(23) ) ; zsumbuf(:) = 0._wp
160	ALLOCATE( isumbuf(4+nclasses) ) ; isumbuf(:) = 0
161	zsumbuf(1) = floating_mass_start
162	zsumbuf(2) = icebergs_mass_start
163	zsumbuf(3) = bits_mass_start
164	CALL mpp_sum( zsumbuf(1:3), 3 )
165	floating_mass_start = zsumbuf(1)
166	icebergs_mass_start = zsumbuf(2)
167	bits_mass_start = zsumbuf(3)
168	ENDIF
169
170	END SUBROUTINE icb_budget_init
171
172	!!-------------------------------------------------------------------------
173
174	SUBROUTINE icb_budget( lbudge )
175	! Arguments
176	LOGICAL :: lbudge
177	! Local variables
178	INTEGER :: k
179	REAL(wp) :: unused_calving, tmpsum, grdd_berg_mass, grdd_bits_mass
180
181	IF( .NOT. ln_bergdia ) RETURN
182
183	unused_calving = SUM( berg_grid%calving(:,:) )
184	tmpsum = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
185	net_melt = net_melt + tmpsum * berg_dt
186	net_outgoing_calving = net_outgoing_calving + ( unused_calving + tmpsum ) * berg_dt
187	tmpsum = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
188	net_berg_melt = net_berg_melt + tmpsum * berg_dt
189	tmpsum = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) )
190	net_bits_src = net_bits_src + tmpsum * berg_dt
191	tmpsum = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
192	net_bits_melt = net_bits_melt + tmpsum * berg_dt
193	tmpsum = SUM( p_calving(:,:) * tmask_i(:,:) )
194	net_calving_returned = net_calving_returned+tmpsum * berg_dt
195	tmpsum = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) )
196	net_outgoing_calving_heat = net_outgoing_calving_heat + tmpsum * berg_dt ! Units of J
197
198	IF( lbudge ) THEN
199	stored_end = SUM( berg_grid%stored_ice(:,:,:) )
200	stored_heat_end = SUM( berg_grid%stored_heat(:,:) )
201	floating_mass_end = sum_mass( first_berg )
202	icebergs_mass_end = sum_mass( first_berg,justbergs=.true. )
203	bits_mass_end = sum_mass( first_berg,justbits=.true. )
204	floating_heat_end = sum_heat( first_berg )
205
206	nbergs_end = count_bergs()
207	grdd_berg_mass = SUM( berg_mass (:,:)e1e2t(:,:)tmask_i(:,:) )
208	grdd_bits_mass = SUM( bits_mass(:,:)e1e2t(:,:)tmask_i(:,:) )
209
210	IF( lk_mpp ) THEN
211	zsumbuf( 1) = stored_end
212	zsumbuf( 2) = stored_heat_end
213	zsumbuf( 3) = floating_mass_end
214	zsumbuf( 4) = icebergs_mass_end
215	zsumbuf( 5) = bits_mass_end
216	zsumbuf( 6) = floating_heat_end
217	zsumbuf( 7) = net_calving_returned
218	zsumbuf( 8) = net_outgoing_calving
219	zsumbuf( 9) = net_calving_received
220	zsumbuf(10) = net_incoming_calving
221	zsumbuf(11) = net_incoming_calving_heat
222	zsumbuf(12) = net_incoming_calving_heat_used
223	zsumbuf(13) = net_outgoing_calving_heat
224	zsumbuf(14) = net_calving_used
225	zsumbuf(15) = net_calving_to_bergs
226	zsumbuf(16) = net_heat_to_bergs
227	zsumbuf(17) = net_heat_to_ocean
228	zsumbuf(18) = net_melt
229	zsumbuf(19) = net_berg_melt
230	zsumbuf(20) = net_bits_src
231	zsumbuf(21) = net_bits_melt
232	zsumbuf(22) = grdd_berg_mass
233	zsumbuf(23) = grdd_bits_mass
234
235	CALL mpp_sum( zsumbuf(1:23), 23)
236
237	stored_end = zsumbuf( 1)
238	stored_heat_end = zsumbuf( 2)
239	floating_mass_end = zsumbuf( 3)
240	icebergs_mass_end = zsumbuf( 4)
241	bits_mass_end = zsumbuf( 5)
242	floating_heat_end = zsumbuf( 6)
243	net_calving_returned = zsumbuf( 7)
244	net_outgoing_calving = zsumbuf( 8)
245	net_calving_received = zsumbuf( 9)
246	net_incoming_calving = zsumbuf(10)
247	net_incoming_calving_heat = zsumbuf(11)
248	net_incoming_calving_heat_used = zsumbuf(12)
249	net_outgoing_calving_heat = zsumbuf(13)
250	net_calving_used = zsumbuf(14)
251	net_calving_to_bergs = zsumbuf(15)
252	net_heat_to_bergs = zsumbuf(16)
253	net_heat_to_ocean = zsumbuf(17)
254	net_melt = zsumbuf(18)
255	net_berg_melt = zsumbuf(19)
256	net_bits_src = zsumbuf(20)
257	net_bits_melt = zsumbuf(21)
258	grdd_berg_mass = zsumbuf(22)
259	grdd_bits_mass = zsumbuf(23)
260
261	isumbuf(1) = nbergs_end
262	isumbuf(2) = nbergs_calved
263	isumbuf(3) = nbergs_melted
264	isumbuf(4) = nspeeding_tickets
265	DO k = 1,nclasses
266	isumbuf(4+k) = nbergs_calved_by_class(k)
267	ENDDO
268
269	CALL mpp_sum( isumbuf(1:nclasses+4), nclasses+4 )
270
271	nbergs_end = isumbuf(1)
272	nbergs_calved = isumbuf(2)
273	nbergs_melted = isumbuf(3)
274	nspeeding_tickets = isumbuf(4)
275	DO k = 1,nclasses
276	nbergs_calved_by_class(k)= isumbuf(4+k)
277	ENDDO
278
279	ENDIF
280
281	CALL report_state('stored ice','kg','',stored_start,'',stored_end,'')
282	CALL report_state('floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end)
283	CALL report_state('icebergs','kg','',icebergs_mass_start,'',icebergs_mass_end,'')
284	CALL report_state('bits','kg','',bits_mass_start,'',bits_mass_end,'')
285	CALL report_istate('berg #','',nbergs_start,'',nbergs_end,'')
286	CALL report_ibudget('berg #','calved',nbergs_calved, &
287	'melted',nbergs_melted, &
288	'#',nbergs_start,nbergs_end)
289	CALL report_budget('stored mass','kg','calving used',net_calving_used, &
290	'bergs',net_calving_to_bergs, &
291	'stored mass',stored_start,stored_end)
292	CALL report_budget('floating mass','kg','calving used',net_calving_to_bergs, &
293	'bergs',net_melt, &
294	'stored mass',floating_mass_start,floating_mass_end)
295	CALL report_budget('berg mass','kg','calving',net_calving_to_bergs, &
296	'melt+eros',net_berg_melt, &
297	'berg mass',icebergs_mass_start,icebergs_mass_end)
298	CALL report_budget('bits mass','kg','eros used',net_bits_src, &
299	'bergs',net_bits_melt, &
300	'stored mass',bits_mass_start,bits_mass_end)
301	CALL report_budget('net mass','kg','recvd',net_calving_received, &
302	'rtrnd',net_calving_returned, &
303	'net mass',stored_start+floating_mass_start, &
304	stored_end+floating_mass_end)
305	CALL report_consistant('iceberg mass','kg','gridded',grdd_berg_mass,'bergs',icebergs_mass_end)
306	CALL report_consistant('bits mass','kg','gridded',grdd_bits_mass,'bits',bits_mass_end)
307	CALL report_state('net heat','J','',stored_heat_start+floating_heat_start,'', &
308	stored_heat_end+floating_heat_end,'')
309	CALL report_state('stored heat','J','',stored_heat_start,'',stored_heat_end,'')
310	CALL report_state('floating heat','J','',floating_heat_start,'',floating_heat_end,'')
311	CALL report_budget('net heat','J','net heat',net_incoming_calving_heat, &
312	'net heat',net_outgoing_calving_heat, &
313	'net heat',stored_heat_start+floating_heat_start, &
314	stored_heat_end+floating_heat_end)
315	CALL report_budget('stored heat','J','calving used',net_incoming_calving_heat_used, &
316	'bergs',net_heat_to_bergs, &
317	'net heat',stored_heat_start,stored_heat_end)
318	CALL report_budget('flting heat','J','calved',net_heat_to_bergs, &
319	'melt',net_heat_to_ocean, &
320	'net heat',floating_heat_start,floating_heat_end)
321	IF (nn_verbose_level >= 1) THEN
322	CALL report_consistant('top interface','kg','from SIS',net_incoming_calving, &
323	'received',net_calving_received)
324	CALL report_consistant('bot interface','kg','sent',net_outgoing_calving, &
325	'returned',net_calving_returned)
326	ENDIF
327	WRITE(numicb,'("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(k),k=1,nclasses)
328	IF ( nspeeding_tickets .GT. 0 ) WRITE(numicb,'("speeding tickets issued = ",i6)') nspeeding_tickets
329
330	nbergs_start = nbergs_end
331	stored_start = stored_end
332	nbergs_melted = 0
333	nbergs_calved = 0
334	nbergs_calved_by_class(:) = 0
335	nspeeding_tickets = 0
336	stored_heat_start = stored_heat_end
337	floating_heat_start = floating_heat_end
338	floating_mass_start = floating_mass_end
339	icebergs_mass_start = icebergs_mass_end
340	bits_mass_start = bits_mass_end
341	net_calving_used = 0._wp
342	net_calving_to_bergs = 0._wp
343	net_heat_to_bergs = 0._wp
344	net_heat_to_ocean = 0._wp
345	net_calving_received = 0._wp
346	net_calving_returned = 0._wp
347	net_incoming_calving = 0._wp
348	net_outgoing_calving = 0._wp
349	net_incoming_calving_heat = 0._wp
350	net_incoming_calving_heat_used = 0._wp
351	net_outgoing_calving_heat = 0._wp
352	net_melt = 0._wp
353	net_berg_melt = 0._wp
354	net_bits_melt = 0._wp
355	net_bits_src = 0._wp
356	ENDIF
357
358	END SUBROUTINE icb_budget
359
360	!!-------------------------------------------------------------------------
361
362	SUBROUTINE icb_budget_step
363	!! things to reset at the beginning of each timestep
364	!! this probably screws up fields going to diawri, so needs to be looked at - sga
365
366	IF( .NOT. ln_bergdia ) RETURN
367	berg_melt (:,:) = 0._wp
368	melt_buoy (:,:) = 0._wp
369	melt_eros (:,:) = 0._wp
370	melt_conv (:,:) = 0._wp
371	bits_src (:,:) = 0._wp
372	bits_melt (:,:) = 0._wp
373	bits_mass (:,:) = 0._wp
374	berg_mass (:,:) = 0._wp
375	virtual_area (:,:) = 0._wp
376	real_calving (:,:,:) = 0._wp
377
378	END SUBROUTINE icb_budget_step
379
380	!!-------------------------------------------------------------------------
381
382	SUBROUTINE icb_budget_put
383
384	IF( .NOT. ln_bergdia ) RETURN
385	CALL iom_put( "berg_melt" , berg_melt (:,:) ) ! 'Melt rate of icebergs' , 'kg/m2/s'
386	CALL iom_put( "berg_melt_buoy" , melt_buoy (:,:) ) ! 'Buoyancy component of iceberg melt rate' , 'kg/m2/s'
387	CALL iom_put( "berg_melt_eros" , melt_eros (:,:) ) ! 'Erosion component of iceberg melt rate' , 'kg/m2/s'
388	CALL iom_put( "berg_melt_conv" , melt_conv (:,:) ) ! 'Convective component of iceberg melt rate', 'kg/m2/s'
389	CALL iom_put( "berg_virtual_area" , virtual_area (:,:) ) ! 'Virtual coverage by icebergs' , 'm2'
390	CALL iom_put( "bits_src" , bits_src (:,:) ) ! 'Mass source of bergy bits' , 'kg/m2/s'
391	CALL iom_put( "bits_melt" , bits_melt (:,:) ) ! 'Melt rate of bergy bits' , 'kg/m2/s'
392	CALL iom_put( "bits_mass" , bits_mass (:,:) ) ! 'Bergy bit density field' , 'kg/m2'
393	CALL iom_put( "berg_mass" , berg_mass (:,:) ) ! 'Iceberg density field' , 'kg/m2'
394	CALL iom_put( "berg_real_calving" , real_calving (:,:,:) ) ! 'Calving into iceberg class' , 'kg/s'
395
396	END SUBROUTINE icb_budget_put
397
398	!!-------------------------------------------------------------------------
399
400	SUBROUTINE calving_budget( ji, jj, jn, calved, heated )
401	INTEGER :: ji, jj, jn
402	REAL(wp) :: calved
403	REAL(wp) :: heated
404
405	IF( .NOT. ln_bergdia ) RETURN
406	real_calving(ji,jj,jn) = real_calving(ji,jj,jn) + calved / berg_dt
407	nbergs_calved = nbergs_calved + 1
408	nbergs_calved_by_class(jn) = nbergs_calved_by_class(jn) + 1
409	net_calving_to_bergs = net_calving_to_bergs + calved
410	net_heat_to_bergs = net_heat_to_bergs + heated
411
412	END SUBROUTINE calving_budget
413
414	!!-------------------------------------------------------------------------
415
416	SUBROUTINE incoming_budget( kt, calving_used, heat_used )
417	INTEGER , INTENT(in) :: kt
418	REAL(wp), INTENT(in) :: calving_used
419	REAL(wp), DIMENSION(:,:), INTENT(in) :: heat_used
420
421	IF( .NOT. ln_bergdia ) RETURN
422
423	IF( kt == nit000 ) THEN
424	stored_start = SUM( berg_grid%stored_ice(:,:,:) )
425	IF( lk_mpp ) CALL mpp_sum( stored_start )
426	WRITE(numicb,'(a,es13.6,a)') 'accumulate_calving: initial stored mass=',stored_start,' kg'
427
428	stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
429	IF( lk_mpp ) CALL mpp_sum( stored_heat_start )
430	WRITE(numicb,'(a,es13.6,a)') 'accumulate_calving: initial stored heat=',stored_heat_start,' J'
431	ENDIF
432
433	net_calving_received = net_calving_received + SUM( berg_grid%calving(:,:) ) * berg_dt
434	net_incoming_calving = net_calving_received
435	net_incoming_calving_heat = net_incoming_calving_heat + &
436	SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt ! Units of J
437	net_calving_used = net_calving_used + calving_used * berg_dt
438	net_incoming_calving_heat_used = net_incoming_calving_heat_used + SUM( heat_used(:,:) )
439
440	END SUBROUTINE incoming_budget
441
442	!!-------------------------------------------------------------------------
443
444	SUBROUTINE size_budget(ji, jj, Wn, Ln, Abits, mass_scale, Mnew, nMbits, z1_e1e2)
445	INTEGER :: ji, jj
446	REAL(wp) :: Wn, Ln, Abits, mass_scale, Mnew, nMbits, z1_e1e2
447
448	IF( .NOT. ln_bergdia ) RETURN
449	virtual_area(ji,jj) = virtual_area(ji,jj)+(WnLn+Abits)mass_scale ! m^2
450	berg_mass(ji,jj) = berg_mass(ji,jj) + Mnew * z1_e1e2 ! kg/m2
451	bits_mass(ji,jj) = bits_mass(ji,jj) + nMbits * z1_e1e2 ! kg/m2
452
453	END SUBROUTINE size_budget
454
455	!!-------------------------------------------------------------------------
456
457	SUBROUTINE speed_budget()
458
459	IF( .NOT. ln_bergdia ) RETURN
460	nspeeding_tickets = nspeeding_tickets + 1
461
462	END SUBROUTINE speed_budget
463
464	!!-------------------------------------------------------------------------
465
466	SUBROUTINE melt_budget(ji, jj, mnew, heat, mass_scale, dM, dMbitsE, dMbitsM, dMb, dMe, dMv, z1_dt_e1e2)
467
468	INTEGER :: ji, jj
469	REAL(wp), INTENT(in) :: mnew, heat, mass_scale
470	REAL(wp), INTENT(in) :: dM, dMbitsE, dMbitsM, dMb, dMe, dMv, z1_dt_e1e2
471
472	IF( .NOT. ln_bergdia ) RETURN
473
474	berg_melt (ji,jj) = berg_melt (ji,jj) + dM * z1_dt_e1e2 ! kg/m2/s
475	bits_src (ji,jj) = bits_src (ji,jj) + dMbitsE * z1_dt_e1e2 ! mass flux into bergy bitskg/m2/s
476	bits_melt (ji,jj) = bits_melt (ji,jj) + dMbitsM * z1_dt_e1e2 ! melt rate of bergy bits kg/m2/s
477	melt_buoy (ji,jj) = melt_buoy (ji,jj) + dMb * z1_dt_e1e2 ! kg/m2/s
478	melt_eros (ji,jj) = melt_eros (ji,jj) + dMe * z1_dt_e1e2 ! erosion rate kg/m2/s
479	melt_conv (ji,jj) = melt_conv (ji,jj) + dMv * z1_dt_e1e2 ! kg/m2/s
480	net_heat_to_ocean = net_heat_to_ocean + heat * mass_scale * berg_dt ! J
481	IF( mnew <= 0._wp ) nbergs_melted = nbergs_melted + 1 ! Delete the berg if completely melted
482
483
484	END SUBROUTINE melt_budget
485
486	!!-------------------------------------------------------------------------
487
488	SUBROUTINE report_state(budgetstr,budgetunits,startstr,startval,endstr,endval,delstr,nbergs)
489	! Arguments
490	CHARACTER(), INTENT(in) :: budgetstr, budgetunits, startstr, endstr, delstr
491	REAL(wp), INTENT(in) :: startval, endval
492	INTEGER, INTENT(in), OPTIONAL :: nbergs
493
494	if (present(nbergs)) then
495	WRITE(numicb,100) budgetstr//' state:', &
496	startstr//' start',startval,budgetunits, &
497	endstr//' end',endval,budgetunits, &
498	'Delta '//delstr,endval-startval,budgetunits, &
499	'# of bergs',nbergs
500	else
501	WRITE(numicb,100) budgetstr//' state:', &
502	startstr//' start',startval,budgetunits, &
503	endstr//' end',endval,budgetunits, &
504	delstr//'Delta',endval-startval,budgetunits
505	endif
506	100 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
507	END SUBROUTINE report_state
508
509	!!-------------------------------------------------------------------------
510
511	SUBROUTINE report_consistant(budgetstr,budgetunits,startstr,startval,endstr,endval)
512	! Arguments
513	CHARACTER(), INTENT(in) :: budgetstr, budgetunits, startstr, endstr
514	REAL(wp), INTENT(in) :: startval, endval
515
516	WRITE(numicb,200) budgetstr//' check:', &
517	startstr,startval,budgetunits, &
518	endstr,endval,budgetunits, &
519	'error',(endval-startval)/((endval+startval)+1e-30),'nd'
520	200 FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
521	END SUBROUTINE report_consistant
522
523	!!-------------------------------------------------------------------------
524
525	SUBROUTINE report_budget(budgetstr,budgetunits,instr,inval,outstr,outval,delstr,startval,endval)
526	! Arguments
527	CHARACTER(), INTENT(in) :: budgetstr, budgetunits, instr, outstr, delstr
528	REAL(wp), INTENT(in) :: inval, outval, startval, endval
529
530	WRITE(numicb,200) budgetstr//' budget:', &
531	instr//' in',inval,budgetunits, &
532	outstr//' out',outval,budgetunits, &
533	'Delta '//delstr,inval-outval,budgetunits, &
534	'error',((endval-startval)-(inval-outval))/max(1.e-30,max(abs(endval-startval),abs(inval-outval))),'nd'
535	200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
536	END SUBROUTINE report_budget
537
538	!!-------------------------------------------------------------------------
539
540	SUBROUTINE report_istate(budgetstr,startstr,startval,endstr,endval,delstr)
541	! Arguments
542	CHARACTER(), INTENT(in) :: budgetstr, startstr, endstr, delstr
543	INTEGER, INTENT(in) :: startval, endval
544
545	WRITE(numicb,100) budgetstr//' state:', &
546	startstr//' start',startval, &
547	endstr//' end',endval, &
548	delstr//'Delta',endval-startval
549	100 FORMAT(a19,3(a18,"=",i14,x,:,","))
550	END SUBROUTINE report_istate
551
552	!!-------------------------------------------------------------------------
553
554	SUBROUTINE report_ibudget(budgetstr,instr,inval,outstr,outval,delstr,startval,endval)
555	! Arguments
556	CHARACTER(), INTENT(in) :: budgetstr, instr, outstr, delstr
557	INTEGER, INTENT(in) :: inval, outval, startval, endval
558
559	WRITE(numicb,200) budgetstr//' budget:', &
560	instr//' in',inval, &
561	outstr//' out',outval, &
562	'Delta '//delstr,inval-outval, &
563	'error',((endval-startval)-(inval-outval))
564	200 FORMAT(a19,10(a18,"=",i14,x,:,","))
565	END SUBROUTINE report_ibudget
566	!!-------------------------------------------------------------------------
567
568	END MODULE icbdia

Note: See TracBrowser for help on using the repository browser.

Download in other formats: