source: NEMO/branches/UKMO/NEMO_4.0.1_ICB_melting_temperature/src/OCE/ICB/icbini.F90 @ 11897

Last change on this file since 11897 was 11897, checked in by cguiavarch, 10 months ago

Change to add basal melt only if the SST is above the freezing point

File size: 23.7 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   !!----------------------------------------------------------------------
42   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
43   !! $Id$
44   !! Software governed by the CeCILL license (see ./LICENSE)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE icb_init( pdt, kt )
49      !!----------------------------------------------------------------------
50      !!                  ***  ROUTINE dom_init  ***
51      !!
52      !! ** Purpose :   iceberg initialization.
53      !!
54      !! ** Method  : - read the iceberg namelist
55      !!              - find non-overlapping processor interior since we can only
56      !!                have one instance of a particular iceberg
57      !!              - calculate the destinations for north fold exchanges
58      !!              - setup either test icebergs or calving file
59      !!----------------------------------------------------------------------
60      REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rdt*nn_fsbc)
61      INTEGER , INTENT(in) ::   kt    ! time step number
62      !
63      INTEGER ::   ji, jj, jn               ! dummy loop indices
64      INTEGER ::   i1, i2, i3               ! local integers
65      INTEGER ::   ii, inum, ivar           !   -       -
66      INTEGER ::   istat1, istat2, istat3   !   -       -
67      CHARACTER(len=300) ::   cl_sdist      ! local character
68      !!----------------------------------------------------------------------
69      !
70      CALL icb_nam               ! Read and print namelist parameters
71      !
72      IF( .NOT. ln_icebergs )   RETURN
73
74      !                          ! allocate gridded fields
75      IF( icb_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'icb_alloc : unable to allocate arrays' )
76      !
77      !                          ! initialised variable with extra haloes to zero
78      uo_e(:,:) = 0._wp   ;   vo_e(:,:) = 0._wp   ;
79      ua_e(:,:) = 0._wp   ;   va_e(:,:) = 0._wp   ;
80      ff_e(:,:) = 0._wp   ;   tt_e(:,:) = 0._wp   ;
81      fr_e(:,:) = 0._wp   ;   ss_e(:,:) = 0._wp   ;
82#if defined key_si3
83      hi_e(:,:) = 0._wp   ;
84      ui_e(:,:) = 0._wp   ;   vi_e(:,:) = 0._wp   ;
85#endif
86      ssh_e(:,:) = 0._wp  ; 
87      !
88      !                          ! open ascii output file or files for iceberg status information
89      !                          ! note that we choose to do this on all processors since we cannot
90      !                          ! predict where icebergs will be ahead of time
91      IF( nn_verbose_level > 0) THEN
92         CALL ctl_opn( numicb, 'icebergs.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
93      ENDIF
94
95      ! set parameters (mostly from namelist)
96      !
97      berg_dt         = pdt
98      first_width (:) = SQRT(  rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) )  )
99      first_length(:) = rn_LoW_ratio * first_width(:)
100
101      berg_grid%calving      (:,:)   = 0._wp
102      berg_grid%calving_hflx (:,:)   = 0._wp
103      berg_grid%stored_heat  (:,:)   = 0._wp
104      berg_grid%floating_melt(:,:)   = 0._wp
105      berg_grid%maxclass     (:,:)   = nclasses
106      berg_grid%stored_ice   (:,:,:) = 0._wp
107      berg_grid%tmp          (:,:)   = 0._wp
108      src_calving            (:,:)   = 0._wp
109      src_calving_hflx       (:,:)   = 0._wp
110
111      !                          ! domain for icebergs
112      IF( lk_mpp .AND. jpni == 1 )   CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' )
113      ! NB: the issue here is simply that cyclic east-west boundary condition have not been coded in mpp case
114      ! for the north fold we work out which points communicate by asking
115      ! lbc_lnk to pass processor number (valid even in single processor case)
116      ! borrow src_calving arrays for this
117      !
118      ! pack i and j together using a scaling of a power of 10
119      nicbpack = 10000
120      IF( jpiglo >= nicbpack )   CALL ctl_stop( 'icbini: processor index packing failure' )
121      nicbfldproc(:) = -1
122
123      DO jj = 1, jpj
124         DO ji = 1, jpi
125            src_calving_hflx(ji,jj) = narea
126            src_calving     (ji,jj) = nicbpack * mjg(jj) + mig(ji)
127         END DO
128      END DO
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      REWIND( numnam_ref )              ! Namelist namberg in reference namelist : Iceberg parameters
407      READ  ( numnam_ref, namberg, IOSTAT = ios, ERR = 901)
408901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist' )
409      REWIND( numnam_cfg )              ! Namelist namberg in configuration namelist : Iceberg parameters
410      READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 )
411902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist' )
412      IF(lwm) WRITE ( numond, namberg )
413      !
414      IF(lwp) WRITE(numout,*)
415      IF( ln_icebergs ) THEN
416         IF(lwp) WRITE(numout,*) '   ==>>>   icebergs are used'
417      ELSE
418         IF(lwp) WRITE(numout,*) '   ==>>>   No icebergs used'
419         RETURN
420      ENDIF
421      !
422      IF( nn_test_icebergs > nclasses ) THEN
423         IF(lwp) WRITE(numout,*)
424         IF(lwp) WRITE(numout,*) '   ==>>>   Resetting of nn_test_icebergs to ', nclasses
425         nn_test_icebergs = nclasses
426      ENDIF
427      !
428      IF( nn_test_icebergs < 0 .AND. .NOT. ln_use_calving ) THEN
429         IF(lwp) WRITE(numout,*)
430         IF(lwp) WRITE(numout,*) '   ==>>>   Resetting ln_use_calving to .true. since we are not using test icebergs'
431         ln_use_calving = .true.
432      ENDIF
433      !
434      IF(lwp) THEN                  ! control print
435         WRITE(numout,*)
436         WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read'
437         WRITE(numout,*) '~~~~~~~~ '
438         WRITE(numout,*) '   Calculate budgets                                            ln_bergdia       = ', ln_bergdia
439         WRITE(numout,*) '   Period between sampling of position for trajectory storage   nn_sample_rate = ', nn_sample_rate
440         WRITE(numout,*) '   Mass thresholds between iceberg classes (kg)                 rn_initial_mass     ='
441         DO jn = 1, nclasses
442            WRITE(numout,'(a,f15.2)') '                                                                ', rn_initial_mass(jn)
443         ENDDO
444         WRITE(numout,*) '   Fraction of calving to apply to this class (non-dim)         rn_distribution     ='
445         DO jn = 1, nclasses
446            WRITE(numout,'(a,f10.4)') '                                                                ', rn_distribution(jn)
447         END DO
448         WRITE(numout,*) '   Ratio between effective and real iceberg mass (non-dim)      rn_mass_scaling     = '
449         DO jn = 1, nclasses
450            WRITE(numout,'(a,f10.2)') '                                                                ', rn_mass_scaling(jn)
451         END DO
452         WRITE(numout,*) '   Total thickness of newly calved bergs (m)                    rn_initial_thickness = '
453         DO jn = 1, nclasses
454            WRITE(numout,'(a,f10.2)') '                                                                ', rn_initial_thickness(jn)
455         END DO
456         WRITE(numout,*) '   Timesteps between verbose messages                           nn_verbose_write    = ', nn_verbose_write
457
458         WRITE(numout,*) '   Density of icebergs                           rn_rho_bergs  = ', rn_rho_bergs
459         WRITE(numout,*) '   Initial ratio L/W for newly calved icebergs   rn_LoW_ratio  = ', rn_LoW_ratio
460         WRITE(numout,*) '   Turn on more verbose output                          level  = ', nn_verbose_level
461         WRITE(numout,*) '   Use first order operator splitting for thermodynamics    ',   &
462            &                    'use_operator_splitting = ', ln_operator_splitting
463         WRITE(numout,*) '   Fraction of erosion melt flux to divert to bergy bits    ',   &
464            &                    'bits_erosion_fraction = ', rn_bits_erosion_fraction
465
466         WRITE(numout,*) '   Shift of sea-ice concentration in erosion flux modulation ',   &
467            &                    '(0<sicn_shift<1)    rn_sicn_shift  = ', rn_sicn_shift
468         WRITE(numout,*) '   Do not add freshwater flux from icebergs to ocean                ',   &
469            &                    '                  passive_mode            = ', ln_passive_mode
470         WRITE(numout,*) '   Time average the weight on the ocean   time_average_weight       = ', ln_time_average_weight
471         WRITE(numout,*) '   Create icebergs in absence of a restart file   nn_test_icebergs  = ', nn_test_icebergs
472         WRITE(numout,*) '                   in lon/lat box                                   = ', rn_test_box
473         WRITE(numout,*) '   Use calving data even if nn_test_icebergs > 0    ln_use_calving  = ', ln_use_calving
474         WRITE(numout,*) '   CFL speed limit for a berg            speed_limit                = ', rn_speed_limit
475         WRITE(numout,*) '   Writing Iceberg status information to icebergs.stat file        '
476      ENDIF
477      !
478      ! ensure that the sum of berg input distribution is equal to one
479      zfact = SUM( rn_distribution )
480      IF( zfact /= 1._wp .AND. 0_wp /= zfact ) THEN
481         rn_distribution(:) = rn_distribution(:) / zfact
482         IF(lwp) THEN
483            WRITE(numout,*)
484            WRITE(numout,*) '      ==>>> CAUTION:    sum of berg input distribution = ', zfact
485            WRITE(numout,*) '            *******     redistribution has been rescaled'
486            WRITE(numout,*) '                        updated berg distribution is :'
487            DO jn = 1, nclasses
488               WRITE(numout,'(a,f10.4)') '                                   ',rn_distribution(jn)
489            END DO
490         ENDIF
491      ENDIF
492      IF( MINVAL( rn_distribution(:) ) < 0._wp ) THEN
493         CALL ctl_stop( 'icb_nam: a negative rn_distribution value encountered ==>> change your namelist namberg' )
494      ENDIF
495      !
496   END SUBROUTINE icb_nam
497
498   !!======================================================================
499END MODULE icbini
Note: See TracBrowser for help on using the repository browser.