icbini.F90 25 KB

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