Context Navigation

icbini.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

File size: 23.5 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 (rdt*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 ;
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_11_11
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 = nlcj/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 = nlci/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,nlcj/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,nlcj/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,*) 'nldi, nlei ', nldi, nlei
206	WRITE(numicb,*) 'nldj, nlej ', nldj, nlej
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 = nlcj/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 = nlci/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_data, '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	!!----------------------------------------------------------------------
387
388	#if defined key_agrif
389	IF(lwp) THEN
390	WRITE(numout,*)
391	WRITE(numout,*) 'icb_nam : AGRIF is not compatible with namelist namberg : '
392	WRITE(numout,*) '~~~~~~~ definition of rn_initial_mass(nclasses) with nclasses as PARAMETER '
393	WRITE(numout,*)
394	WRITE(numout,*) ' ==>>> force NO icebergs used. The namelist namberg is not read'
395	ENDIF
396	ln_icebergs = .false.
397	RETURN
398	#else
399	IF(lwp) THEN
400	WRITE(numout,*)
401	WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read'
402	WRITE(numout,*) '~~~~~~~~ '
403	ENDIF
404	#endif
405	! !== read namelist ==!
406	READ ( numnam_ref, namberg, IOSTAT = ios, ERR = 901)
407	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist' )
408	READ ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 )
409	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist' )
410	IF(lwm) WRITE ( numond, namberg )
411	!
412	IF(lwp) WRITE(numout,*)
413	IF( ln_icebergs ) THEN
414	IF(lwp) WRITE(numout,*) ' ==>>> icebergs are used'
415	ELSE
416	IF(lwp) WRITE(numout,*) ' ==>>> No icebergs used'
417	RETURN
418	ENDIF
419	!
420	IF( nn_test_icebergs > nclasses ) THEN
421	IF(lwp) WRITE(numout,*)
422	IF(lwp) WRITE(numout,*) ' ==>>> Resetting of nn_test_icebergs to ', nclasses
423	nn_test_icebergs = nclasses
424	ENDIF
425	!
426	IF( nn_test_icebergs < 0 .AND. .NOT. ln_use_calving ) THEN
427	IF(lwp) WRITE(numout,*)
428	IF(lwp) WRITE(numout,*) ' ==>>> Resetting ln_use_calving to .true. since we are not using test icebergs'
429	ln_use_calving = .true.
430	ENDIF
431	!
432	IF(lwp) THEN ! control print
433	WRITE(numout,*)
434	WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read'
435	WRITE(numout,*) '~~~~~~~~ '
436	WRITE(numout,*) ' Calculate budgets ln_bergdia = ', ln_bergdia
437	WRITE(numout,*) ' Period between sampling of position for trajectory storage nn_sample_rate = ', nn_sample_rate
438	WRITE(numout,*) ' Mass thresholds between iceberg classes (kg) rn_initial_mass ='
439	DO jn = 1, nclasses
440	WRITE(numout,'(a,f15.2)') ' ', rn_initial_mass(jn)
441	ENDDO
442	WRITE(numout,*) ' Fraction of calving to apply to this class (non-dim) rn_distribution ='
443	DO jn = 1, nclasses
444	WRITE(numout,'(a,f10.4)') ' ', rn_distribution(jn)
445	END DO
446	WRITE(numout,*) ' Ratio between effective and real iceberg mass (non-dim) rn_mass_scaling = '
447	DO jn = 1, nclasses
448	WRITE(numout,'(a,f10.2)') ' ', rn_mass_scaling(jn)
449	END DO
450	WRITE(numout,*) ' Total thickness of newly calved bergs (m) rn_initial_thickness = '
451	DO jn = 1, nclasses
452	WRITE(numout,'(a,f10.2)') ' ', rn_initial_thickness(jn)
453	END DO
454	WRITE(numout,*) ' Timesteps between verbose messages nn_verbose_write = ', nn_verbose_write
455
456	WRITE(numout,*) ' Density of icebergs rn_rho_bergs = ', rn_rho_bergs
457	WRITE(numout,*) ' Initial ratio L/W for newly calved icebergs rn_LoW_ratio = ', rn_LoW_ratio
458	WRITE(numout,*) ' Turn on more verbose output level = ', nn_verbose_level
459	WRITE(numout,*) ' Use first order operator splitting for thermodynamics ', &
460	& 'use_operator_splitting = ', ln_operator_splitting
461	WRITE(numout,*) ' Fraction of erosion melt flux to divert to bergy bits ', &
462	& 'bits_erosion_fraction = ', rn_bits_erosion_fraction
463
464	WRITE(numout,*) ' Shift of sea-ice concentration in erosion flux modulation ', &
465	& '(0<sicn_shift<1) rn_sicn_shift = ', rn_sicn_shift
466	WRITE(numout,*) ' Do not add freshwater flux from icebergs to ocean ', &
467	& ' passive_mode = ', ln_passive_mode
468	WRITE(numout,*) ' Time average the weight on the ocean time_average_weight = ', ln_time_average_weight
469	WRITE(numout,*) ' Create icebergs in absence of a restart file nn_test_icebergs = ', nn_test_icebergs
470	WRITE(numout,*) ' in lon/lat box = ', rn_test_box
471	WRITE(numout,*) ' Use calving data even if nn_test_icebergs > 0 ln_use_calving = ', ln_use_calving
472	WRITE(numout,*) ' CFL speed limit for a berg speed_limit = ', rn_speed_limit
473	WRITE(numout,*) ' Writing Iceberg status information to icebergs.stat file '
474	ENDIF
475	!
476	! ensure that the sum of berg input distribution is equal to one
477	zfact = SUM( rn_distribution )
478	IF( zfact /= 1._wp .AND. 0_wp /= zfact ) THEN
479	rn_distribution(:) = rn_distribution(:) / zfact
480	IF(lwp) THEN
481	WRITE(numout,*)
482	WRITE(numout,*) ' ==>>> CAUTION: sum of berg input distribution = ', zfact
483	WRITE(numout,) ' ****** redistribution has been rescaled'
484	WRITE(numout,*) ' updated berg distribution is :'
485	DO jn = 1, nclasses
486	WRITE(numout,'(a,f10.4)') ' ',rn_distribution(jn)
487	END DO
488	ENDIF
489	ENDIF
490	IF( MINVAL( rn_distribution(:) ) < 0._wp ) THEN
491	CALL ctl_stop( 'icb_nam: a negative rn_distribution value encountered ==>> change your namelist namberg' )
492	ENDIF
493	!
494	END SUBROUTINE icb_nam
495
496	!!======================================================================
497	END MODULE icbini

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

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

Download in other formats: