PageRenderTime 50ms CodeModel.GetById 20ms RepoModel.GetById 0ms app.codeStats 0ms

/input_output_hdf5.f90

https://bitbucket.org/kwmsmith/kaw-sim-hdf5
FORTRAN Modern | 819 lines | 647 code | 165 blank | 7 comment | 64 complexity | 5bef93028addc7bec2f9ba0f655e5e0a MD5 | raw file
Possible License(s): GPL-3.0
  1. module input_output_hdf5
  2. use globalpars
  3. use mpimod
  4. use io_constants, only : get_array_name
  5. use input_output_base_hdf5
  6. use params_io
  7. use table_funcs
  8. use HDF5
  9. use H5LT
  10. use H5TB
  11. implicit none
  12. SAVE
  13. PRIVATE
  14. integer(HSIZE_T), dimension(1), parameter :: dummy_dims = (/ 20 /)
  15. integer, parameter :: GRP_NAME_LEN = 20, NGPS = 17, NSTATS=11
  16. integer, parameter :: ROOT = 0
  17. character(LEN=GRP_NAME_LEN), dimension(NSTATS), parameter :: &
  18. stats_names = (/ "psi", "vor", "den", &
  19. "phi", "cur", &
  20. "bx", "by", &
  21. "vx", "vy", &
  22. "gdx", "gdy" /)
  23. character(LEN=GRP_NAME_LEN), dimension(NGPS), parameter :: &
  24. group_names = (/ "cpsi", "cvor", "cden", &
  25. "psi", "vor", "den", &
  26. "phi", "cur", &
  27. "bx", "by", &
  28. "vx", "vy", &
  29. "gdx", "gdy", &
  30. "scalars", "stats", &
  31. "sim_params" /)
  32. public :: init_hdf5, close_hdf5, create_file, init_file, write_rarr_hdf5,&
  33. write_carr_hdf5, read_carr_hdf5, open_file_hdf5, close_file_hdf5, HID_T, &
  34. dump_arrs_hdf5, load_cmplx_arrs_hdf5, group_names, DATA_FNAME, init_io_hdf5, &
  35. dump_scalars_hdf5, dump_params_hdf5, load_params_hdf5, input_params_t, &
  36. check_restart_params, find_last_arr_idx_hdf5
  37. contains
  38. subroutine check_restart_params(fname, input_params, error)
  39. character(*), intent(in) :: fname
  40. type(input_params_t), intent(inout) :: input_params
  41. integer, intent(out) :: error
  42. integer :: errbuf(1), ierr
  43. type(input_params_t) :: hdf5_input_params
  44. error = 0
  45. if(pid .eq. 0) then
  46. call load_params_hdf5(fname, hdf5_input_params, error)
  47. error = 0
  48. ! we only allow NSTEPS to change, everything else must be the same.
  49. if(hdf5_input_params%nsteps .gt. input_params%nsteps ) then
  50. write(STDERR, *) "*** HDF5 NSTEPS > input params NSTEPS ***"
  51. call flush(STDERR)
  52. error = 1
  53. endif
  54. if(hdf5_input_params%max_wall_mins .ne. input_params%max_wall_mins ) then
  55. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  56. call flush(STDERR)
  57. error = 1
  58. endif
  59. if(hdf5_input_params%nout_arrs .ne. input_params%nout_arrs ) then
  60. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  61. call flush(STDERR)
  62. error = 1
  63. endif
  64. if(hdf5_input_params%nout_scals .ne. input_params%nout_scals ) then
  65. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  66. call flush(STDERR)
  67. error = 1
  68. endif
  69. if(hdf5_input_params%rng_seed .ne. input_params%rng_seed ) then
  70. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  71. call flush(STDERR)
  72. error = 1
  73. endif
  74. if(hdf5_input_params%tstep .ne. input_params%tstep ) then
  75. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  76. call flush(STDERR)
  77. error = 1
  78. endif
  79. if(hdf5_input_params%lx .ne. input_params%lx ) then
  80. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  81. call flush(STDERR)
  82. error = 1
  83. endif
  84. if(hdf5_input_params%ly .ne. input_params%ly ) then
  85. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  86. call flush(STDERR)
  87. error = 1
  88. endif
  89. if(hdf5_input_params%viscos .ne. input_params%viscos ) then
  90. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  91. call flush(STDERR)
  92. error = 1
  93. endif
  94. if(hdf5_input_params%h_viscos .ne. input_params%h_viscos ) then
  95. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  96. call flush(STDERR)
  97. error = 1
  98. endif
  99. if(hdf5_input_params%resis .ne. input_params%resis ) then
  100. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  101. call flush(STDERR)
  102. error = 1
  103. endif
  104. if(hdf5_input_params%h_resis .ne. input_params%h_resis ) then
  105. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  106. call flush(STDERR)
  107. error = 1
  108. endif
  109. if(hdf5_input_params%diffus .ne. input_params%diffus ) then
  110. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  111. call flush(STDERR)
  112. error = 1
  113. endif
  114. if(hdf5_input_params%h_diffus .ne. input_params%h_diffus ) then
  115. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  116. call flush(STDERR)
  117. error = 1
  118. endif
  119. if(hdf5_input_params%spectrum_slope .ne. input_params%spectrum_slope) then
  120. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  121. call flush(STDERR)
  122. error = 1
  123. endif
  124. if(hdf5_input_params%spectrum_peak .ne. input_params%spectrum_peak ) then
  125. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  126. call flush(STDERR)
  127. error = 1
  128. endif
  129. if(hdf5_input_params%eb .ne. input_params%eb ) then
  130. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  131. call flush(STDERR)
  132. error = 1
  133. endif
  134. if(hdf5_input_params%ev .ne. input_params%ev ) then
  135. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  136. call flush(STDERR)
  137. error = 1
  138. endif
  139. if(hdf5_input_params%en .ne. input_params%en ) then
  140. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  141. call flush(STDERR)
  142. error = 1
  143. endif
  144. if(hdf5_input_params%rho_s2 .ne. input_params%rho_s2 ) then
  145. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  146. call flush(STDERR)
  147. error = 1
  148. endif
  149. if(hdf5_input_params%dtfac .ne. input_params%dtfac ) then
  150. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  151. call flush(STDERR)
  152. error = 1
  153. endif
  154. if(hdf5_input_params%mason .ne. input_params%mason ) then
  155. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  156. call flush(STDERR)
  157. error = 1
  158. endif
  159. if(hdf5_input_params%famp .ne. input_params%famp ) then
  160. write(STDERR, *) "*** HDF5 param does not equal input param ***"
  161. call flush(STDERR)
  162. error = 1
  163. endif
  164. errbuf(1) = error
  165. endif
  166. CALL MPI_BCAST(errbuf, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
  167. error = errbuf(1)
  168. end subroutine check_restart_params
  169. subroutine find_last_arr_idx_hdf5(fname, last_idx, error)
  170. implicit none
  171. character(*), intent(in) :: fname
  172. integer, intent(out) :: last_idx
  173. integer, intent(out) :: error
  174. integer(HID_T) :: file_id, group_id
  175. integer :: exists, nout_arrs, i, ierr, intbuf(1)
  176. if(pid .eq. 0) then
  177. call open_file_hdf5(fname, file_id, error)
  178. call h5gopen_f(file_id, "sim_params", group_id, error)
  179. call read_attr_integer(group_id, "NOUT_ARRS", nout_arrs, error)
  180. call h5gclose_f(group_id, error)
  181. call h5gopen_f(file_id, "cden", group_id, error)
  182. last_idx = -1
  183. i = 0
  184. do
  185. exists = h5ltfind_dataset_f(group_id, get_array_name(i))
  186. if (exists .eq. 1) then
  187. last_idx = i
  188. else
  189. exit
  190. endif
  191. i = i + nout_arrs
  192. enddo
  193. call h5gclose_f(group_id, error)
  194. call close_file_hdf5(file_id, error)
  195. intbuf(1) = last_idx
  196. endif
  197. CALL MPI_BCAST(intbuf, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
  198. last_idx = intbuf(1)
  199. end subroutine find_last_arr_idx_hdf5
  200. subroutine load_params_hdf5(fname, input_params, error)
  201. implicit none
  202. character(*), intent(in) :: fname
  203. type(input_params_t), intent(out) :: input_params
  204. integer, intent(out) :: error
  205. integer(HID_T) :: file_id, group_id, input_int
  206. if(pid .ne. 0) return
  207. call open_file_hdf5(fname, file_id, error)
  208. call h5gopen_f(file_id, "sim_params", group_id, error)
  209. call read_attr_integer(group_id, "MAJOR_VERSION", input_int, error)
  210. if (input_int .ne. MAJOR_VERSION) then
  211. write(STDERR, *) "*** datafile MAJOR_VERSION ", &
  212. input_int, " .ne. to compiled MAJOR_VERSION ", &
  213. MAJOR_VERSION, " ***"
  214. call flush(STDERR)
  215. error = 1
  216. endif
  217. call read_attr_integer(group_id, "MINOR_VERSION", input_int, error)
  218. if (input_int .ne. MINOR_VERSION) then
  219. write(STDERR, *) "*** datafile MINOR_VERSION ", &
  220. input_int, " .ne. to compiled MINOR_VERSION ", &
  221. MINOR_VERSION, " ***"
  222. call flush(STDERR)
  223. error = 1
  224. endif
  225. call read_attr_integer(group_id, "NX", input_int, error)
  226. if (input_int .ne. NX) then
  227. write(STDERR, *) "*** datafile NX ", &
  228. input_int, " .ne. to compiled NX ", &
  229. NX, " ***"
  230. call flush(STDERR)
  231. error = 1
  232. endif
  233. call read_attr_integer(group_id, "NY", input_int, error)
  234. if (input_int .ne. NY) then
  235. write(STDERR, *) "*** datafile NY ", &
  236. input_int, " .ne. to compiled NY ", &
  237. NY, " ***"
  238. call flush(STDERR)
  239. error = 1
  240. endif
  241. call read_attr_integer(group_id, "NP", input_int, error)
  242. if (input_int .ne. NP) then
  243. write(STDERR, *) "*** datafile NP ", &
  244. input_int, " .ne. to compiled NP ", &
  245. NP, " ***"
  246. call flush(STDERR)
  247. error = 1
  248. endif
  249. call read_attr_integer(group_id, "NSTEPS", input_params%nsteps, error)
  250. call read_attr_integer(group_id, "MAX_WALL_MINS", input_params%max_wall_mins, error)
  251. call read_attr_integer(group_id, "NOUT_ARRS", input_params%nout_arrs, error)
  252. call read_attr_integer(group_id, "NOUT_SCALS", input_params%nout_scals, error)
  253. call read_attr_integer(group_id, "RNG_SEED", input_params%rng_seed, error)
  254. call read_attr_real(group_id, "TSTEP", input_params%tstep, error)
  255. call read_attr_real(group_id, "LX", input_params%lx, error)
  256. call read_attr_real(group_id, "LY", input_params%ly, error)
  257. call read_attr_real(group_id, "VISCOS", input_params%viscos, error)
  258. call read_attr_real(group_id, "H_VISCOS", input_params%h_viscos, error)
  259. call read_attr_real(group_id, "RESIS", input_params%resis, error)
  260. call read_attr_real(group_id, "H_RESIS", input_params%h_resis, error)
  261. call read_attr_real(group_id, "DIFFUS", input_params%diffus, error)
  262. call read_attr_real(group_id, "H_DIFFUS", input_params%h_diffus, error)
  263. call read_attr_real(group_id, "SPECTRUM_SLOPE", input_params%spectrum_slope, error)
  264. call read_attr_real(group_id, "SPECTRUM_PEAK", input_params%spectrum_peak, error)
  265. call read_attr_real(group_id, "EB", input_params%eb, error)
  266. call read_attr_real(group_id, "EV", input_params%ev, error)
  267. call read_attr_real(group_id, "EN", input_params%en, error)
  268. call read_attr_real(group_id, "RHO_S2", input_params%rho_s2, error)
  269. call read_attr_real(group_id, "DTFAC", input_params%dtfac, error)
  270. call read_attr_real(group_id, "MASON", input_params%mason, error)
  271. call read_attr_real(group_id, "FAMP", input_params%famp, error)
  272. call h5gclose_f(group_id, error)
  273. call close_file_hdf5(file_id, error)
  274. end subroutine load_params_hdf5
  275. subroutine read_attr_real(group_id, attr_name, attr_value, err)
  276. integer(HID_T), intent(in) :: group_id
  277. character(*), intent(in) :: attr_name
  278. real(sp), intent(out) :: attr_value
  279. integer, intent(out) :: err
  280. integer(HID_T) :: attr_id
  281. call h5aopen_f(group_id, attr_name, attr_id, err)
  282. call h5aread_f(attr_id, H5T_NATIVE_REAL, attr_value, &
  283. dummy_dims, err)
  284. call h5aclose_f(attr_id, err)
  285. end subroutine read_attr_real
  286. subroutine read_attr_integer(group_id, attr_name, attr_value, err)
  287. integer(HID_T), intent(in) :: group_id
  288. character(*), intent(in) :: attr_name
  289. integer, intent(out) :: attr_value
  290. integer, intent(out) :: err
  291. integer(HID_T) :: attr_id
  292. call h5aopen_f(group_id, attr_name, attr_id, err)
  293. call h5aread_f(attr_id, H5T_NATIVE_INTEGER, attr_value, &
  294. dummy_dims, err)
  295. call h5aclose_f(attr_id, err)
  296. end subroutine read_attr_integer
  297. subroutine read_attr_character(group_id, attr_name, attr_value, err)
  298. integer(HID_T), intent(in) :: group_id
  299. character(*), intent(in) :: attr_name
  300. character(*), intent(out) :: attr_value
  301. integer, intent(out) :: err
  302. character(STR_LEN) :: buf
  303. integer(HID_T) :: attr_id, atype_id
  304. call h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, err)
  305. call h5tset_size_f(atype_id, int(STR_LEN, kind=HSIZE_T), err)
  306. call h5aopen_f(group_id, attr_name, attr_id, err)
  307. call h5aread_f(attr_id, atype_id, buf, &
  308. dummy_dims, err)
  309. call h5aclose_f(attr_id, err)
  310. attr_value = buf
  311. end subroutine read_attr_character
  312. subroutine dump_params_restart(fname, input_params)
  313. character(*), intent(in) :: fname
  314. type(input_params_t), intent(in) :: input_params
  315. integer(HID_T) :: file_id, group_id
  316. integer :: err
  317. if(pid .ne. 0) return
  318. call open_file_hdf5(fname, file_id, err)
  319. call h5gopen_f(file_id, "sim_params", group_id, err)
  320. call write_attr_integer(group_id, "NSTEPS", input_params%nsteps, err)
  321. call h5gclose_f(group_id, err)
  322. call close_file_hdf5(file_id, err)
  323. contains
  324. subroutine write_attr_integer(group_id, attr_name, attr_value, err)
  325. integer(HID_T), intent(in) :: group_id
  326. character(*), intent(in) :: attr_name
  327. integer, intent(in) :: attr_value
  328. integer, intent(out) :: err
  329. integer(HID_T) :: attr_id
  330. call h5aopen_f(group_id, attr_name, attr_id, err)
  331. call h5awrite_f(attr_id, H5T_NATIVE_INTEGER,&
  332. attr_value, dummy_dims, err)
  333. call h5aclose_f(attr_id, err)
  334. end subroutine write_attr_integer
  335. end subroutine dump_params_restart
  336. subroutine dump_params_hdf5(fname, input_params, restart)
  337. implicit none
  338. character(*), intent(in) :: fname
  339. type(input_params_t), intent(in) :: input_params
  340. logical, intent(in) :: restart
  341. integer(HID_T) :: atype_id, space_id, file_id, group_id
  342. integer :: err
  343. integer(HSIZE_T), dimension(1), parameter :: dummy_dims = (/ 20 /)
  344. if(pid .ne. 0) return
  345. if(restart) then
  346. call dump_params_restart(fname, input_params)
  347. return
  348. endif
  349. call open_file_hdf5(fname, file_id, err)
  350. call h5gopen_f(file_id, "sim_params", group_id, err)
  351. call h5screate_f(H5S_SCALAR_F, space_id, err)
  352. CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, err)
  353. CALL h5tset_size_f(atype_id, int(STR_LEN, kind=HSIZE_T), err)
  354. call write_attr_integer("MAJOR_VERSION", MAJOR_VERSION, err)
  355. call write_attr_integer("MINOR_VERSION", MINOR_VERSION, err)
  356. call write_attr_integer("NX", nx, err)
  357. call write_attr_integer("NY", ny, err)
  358. call write_attr_integer("NP", np, err)
  359. ! REVISION, INTEGRATOR & MODEL -- character arrays
  360. call write_attr_character("REVISION", REVISION, err)
  361. call write_attr_character("INTEGRATOR", INTEGRATOR_, err)
  362. call write_attr_character("MODEL", MODEL, err)
  363. call write_attr_integer("NSTEPS", input_params%nsteps, err)
  364. call write_attr_integer("MAX_WALL_MINS", input_params%max_wall_mins, err)
  365. call write_attr_integer("NOUT_ARRS", input_params%nout_arrs, err)
  366. call write_attr_integer("NOUT_SCALS", input_params%nout_scals, err)
  367. call write_attr_integer("RNG_SEED", input_params%rng_seed, err)
  368. call write_attr_real("TSTEP", input_params%tstep, err)
  369. call write_attr_real("LX", input_params%lx, err)
  370. call write_attr_real("LY", input_params%ly, err)
  371. call write_attr_real("VISCOS", input_params%viscos, err)
  372. call write_attr_real("H_VISCOS", input_params%h_viscos, err)
  373. call write_attr_real("RESIS", input_params%resis, err)
  374. call write_attr_real("H_RESIS", input_params%h_resis, err)
  375. call write_attr_real("DIFFUS", input_params%diffus, err)
  376. call write_attr_real("H_DIFFUS", input_params%h_diffus, err)
  377. call write_attr_real("SPECTRUM_SLOPE", input_params%spectrum_slope, err)
  378. call write_attr_real("SPECTRUM_PEAK", input_params%spectrum_peak, err)
  379. call write_attr_real("EB", input_params%eb, err)
  380. call write_attr_real("EV", input_params%ev, err)
  381. call write_attr_real("EN", input_params%en, err)
  382. call write_attr_real("RHO_S2", input_params%rho_s2, err)
  383. call write_attr_real("DTFAC", input_params%dtfac, err)
  384. call write_attr_real("MASON", input_params%mason, err)
  385. call write_attr_real("FAMP", input_params%famp, err)
  386. call h5sclose_f(space_id, err)
  387. call h5gclose_f(group_id, err)
  388. call close_file_hdf5(file_id, err)
  389. contains!{{{
  390. subroutine write_attr_real(attr_name, attr_value, err)
  391. character(*), intent(in) :: attr_name
  392. real(sp), intent(in) :: attr_value
  393. integer, intent(out) :: err
  394. integer(HID_T) :: attr_id
  395. call h5acreate_f(group_id, attr_name,&
  396. H5T_NATIVE_REAL, space_id, attr_id, err)
  397. call h5awrite_f(attr_id, H5T_NATIVE_REAL,&
  398. attr_value, dummy_dims, err)
  399. call h5aclose_f(attr_id, err)
  400. end subroutine write_attr_real
  401. subroutine write_attr_integer(attr_name, attr_value, err)
  402. character(*), intent(in) :: attr_name
  403. integer, intent(in) :: attr_value
  404. integer, intent(out) :: err
  405. integer(HID_T) :: attr_id
  406. call h5acreate_f(group_id, attr_name,&
  407. H5T_NATIVE_INTEGER, space_id, attr_id, err)
  408. call h5awrite_f(attr_id, H5T_NATIVE_INTEGER,&
  409. attr_value, dummy_dims, err)
  410. call h5aclose_f(attr_id, err)
  411. end subroutine write_attr_integer
  412. subroutine write_attr_character(attr_name, attr_value, err)
  413. character(*), intent(in) :: attr_name
  414. character(*), intent(in) :: attr_value
  415. integer, intent(out) :: err
  416. character(STR_LEN) :: buf
  417. integer(HID_T) :: attr_id
  418. buf = attr_value
  419. call h5acreate_f(group_id, attr_name,&
  420. atype_id, space_id, attr_id, err)
  421. call h5awrite_f(attr_id, atype_id,&
  422. buf, dummy_dims, err)
  423. call h5aclose_f(attr_id, err)
  424. end subroutine write_attr_character
  425. !}}}
  426. end subroutine dump_params_hdf5
  427. subroutine init_io_hdf5(fname, overwrite, restart, error)
  428. implicit none
  429. character(*), intent(in) :: fname
  430. logical, intent(in) :: restart
  431. logical, intent(in) :: overwrite
  432. integer, intent(out) :: error
  433. integer(HID_T) :: file_id, group_id
  434. integer :: i
  435. call init_table_funcs()
  436. if(restart) return
  437. call create_file(fname, overwrite, error)
  438. if(error .ne. 0) return
  439. call init_file(fname, group_names, error)
  440. if(pid .eq. ROOT) then
  441. call open_file_hdf5(fname, file_id, error)
  442. call h5gopen_f(file_id, "scalars", group_id, error)
  443. call make_table_scalars(group_id, error)
  444. call h5gclose_f(group_id, error)
  445. call h5gopen_f(file_id, "stats", group_id, error)
  446. do i = 1, NSTATS
  447. call make_table_stats(group_id, stats_names(i), error)
  448. enddo
  449. call h5gclose_f(group_id, error)
  450. call close_file_hdf5(file_id, error)
  451. endif
  452. end subroutine init_io_hdf5
  453. subroutine close_io_hdf5()
  454. implicit none
  455. end subroutine close_io_hdf5
  456. subroutine dump_arrs_hdf5(fname, step_num, nout_arrs, cfields, iserr)
  457. implicit none
  458. character(*), intent(in) :: fname
  459. integer, intent(in) :: step_num, nout_arrs
  460. complex(sp), dimension(cdim, NF), intent(in) :: cfields
  461. integer, intent(out) :: iserr
  462. iserr = 0
  463. if(nout_arrs .eq. 0) then
  464. write(STDERR, *) "*** Error: nout_arrs is 0. ***"
  465. call flush(STDERR)
  466. iserr = 1
  467. return
  468. endif
  469. if(mod(step_num, nout_arrs) .eq. 0) then
  470. call dump_cmplx_arrs(fname, step_num, cfields)
  471. call dump_real_arrs(fname, step_num, cfields)
  472. endif
  473. end subroutine dump_arrs_hdf5
  474. subroutine load_cmplx_arrs_hdf5(fname, snap, cfield, error)
  475. implicit none
  476. character(*), intent(in) :: fname
  477. integer, intent(in) :: snap
  478. complex(sp), dimension(cdim, NF), intent(out) :: cfield
  479. integer, intent(out) :: error
  480. integer(HID_T) :: file_id
  481. error = 0
  482. call open_file_hdf5(fname, file_id, error)
  483. if (error .ne. 0) return
  484. call read_carr_hdf5(file_id, "cpsi", snap, cfield(:,PSI_IDX), error)
  485. if(error .ne. 0) goto 90
  486. call read_carr_hdf5(file_id, "cvor", snap, cfield(:,VOR_IDX), error)
  487. if(error .ne. 0) goto 90
  488. call read_carr_hdf5(file_id, "cden", snap, cfield(:,DEN_IDX), error)
  489. if(error .ne. 0) goto 90
  490. 90 call close_file_hdf5(file_id, error)
  491. end subroutine load_cmplx_arrs_hdf5
  492. subroutine dump_cmplx_arrs(fname, snap, cfield)
  493. implicit none
  494. character(*), intent(in) :: fname
  495. integer, intent(in) :: snap
  496. complex(sp), dimension(cdim, NF), intent(in) :: cfield
  497. integer(HID_T) :: file_id
  498. integer :: error
  499. error = 0
  500. call open_file_hdf5(fname, file_id, error)
  501. if(error .ne. 0) return
  502. call write_carr_hdf5(file_id, "cpsi", snap, cfield(:,PSI_IDX), error)
  503. if(error .ne. 0) goto 70
  504. call write_carr_hdf5(file_id, "cvor", snap, cfield(:,VOR_IDX), error)
  505. if(error .ne. 0) goto 70
  506. call write_carr_hdf5(file_id, "cden", snap, cfield(:,DEN_IDX), error)
  507. if(error .ne. 0) goto 70
  508. 70 call close_file_hdf5(file_id, error)
  509. end subroutine dump_cmplx_arrs
  510. subroutine dump_real_arrs(fname, snap, cfield)
  511. use pfft
  512. use spectral
  513. implicit none
  514. character(*), intent(in) :: fname
  515. integer, intent(in) :: snap
  516. complex(sp), dimension(cdim, NF), intent(in) :: cfield
  517. integer(HID_T) :: file_id
  518. integer :: error
  519. real(sp), dimension(ldim) :: r_aux
  520. error = 0
  521. call open_file_hdf5(fname, file_id, error)
  522. if(error .ne. 0) return
  523. call pfft_c2r(cfield(:,PSI_IDX), r_aux)
  524. call write_rarr_hdf5(file_id, "psi", snap, r_aux, error)
  525. if (error .ne. 0) goto 80
  526. call pfft_c2r(cfield(:,VOR_IDX), r_aux)
  527. call write_rarr_hdf5(file_id, "vor", snap, r_aux, error)
  528. if (error .ne. 0) goto 80
  529. call pfft_c2r(cfield(:,DEN_IDX), r_aux)
  530. call write_rarr_hdf5(file_id, "den", snap, r_aux, error)
  531. if (error .ne. 0) goto 80
  532. call pfft_c2r(-km2*cfield(:,VOR_IDX), r_aux)
  533. call write_rarr_hdf5(file_id, "phi", snap, r_aux, error)
  534. if (error .ne. 0) goto 80
  535. call pfft_c2r(-k2*cfield(:,PSI_IDX), r_aux)
  536. call write_rarr_hdf5(file_id, "cur", snap, r_aux, error)
  537. if (error .ne. 0) goto 80
  538. call derivative(X_DIR, cfield(:,PSI_IDX), r_aux)
  539. call write_rarr_hdf5(file_id, "bx", snap, r_aux, error)
  540. if (error .ne. 0) goto 80
  541. call derivative(Y_DIR, cfield(:,PSI_IDX), r_aux)
  542. call write_rarr_hdf5(file_id, "by", snap, r_aux, error)
  543. if (error .ne. 0) goto 80
  544. call derivative(X_DIR, cfield(:,DEN_IDX), r_aux)
  545. call write_rarr_hdf5(file_id, "gdx", snap, r_aux, error)
  546. if (error .ne. 0) goto 80
  547. call derivative(Y_DIR, cfield(:,DEN_IDX), r_aux)
  548. call write_rarr_hdf5(file_id, "gdy", snap, r_aux, error)
  549. if (error .ne. 0) goto 80
  550. call derivative(X_DIR, -km2*cfield(:,VOR_IDX), r_aux)
  551. call write_rarr_hdf5(file_id, "vx", snap, r_aux, error)
  552. if (error .ne. 0) goto 80
  553. call derivative(Y_DIR, -km2*cfield(:,VOR_IDX), r_aux)
  554. call write_rarr_hdf5(file_id, "vy", snap, r_aux, error)
  555. if (error .ne. 0) goto 80
  556. 80 call close_file_hdf5(file_id, error)
  557. end subroutine dump_real_arrs
  558. subroutine dump_stats_hdf5(fname, dump_idx, cfields)
  559. use spectral
  560. use pfft
  561. use statistics
  562. implicit none
  563. character(*), intent(in) :: fname
  564. integer, intent(in) :: dump_idx
  565. complex(sp), dimension(cdim, NF), intent(in) :: cfields
  566. integer :: error
  567. integer(HID_T) :: file_id, group_id
  568. if(pid .eq. ROOT) then
  569. error = 0
  570. call open_file_hdf5(fname, file_id, error)
  571. call h5gopen_f(file_id, "stats", group_id, error)
  572. endif
  573. call write_single_("psi", cfields(:,PSI_IDX))
  574. call write_single_("phi", -km2*cfields(:,VOR_IDX))
  575. call write_single_("cur", -k2*cfields(:,PSI_IDX))
  576. call write_single_("bx", ikx*cfields(:,PSI_IDX))
  577. call write_single_("by", iky*cfields(:,PSI_IDX))
  578. call write_single_("den", cfields(:,DEN_IDX))
  579. call write_single_("gdx", ikx*cfields(:,DEN_IDX))
  580. call write_single_("gdy", iky*cfields(:,DEN_IDX))
  581. call write_single_("vor", cfields(:,VOR_IDX))
  582. call write_single_("vx", -km2*ikx*cfields(:,VOR_IDX))
  583. call write_single_("vy", -km2*iky*cfields(:,VOR_IDX))
  584. if(pid .eq. ROOT) then
  585. call h5gclose_f(group_id, error)
  586. call close_file_hdf5(file_id, error)
  587. endif
  588. contains
  589. subroutine write_single_(nm, carr)
  590. implicit none
  591. character(*), intent(in) :: nm
  592. complex(sp), dimension(cdim), intent(in) :: carr
  593. real(sp), dimension(ldim) :: rfield
  594. real(db) :: ave, std_dev, skew, kurt
  595. integer :: nrecords
  596. type(stat_record), dimension(1) :: data_
  597. call pfft_c2r(carr, rfield)
  598. call get_moments(rfield, ave, std_dev, skew, kurt)
  599. if(pid .eq. ROOT) then
  600. error = 0
  601. nrecords = 1
  602. data_ = (/ stat_record(dump_idx, ave, std_dev, skew, kurt) /)
  603. call append_record_stats(group_id, nm, nrecords, data_, error)
  604. endif
  605. end subroutine write_single_
  606. end subroutine dump_stats_hdf5
  607. subroutine dump_scalars_hdf5(fname, dump_idx, time, basic_steps, rho_s2,&
  608. cfield)
  609. implicit none
  610. character(*), intent(in) :: fname
  611. integer, intent(in) :: dump_idx, basic_steps
  612. real(db), intent(in) :: time
  613. real(sp), intent(in) :: rho_s2
  614. complex(sp), dimension(cdim, NF), intent(in) :: cfield
  615. call dump_scalars_hdf5_(fname, dump_idx, time, basic_steps, rho_s2,&
  616. cfield)
  617. call dump_stats_hdf5(fname, dump_idx, cfield)
  618. end subroutine dump_scalars_hdf5
  619. subroutine dump_scalars_hdf5_(fname, dump_idx, time, basic_steps, rho_s2,&
  620. cfield)
  621. use spectral
  622. implicit none
  623. character(*), intent(in) :: fname
  624. integer, intent(in) :: dump_idx, basic_steps
  625. real(db), intent(in) :: time
  626. real(sp), intent(in) :: rho_s2
  627. complex(sp), dimension(cdim, NF), intent(in) :: cfield
  628. real(db) :: msf, be, ve, ne
  629. integer :: root, error, nrecords
  630. type(scalar_record), dimension(1) :: data_
  631. integer(HID_T) :: file_id, group_id
  632. root = 0
  633. ! msf
  634. call reduce_sum(root, cfield(:,PSI_IDX)*conjg(cfield(:,PSI_IDX)), msf)
  635. ! b-energy
  636. call reduce_sum(root, k2*cfield(:,PSI_IDX)*conjg(cfield(:,PSI_IDX)), be)
  637. ! v-energy
  638. call reduce_sum(root, km2*cfield(:,VOR_IDX)*conjg(cfield(:,VOR_IDX)), ve)
  639. ! internal-energy
  640. call reduce_sum(root, cfield(:,DEN_IDX)*conjg(cfield(:,DEN_IDX)), ne)
  641. ne = rho_s2 * ne
  642. if(pid .eq. root) then
  643. error = 0
  644. nrecords = 1
  645. data_ = (/ scalar_record(dump_idx, mpi_wtime()-start_time,&
  646. basic_steps, time, be, ve, ne, msf) /)
  647. call open_file_hdf5(fname, file_id, error)
  648. call h5gopen_f(file_id, "scalars", group_id, error)
  649. call append_records_scalars(group_id, nrecords, data_, error)
  650. call h5gclose_f(group_id, error)
  651. call close_file_hdf5(file_id, error)
  652. endif
  653. end subroutine dump_scalars_hdf5_
  654. end module input_output_hdf5