icbrst.F90 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436
  1. MODULE icbrst
  2. !!======================================================================
  3. !! *** MODULE icbrst ***
  4. !! Ocean physics: read and write iceberg restart files
  5. !!======================================================================
  6. !! History : 3.3.1 ! 2010-01 (Martin&Adcroft) Original code
  7. !! - ! 2011-03 (Madec) Part conversion to NEMO form
  8. !! - ! Removal of mapping from another grid
  9. !! - ! 2011-04 (Alderson) Split into separate modules
  10. !! - ! 2011-04 (Alderson) Restore restart routine
  11. !! - ! Currently needs a fixed processor
  12. !! - ! layout between restarts
  13. !! - ! 2015-11 Dave Storkey Convert icb_rst_read to use IOM so can
  14. !! read single restart files
  15. !!----------------------------------------------------------------------
  16. !!----------------------------------------------------------------------
  17. !! icb_rst_read : read restart file
  18. !! icb_rst_write : write restart file
  19. !!----------------------------------------------------------------------
  20. USE par_oce ! NEMO parameters
  21. USE dom_oce ! NEMO domain
  22. USE in_out_manager ! NEMO IO routines
  23. USE lib_mpp ! NEMO MPI library, lk_mpp in particular
  24. USE netcdf ! netcdf routines for IO
  25. USE iom
  26. USE icb_oce ! define iceberg arrays
  27. USE icbutl ! iceberg utility routines
  28. IMPLICIT NONE
  29. PRIVATE
  30. PUBLIC icb_rst_read ! routine called in icbini.F90 module
  31. PUBLIC icb_rst_write ! routine called in icbstp.F90 module
  32. INTEGER :: nlonid, nlatid, nxid, nyid, nuvelid, nvvelid
  33. INTEGER :: nmassid, nthicknessid, nwidthid, nlengthid
  34. INTEGER :: nyearid, ndayid
  35. INTEGER :: nscaling_id, nmass_of_bits_id, nheat_density_id, numberid
  36. INTEGER :: nsiceid, nsheatid, ncalvid, ncalvhid, nkountid, nvirtid
  37. INTEGER :: nret, ncid, nc_dim
  38. INTEGER, DIMENSION(3) :: nstrt3, nlngth3
  39. !!----------------------------------------------------------------------
  40. !! NEMO/OCE 4.0 , NEMO Consortium (2018)
  41. !! $Id: icbrst.F90 15088 2021-07-06 13:03:34Z acc $
  42. !! Software governed by the CeCILL license (see ./LICENSE)
  43. !!----------------------------------------------------------------------
  44. CONTAINS
  45. SUBROUTINE icb_rst_read()
  46. !!----------------------------------------------------------------------
  47. !! *** SUBROUTINE icb_rst_read ***
  48. !!
  49. !! ** Purpose : read a iceberg restart file
  50. !! NB: for this version, we just read back in the restart for this processor
  51. !! so we cannot change the processor layout currently with iceberg code
  52. !!----------------------------------------------------------------------
  53. INTEGER :: idim, ivar, iatt
  54. INTEGER :: jn, iunlim_dim, ibergs_in_file
  55. INTEGER :: ii, ij, iclass, ibase_err, imax_icb
  56. REAL(wp), DIMENSION(nkounts) :: zdata
  57. LOGICAL :: ll_found_restart
  58. CHARACTER(len=256) :: cl_path
  59. CHARACTER(len=256) :: cl_filename
  60. CHARACTER(len=NF90_MAX_NAME) :: cl_dname
  61. TYPE(iceberg) :: localberg ! NOT a pointer but an actual local variable
  62. TYPE(point) :: localpt ! NOT a pointer but an actual local variable
  63. !!----------------------------------------------------------------------
  64. ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts
  65. ! and are called TRIM(cn_ocerst)//'_icebergs'
  66. cl_path = TRIM(cn_icbrst_indir)
  67. IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
  68. cl_filename = TRIM(cn_icbrst_in)
  69. CALL iom_open( TRIM(cl_path)//cl_filename, ncid )
  70. imax_icb = 0
  71. IF( iom_file(ncid)%iduld .GE. 0) THEN
  72. ibergs_in_file = iom_file(ncid)%lenuld
  73. DO jn = 1,ibergs_in_file
  74. ! iom_get treats the unlimited dimension as time. Here the unlimited dimension
  75. ! is the iceberg index, but we can still use the ktime keyword to get the iceberg we want.
  76. CALL iom_get( ncid, 'xi' ,localpt%xi , ktime=jn )
  77. CALL iom_get( ncid, 'yj' ,localpt%yj , ktime=jn )
  78. ii = INT( localpt%xi + 0.5 ) + ( nn_hls-1 )
  79. ij = INT( localpt%yj + 0.5 ) + ( nn_hls-1 )
  80. ! Only proceed if this iceberg is on the local processor (excluding halos).
  81. IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND. &
  82. & ij >= mjg(Njs0) .AND. ij <= mjg(Nje0) ) THEN
  83. CALL iom_get( ncid, jpdom_unknown, 'number', zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) )
  84. localberg%number(:) = INT(zdata(:))
  85. imax_icb = MAX( imax_icb, INT(zdata(1)) )
  86. CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn )
  87. CALL iom_get( ncid, 'lon' , localpt%lon , ktime=jn )
  88. CALL iom_get( ncid, 'lat' , localpt%lat , ktime=jn )
  89. CALL iom_get( ncid, 'uvel' , localpt%uvel , ktime=jn )
  90. CALL iom_get( ncid, 'vvel' , localpt%vvel , ktime=jn )
  91. CALL iom_get( ncid, 'mass' , localpt%mass , ktime=jn )
  92. CALL iom_get( ncid, 'thickness' , localpt%thickness , ktime=jn )
  93. CALL iom_get( ncid, 'width' , localpt%width , ktime=jn )
  94. CALL iom_get( ncid, 'length' , localpt%length , ktime=jn )
  95. CALL iom_get( ncid, 'year' , zdata(1) , ktime=jn )
  96. localpt%year = INT(zdata(1))
  97. CALL iom_get( ncid, 'day' , localpt%day , ktime=jn )
  98. CALL iom_get( ncid, 'mass_of_bits' , localpt%mass_of_bits , ktime=jn )
  99. CALL iom_get( ncid, 'heat_density' , localpt%heat_density , ktime=jn )
  100. !
  101. CALL icb_utl_add( localberg, localpt )
  102. !
  103. ENDIF
  104. !
  105. END DO
  106. !
  107. ELSE
  108. ibergs_in_file = 0
  109. ENDIF
  110. ! Gridded variables
  111. CALL iom_get( ncid, jpdom_auto, 'calving' , src_calving )
  112. CALL iom_get( ncid, jpdom_auto, 'calving_hflx', src_calving_hflx )
  113. CALL iom_get( ncid, jpdom_auto, 'stored_heat' , berg_grid%stored_heat )
  114. ! with jpdom_auto_xy, ue use only the third element of kstart and kcount.
  115. CALL iom_get( ncid, jpdom_auto_xy, 'stored_ice' , berg_grid%stored_ice, kstart=(/-99,-99,1/), kcount=(/-99,-99,nclasses/) )
  116. CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) )
  117. num_bergs(:) = INT(zdata(:))
  118. CALL iom_get( ncid, jpdom_auto, 'virtual_area' , virtual_area )
  119. !
  120. ! Sanity checks
  121. jn = icb_utl_count()
  122. IF ( lwp .AND. nn_verbose_level >= 0 ) &
  123. WRITE(numout,'(2(a,i5))') 'icebergs, read_restart_bergs: # bergs =',jn,' on PE',narea-1
  124. IF( lk_mpp ) THEN
  125. ! Only mpp_sum ibergs_in_file if we are reading from multiple restart files.
  126. IF( INDEX(iom_file(ncid)%name,'icebergs.nc' ) .EQ. 0 ) CALL mpp_sum('icbrst', ibergs_in_file)
  127. CALL mpp_sum('icbrst', jn)
  128. ENDIF
  129. IF( lwp ) WRITE(numout,'(a,i5,a,i5,a)') 'icebergs, icb_rst_read: there were',ibergs_in_file, &
  130. & ' bergs in the restart file and', jn,' bergs have been read'
  131. ! Close file
  132. CALL iom_close( ncid )
  133. !
  134. ! Confirm that all areas have a suitable base for assigning new iceberg
  135. ! numbers. This will not be the case if restarting from a collated dataset
  136. ! (even if using the same processor decomposition)
  137. !
  138. ibase_err = 0
  139. IF( num_bergs(1) < 0 .AND. num_bergs(1) /= narea - jpnij ) THEN
  140. ! If this area has never calved a new berg then the base should be
  141. ! set to narea - jpnij. If it is negative but something else then
  142. ! a new base will be needed to guarantee unique, future iceberg numbers
  143. ibase_err = 1
  144. ELSEIF( MOD( num_bergs(1) - narea , jpnij ) /= 0 ) THEN
  145. ! If this area has a base which is not in the set {narea + N*jpnij}
  146. ! for positive integers N then a new base will be needed to guarantee
  147. ! unique, future iceberg numbers
  148. ibase_err = 1
  149. ENDIF
  150. IF( lk_mpp ) THEN
  151. CALL mpp_sum('icbrst', ibase_err)
  152. ENDIF
  153. IF( ibase_err > 0 ) THEN
  154. !
  155. ! A new base is needed. The only secure solution is to set bases such that
  156. ! all future icebergs numbers will be greater than the current global maximum
  157. IF( lk_mpp ) THEN
  158. CALL mpp_max('icbrst', imax_icb)
  159. ENDIF
  160. num_bergs(1) = imax_icb - jpnij + narea
  161. ENDIF
  162. !
  163. IF( lwp .AND. nn_verbose_level >= 0 ) WRITE(numout,'(a)') 'icebergs, icb_rst_read: completed'
  164. !
  165. END SUBROUTINE icb_rst_read
  166. SUBROUTINE icb_rst_write( kt )
  167. !!----------------------------------------------------------------------
  168. !! *** SUBROUTINE icb_rst_write ***
  169. !!
  170. !!----------------------------------------------------------------------
  171. INTEGER, INTENT( in ) :: kt
  172. !
  173. INTEGER :: jn ! dummy loop index
  174. INTEGER :: idg ! number of digits
  175. INTEGER :: ix_dim, iy_dim, ik_dim, in_dim
  176. CHARACTER(len=256) :: cl_path
  177. CHARACTER(len=256) :: cl_filename
  178. CHARACTER(len=8 ) :: cl_kt
  179. CHARACTER(LEN=12 ) :: clfmt ! writing format
  180. TYPE(iceberg), POINTER :: this
  181. TYPE(point) , POINTER :: pt
  182. !!----------------------------------------------------------------------
  183. ! Following the normal restart procedure, this routine will be called
  184. ! the timestep before a restart stage as well as the restart timestep.
  185. ! This is a performance step enabling the file to be opened and contents
  186. ! defined in advance of the write. This is not possible with icebergs
  187. ! since the number of bergs to be written could change between timesteps
  188. IF( kt == nitrst ) THEN
  189. ! Only operate on the restart timestep itself.
  190. ! Assume we write iceberg restarts to same directory as ocean restarts.
  191. !
  192. ! directory name
  193. cl_path = TRIM(cn_icbrst_outdir)
  194. IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
  195. !
  196. ! file name
  197. WRITE(cl_kt, '(i8.8)') kt
  198. cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out)
  199. IF( lk_mpp ) THEN
  200. idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9
  201. WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)'
  202. WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc'
  203. ELSE
  204. WRITE(cl_filename,'(a,a)') TRIM(cl_filename), '.nc'
  205. ENDIF
  206. IF ( lwp .AND. nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ', &
  207. & TRIM(cl_path)//TRIM(cl_filename)
  208. nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid)
  209. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed')
  210. ! Dimensions
  211. nret = NF90_DEF_DIM(ncid, 'x', Ni_0, ix_dim)
  212. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim x failed')
  213. nret = NF90_DEF_DIM(ncid, 'y', Nj_0, iy_dim)
  214. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim y failed')
  215. nret = NF90_DEF_DIM(ncid, 'c', nclasses, nc_dim)
  216. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim c failed')
  217. nret = NF90_DEF_DIM(ncid, 'k', nkounts, ik_dim)
  218. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim k failed')
  219. ! global attributes
  220. IF( lk_mpp ) THEN
  221. ! Set domain parameters (assume jpdom_local_full)
  222. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij )
  223. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 )
  224. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) )
  225. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) )
  226. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) )
  227. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) )
  228. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) )
  229. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) )
  230. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) )
  231. nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' )
  232. ENDIF
  233. IF (associated(first_berg)) then
  234. nret = NF90_DEF_DIM(ncid, 'n', NF90_UNLIMITED, in_dim)
  235. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim n failed')
  236. ENDIF
  237. ! Variables
  238. nret = NF90_DEF_VAR(ncid, 'kount' , NF90_INT , (/ ik_dim /), nkountid)
  239. nret = NF90_DEF_VAR(ncid, 'calving' , NF90_DOUBLE, (/ ix_dim, iy_dim /), ncalvid)
  240. nret = NF90_DEF_VAR(ncid, 'calving_hflx', NF90_DOUBLE, (/ ix_dim, iy_dim /), ncalvhid)
  241. nret = NF90_DEF_VAR(ncid, 'stored_ice' , NF90_DOUBLE, (/ ix_dim, iy_dim, nc_dim /), nsiceid)
  242. nret = NF90_DEF_VAR(ncid, 'stored_heat' , NF90_DOUBLE, (/ ix_dim, iy_dim /), nsheatid)
  243. nret = NF90_DEF_VAR(ncid, 'virtual_area', NF90_DOUBLE, (/ ix_dim, iy_dim /), nvirtid)
  244. ! Attributes
  245. nret = NF90_PUT_ATT(ncid, ncalvid , 'long_name', 'iceberg calving')
  246. nret = NF90_PUT_ATT(ncid, ncalvid , 'units', 'some')
  247. nret = NF90_PUT_ATT(ncid, ncalvhid, 'long_name', 'heat flux associated with iceberg calving')
  248. nret = NF90_PUT_ATT(ncid, ncalvhid, 'units', 'some')
  249. nret = NF90_PUT_ATT(ncid, nsiceid , 'long_name', 'stored ice used to calve icebergs')
  250. nret = NF90_PUT_ATT(ncid, nsiceid , 'units', 'kg/s')
  251. nret = NF90_PUT_ATT(ncid, nsheatid, 'long_name', 'heat in stored ice used to calve icebergs')
  252. nret = NF90_PUT_ATT(ncid, nsheatid, 'units', 'J/kg/s')
  253. nret = NF90_PUT_ATT(ncid, nvirtid, 'units', 'm2')
  254. nret = NF90_PUT_ATT(ncid, nvirtid, 'long_name', 'icebergs virtual area')
  255. IF ( ASSOCIATED(first_berg) ) THEN
  256. ! Only add berg variables for this PE if we have anything to say
  257. ! Variables
  258. nret = NF90_DEF_VAR(ncid, 'lon', NF90_DOUBLE, in_dim, nlonid)
  259. nret = NF90_DEF_VAR(ncid, 'lat', NF90_DOUBLE, in_dim, nlatid)
  260. nret = NF90_DEF_VAR(ncid, 'xi', NF90_DOUBLE, in_dim, nxid)
  261. nret = NF90_DEF_VAR(ncid, 'yj', NF90_DOUBLE, in_dim, nyid)
  262. nret = NF90_DEF_VAR(ncid, 'uvel', NF90_DOUBLE, in_dim, nuvelid)
  263. nret = NF90_DEF_VAR(ncid, 'vvel', NF90_DOUBLE, in_dim, nvvelid)
  264. nret = NF90_DEF_VAR(ncid, 'mass', NF90_DOUBLE, in_dim, nmassid)
  265. nret = NF90_DEF_VAR(ncid, 'thickness', NF90_DOUBLE, in_dim, nthicknessid)
  266. nret = NF90_DEF_VAR(ncid, 'width', NF90_DOUBLE, in_dim, nwidthid)
  267. nret = NF90_DEF_VAR(ncid, 'length', NF90_DOUBLE, in_dim, nlengthid)
  268. nret = NF90_DEF_VAR(ncid, 'number', NF90_INT, (/ik_dim,in_dim/), numberid)
  269. nret = NF90_DEF_VAR(ncid, 'year', NF90_INT, in_dim, nyearid)
  270. nret = NF90_DEF_VAR(ncid, 'day', NF90_DOUBLE, in_dim, ndayid)
  271. nret = NF90_DEF_VAR(ncid, 'mass_scaling', NF90_DOUBLE, in_dim, nscaling_id)
  272. nret = NF90_DEF_VAR(ncid, 'mass_of_bits', NF90_DOUBLE, in_dim, nmass_of_bits_id)
  273. nret = NF90_DEF_VAR(ncid, 'heat_density', NF90_DOUBLE, in_dim, nheat_density_id)
  274. ! Attributes
  275. nret = NF90_PUT_ATT(ncid, nlonid, 'long_name', 'longitude')
  276. nret = NF90_PUT_ATT(ncid, nlonid, 'units', 'degrees_E')
  277. nret = NF90_PUT_ATT(ncid, nlatid, 'long_name', 'latitude')
  278. nret = NF90_PUT_ATT(ncid, nlatid, 'units', 'degrees_N')
  279. nret = NF90_PUT_ATT(ncid, nxid, 'long_name', 'x grid box position')
  280. nret = NF90_PUT_ATT(ncid, nxid, 'units', 'fractional')
  281. nret = NF90_PUT_ATT(ncid, nyid, 'long_name', 'y grid box position')
  282. nret = NF90_PUT_ATT(ncid, nyid, 'units', 'fractional')
  283. nret = NF90_PUT_ATT(ncid, nuvelid, 'long_name', 'zonal velocity')
  284. nret = NF90_PUT_ATT(ncid, nuvelid, 'units', 'm/s')
  285. nret = NF90_PUT_ATT(ncid, nvvelid, 'long_name', 'meridional velocity')
  286. nret = NF90_PUT_ATT(ncid, nvvelid, 'units', 'm/s')
  287. nret = NF90_PUT_ATT(ncid, nmassid, 'long_name', 'mass')
  288. nret = NF90_PUT_ATT(ncid, nmassid, 'units', 'kg')
  289. nret = NF90_PUT_ATT(ncid, nthicknessid, 'long_name', 'thickness')
  290. nret = NF90_PUT_ATT(ncid, nthicknessid, 'units', 'm')
  291. nret = NF90_PUT_ATT(ncid, nwidthid, 'long_name', 'width')
  292. nret = NF90_PUT_ATT(ncid, nwidthid, 'units', 'm')
  293. nret = NF90_PUT_ATT(ncid, nlengthid, 'long_name', 'length')
  294. nret = NF90_PUT_ATT(ncid, nlengthid, 'units', 'm')
  295. nret = NF90_PUT_ATT(ncid, numberid, 'long_name', 'iceberg number on this processor')
  296. nret = NF90_PUT_ATT(ncid, numberid, 'units', 'count')
  297. nret = NF90_PUT_ATT(ncid, nyearid, 'long_name', 'calendar year of calving event')
  298. nret = NF90_PUT_ATT(ncid, nyearid, 'units', 'years')
  299. nret = NF90_PUT_ATT(ncid, ndayid, 'long_name', 'year day of calving event')
  300. nret = NF90_PUT_ATT(ncid, ndayid, 'units', 'days')
  301. nret = NF90_PUT_ATT(ncid, nscaling_id, 'long_name', 'scaling factor for mass of calving berg')
  302. nret = NF90_PUT_ATT(ncid, nscaling_id, 'units', 'none')
  303. nret = NF90_PUT_ATT(ncid, nmass_of_bits_id, 'long_name', 'mass of bergy bits')
  304. nret = NF90_PUT_ATT(ncid, nmass_of_bits_id, 'units', 'kg')
  305. nret = NF90_PUT_ATT(ncid, nheat_density_id, 'long_name', 'heat density')
  306. nret = NF90_PUT_ATT(ncid, nheat_density_id, 'units', 'J/kg')
  307. ENDIF ! associated(first_berg)
  308. ! End define mode
  309. nret = NF90_ENDDEF(ncid)
  310. ! --------------------------------
  311. ! now write some data
  312. nstrt3(1) = 1
  313. nstrt3(2) = 1
  314. nlngth3(1) = Ni_0
  315. nlngth3(2) = Nj_0
  316. nlngth3(3) = 1
  317. DO jn=1,nclasses
  318. nstrt3(3) = jn
  319. nret = NF90_PUT_VAR( ncid, nsiceid, berg_grid%stored_ice(Nis0:Nie0,Njs0:Nje0,jn), nstrt3, nlngth3 )
  320. IF (nret .ne. NF90_NOERR) THEN
  321. IF( lwp ) WRITE(numout,*) TRIM(NF90_STRERROR( nret ))
  322. CALL ctl_stop('icebergs, write_restart: nf_put_var stored_ice failed')
  323. ENDIF
  324. ENDDO
  325. IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice written'
  326. nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) )
  327. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var kount failed')
  328. nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(Nis0:Nie0,Njs0:Nje0) )
  329. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed')
  330. IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written'
  331. nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(Nis0:Nie0,Njs0:Nje0) )
  332. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving failed')
  333. nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(Nis0:Nie0,Njs0:Nje0) )
  334. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed')
  335. IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written'
  336. nret = NF90_PUT_VAR( ncid, nvirtid, virtual_area(Nis0:Nie0,Njs0:Nje0) )
  337. IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var virtual_area failed')
  338. IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: virtual_area written'
  339. IF ( ASSOCIATED(first_berg) ) THEN
  340. ! Write variables
  341. ! just write out the current point of the trajectory
  342. this => first_berg
  343. jn = 0
  344. DO WHILE (ASSOCIATED(this))
  345. pt => this%current_point
  346. jn=jn+1
  347. nret = NF90_PUT_VAR(ncid, numberid, this%number, (/1,jn/), (/nkounts,1/) )
  348. nret = NF90_PUT_VAR(ncid, nscaling_id, this%mass_scaling, (/ jn /) )
  349. nret = NF90_PUT_VAR(ncid, nlonid, pt%lon, (/ jn /) )
  350. nret = NF90_PUT_VAR(ncid, nlatid, pt%lat, (/ jn /) )
  351. nret = NF90_PUT_VAR(ncid, nxid, pt%xi, (/ jn /) )
  352. nret = NF90_PUT_VAR(ncid, nyid, pt%yj, (/ jn /) )
  353. nret = NF90_PUT_VAR(ncid, nuvelid, pt%uvel, (/ jn /) )
  354. nret = NF90_PUT_VAR(ncid, nvvelid, pt%vvel, (/ jn /) )
  355. nret = NF90_PUT_VAR(ncid, nmassid, pt%mass, (/ jn /) )
  356. nret = NF90_PUT_VAR(ncid, nthicknessid, pt%thickness, (/ jn /) )
  357. nret = NF90_PUT_VAR(ncid, nwidthid, pt%width, (/ jn /) )
  358. nret = NF90_PUT_VAR(ncid, nlengthid, pt%length, (/ jn /) )
  359. nret = NF90_PUT_VAR(ncid, nyearid, pt%year, (/ jn /) )
  360. nret = NF90_PUT_VAR(ncid, ndayid, pt%day, (/ jn /) )
  361. nret = NF90_PUT_VAR(ncid, nmass_of_bits_id, pt%mass_of_bits, (/ jn /) )
  362. nret = NF90_PUT_VAR(ncid, nheat_density_id, pt%heat_density, (/ jn /) )
  363. this=>this%next
  364. END DO
  365. !
  366. ENDIF ! associated(first_berg)
  367. ! Finish up
  368. nret = NF90_CLOSE(ncid)
  369. IF (nret /= NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_close failed')
  370. ! Sanity check
  371. jn = icb_utl_count()
  372. IF ( lwp .AND. nn_verbose_level >= 0) &
  373. WRITE(numout,'(2(a,i5))') 'icebergs, icb_rst_write: # bergs =',jn,' on PE',narea-1
  374. IF( lk_mpp ) THEN
  375. CALL mpp_sum('icbrst', jn)
  376. ENDIF
  377. IF(lwp) WRITE(numout,'(a,i5,a,i5,a)') 'icebergs, icb_rst_write: ', jn, &
  378. & ' bergs in total have been written at timestep ', kt
  379. !
  380. ! Finish up
  381. !
  382. ENDIF
  383. END SUBROUTINE icb_rst_write
  384. !
  385. !!======================================================================
  386. END MODULE icbrst