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.

icbini.F90 in NEMO/trunk/src/OCE/ICB – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/ICB/icbini.F90 @ 13295

Last change on this file since 13295 was 13295, checked in by acc, 4 years ago
Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision
Property svn:keywords set to `Id`
File size: 23.7 KB

Line
1	MODULE icbini
2	!!======================================================================
3	!! * MODULE icbini *
4	!! Icebergs: initialise variables for iceberg tracking
5	!!======================================================================
6	!! History : - ! 2010-01 (T. Martin & A. Adcroft) Original code
7	!! 3.3 ! 2011-03 (G. Madec) Part conversion to NEMO form ; Removal of mapping from another grid
8	!! - ! 2011-04 (S. Alderson) Split into separate modules ; Restore restart routines
9	!! - ! 2011-05 (S. Alderson) generate_test_icebergs restored ; new forcing arrays with extra halo ;
10	!! - ! north fold exchange arrays added
11	!!----------------------------------------------------------------------
12	!!----------------------------------------------------------------------
13	!! icb_init : initialise icebergs
14	!! icb_ini_gen : generate test icebergs
15	!! icb_nam : read iceberg namelist
16	!!----------------------------------------------------------------------
17	USE dom_oce ! ocean domain
18	USE in_out_manager ! IO routines and numout in particular
19	USE lib_mpp ! mpi library and lk_mpp in particular
20	USE sbc_oce ! ocean : surface boundary condition
21	USE sbc_ice ! sea-ice: surface boundary condition
22	USE iom ! IOM library
23	USE fldread ! field read
24	USE lbclnk ! lateral boundary condition - MPP link
25	!
26	USE icb_oce ! define iceberg arrays
27	USE icbutl ! iceberg utility routines
28	USE icbrst ! iceberg restart routines
29	USE icbtrj ! iceberg trajectory I/O routines
30	USE icbdia ! iceberg budget routines
31
32	IMPLICIT NONE
33	PRIVATE
34
35	PUBLIC icb_init ! routine called in nemogcm.F90 module
36
37	CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of icb files
38	TYPE(FLD_N) :: sn_icb !: information about the calving file to be read
39	TYPE(FLD), PUBLIC, ALLOCATABLE , DIMENSION(:) :: sf_icb !: structure: file information, fields read
40	!: used in icbini and icbstp
41	!! * Substitutions
42	# include "do_loop_substitute.h90"
43	!!----------------------------------------------------------------------
44	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
45	!! $Id$
46	!! Software governed by the CeCILL license (see ./LICENSE)
47	!!----------------------------------------------------------------------
48	CONTAINS
49
50	SUBROUTINE icb_init( pdt, kt )
51	!!----------------------------------------------------------------------
52	!! * ROUTINE dom_init *
53	!!
54	!! ** Purpose : iceberg initialization.
55	!!
56	!! ** Method : - read the iceberg namelist
57	!! - find non-overlapping processor interior since we can only
58	!! have one instance of a particular iceberg
59	!! - calculate the destinations for north fold exchanges
60	!! - setup either test icebergs or calving file
61	!!----------------------------------------------------------------------
62	REAL(wp), INTENT(in) :: pdt ! iceberg time-step (rn_Dt*nn_fsbc)
63	INTEGER , INTENT(in) :: kt ! time step number
64	!
65	INTEGER :: ji, jj, jn ! dummy loop indices
66	INTEGER :: i1, i2, i3 ! local integers
67	INTEGER :: ii, inum, ivar ! - -
68	INTEGER :: istat1, istat2, istat3 ! - -
69	CHARACTER(len=300) :: cl_sdist ! local character
70	!!----------------------------------------------------------------------
71	!
72	CALL icb_nam ! Read and print namelist parameters
73	!
74	IF( .NOT. ln_icebergs ) RETURN
75
76	! ! allocate gridded fields
77	IF( icb_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'icb_alloc : unable to allocate arrays' )
78	!
79	! ! initialised variable with extra haloes to zero
80	uo_e(:,:) = 0._wp ; vo_e(:,:) = 0._wp ;
81	ua_e(:,:) = 0._wp ; va_e(:,:) = 0._wp ;
82	ff_e(:,:) = 0._wp ; tt_e(:,:) = 0._wp ;
83	fr_e(:,:) = 0._wp ; ss_e(:,:) = 0._wp ;
84	#if defined key_si3
85	hi_e(:,:) = 0._wp ;
86	ui_e(:,:) = 0._wp ; vi_e(:,:) = 0._wp ;
87	#endif
88	ssh_e(:,:) = 0._wp ;
89	!
90	! ! open ascii output file or files for iceberg status information
91	! ! note that we choose to do this on all processors since we cannot
92	! ! predict where icebergs will be ahead of time
93	IF( nn_verbose_level > 0) THEN
94	CALL ctl_opn( numicb, 'icebergs.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
95	ENDIF
96
97	! set parameters (mostly from namelist)
98	!
99	berg_dt = pdt
100	first_width (:) = SQRT( rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) ) )
101	first_length(:) = rn_LoW_ratio * first_width(:)
102
103	berg_grid%calving (:,:) = 0._wp
104	berg_grid%calving_hflx (:,:) = 0._wp
105	berg_grid%stored_heat (:,:) = 0._wp
106	berg_grid%floating_melt(:,:) = 0._wp
107	berg_grid%maxclass (:,:) = nclasses
108	berg_grid%stored_ice (:,:,:) = 0._wp
109	berg_grid%tmp (:,:) = 0._wp
110	src_calving (:,:) = 0._wp
111	src_calving_hflx (:,:) = 0._wp
112
113	! ! domain for icebergs
114	IF( lk_mpp .AND. jpni == 1 ) CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' )
115	! NB: the issue here is simply that cyclic east-west boundary condition have not been coded in mpp case
116	! for the north fold we work out which points communicate by asking
117	! lbc_lnk to pass processor number (valid even in single processor case)
118	! borrow src_calving arrays for this
119	!
120	! pack i and j together using a scaling of a power of 10
121	nicbpack = 10000
122	IF( jpiglo >= nicbpack ) CALL ctl_stop( 'icbini: processor index packing failure' )
123	nicbfldproc(:) = -1
124
125	DO_2D( 1, 1, 1, 1 )
126	src_calving_hflx(ji,jj) = narea
127	src_calving (ji,jj) = nicbpack * mjg(jj) + mig(ji)
128	END_2D
129	CALL lbc_lnk( 'icbini', src_calving_hflx, 'T', 1._wp )
130	CALL lbc_lnk( 'icbini', src_calving , 'T', 1._wp )
131
132	! work out interior of processor from exchange array
133	! first entry with narea for this processor is left hand interior index
134	! last entry is right hand interior index
135	jj = jpj/2
136	nicbdi = -1
137	nicbei = -1
138	DO ji = 1, jpi
139	i3 = INT( src_calving(ji,jj) )
140	i2 = INT( i3/nicbpack )
141	i1 = i3 - i2*nicbpack
142	i3 = INT( src_calving_hflx(ji,jj) )
143	IF( i1 == mig(ji) .AND. i3 == narea ) THEN
144	IF( nicbdi < 0 ) THEN ; nicbdi = ji
145	ELSE ; nicbei = ji
146	ENDIF
147	ENDIF
148	END DO
149	!
150	! repeat for j direction
151	ji = jpi/2
152	nicbdj = -1
153	nicbej = -1
154	DO jj = 1, jpj
155	i3 = INT( src_calving(ji,jj) )
156	i2 = INT( i3/nicbpack )
157	i1 = i3 - i2*nicbpack
158	i3 = INT( src_calving_hflx(ji,jj) )
159	IF( i2 == mjg(jj) .AND. i3 == narea ) THEN
160	IF( nicbdj < 0 ) THEN ; nicbdj = jj
161	ELSE ; nicbej = jj
162	ENDIF
163	ENDIF
164	END DO
165	!
166	! special for east-west boundary exchange we save the destination index
167	i1 = MAX( nicbdi-1, 1)
168	i3 = INT( src_calving(i1,jpj/2) )
169	jj = INT( i3/nicbpack )
170	ricb_left = REAL( i3 - nicbpack*jj, wp )
171	i1 = MIN( nicbei+1, jpi )
172	i3 = INT( src_calving(i1,jpj/2) )
173	jj = INT( i3/nicbpack )
174	ricb_right = REAL( i3 - nicbpack*jj, wp )
175
176	! north fold
177	IF( npolj > 0 ) THEN
178	!
179	! icebergs in row nicbej+1 get passed across fold
180	nicbfldpts(:) = INT( src_calving(:,nicbej+1) )
181	nicbflddest(:) = INT( src_calving_hflx(:,nicbej+1) )
182	!
183	! work out list of unique processors to talk to
184	! pack them into a fixed size array where empty slots are marked by a -1
185	DO ji = nicbdi, nicbei
186	ii = nicbflddest(ji)
187	IF( ii .GT. 0 ) THEN ! Needed because land suppression can mean
188	! that unused points are not set in edge haloes
189	DO jn = 1, jpni
190	! work along array until we find an empty slot
191	IF( nicbfldproc(jn) == -1 ) THEN
192	nicbfldproc(jn) = ii
193	EXIT !!gm EXIT should be avoided: use DO WHILE expression instead
194	ENDIF
195	! before we find an empty slot, we may find processor number is already here so we exit
196	IF( nicbfldproc(jn) == ii ) EXIT
197	END DO
198	ENDIF
199	END DO
200	ENDIF
201	!
202	IF( nn_verbose_level > 0) THEN
203	WRITE(numicb,*) 'processor ', narea
204	WRITE(numicb,*) 'jpi, jpj ', jpi, jpj
205	WRITE(numicb,*) 'Nis0, Nie0 ', Nis0, Nie0
206	WRITE(numicb,*) 'Njs0, Nje0 ', Njs0, Nje0
207	WRITE(numicb,*) 'berg i interior ', nicbdi, nicbei
208	WRITE(numicb,*) 'berg j interior ', nicbdj, nicbej
209	WRITE(numicb,*) 'berg left ', ricb_left
210	WRITE(numicb,*) 'berg right ', ricb_right
211	jj = jpj/2
212	WRITE(numicb,*) "central j line:"
213	WRITE(numicb,*) "i processor"
214	WRITE(numicb,*) (INT(src_calving_hflx(ji,jj)), ji=1,jpi)
215	WRITE(numicb,*) "i point"
216	WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi)
217	ji = jpi/2
218	WRITE(numicb,*) "central i line:"
219	WRITE(numicb,*) "j processor"
220	WRITE(numicb,*) (INT(src_calving_hflx(ji,jj)), jj=1,jpj)
221	WRITE(numicb,*) "j point"
222	WRITE(numicb,*) (INT(src_calving(ji,jj)), jj=1,jpj)
223	IF( npolj > 0 ) THEN
224	WRITE(numicb,*) 'north fold destination points '
225	WRITE(numicb,*) nicbfldpts
226	WRITE(numicb,*) 'north fold destination procs '
227	WRITE(numicb,*) nicbflddest
228	WRITE(numicb,*) 'north fold destination proclist '
229	WRITE(numicb,*) nicbfldproc
230	ENDIF
231	CALL flush(numicb)
232	ENDIF
233
234	src_calving (:,:) = 0._wp
235	src_calving_hflx(:,:) = 0._wp
236
237	! definition of extended surface masked needed by icb_bilin_h
238	tmask_e(:,:) = 0._wp ; tmask_e(1:jpi,1:jpj) = tmask(:,:,1)
239	umask_e(:,:) = 0._wp ; umask_e(1:jpi,1:jpj) = umask(:,:,1)
240	vmask_e(:,:) = 0._wp ; vmask_e(1:jpi,1:jpj) = vmask(:,:,1)
241	CALL lbc_lnk_icb( 'icbini', tmask_e, 'T', +1._wp, 1, 1 )
242	CALL lbc_lnk_icb( 'icbini', umask_e, 'T', +1._wp, 1, 1 )
243	CALL lbc_lnk_icb( 'icbini', vmask_e, 'T', +1._wp, 1, 1 )
244	!
245	! assign each new iceberg with a unique number constructed from the processor number
246	! and incremented by the total number of processors
247	num_bergs(:) = 0
248	num_bergs(1) = narea - jpnij
249
250	! when not generating test icebergs we need to setup calving file
251	IF( nn_test_icebergs < 0 .OR. ln_use_calving ) THEN
252	!
253	! maximum distribution class array does not change in time so read it once
254	cl_sdist = TRIM( cn_dir )//TRIM( sn_icb%clname )
255	CALL iom_open ( cl_sdist, inum ) ! open file
256	ivar = iom_varid( inum, 'maxclass', ldstop=.FALSE. )
257	IF( ivar > 0 ) THEN
258	CALL iom_get ( inum, jpdom_global, 'maxclass', src_calving ) ! read the max distribution array
259	berg_grid%maxclass(:,:) = INT( src_calving )
260	src_calving(:,:) = 0._wp
261	ENDIF
262	CALL iom_close( inum ) ! close file
263	!
264	IF( nn_verbose_level > 0) THEN
265	WRITE(numicb,*)
266	WRITE(numicb,*) ' calving read in a file'
267	ENDIF
268	ALLOCATE( sf_icb(1), STAT=istat1 ) ! Create sf_icb structure (calving)
269	ALLOCATE( sf_icb(1)%fnow(jpi,jpj,1), STAT=istat2 )
270	ALLOCATE( sf_icb(1)%fdta(jpi,jpj,1,2), STAT=istat3 )
271	IF( istat1+istat2+istat3 > 0 ) THEN
272	CALL ctl_stop( 'sbc_icb: unable to allocate sf_icb structure' ) ; RETURN
273	ENDIF
274	! ! fill sf_icb with the namelist (sn_icb) and control print
275	CALL fld_fill( sf_icb, (/ sn_icb /), cn_dir, 'icb_init', 'read calving data', 'namicb' )
276	!
277	ENDIF
278
279	IF( .NOT.ln_rstart ) THEN
280	IF( nn_test_icebergs > 0 ) CALL icb_ini_gen()
281	ELSE
282	IF( nn_test_icebergs > 0 ) THEN
283	CALL icb_ini_gen()
284	ELSE
285	CALL icb_rst_read()
286	l_restarted_bergs = .TRUE.
287	ENDIF
288	ENDIF
289	!
290	IF( nn_sample_rate .GT. 0 ) CALL icb_trj_init( nitend )
291	!
292	CALL icb_dia_init()
293	!
294	IF( nn_verbose_level >= 2 ) CALL icb_utl_print('icb_init, initial status', nit000-1)
295	!
296	END SUBROUTINE icb_init
297
298
299	SUBROUTINE icb_ini_gen()
300	!!----------------------------------------------------------------------
301	!! * ROUTINE icb_ini_gen *
302	!!
303	!! ** Purpose : iceberg generation
304	!!
305	!! ** Method : - at each grid point of the test box supplied in the namelist
306	!! generate an iceberg in one class determined by the value of
307	!! parameter nn_test_icebergs
308	!!----------------------------------------------------------------------
309	INTEGER :: ji, jj, ibergs
310	TYPE(iceberg) :: localberg ! NOT a pointer but an actual local variable
311	TYPE(point) :: localpt
312	INTEGER :: iyr, imon, iday, ihr, imin, isec
313	INTEGER :: iberg
314	!!----------------------------------------------------------------------
315
316	! For convenience
317	iberg = nn_test_icebergs
318
319	! call get_date(Time, iyr, imon, iday, ihr, imin, isec)
320	! Convert nemo time variables from dom_oce into local versions
321	iyr = nyear
322	imon = nmonth
323	iday = nday
324	ihr = INT(nsec_day/3600)
325	imin = INT((nsec_day-ihr*3600)/60)
326	isec = nsec_day - ihr3600 - imin60
327
328	! no overlap for icebergs since we want only one instance of each across the whole domain
329	! so restrict area of interest
330	! use tmask here because tmask_i has been doctored on one side of the north fold line
331
332	DO jj = nicbdj, nicbej
333	DO ji = nicbdi, nicbei
334	IF( tmask(ji,jj,1) > 0._wp .AND. &
335	rn_test_box(1) < glamt(ji,jj) .AND. glamt(ji,jj) < rn_test_box(2) .AND. &
336	rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN
337	localberg%mass_scaling = rn_mass_scaling(iberg)
338	localpt%xi = REAL( mig(ji), wp )
339	localpt%yj = REAL( mjg(jj), wp )
340	localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T' )
341	localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T' )
342	localpt%mass = rn_initial_mass (iberg)
343	localpt%thickness = rn_initial_thickness(iberg)
344	localpt%width = first_width (iberg)
345	localpt%length = first_length(iberg)
346	localpt%year = iyr
347	localpt%day = REAL(iday,wp)+(REAL(ihr,wp)+REAL(imin,wp)/60._wp)/24._wp
348	localpt%mass_of_bits = 0._wp
349	localpt%heat_density = 0._wp
350	localpt%uvel = 0._wp
351	localpt%vvel = 0._wp
352	CALL icb_utl_incr()
353	localberg%number(:) = num_bergs(:)
354	call icb_utl_add(localberg, localpt)
355	ENDIF
356	END DO
357	END DO
358	!
359	ibergs = icb_utl_count()
360	CALL mpp_sum('icbini', ibergs)
361	IF( nn_verbose_level > 0) THEN
362	WRITE(numicb,'(a,i6,a)') 'diamonds, icb_ini_gen: ',ibergs,' were generated'
363	ENDIF
364	!
365	END SUBROUTINE icb_ini_gen
366
367
368	SUBROUTINE icb_nam
369	!!----------------------------------------------------------------------
370	!! * ROUTINE icb_nam *
371	!!
372	!! ** Purpose : read iceberg namelist and print the variables.
373	!!
374	!! ** input : - namberg namelist
375	!!----------------------------------------------------------------------
376	INTEGER :: jn ! dummy loop indices
377	INTEGER :: ios ! Local integer output status for namelist read
378	REAL(wp) :: zfact ! local scalar
379	!
380	NAMELIST/namberg/ ln_icebergs , ln_bergdia , nn_sample_rate , rn_initial_mass , &
381	& rn_distribution, rn_mass_scaling, rn_initial_thickness, nn_verbose_write , &
382	& rn_rho_bergs , rn_LoW_ratio , nn_verbose_level , ln_operator_splitting, &
383	& rn_bits_erosion_fraction , rn_sicn_shift , ln_passive_mode , &
384	& ln_time_average_weight , nn_test_icebergs , rn_test_box , &
385	& ln_use_calving , rn_speed_limit , cn_dir, sn_icb , &
386	& cn_icbrst_indir, cn_icbrst_in , cn_icbrst_outdir , cn_icbrst_out
387	!!----------------------------------------------------------------------
388
389	#if defined key_agrif
390	IF(lwp) THEN
391	WRITE(numout,*)
392	WRITE(numout,*) 'icb_nam : AGRIF is not compatible with namelist namberg : '
393	WRITE(numout,*) '~~~~~~~ definition of rn_initial_mass(nclasses) with nclasses as PARAMETER '
394	WRITE(numout,*)
395	WRITE(numout,*) ' ==>>> force NO icebergs used. The namelist namberg is not read'
396	ENDIF
397	ln_icebergs = .false.
398	RETURN
399	#else
400	IF(lwp) THEN
401	WRITE(numout,*)
402	WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read'
403	WRITE(numout,*) '~~~~~~~~ '
404	ENDIF
405	#endif
406	! !== read namelist ==!
407	READ ( numnam_ref, namberg, IOSTAT = ios, ERR = 901)
408	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist' )
409	READ ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 )
410	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist' )
411	IF(lwm) WRITE ( numond, namberg )
412	!
413	IF(lwp) WRITE(numout,*)
414	IF( ln_icebergs ) THEN
415	IF(lwp) WRITE(numout,*) ' ==>>> icebergs are used'
416	ELSE
417	IF(lwp) WRITE(numout,*) ' ==>>> No icebergs used'
418	RETURN
419	ENDIF
420	!
421	IF( nn_test_icebergs > nclasses ) THEN
422	IF(lwp) WRITE(numout,*)
423	IF(lwp) WRITE(numout,*) ' ==>>> Resetting of nn_test_icebergs to ', nclasses
424	nn_test_icebergs = nclasses
425	ENDIF
426	!
427	IF( nn_test_icebergs < 0 .AND. .NOT. ln_use_calving ) THEN
428	IF(lwp) WRITE(numout,*)
429	IF(lwp) WRITE(numout,*) ' ==>>> Resetting ln_use_calving to .true. since we are not using test icebergs'
430	ln_use_calving = .true.
431	ENDIF
432	!
433	IF(lwp) THEN ! control print
434	WRITE(numout,*)
435	WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read'
436	WRITE(numout,*) '~~~~~~~~ '
437	WRITE(numout,*) ' Calculate budgets ln_bergdia = ', ln_bergdia
438	WRITE(numout,*) ' Period between sampling of position for trajectory storage nn_sample_rate = ', nn_sample_rate
439	WRITE(numout,*) ' Mass thresholds between iceberg classes (kg) rn_initial_mass ='
440	DO jn = 1, nclasses
441	WRITE(numout,'(a,f15.2)') ' ', rn_initial_mass(jn)
442	ENDDO
443	WRITE(numout,*) ' Fraction of calving to apply to this class (non-dim) rn_distribution ='
444	DO jn = 1, nclasses
445	WRITE(numout,'(a,f10.4)') ' ', rn_distribution(jn)
446	END DO
447	WRITE(numout,*) ' Ratio between effective and real iceberg mass (non-dim) rn_mass_scaling = '
448	DO jn = 1, nclasses
449	WRITE(numout,'(a,f10.2)') ' ', rn_mass_scaling(jn)
450	END DO
451	WRITE(numout,*) ' Total thickness of newly calved bergs (m) rn_initial_thickness = '
452	DO jn = 1, nclasses
453	WRITE(numout,'(a,f10.2)') ' ', rn_initial_thickness(jn)
454	END DO
455	WRITE(numout,*) ' Timesteps between verbose messages nn_verbose_write = ', nn_verbose_write
456
457	WRITE(numout,*) ' Density of icebergs rn_rho_bergs = ', rn_rho_bergs
458	WRITE(numout,*) ' Initial ratio L/W for newly calved icebergs rn_LoW_ratio = ', rn_LoW_ratio
459	WRITE(numout,*) ' Turn on more verbose output level = ', nn_verbose_level
460	WRITE(numout,*) ' Use first order operator splitting for thermodynamics ', &
461	& 'use_operator_splitting = ', ln_operator_splitting
462	WRITE(numout,*) ' Fraction of erosion melt flux to divert to bergy bits ', &
463	& 'bits_erosion_fraction = ', rn_bits_erosion_fraction
464
465	WRITE(numout,*) ' Shift of sea-ice concentration in erosion flux modulation ', &
466	& '(0<sicn_shift<1) rn_sicn_shift = ', rn_sicn_shift
467	WRITE(numout,*) ' Do not add freshwater flux from icebergs to ocean ', &
468	& ' passive_mode = ', ln_passive_mode
469	WRITE(numout,*) ' Time average the weight on the ocean time_average_weight = ', ln_time_average_weight
470	WRITE(numout,*) ' Create icebergs in absence of a restart file nn_test_icebergs = ', nn_test_icebergs
471	WRITE(numout,*) ' in lon/lat box = ', rn_test_box
472	WRITE(numout,*) ' Use calving data even if nn_test_icebergs > 0 ln_use_calving = ', ln_use_calving
473	WRITE(numout,*) ' CFL speed limit for a berg speed_limit = ', rn_speed_limit
474	WRITE(numout,*) ' Writing Iceberg status information to icebergs.stat file '
475	ENDIF
476	!
477	! ensure that the sum of berg input distribution is equal to one
478	zfact = SUM( rn_distribution )
479	IF( zfact /= 1._wp .AND. 0_wp /= zfact ) THEN
480	rn_distribution(:) = rn_distribution(:) / zfact
481	IF(lwp) THEN
482	WRITE(numout,*)
483	WRITE(numout,*) ' ==>>> CAUTION: sum of berg input distribution = ', zfact
484	WRITE(numout,) ' ****** redistribution has been rescaled'
485	WRITE(numout,*) ' updated berg distribution is :'
486	DO jn = 1, nclasses
487	WRITE(numout,'(a,f10.4)') ' ',rn_distribution(jn)
488	END DO
489	ENDIF
490	ENDIF
491	IF( MINVAL( rn_distribution(:) ) < 0._wp ) THEN
492	CALL ctl_stop( 'icb_nam: a negative rn_distribution value encountered ==>> change your namelist namberg' )
493	ENDIF
494	!
495	END SUBROUTINE icb_nam
496
497	!!======================================================================
498	END MODULE icbini

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

Download in other formats: