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

Last change on this file since 12377 was 12377, checked in by acc, 20 months 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 
1MODULE 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   !!----------------------------------------------------------------------
48CONTAINS
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 - ihr*3600 - imin*60
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)
407901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist' )
408      READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 )
409902   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   !!======================================================================
497END MODULE icbini
Note: See TracBrowser for help on using the repository browser.