diawri.F90 58 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119
  1. MODULE diawri
  2. !!======================================================================
  3. !! *** MODULE diawri ***
  4. !! Ocean diagnostics : write ocean output files
  5. !!=====================================================================
  6. !! History : OPA ! 1991-03 (M.-A. Foujols) Original code
  7. !! 4.0 ! 1991-11 (G. Madec)
  8. !! ! 1992-06 (M. Imbard) correction restart file
  9. !! ! 1992-07 (M. Imbard) split into diawri and rstwri
  10. !! ! 1993-03 (M. Imbard) suppress writibm
  11. !! ! 1998-01 (C. Levy) NETCDF format using ioipsl INTERFACE
  12. !! ! 1999-02 (E. Guilyardi) name of netCDF files + variables
  13. !! 8.2 ! 2000-06 (M. Imbard) Original code (diabort.F)
  14. !! NEMO 1.0 ! 2002-06 (A.Bozec, E. Durand) Original code (diainit.F)
  15. !! - ! 2002-09 (G. Madec) F90: Free form and module
  16. !! - ! 2002-12 (G. Madec) merge of diabort and diainit, F90
  17. !! ! 2005-11 (V. Garnier) Surface pressure gradient organization
  18. !! 3.2 ! 2008-11 (B. Lemaire) creation from old diawri
  19. !!----------------------------------------------------------------------
  20. !!----------------------------------------------------------------------
  21. !! dia_wri : create the standart output files
  22. !! dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
  23. !!----------------------------------------------------------------------
  24. USE oce ! ocean dynamics and tracers
  25. USE dom_oce ! ocean space and time domain
  26. USE dynadv, ONLY: ln_dynadv_vec
  27. USE zdf_oce ! ocean vertical physics
  28. USE ldftra_oce ! ocean active tracers: lateral physics
  29. USE ldfdyn_oce ! ocean dynamics: lateral physics
  30. USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
  31. USE sol_oce ! solver variables
  32. USE sbc_oce ! Surface boundary condition: ocean fields
  33. USE sbc_ice ! Surface boundary condition: ice fields
  34. USE icb_oce ! Icebergs
  35. USE icbdia ! Iceberg budgets
  36. USE sbcssr ! restoring term toward SST/SSS climatology
  37. USE phycst ! physical constants
  38. USE zdfmxl ! mixed layer
  39. USE dianam ! build name of file (routine)
  40. USE zdfddm ! vertical physics: double diffusion
  41. USE diahth ! thermocline diagnostics
  42. USE lbclnk ! ocean lateral boundary conditions (or mpp link)
  43. USE in_out_manager ! I/O manager
  44. USE diadimg ! dimg direct access file format output
  45. USE iom
  46. USE ioipsl
  47. USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities
  48. #if defined key_lim2
  49. USE limwri_2
  50. #elif defined key_lim3
  51. USE limwri
  52. #endif
  53. USE lib_mpp ! MPP library
  54. USE timing ! preformance summary
  55. USE wrk_nemo ! working array
  56. IMPLICIT NONE
  57. PRIVATE
  58. PUBLIC dia_wri ! routines called by step.F90
  59. PUBLIC dia_wri_state
  60. PUBLIC dia_wri_alloc ! Called by nemogcm module
  61. INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file
  62. INTEGER :: nb_T , ndim_bT ! grid_T file
  63. INTEGER :: nid_U, nz_U, nh_U, ndim_U, ndim_hU ! grid_U file
  64. INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file
  65. INTEGER :: nid_W, nz_W, nh_W ! grid_W file
  66. INTEGER :: ndex(1) ! ???
  67. INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
  68. INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
  69. INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
  70. !! * Substitutions
  71. # include "zdfddm_substitute.h90"
  72. # include "domzgr_substitute.h90"
  73. # include "vectopt_loop_substitute.h90"
  74. !!----------------------------------------------------------------------
  75. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  76. !! $Id: diawri.F90 5565 2015-07-08 13:15:04Z clem $
  77. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  78. !!----------------------------------------------------------------------
  79. CONTAINS
  80. INTEGER FUNCTION dia_wri_alloc()
  81. !!----------------------------------------------------------------------
  82. INTEGER, DIMENSION(2) :: ierr
  83. !!----------------------------------------------------------------------
  84. ierr = 0
  85. ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , &
  86. & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , &
  87. & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
  88. !
  89. dia_wri_alloc = MAXVAL(ierr)
  90. IF( lk_mpp ) CALL mpp_sum( dia_wri_alloc )
  91. !
  92. END FUNCTION dia_wri_alloc
  93. #if defined key_dimgout
  94. !!----------------------------------------------------------------------
  95. !! 'key_dimgout' DIMG output file
  96. !!----------------------------------------------------------------------
  97. # include "diawri_dimg.h90"
  98. #else
  99. !!----------------------------------------------------------------------
  100. !! Default option NetCDF output file
  101. !!----------------------------------------------------------------------
  102. # if defined key_iomput
  103. !!----------------------------------------------------------------------
  104. !! 'key_iomput' use IOM library
  105. !!----------------------------------------------------------------------
  106. SUBROUTINE dia_wri( kt )
  107. !!---------------------------------------------------------------------
  108. !! *** ROUTINE dia_wri ***
  109. !!
  110. !! ** Purpose : Standard output of opa: dynamics and tracer fields
  111. !! NETCDF format is used by default
  112. !!
  113. !! ** Method : use iom_put
  114. !!----------------------------------------------------------------------
  115. !!
  116. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  117. !!
  118. INTEGER :: ji, jj, jk ! dummy loop indices
  119. INTEGER :: jkbot !
  120. REAL(wp) :: zztmp, zztmpx, zztmpy !
  121. !!
  122. REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace
  123. REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace
  124. !!----------------------------------------------------------------------
  125. !
  126. IF( nn_timing == 1 ) CALL timing_start('dia_wri')
  127. !
  128. CALL wrk_alloc( jpi , jpj , z2d )
  129. CALL wrk_alloc( jpi , jpj, jpk , z3d )
  130. !
  131. ! Output the initial state and forcings
  132. IF( ninist == 1 ) THEN
  133. CALL dia_wri_state( 'output.init', kt )
  134. ninist = 0
  135. ENDIF
  136. ! Output of initial vertical scale factor
  137. CALL iom_put("e3t_0", e3t_0(:,:,:) )
  138. CALL iom_put("e3u_0", e3t_0(:,:,:) )
  139. CALL iom_put("e3v_0", e3t_0(:,:,:) )
  140. !
  141. CALL iom_put( "e3t" , fse3t_n(:,:,:) )
  142. CALL iom_put( "e3u" , fse3u_n(:,:,:) )
  143. CALL iom_put( "e3v" , fse3v_n(:,:,:) )
  144. CALL iom_put( "e3w" , fse3w_n(:,:,:) )
  145. IF( iom_use("e3tdef") ) &
  146. CALL iom_put( "e3tdef" , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
  147. CALL iom_put("tpt_dep", fsdept_n(:,:,:) )
  148. CALL iom_put( "ssh" , sshn ) ! sea surface height
  149. CALL iom_put( "toce", tsn(:,:,:,jp_tem) ) ! 3D temperature
  150. CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature
  151. IF ( iom_use("sbt") ) THEN
  152. DO jj = 1, jpj
  153. DO ji = 1, jpi
  154. jkbot = mbkt(ji,jj)
  155. z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem)
  156. END DO
  157. END DO
  158. CALL iom_put( "sbt", z2d ) ! bottom temperature
  159. ENDIF
  160. CALL iom_put( "soce", tsn(:,:,:,jp_sal) ) ! 3D salinity
  161. CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity
  162. IF ( iom_use("sbs") ) THEN
  163. DO jj = 1, jpj
  164. DO ji = 1, jpi
  165. jkbot = mbkt(ji,jj)
  166. z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal)
  167. END DO
  168. END DO
  169. CALL iom_put( "sbs", z2d ) ! bottom salinity
  170. ENDIF
  171. IF ( iom_use("taubot") ) THEN ! bottom stress
  172. z2d(:,:) = 0._wp
  173. DO jj = 2, jpjm1
  174. DO ji = fs_2, fs_jpim1 ! vector opt.
  175. zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) &
  176. & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) )
  177. zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) &
  178. & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) )
  179. z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)
  180. !
  181. ENDDO
  182. ENDDO
  183. CALL lbc_lnk( z2d, 'T', 1. )
  184. CALL iom_put( "taubot", z2d )
  185. ENDIF
  186. CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current
  187. CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current
  188. IF ( iom_use("sbu") ) THEN
  189. DO jj = 1, jpj
  190. DO ji = 1, jpi
  191. jkbot = mbku(ji,jj)
  192. z2d(ji,jj) = un(ji,jj,jkbot)
  193. END DO
  194. END DO
  195. CALL iom_put( "sbu", z2d ) ! bottom i-current
  196. ENDIF
  197. #if defined key_dynspg_ts
  198. CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current
  199. #else
  200. CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current
  201. #endif
  202. CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current
  203. CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current
  204. IF ( iom_use("sbv") ) THEN
  205. DO jj = 1, jpj
  206. DO ji = 1, jpi
  207. jkbot = mbkv(ji,jj)
  208. z2d(ji,jj) = vn(ji,jj,jkbot)
  209. END DO
  210. END DO
  211. CALL iom_put( "sbv", z2d ) ! bottom j-current
  212. ENDIF
  213. #if defined key_dynspg_ts
  214. CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current
  215. #else
  216. CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current
  217. #endif
  218. CALL iom_put( "woce", wn ) ! vertical velocity
  219. IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value
  220. ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
  221. z2d(:,:) = rau0 * e12t(:,:)
  222. DO jk = 1, jpk
  223. z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
  224. END DO
  225. CALL iom_put( "w_masstr" , z3d )
  226. IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
  227. ENDIF
  228. CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
  229. CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef.
  230. CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm)
  231. ! Log of eddy diff coef
  232. IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt (:,:,:) ) ) )
  233. IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) )
  234. IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
  235. DO jj = 2, jpjm1 ! sst gradient
  236. DO ji = fs_2, fs_jpim1 ! vector opt.
  237. zztmp = tsn(ji,jj,1,jp_tem)
  238. zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) / e1u(ji-1,jj )
  239. zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) / e2v(ji ,jj-1)
  240. z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
  241. & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
  242. END DO
  243. END DO
  244. CALL lbc_lnk( z2d, 'T', 1. )
  245. CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient
  246. z2d(:,:) = SQRT( z2d(:,:) )
  247. CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient
  248. ENDIF
  249. ! clem: heat and salt content
  250. IF( iom_use("heatc") ) THEN
  251. z2d(:,:) = 0._wp
  252. DO jk = 1, jpkm1
  253. DO jj = 1, jpj
  254. DO ji = 1, jpi
  255. z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
  256. END DO
  257. END DO
  258. END DO
  259. CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2)
  260. ENDIF
  261. IF( iom_use("saltc") ) THEN
  262. z2d(:,:) = 0._wp
  263. DO jk = 1, jpkm1
  264. DO jj = 1, jpj
  265. DO ji = 1, jpi
  266. z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
  267. END DO
  268. END DO
  269. END DO
  270. CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)
  271. ENDIF
  272. !
  273. IF ( iom_use("eken") ) THEN
  274. rke(:,:,jpk) = 0._wp ! kinetic energy
  275. DO jk = 1, jpkm1
  276. DO jj = 2, jpjm1
  277. DO ji = fs_2, fs_jpim1 ! vector opt.
  278. zztmp = 1 / (e1e2t(ji,jj) * fse3t(ji,jj,jk))
  279. zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1u(ji-1,jj) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) &
  280. & + un(ji ,jj,jk) * un(ji ,jj,jk) * e1u(ji, jj) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) &
  281. & * zztmp
  282. !
  283. zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e2v(ji,jj-1) * fse3v(ji,jj-1,jk) &
  284. & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e2v(ji,jj ) * fse3v(ji,jj ,jk) ) &
  285. & * zztmp
  286. !
  287. rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy )
  288. !
  289. ENDDO
  290. ENDDO
  291. ENDDO
  292. CALL lbc_lnk( rke, 'T', 1. )
  293. CALL iom_put( "eken", rke )
  294. ENDIF
  295. !
  296. CALL iom_put( "hdiv", hdivn ) ! Horizontal divergence
  297. !
  298. IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
  299. z3d(:,:,jpk) = 0.e0
  300. z2d(:,:) = 0.e0
  301. DO jk = 1, jpkm1
  302. z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk)
  303. z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
  304. END DO
  305. CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction
  306. CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum
  307. ENDIF
  308. IF( iom_use("u_heattr") ) THEN
  309. z2d(:,:) = 0.e0
  310. DO jk = 1, jpkm1
  311. DO jj = 2, jpjm1
  312. DO ji = fs_2, fs_jpim1 ! vector opt.
  313. z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
  314. END DO
  315. END DO
  316. END DO
  317. CALL lbc_lnk( z2d, 'U', -1. )
  318. CALL iom_put( "u_heattr", (0.5 * rcp) * z2d ) ! heat transport in i-direction
  319. ENDIF
  320. IF( iom_use("u_salttr") ) THEN
  321. z2d(:,:) = 0.e0
  322. DO jk = 1, jpkm1
  323. DO jj = 2, jpjm1
  324. DO ji = fs_2, fs_jpim1 ! vector opt.
  325. z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
  326. END DO
  327. END DO
  328. END DO
  329. CALL lbc_lnk( z2d, 'U', -1. )
  330. CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction
  331. ENDIF
  332. IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
  333. z3d(:,:,jpk) = 0.e0
  334. DO jk = 1, jpkm1
  335. z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk)
  336. END DO
  337. CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction
  338. ENDIF
  339. IF( iom_use("v_heattr") ) THEN
  340. z2d(:,:) = 0.e0
  341. DO jk = 1, jpkm1
  342. DO jj = 2, jpjm1
  343. DO ji = fs_2, fs_jpim1 ! vector opt.
  344. z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
  345. END DO
  346. END DO
  347. END DO
  348. CALL lbc_lnk( z2d, 'V', -1. )
  349. CALL iom_put( "v_heattr", (0.5 * rcp) * z2d ) ! heat transport in j-direction
  350. ENDIF
  351. IF( iom_use("v_salttr") ) THEN
  352. z2d(:,:) = 0.e0
  353. DO jk = 1, jpkm1
  354. DO jj = 2, jpjm1
  355. DO ji = fs_2, fs_jpim1 ! vector opt.
  356. z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
  357. END DO
  358. END DO
  359. END DO
  360. CALL lbc_lnk( z2d, 'V', -1. )
  361. CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction
  362. ENDIF
  363. ! Vertical integral of temperature
  364. IF( iom_use("tosmint") ) THEN
  365. z2d(:,:)=0._wp
  366. DO jk = 1, jpkm1
  367. DO jj = 2, jpjm1
  368. DO ji = fs_2, fs_jpim1 ! vector opt.
  369. z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem)
  370. END DO
  371. END DO
  372. END DO
  373. CALL lbc_lnk( z2d, 'T', -1. )
  374. CALL iom_put( "tosmint", z2d )
  375. ENDIF
  376. ! Vertical integral of salinity
  377. IF( iom_use("somint") ) THEN
  378. z2d(:,:)=0._wp
  379. DO jk = 1, jpkm1
  380. DO jj = 2, jpjm1
  381. DO ji = fs_2, fs_jpim1 ! vector opt.
  382. z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
  383. END DO
  384. END DO
  385. END DO
  386. CALL lbc_lnk( z2d, 'T', -1. )
  387. CALL iom_put( "somint", z2d )
  388. ENDIF
  389. CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2)
  390. !
  391. CALL wrk_dealloc( jpi , jpj , z2d )
  392. CALL wrk_dealloc( jpi , jpj, jpk , z3d )
  393. !
  394. IF( nn_timing == 1 ) CALL timing_stop('dia_wri')
  395. !
  396. END SUBROUTINE dia_wri
  397. #else
  398. !!----------------------------------------------------------------------
  399. !! Default option use IOIPSL library
  400. !!----------------------------------------------------------------------
  401. SUBROUTINE dia_wri( kt )
  402. !!---------------------------------------------------------------------
  403. !! *** ROUTINE dia_wri ***
  404. !!
  405. !! ** Purpose : Standard output of opa: dynamics and tracer fields
  406. !! NETCDF format is used by default
  407. !!
  408. !! ** Method : At the beginning of the first time step (nit000),
  409. !! define all the NETCDF files and fields
  410. !! At each time step call histdef to compute the mean if ncessary
  411. !! Each nwrite time step, output the instantaneous or mean fields
  412. !!----------------------------------------------------------------------
  413. !!
  414. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  415. !!
  416. LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
  417. CHARACTER (len=40) :: clhstnam, clop, clmx ! local names
  418. INTEGER :: inum = 11 ! temporary logical unit
  419. INTEGER :: ji, jj, jk ! dummy loop indices
  420. INTEGER :: ierr ! error code return from allocation
  421. INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers
  422. INTEGER :: jn, ierror ! local integers
  423. REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars
  424. !!
  425. REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace
  426. REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace
  427. !!----------------------------------------------------------------------
  428. !
  429. IF( nn_timing == 1 ) CALL timing_start('dia_wri')
  430. !
  431. CALL wrk_alloc( jpi , jpj , zw2d )
  432. IF ( ln_traldf_gdia .OR. lk_vvl ) call wrk_alloc( jpi , jpj , jpk , zw3d )
  433. !
  434. ! Output the initial state and forcings
  435. IF( ninist == 1 ) THEN
  436. CALL dia_wri_state( 'output.init', kt )
  437. ninist = 0
  438. ENDIF
  439. !
  440. ! 0. Initialisation
  441. ! -----------------
  442. ! local variable for debugging
  443. ll_print = .FALSE.
  444. ll_print = ll_print .AND. lwp
  445. ! Define frequency of output and means
  446. zdt = rdt
  447. IF( nacc == 1 ) zdt = rdtmin
  448. clop = "x" ! no use of the mask value (require less cpu time, and otherwise the model crashes)
  449. #if defined key_diainstant
  450. zsto = nwrite * zdt
  451. clop = "inst("//TRIM(clop)//")"
  452. #else
  453. zsto=zdt
  454. clop = "ave("//TRIM(clop)//")"
  455. #endif
  456. zout = nwrite * zdt
  457. zmax = ( nitend - nit000 + 1 ) * zdt
  458. ! Define indices of the horizontal output zoom and vertical limit storage
  459. iimi = 1 ; iima = jpi
  460. ijmi = 1 ; ijma = jpj
  461. ipk = jpk
  462. ! define time axis
  463. it = kt
  464. itmod = kt - nit000 + 1
  465. ! 1. Define NETCDF files and fields at beginning of first time step
  466. ! -----------------------------------------------------------------
  467. IF( kt == nit000 ) THEN
  468. ! Define the NETCDF files (one per grid)
  469. ! Compute julian date from starting date of the run
  470. CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
  471. zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
  472. IF(lwp)WRITE(numout,*)
  473. IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear, &
  474. & ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
  475. IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &
  476. ' limit storage in depth = ', ipk
  477. ! WRITE root name in date.file for use by postpro
  478. IF(lwp) THEN
  479. CALL dia_nam( clhstnam, nwrite,' ' )
  480. CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
  481. WRITE(inum,*) clhstnam
  482. CLOSE(inum)
  483. ENDIF
  484. ! Define the T grid FILE ( nid_T )
  485. CALL dia_nam( clhstnam, nwrite, 'grid_T' )
  486. IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
  487. CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
  488. & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
  489. & nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
  490. CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept
  491. & "m", ipk, gdept_1d, nz_T, "down" )
  492. ! ! Index of ocean points
  493. CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T ) ! volume
  494. CALL wheneq( jpi*jpj , tmask, 1, 1., ndex_hT, ndim_hT ) ! surface
  495. !
  496. IF( ln_icebergs ) THEN
  497. !
  498. !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after
  499. !! that routine is called from nemogcm, so do it here immediately before its needed
  500. ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror )
  501. IF( lk_mpp ) CALL mpp_sum( ierror )
  502. IF( ierror /= 0 ) THEN
  503. CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array')
  504. RETURN
  505. ENDIF
  506. !
  507. !! iceberg vertical coordinate is class number
  508. CALL histvert( nid_T, "class", "Iceberg class", & ! Vertical grid: class
  509. & "number", nclasses, class_num, nb_T )
  510. !
  511. !! each class just needs the surface index pattern
  512. ndim_bT = 3
  513. DO jn = 1,nclasses
  514. ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj)
  515. ENDDO
  516. !
  517. ENDIF
  518. ! Define the U grid FILE ( nid_U )
  519. CALL dia_nam( clhstnam, nwrite, 'grid_U' )
  520. IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
  521. CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu
  522. & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
  523. & nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
  524. CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept
  525. & "m", ipk, gdept_1d, nz_U, "down" )
  526. ! ! Index of ocean points
  527. CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U ) ! volume
  528. CALL wheneq( jpi*jpj , umask, 1, 1., ndex_hU, ndim_hU ) ! surface
  529. ! Define the V grid FILE ( nid_V )
  530. CALL dia_nam( clhstnam, nwrite, 'grid_V' ) ! filename
  531. IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
  532. CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv
  533. & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
  534. & nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
  535. CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept
  536. & "m", ipk, gdept_1d, nz_V, "down" )
  537. ! ! Index of ocean points
  538. CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V ) ! volume
  539. CALL wheneq( jpi*jpj , vmask, 1, 1., ndex_hV, ndim_hV ) ! surface
  540. ! Define the W grid FILE ( nid_W )
  541. CALL dia_nam( clhstnam, nwrite, 'grid_W' ) ! filename
  542. IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
  543. CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
  544. & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
  545. & nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
  546. CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw
  547. & "m", ipk, gdepw_1d, nz_W, "down" )
  548. ! Declare all the output fields as NETCDF variables
  549. ! !!! nid_T : 3D
  550. CALL histdef( nid_T, "votemper", "Temperature" , "C" , & ! tn
  551. & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
  552. CALL histdef( nid_T, "vosaline", "Salinity" , "PSU" , & ! sn
  553. & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
  554. IF( lk_vvl ) THEN
  555. CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t_n
  556. & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
  557. CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t_n
  558. & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
  559. CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t_n
  560. & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
  561. ENDIF
  562. ! !!! nid_T : 2D
  563. CALL histdef( nid_T, "sosstsst", "Sea Surface temperature" , "C" , & ! sst
  564. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  565. CALL histdef( nid_T, "sosaline", "Sea Surface Salinity" , "PSU" , & ! sss
  566. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  567. CALL histdef( nid_T, "sossheig", "Sea Surface Height" , "m" , & ! ssh
  568. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  569. CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! (emp-rnf)
  570. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  571. CALL histdef( nid_T, "sorunoff", "River runoffs" , "Kg/m2/s", & ! runoffs
  572. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  573. CALL histdef( nid_T, "sosfldow", "downward salt flux" , "PSU/m2/s", & ! sfx
  574. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  575. IF( .NOT. lk_vvl ) THEN
  576. CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature" & ! emp * tsn(:,:,1,jp_tem)
  577. & , "KgC/m2/s", & ! sosst_cd
  578. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  579. CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity" & ! emp * tsn(:,:,1,jp_sal)
  580. & , "KgPSU/m2/s",& ! sosss_cd
  581. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  582. ENDIF
  583. CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr
  584. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  585. CALL histdef( nid_T, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! qsr
  586. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  587. CALL histdef( nid_T, "somixhgt", "Turbocline Depth" , "m" , & ! hmld
  588. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  589. CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01" , "m" , & ! hmlp
  590. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  591. CALL histdef( nid_T, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
  592. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  593. CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm
  594. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  595. !
  596. IF( ln_icebergs ) THEN
  597. CALL histdef( nid_T, "calving" , "calving mass input" , "kg/s" , &
  598. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  599. CALL histdef( nid_T, "calving_heat" , "calving heat flux" , "XXXX" , &
  600. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  601. CALL histdef( nid_T, "berg_floating_melt" , "Melt rate of icebergs + bits" , "kg/m2/s", &
  602. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  603. CALL histdef( nid_T, "berg_stored_ice" , "Accumulated ice mass by class" , "kg" , &
  604. & jpi, jpj, nh_T, nclasses , 1, nclasses , nb_T , 32, clop, zsto, zout )
  605. IF( ln_bergdia ) THEN
  606. CALL histdef( nid_T, "berg_melt" , "Melt rate of icebergs" , "kg/m2/s", &
  607. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  608. CALL histdef( nid_T, "berg_buoy_melt" , "Buoyancy component of iceberg melt rate" , "kg/m2/s", &
  609. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  610. CALL histdef( nid_T, "berg_eros_melt" , "Erosion component of iceberg melt rate" , "kg/m2/s", &
  611. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  612. CALL histdef( nid_T, "berg_conv_melt" , "Convective component of iceberg melt rate", "kg/m2/s", &
  613. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  614. CALL histdef( nid_T, "berg_virtual_area" , "Virtual coverage by icebergs" , "m2" , &
  615. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  616. CALL histdef( nid_T, "bits_src" , "Mass source of bergy bits" , "kg/m2/s", &
  617. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  618. CALL histdef( nid_T, "bits_melt" , "Melt rate of bergy bits" , "kg/m2/s", &
  619. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  620. CALL histdef( nid_T, "bits_mass" , "Bergy bit density field" , "kg/m2" , &
  621. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  622. CALL histdef( nid_T, "berg_mass" , "Iceberg density field" , "kg/m2" , &
  623. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  624. CALL histdef( nid_T, "berg_real_calving" , "Calving into iceberg class" , "kg/s" , &
  625. & jpi, jpj, nh_T, nclasses , 1, nclasses , nb_T , 32, clop, zsto, zout )
  626. ENDIF
  627. ENDIF
  628. IF( .NOT. ln_cpl ) THEN
  629. CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp
  630. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  631. CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp
  632. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  633. CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn
  634. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  635. ENDIF
  636. IF( ln_cpl .AND. nn_ice <= 1 ) THEN
  637. CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp
  638. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  639. CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp
  640. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  641. CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping" , "Kg/m2/s", & ! erp * sn
  642. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  643. ENDIF
  644. clmx ="l_max(only(x))" ! max index on a period
  645. CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX
  646. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clmx, zsto, zout )
  647. #if defined key_diahth
  648. CALL histdef( nid_T, "sothedep", "Thermocline Depth" , "m" , & ! hth
  649. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  650. CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm" , "m" , & ! hd20
  651. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  652. CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm" , "m" , & ! hd28
  653. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  654. CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "W" , & ! htc3
  655. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  656. #endif
  657. IF( ln_cpl .AND. nn_ice == 2 ) THEN
  658. CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice
  659. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  660. CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice
  661. & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  662. ENDIF
  663. CALL histend( nid_T, snc4chunks=snc4set )
  664. ! !!! nid_U : 3D
  665. CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! un
  666. & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
  667. IF( ln_traldf_gdia ) THEN
  668. CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv
  669. & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
  670. ELSE
  671. #if defined key_diaeiv
  672. CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv
  673. & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
  674. #endif
  675. END IF
  676. ! !!! nid_U : 2D
  677. CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
  678. & jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
  679. CALL histend( nid_U, snc4chunks=snc4set )
  680. ! !!! nid_V : 3D
  681. CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vn
  682. & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
  683. IF( ln_traldf_gdia ) THEN
  684. CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv
  685. & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
  686. ELSE
  687. #if defined key_diaeiv
  688. CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv
  689. & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
  690. #endif
  691. END IF
  692. ! !!! nid_V : 2D
  693. CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
  694. & jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
  695. CALL histend( nid_V, snc4chunks=snc4set )
  696. ! !!! nid_W : 3D
  697. CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! wn
  698. & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
  699. IF( ln_traldf_gdia ) THEN
  700. CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv
  701. & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
  702. ELSE
  703. #if defined key_diaeiv
  704. CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv
  705. & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
  706. #endif
  707. END IF
  708. CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt
  709. & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
  710. CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity" , "m2/s" , & ! avmu
  711. & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
  712. IF( lk_zdfddm ) THEN
  713. CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity" , "m2/s" , & ! avs
  714. & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
  715. ENDIF
  716. ! !!! nid_W : 2D
  717. #if defined key_traldf_c2d
  718. CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity" , "m2/s" , & ! ahtw
  719. & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
  720. # if defined key_traldf_eiv
  721. CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s", & ! aeiw
  722. & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
  723. # endif
  724. #endif
  725. CALL histend( nid_W, snc4chunks=snc4set )
  726. IF(lwp) WRITE(numout,*)
  727. IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
  728. IF(ll_print) CALL FLUSH(numout )
  729. ENDIF
  730. ! 2. Start writing data
  731. ! ---------------------
  732. ! ndex(1) est utilise ssi l'avant dernier argument est different de
  733. ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
  734. ! donne le nombre d'elements, et ndex la liste des indices a sortir
  735. IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN
  736. WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
  737. WRITE(numout,*) '~~~~~~ '
  738. ENDIF
  739. IF( lk_vvl ) THEN
  740. CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content
  741. CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content
  742. CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content
  743. CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content
  744. ELSE
  745. CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T ) ! temperature
  746. CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T ) ! salinity
  747. CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT ) ! sea surface temperature
  748. CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT ) ! sea surface salinity
  749. ENDIF
  750. IF( lk_vvl ) THEN
  751. zw3d(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
  752. CALL histwrite( nid_T, "vovvle3t", it, fse3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness
  753. CALL histwrite( nid_T, "vovvldep", it, fsdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth
  754. CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation
  755. ENDIF
  756. CALL histwrite( nid_T, "sossheig", it, sshn , ndim_hT, ndex_hT ) ! sea surface height
  757. CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf ) , ndim_hT, ndex_hT ) ! upward water flux
  758. CALL histwrite( nid_T, "sorunoff", it, rnf , ndim_hT, ndex_hT ) ! river runoffs
  759. CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux
  760. ! (includes virtual salt flux beneath ice
  761. ! in linear free surface case)
  762. IF( .NOT. lk_vvl ) THEN
  763. zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem)
  764. CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst
  765. zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal)
  766. CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sss
  767. ENDIF
  768. CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux
  769. CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
  770. CALL histwrite( nid_T, "somixhgt", it, hmld , ndim_hT, ndex_hT ) ! turbocline depth
  771. CALL histwrite( nid_T, "somxl010", it, hmlp , ndim_hT, ndex_hT ) ! mixed layer depth
  772. CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction
  773. CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed
  774. !
  775. IF( ln_icebergs ) THEN
  776. !
  777. CALL histwrite( nid_T, "calving" , it, berg_grid%calving , ndim_hT, ndex_hT )
  778. CALL histwrite( nid_T, "calving_heat" , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )
  779. CALL histwrite( nid_T, "berg_floating_melt" , it, berg_grid%floating_melt, ndim_hT, ndex_hT )
  780. !
  781. CALL histwrite( nid_T, "berg_stored_ice" , it, berg_grid%stored_ice , ndim_bT, ndex_bT )
  782. !
  783. IF( ln_bergdia ) THEN
  784. CALL histwrite( nid_T, "berg_melt" , it, berg_melt , ndim_hT, ndex_hT )
  785. CALL histwrite( nid_T, "berg_buoy_melt" , it, buoy_melt , ndim_hT, ndex_hT )
  786. CALL histwrite( nid_T, "berg_eros_melt" , it, eros_melt , ndim_hT, ndex_hT )
  787. CALL histwrite( nid_T, "berg_conv_melt" , it, conv_melt , ndim_hT, ndex_hT )
  788. CALL histwrite( nid_T, "berg_virtual_area" , it, virtual_area , ndim_hT, ndex_hT )
  789. CALL histwrite( nid_T, "bits_src" , it, bits_src , ndim_hT, ndex_hT )
  790. CALL histwrite( nid_T, "bits_melt" , it, bits_melt , ndim_hT, ndex_hT )
  791. CALL histwrite( nid_T, "bits_mass" , it, bits_mass , ndim_hT, ndex_hT )
  792. CALL histwrite( nid_T, "berg_mass" , it, berg_mass , ndim_hT, ndex_hT )
  793. !
  794. CALL histwrite( nid_T, "berg_real_calving" , it, real_calving , ndim_bT, ndex_bT )
  795. ENDIF
  796. ENDIF
  797. IF( .NOT. ln_cpl ) THEN
  798. CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping
  799. CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping
  800. IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
  801. CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping
  802. ENDIF
  803. IF( ln_cpl .AND. nn_ice <= 1 ) THEN
  804. CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping
  805. CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping
  806. IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
  807. CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping
  808. ENDIF
  809. ! zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
  810. ! CALL histwrite( nid_T, "sobowlin", it, zw2d , ndim_hT, ndex_hT ) ! ???
  811. #if defined key_diahth
  812. CALL histwrite( nid_T, "sothedep", it, hth , ndim_hT, ndex_hT ) ! depth of the thermocline
  813. CALL histwrite( nid_T, "so20chgt", it, hd20 , ndim_hT, ndex_hT ) ! depth of the 20 isotherm
  814. CALL histwrite( nid_T, "so28chgt", it, hd28 , ndim_hT, ndex_hT ) ! depth of the 28 isotherm
  815. CALL histwrite( nid_T, "sohtc300", it, htc3 , ndim_hT, ndex_hT ) ! first 300m heaat content
  816. #endif
  817. IF( ln_cpl .AND. nn_ice == 2 ) THEN
  818. CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature
  819. CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo
  820. ENDIF
  821. CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current
  822. IF( ln_traldf_gdia ) THEN
  823. IF (.not. ALLOCATED(psix_eiv))THEN
  824. ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
  825. IF( lk_mpp ) CALL mpp_sum ( ierr )
  826. IF( ierr > 0 ) CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')
  827. psix_eiv(:,:,:) = 0.0_wp
  828. psiy_eiv(:,:,:) = 0.0_wp
  829. ENDIF
  830. DO jk=1,jpkm1
  831. zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz
  832. END DO
  833. zw3d(:,:,jpk) = 0._wp
  834. CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U ) ! i-eiv current
  835. ELSE
  836. #if defined key_diaeiv
  837. CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U ) ! i-eiv current
  838. #endif
  839. ENDIF
  840. CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
  841. CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current
  842. IF( ln_traldf_gdia ) THEN
  843. DO jk=1,jpk-1
  844. zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz
  845. END DO
  846. zw3d(:,:,jpk) = 0._wp
  847. CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V ) ! j-eiv current
  848. ELSE
  849. #if defined key_diaeiv
  850. CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V ) ! j-eiv current
  851. #endif
  852. ENDIF
  853. CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
  854. CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current
  855. IF( ln_traldf_gdia ) THEN
  856. DO jk=1,jpk-1
  857. DO jj = 2, jpjm1
  858. DO ji = fs_2, fs_jpim1 ! vector opt.
  859. zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + &
  860. & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
  861. END DO
  862. END DO
  863. END DO
  864. zw3d(:,:,jpk) = 0._wp
  865. CALL histwrite( nid_W, "voveeivw", it, zw3d , ndim_T, ndex_T ) ! vert. eiv current
  866. ELSE
  867. # if defined key_diaeiv
  868. CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current
  869. # endif
  870. ENDIF
  871. CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef.
  872. CALL histwrite( nid_W, "votkeavm", it, avmu , ndim_T, ndex_T ) ! T vert. eddy visc. coef.
  873. IF( lk_zdfddm ) THEN
  874. CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T ) ! S vert. eddy diff. coef.
  875. ENDIF
  876. #if defined key_traldf_c2d
  877. CALL histwrite( nid_W, "soleahtw", it, ahtw , ndim_hT, ndex_hT ) ! lateral eddy diff. coef.
  878. # if defined key_traldf_eiv
  879. CALL histwrite( nid_W, "soleaeiw", it, aeiw , ndim_hT, ndex_hT ) ! EIV coefficient at w-point
  880. # endif
  881. #endif
  882. ! 3. Close all files
  883. ! ---------------------------------------
  884. IF( kt == nitend ) THEN
  885. CALL histclo( nid_T )
  886. CALL histclo( nid_U )
  887. CALL histclo( nid_V )
  888. CALL histclo( nid_W )
  889. ENDIF
  890. !
  891. CALL wrk_dealloc( jpi , jpj , zw2d )
  892. IF ( ln_traldf_gdia .OR. lk_vvl ) call wrk_dealloc( jpi , jpj , jpk , zw3d )
  893. !
  894. IF( nn_timing == 1 ) CALL timing_stop('dia_wri')
  895. !
  896. END SUBROUTINE dia_wri
  897. # endif
  898. #endif
  899. SUBROUTINE dia_wri_state( cdfile_name, kt )
  900. !!---------------------------------------------------------------------
  901. !! *** ROUTINE dia_wri_state ***
  902. !!
  903. !! ** Purpose : create a NetCDF file named cdfile_name which contains
  904. !! the instantaneous ocean state and forcing fields.
  905. !! Used to find errors in the initial state or save the last
  906. !! ocean state in case of abnormal end of a simulation
  907. !!
  908. !! ** Method : NetCDF files using ioipsl
  909. !! File 'output.init.nc' is created if ninist = 1 (namelist)
  910. !! File 'output.abort.nc' is created in case of abnormal job end
  911. !!----------------------------------------------------------------------
  912. CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created
  913. INTEGER , INTENT( in ) :: kt ! ocean time-step index
  914. !!
  915. CHARACTER (len=32) :: clname
  916. CHARACTER (len=40) :: clop
  917. INTEGER :: id_i , nz_i, nh_i
  918. INTEGER, DIMENSION(1) :: idex ! local workspace
  919. REAL(wp) :: zsto, zout, zmax, zjulian, zdt
  920. !!----------------------------------------------------------------------
  921. !
  922. ! IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep
  923. ! 0. Initialisation
  924. ! -----------------
  925. ! Define name, frequency of output and means
  926. clname = cdfile_name
  927. IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
  928. zdt = rdt
  929. zsto = rdt
  930. clop = "inst(x)" ! no use of the mask value (require less cpu time)
  931. zout = rdt
  932. zmax = ( nitend - nit000 + 1 ) * zdt
  933. IF(lwp) WRITE(numout,*)
  934. IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
  935. IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created '
  936. IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc'
  937. ! 1. Define NETCDF files and fields at beginning of first time step
  938. ! -----------------------------------------------------------------
  939. ! Compute julian date from starting date of the run
  940. CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis
  941. zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
  942. CALL histbeg( clname, jpi, glamt, jpj, gphit, &
  943. 1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
  944. CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept
  945. "m", jpk, gdept_1d, nz_i, "down")
  946. ! Declare all the output fields as NetCDF variables
  947. CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity
  948. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  949. CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature
  950. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  951. CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh
  952. & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout )
  953. CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current
  954. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  955. CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current
  956. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  957. CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current
  958. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  959. CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater
  960. & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  961. CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux
  962. & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  963. CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux
  964. & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  965. CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
  966. & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  967. CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress
  968. & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  969. CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress
  970. & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
  971. IF( lk_vvl ) THEN
  972. CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth
  973. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  974. CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth
  975. & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
  976. END IF
  977. #if defined key_lim2
  978. CALL lim_wri_state_2( kt, id_i, nh_i )
  979. #elif defined key_lim3
  980. CALL lim_wri_state( kt, id_i, nh_i )
  981. #else
  982. CALL histend( id_i, snc4chunks=snc4set )
  983. #endif
  984. ! 2. Start writing data
  985. ! ---------------------
  986. ! idex(1) est utilise ssi l'avant dernier argument est diffferent de
  987. ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
  988. ! donne le nombre d'elements, et idex la liste des indices a sortir
  989. idex(1) = 1 ! init to avoid compil warning
  990. ! Write all fields on T grid
  991. CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex ) ! now temperature
  992. CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex ) ! now salinity
  993. CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height
  994. CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity
  995. CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity
  996. CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity
  997. CALL histwrite( id_i, "sowaflup", kt, (emp-rnf ) , jpi*jpj , idex ) ! freshwater budget
  998. CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux
  999. CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux
  1000. CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction
  1001. CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress
  1002. CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress
  1003. IF( lk_vvl ) THEN
  1004. CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth
  1005. CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )! T-cell thickness
  1006. END IF
  1007. ! 3. Close the file
  1008. ! -----------------
  1009. CALL histclo( id_i )
  1010. #if ! defined key_iomput && ! defined key_dimgout
  1011. IF( ninist /= 1 ) THEN
  1012. CALL histclo( nid_T )
  1013. CALL histclo( nid_U )
  1014. CALL histclo( nid_V )
  1015. CALL histclo( nid_W )
  1016. ENDIF
  1017. #endif
  1018. ! IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep
  1019. !
  1020. END SUBROUTINE dia_wri_state
  1021. !!======================================================================
  1022. END MODULE diawri