/input_output_hdf5.f90
FORTRAN Modern | 819 lines | 647 code | 165 blank | 7 comment | 64 complexity | 5bef93028addc7bec2f9ba0f655e5e0a MD5 | raw file
Possible License(s): GPL-3.0
- module input_output_hdf5
- use globalpars
- use mpimod
- use io_constants, only : get_array_name
- use input_output_base_hdf5
- use params_io
- use table_funcs
- use HDF5
- use H5LT
- use H5TB
- implicit none
- SAVE
- PRIVATE
- integer(HSIZE_T), dimension(1), parameter :: dummy_dims = (/ 20 /)
- integer, parameter :: GRP_NAME_LEN = 20, NGPS = 17, NSTATS=11
- integer, parameter :: ROOT = 0
- character(LEN=GRP_NAME_LEN), dimension(NSTATS), parameter :: &
- stats_names = (/ "psi", "vor", "den", &
- "phi", "cur", &
- "bx", "by", &
- "vx", "vy", &
- "gdx", "gdy" /)
- character(LEN=GRP_NAME_LEN), dimension(NGPS), parameter :: &
- group_names = (/ "cpsi", "cvor", "cden", &
- "psi", "vor", "den", &
- "phi", "cur", &
- "bx", "by", &
- "vx", "vy", &
- "gdx", "gdy", &
- "scalars", "stats", &
- "sim_params" /)
- public :: init_hdf5, close_hdf5, create_file, init_file, write_rarr_hdf5,&
- write_carr_hdf5, read_carr_hdf5, open_file_hdf5, close_file_hdf5, HID_T, &
- dump_arrs_hdf5, load_cmplx_arrs_hdf5, group_names, DATA_FNAME, init_io_hdf5, &
- dump_scalars_hdf5, dump_params_hdf5, load_params_hdf5, input_params_t, &
- check_restart_params, find_last_arr_idx_hdf5
- contains
- subroutine check_restart_params(fname, input_params, error)
- character(*), intent(in) :: fname
- type(input_params_t), intent(inout) :: input_params
- integer, intent(out) :: error
- integer :: errbuf(1), ierr
- type(input_params_t) :: hdf5_input_params
- error = 0
- if(pid .eq. 0) then
- call load_params_hdf5(fname, hdf5_input_params, error)
- error = 0
- ! we only allow NSTEPS to change, everything else must be the same.
- if(hdf5_input_params%nsteps .gt. input_params%nsteps ) then
- write(STDERR, *) "*** HDF5 NSTEPS > input params NSTEPS ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%max_wall_mins .ne. input_params%max_wall_mins ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%nout_arrs .ne. input_params%nout_arrs ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%nout_scals .ne. input_params%nout_scals ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%rng_seed .ne. input_params%rng_seed ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%tstep .ne. input_params%tstep ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%lx .ne. input_params%lx ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%ly .ne. input_params%ly ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%viscos .ne. input_params%viscos ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%h_viscos .ne. input_params%h_viscos ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%resis .ne. input_params%resis ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%h_resis .ne. input_params%h_resis ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%diffus .ne. input_params%diffus ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%h_diffus .ne. input_params%h_diffus ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%spectrum_slope .ne. input_params%spectrum_slope) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%spectrum_peak .ne. input_params%spectrum_peak ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%eb .ne. input_params%eb ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%ev .ne. input_params%ev ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%en .ne. input_params%en ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%rho_s2 .ne. input_params%rho_s2 ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%dtfac .ne. input_params%dtfac ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%mason .ne. input_params%mason ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- if(hdf5_input_params%famp .ne. input_params%famp ) then
- write(STDERR, *) "*** HDF5 param does not equal input param ***"
- call flush(STDERR)
- error = 1
- endif
- errbuf(1) = error
- endif
- CALL MPI_BCAST(errbuf, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
- error = errbuf(1)
- end subroutine check_restart_params
- subroutine find_last_arr_idx_hdf5(fname, last_idx, error)
- implicit none
- character(*), intent(in) :: fname
- integer, intent(out) :: last_idx
- integer, intent(out) :: error
- integer(HID_T) :: file_id, group_id
- integer :: exists, nout_arrs, i, ierr, intbuf(1)
- if(pid .eq. 0) then
- call open_file_hdf5(fname, file_id, error)
- call h5gopen_f(file_id, "sim_params", group_id, error)
- call read_attr_integer(group_id, "NOUT_ARRS", nout_arrs, error)
- call h5gclose_f(group_id, error)
- call h5gopen_f(file_id, "cden", group_id, error)
- last_idx = -1
- i = 0
- do
- exists = h5ltfind_dataset_f(group_id, get_array_name(i))
- if (exists .eq. 1) then
- last_idx = i
- else
- exit
- endif
- i = i + nout_arrs
- enddo
- call h5gclose_f(group_id, error)
- call close_file_hdf5(file_id, error)
- intbuf(1) = last_idx
- endif
- CALL MPI_BCAST(intbuf, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
- last_idx = intbuf(1)
- end subroutine find_last_arr_idx_hdf5
- subroutine load_params_hdf5(fname, input_params, error)
- implicit none
- character(*), intent(in) :: fname
- type(input_params_t), intent(out) :: input_params
- integer, intent(out) :: error
- integer(HID_T) :: file_id, group_id, input_int
- if(pid .ne. 0) return
- call open_file_hdf5(fname, file_id, error)
- call h5gopen_f(file_id, "sim_params", group_id, error)
- call read_attr_integer(group_id, "MAJOR_VERSION", input_int, error)
- if (input_int .ne. MAJOR_VERSION) then
- write(STDERR, *) "*** datafile MAJOR_VERSION ", &
- input_int, " .ne. to compiled MAJOR_VERSION ", &
- MAJOR_VERSION, " ***"
- call flush(STDERR)
- error = 1
- endif
- call read_attr_integer(group_id, "MINOR_VERSION", input_int, error)
- if (input_int .ne. MINOR_VERSION) then
- write(STDERR, *) "*** datafile MINOR_VERSION ", &
- input_int, " .ne. to compiled MINOR_VERSION ", &
- MINOR_VERSION, " ***"
- call flush(STDERR)
- error = 1
- endif
- call read_attr_integer(group_id, "NX", input_int, error)
- if (input_int .ne. NX) then
- write(STDERR, *) "*** datafile NX ", &
- input_int, " .ne. to compiled NX ", &
- NX, " ***"
- call flush(STDERR)
- error = 1
- endif
- call read_attr_integer(group_id, "NY", input_int, error)
- if (input_int .ne. NY) then
- write(STDERR, *) "*** datafile NY ", &
- input_int, " .ne. to compiled NY ", &
- NY, " ***"
- call flush(STDERR)
- error = 1
- endif
- call read_attr_integer(group_id, "NP", input_int, error)
- if (input_int .ne. NP) then
- write(STDERR, *) "*** datafile NP ", &
- input_int, " .ne. to compiled NP ", &
- NP, " ***"
- call flush(STDERR)
- error = 1
- endif
- call read_attr_integer(group_id, "NSTEPS", input_params%nsteps, error)
- call read_attr_integer(group_id, "MAX_WALL_MINS", input_params%max_wall_mins, error)
- call read_attr_integer(group_id, "NOUT_ARRS", input_params%nout_arrs, error)
- call read_attr_integer(group_id, "NOUT_SCALS", input_params%nout_scals, error)
- call read_attr_integer(group_id, "RNG_SEED", input_params%rng_seed, error)
- call read_attr_real(group_id, "TSTEP", input_params%tstep, error)
- call read_attr_real(group_id, "LX", input_params%lx, error)
- call read_attr_real(group_id, "LY", input_params%ly, error)
- call read_attr_real(group_id, "VISCOS", input_params%viscos, error)
- call read_attr_real(group_id, "H_VISCOS", input_params%h_viscos, error)
- call read_attr_real(group_id, "RESIS", input_params%resis, error)
- call read_attr_real(group_id, "H_RESIS", input_params%h_resis, error)
- call read_attr_real(group_id, "DIFFUS", input_params%diffus, error)
- call read_attr_real(group_id, "H_DIFFUS", input_params%h_diffus, error)
- call read_attr_real(group_id, "SPECTRUM_SLOPE", input_params%spectrum_slope, error)
- call read_attr_real(group_id, "SPECTRUM_PEAK", input_params%spectrum_peak, error)
- call read_attr_real(group_id, "EB", input_params%eb, error)
- call read_attr_real(group_id, "EV", input_params%ev, error)
- call read_attr_real(group_id, "EN", input_params%en, error)
- call read_attr_real(group_id, "RHO_S2", input_params%rho_s2, error)
- call read_attr_real(group_id, "DTFAC", input_params%dtfac, error)
- call read_attr_real(group_id, "MASON", input_params%mason, error)
- call read_attr_real(group_id, "FAMP", input_params%famp, error)
- call h5gclose_f(group_id, error)
- call close_file_hdf5(file_id, error)
- end subroutine load_params_hdf5
- subroutine read_attr_real(group_id, attr_name, attr_value, err)
- integer(HID_T), intent(in) :: group_id
- character(*), intent(in) :: attr_name
- real(sp), intent(out) :: attr_value
- integer, intent(out) :: err
- integer(HID_T) :: attr_id
- call h5aopen_f(group_id, attr_name, attr_id, err)
- call h5aread_f(attr_id, H5T_NATIVE_REAL, attr_value, &
- dummy_dims, err)
- call h5aclose_f(attr_id, err)
- end subroutine read_attr_real
- subroutine read_attr_integer(group_id, attr_name, attr_value, err)
- integer(HID_T), intent(in) :: group_id
- character(*), intent(in) :: attr_name
- integer, intent(out) :: attr_value
- integer, intent(out) :: err
- integer(HID_T) :: attr_id
- call h5aopen_f(group_id, attr_name, attr_id, err)
- call h5aread_f(attr_id, H5T_NATIVE_INTEGER, attr_value, &
- dummy_dims, err)
- call h5aclose_f(attr_id, err)
- end subroutine read_attr_integer
- subroutine read_attr_character(group_id, attr_name, attr_value, err)
- integer(HID_T), intent(in) :: group_id
- character(*), intent(in) :: attr_name
- character(*), intent(out) :: attr_value
- integer, intent(out) :: err
- character(STR_LEN) :: buf
- integer(HID_T) :: attr_id, atype_id
- call h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, err)
- call h5tset_size_f(atype_id, int(STR_LEN, kind=HSIZE_T), err)
- call h5aopen_f(group_id, attr_name, attr_id, err)
- call h5aread_f(attr_id, atype_id, buf, &
- dummy_dims, err)
- call h5aclose_f(attr_id, err)
- attr_value = buf
- end subroutine read_attr_character
- subroutine dump_params_restart(fname, input_params)
- character(*), intent(in) :: fname
- type(input_params_t), intent(in) :: input_params
- integer(HID_T) :: file_id, group_id
- integer :: err
- if(pid .ne. 0) return
- call open_file_hdf5(fname, file_id, err)
- call h5gopen_f(file_id, "sim_params", group_id, err)
- call write_attr_integer(group_id, "NSTEPS", input_params%nsteps, err)
- call h5gclose_f(group_id, err)
- call close_file_hdf5(file_id, err)
- contains
- subroutine write_attr_integer(group_id, attr_name, attr_value, err)
- integer(HID_T), intent(in) :: group_id
- character(*), intent(in) :: attr_name
- integer, intent(in) :: attr_value
- integer, intent(out) :: err
- integer(HID_T) :: attr_id
- call h5aopen_f(group_id, attr_name, attr_id, err)
- call h5awrite_f(attr_id, H5T_NATIVE_INTEGER,&
- attr_value, dummy_dims, err)
- call h5aclose_f(attr_id, err)
- end subroutine write_attr_integer
- end subroutine dump_params_restart
- subroutine dump_params_hdf5(fname, input_params, restart)
- implicit none
- character(*), intent(in) :: fname
- type(input_params_t), intent(in) :: input_params
- logical, intent(in) :: restart
- integer(HID_T) :: atype_id, space_id, file_id, group_id
- integer :: err
- integer(HSIZE_T), dimension(1), parameter :: dummy_dims = (/ 20 /)
- if(pid .ne. 0) return
- if(restart) then
- call dump_params_restart(fname, input_params)
- return
- endif
- call open_file_hdf5(fname, file_id, err)
- call h5gopen_f(file_id, "sim_params", group_id, err)
- call h5screate_f(H5S_SCALAR_F, space_id, err)
- CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, err)
- CALL h5tset_size_f(atype_id, int(STR_LEN, kind=HSIZE_T), err)
- call write_attr_integer("MAJOR_VERSION", MAJOR_VERSION, err)
- call write_attr_integer("MINOR_VERSION", MINOR_VERSION, err)
- call write_attr_integer("NX", nx, err)
- call write_attr_integer("NY", ny, err)
- call write_attr_integer("NP", np, err)
- ! REVISION, INTEGRATOR & MODEL -- character arrays
- call write_attr_character("REVISION", REVISION, err)
- call write_attr_character("INTEGRATOR", INTEGRATOR_, err)
- call write_attr_character("MODEL", MODEL, err)
- call write_attr_integer("NSTEPS", input_params%nsteps, err)
- call write_attr_integer("MAX_WALL_MINS", input_params%max_wall_mins, err)
- call write_attr_integer("NOUT_ARRS", input_params%nout_arrs, err)
- call write_attr_integer("NOUT_SCALS", input_params%nout_scals, err)
- call write_attr_integer("RNG_SEED", input_params%rng_seed, err)
- call write_attr_real("TSTEP", input_params%tstep, err)
- call write_attr_real("LX", input_params%lx, err)
- call write_attr_real("LY", input_params%ly, err)
- call write_attr_real("VISCOS", input_params%viscos, err)
- call write_attr_real("H_VISCOS", input_params%h_viscos, err)
- call write_attr_real("RESIS", input_params%resis, err)
- call write_attr_real("H_RESIS", input_params%h_resis, err)
- call write_attr_real("DIFFUS", input_params%diffus, err)
- call write_attr_real("H_DIFFUS", input_params%h_diffus, err)
- call write_attr_real("SPECTRUM_SLOPE", input_params%spectrum_slope, err)
- call write_attr_real("SPECTRUM_PEAK", input_params%spectrum_peak, err)
- call write_attr_real("EB", input_params%eb, err)
- call write_attr_real("EV", input_params%ev, err)
- call write_attr_real("EN", input_params%en, err)
- call write_attr_real("RHO_S2", input_params%rho_s2, err)
- call write_attr_real("DTFAC", input_params%dtfac, err)
- call write_attr_real("MASON", input_params%mason, err)
- call write_attr_real("FAMP", input_params%famp, err)
- call h5sclose_f(space_id, err)
- call h5gclose_f(group_id, err)
- call close_file_hdf5(file_id, err)
- contains!{{{
- subroutine write_attr_real(attr_name, attr_value, err)
- character(*), intent(in) :: attr_name
- real(sp), intent(in) :: attr_value
- integer, intent(out) :: err
- integer(HID_T) :: attr_id
- call h5acreate_f(group_id, attr_name,&
- H5T_NATIVE_REAL, space_id, attr_id, err)
- call h5awrite_f(attr_id, H5T_NATIVE_REAL,&
- attr_value, dummy_dims, err)
- call h5aclose_f(attr_id, err)
- end subroutine write_attr_real
- subroutine write_attr_integer(attr_name, attr_value, err)
- character(*), intent(in) :: attr_name
- integer, intent(in) :: attr_value
- integer, intent(out) :: err
- integer(HID_T) :: attr_id
- call h5acreate_f(group_id, attr_name,&
- H5T_NATIVE_INTEGER, space_id, attr_id, err)
- call h5awrite_f(attr_id, H5T_NATIVE_INTEGER,&
- attr_value, dummy_dims, err)
- call h5aclose_f(attr_id, err)
- end subroutine write_attr_integer
- subroutine write_attr_character(attr_name, attr_value, err)
- character(*), intent(in) :: attr_name
- character(*), intent(in) :: attr_value
- integer, intent(out) :: err
- character(STR_LEN) :: buf
- integer(HID_T) :: attr_id
- buf = attr_value
-
- call h5acreate_f(group_id, attr_name,&
- atype_id, space_id, attr_id, err)
- call h5awrite_f(attr_id, atype_id,&
- buf, dummy_dims, err)
- call h5aclose_f(attr_id, err)
- end subroutine write_attr_character
- !}}}
- end subroutine dump_params_hdf5
- subroutine init_io_hdf5(fname, overwrite, restart, error)
- implicit none
- character(*), intent(in) :: fname
- logical, intent(in) :: restart
- logical, intent(in) :: overwrite
- integer, intent(out) :: error
- integer(HID_T) :: file_id, group_id
- integer :: i
- call init_table_funcs()
- if(restart) return
- call create_file(fname, overwrite, error)
- if(error .ne. 0) return
- call init_file(fname, group_names, error)
- if(pid .eq. ROOT) then
- call open_file_hdf5(fname, file_id, error)
- call h5gopen_f(file_id, "scalars", group_id, error)
- call make_table_scalars(group_id, error)
- call h5gclose_f(group_id, error)
- call h5gopen_f(file_id, "stats", group_id, error)
- do i = 1, NSTATS
- call make_table_stats(group_id, stats_names(i), error)
- enddo
- call h5gclose_f(group_id, error)
- call close_file_hdf5(file_id, error)
- endif
- end subroutine init_io_hdf5
- subroutine close_io_hdf5()
- implicit none
- end subroutine close_io_hdf5
- subroutine dump_arrs_hdf5(fname, step_num, nout_arrs, cfields, iserr)
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: step_num, nout_arrs
- complex(sp), dimension(cdim, NF), intent(in) :: cfields
- integer, intent(out) :: iserr
- iserr = 0
- if(nout_arrs .eq. 0) then
- write(STDERR, *) "*** Error: nout_arrs is 0. ***"
- call flush(STDERR)
- iserr = 1
- return
- endif
- if(mod(step_num, nout_arrs) .eq. 0) then
- call dump_cmplx_arrs(fname, step_num, cfields)
- call dump_real_arrs(fname, step_num, cfields)
- endif
- end subroutine dump_arrs_hdf5
- subroutine load_cmplx_arrs_hdf5(fname, snap, cfield, error)
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: snap
- complex(sp), dimension(cdim, NF), intent(out) :: cfield
- integer, intent(out) :: error
- integer(HID_T) :: file_id
- error = 0
- call open_file_hdf5(fname, file_id, error)
- if (error .ne. 0) return
- call read_carr_hdf5(file_id, "cpsi", snap, cfield(:,PSI_IDX), error)
- if(error .ne. 0) goto 90
- call read_carr_hdf5(file_id, "cvor", snap, cfield(:,VOR_IDX), error)
- if(error .ne. 0) goto 90
- call read_carr_hdf5(file_id, "cden", snap, cfield(:,DEN_IDX), error)
- if(error .ne. 0) goto 90
- 90 call close_file_hdf5(file_id, error)
- end subroutine load_cmplx_arrs_hdf5
- subroutine dump_cmplx_arrs(fname, snap, cfield)
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: snap
- complex(sp), dimension(cdim, NF), intent(in) :: cfield
- integer(HID_T) :: file_id
- integer :: error
- error = 0
- call open_file_hdf5(fname, file_id, error)
- if(error .ne. 0) return
- call write_carr_hdf5(file_id, "cpsi", snap, cfield(:,PSI_IDX), error)
- if(error .ne. 0) goto 70
- call write_carr_hdf5(file_id, "cvor", snap, cfield(:,VOR_IDX), error)
- if(error .ne. 0) goto 70
- call write_carr_hdf5(file_id, "cden", snap, cfield(:,DEN_IDX), error)
- if(error .ne. 0) goto 70
- 70 call close_file_hdf5(file_id, error)
- end subroutine dump_cmplx_arrs
- subroutine dump_real_arrs(fname, snap, cfield)
- use pfft
- use spectral
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: snap
- complex(sp), dimension(cdim, NF), intent(in) :: cfield
- integer(HID_T) :: file_id
- integer :: error
- real(sp), dimension(ldim) :: r_aux
- error = 0
- call open_file_hdf5(fname, file_id, error)
- if(error .ne. 0) return
- call pfft_c2r(cfield(:,PSI_IDX), r_aux)
- call write_rarr_hdf5(file_id, "psi", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call pfft_c2r(cfield(:,VOR_IDX), r_aux)
- call write_rarr_hdf5(file_id, "vor", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call pfft_c2r(cfield(:,DEN_IDX), r_aux)
- call write_rarr_hdf5(file_id, "den", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call pfft_c2r(-km2*cfield(:,VOR_IDX), r_aux)
- call write_rarr_hdf5(file_id, "phi", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call pfft_c2r(-k2*cfield(:,PSI_IDX), r_aux)
- call write_rarr_hdf5(file_id, "cur", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call derivative(X_DIR, cfield(:,PSI_IDX), r_aux)
- call write_rarr_hdf5(file_id, "bx", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call derivative(Y_DIR, cfield(:,PSI_IDX), r_aux)
- call write_rarr_hdf5(file_id, "by", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call derivative(X_DIR, cfield(:,DEN_IDX), r_aux)
- call write_rarr_hdf5(file_id, "gdx", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call derivative(Y_DIR, cfield(:,DEN_IDX), r_aux)
- call write_rarr_hdf5(file_id, "gdy", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call derivative(X_DIR, -km2*cfield(:,VOR_IDX), r_aux)
- call write_rarr_hdf5(file_id, "vx", snap, r_aux, error)
- if (error .ne. 0) goto 80
- call derivative(Y_DIR, -km2*cfield(:,VOR_IDX), r_aux)
- call write_rarr_hdf5(file_id, "vy", snap, r_aux, error)
- if (error .ne. 0) goto 80
- 80 call close_file_hdf5(file_id, error)
- end subroutine dump_real_arrs
- subroutine dump_stats_hdf5(fname, dump_idx, cfields)
- use spectral
- use pfft
- use statistics
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: dump_idx
- complex(sp), dimension(cdim, NF), intent(in) :: cfields
- integer :: error
- integer(HID_T) :: file_id, group_id
- if(pid .eq. ROOT) then
- error = 0
- call open_file_hdf5(fname, file_id, error)
- call h5gopen_f(file_id, "stats", group_id, error)
- endif
- call write_single_("psi", cfields(:,PSI_IDX))
- call write_single_("phi", -km2*cfields(:,VOR_IDX))
- call write_single_("cur", -k2*cfields(:,PSI_IDX))
- call write_single_("bx", ikx*cfields(:,PSI_IDX))
- call write_single_("by", iky*cfields(:,PSI_IDX))
- call write_single_("den", cfields(:,DEN_IDX))
- call write_single_("gdx", ikx*cfields(:,DEN_IDX))
- call write_single_("gdy", iky*cfields(:,DEN_IDX))
- call write_single_("vor", cfields(:,VOR_IDX))
- call write_single_("vx", -km2*ikx*cfields(:,VOR_IDX))
- call write_single_("vy", -km2*iky*cfields(:,VOR_IDX))
- if(pid .eq. ROOT) then
- call h5gclose_f(group_id, error)
- call close_file_hdf5(file_id, error)
- endif
- contains
- subroutine write_single_(nm, carr)
- implicit none
- character(*), intent(in) :: nm
- complex(sp), dimension(cdim), intent(in) :: carr
- real(sp), dimension(ldim) :: rfield
- real(db) :: ave, std_dev, skew, kurt
- integer :: nrecords
- type(stat_record), dimension(1) :: data_
- call pfft_c2r(carr, rfield)
- call get_moments(rfield, ave, std_dev, skew, kurt)
- if(pid .eq. ROOT) then
- error = 0
- nrecords = 1
- data_ = (/ stat_record(dump_idx, ave, std_dev, skew, kurt) /)
- call append_record_stats(group_id, nm, nrecords, data_, error)
- endif
- end subroutine write_single_
- end subroutine dump_stats_hdf5
- subroutine dump_scalars_hdf5(fname, dump_idx, time, basic_steps, rho_s2,&
- cfield)
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: dump_idx, basic_steps
- real(db), intent(in) :: time
- real(sp), intent(in) :: rho_s2
- complex(sp), dimension(cdim, NF), intent(in) :: cfield
- call dump_scalars_hdf5_(fname, dump_idx, time, basic_steps, rho_s2,&
- cfield)
- call dump_stats_hdf5(fname, dump_idx, cfield)
- end subroutine dump_scalars_hdf5
- subroutine dump_scalars_hdf5_(fname, dump_idx, time, basic_steps, rho_s2,&
- cfield)
- use spectral
- implicit none
- character(*), intent(in) :: fname
- integer, intent(in) :: dump_idx, basic_steps
- real(db), intent(in) :: time
- real(sp), intent(in) :: rho_s2
- complex(sp), dimension(cdim, NF), intent(in) :: cfield
- real(db) :: msf, be, ve, ne
- integer :: root, error, nrecords
- type(scalar_record), dimension(1) :: data_
- integer(HID_T) :: file_id, group_id
- root = 0
- ! msf
- call reduce_sum(root, cfield(:,PSI_IDX)*conjg(cfield(:,PSI_IDX)), msf)
- ! b-energy
- call reduce_sum(root, k2*cfield(:,PSI_IDX)*conjg(cfield(:,PSI_IDX)), be)
- ! v-energy
- call reduce_sum(root, km2*cfield(:,VOR_IDX)*conjg(cfield(:,VOR_IDX)), ve)
- ! internal-energy
- call reduce_sum(root, cfield(:,DEN_IDX)*conjg(cfield(:,DEN_IDX)), ne)
- ne = rho_s2 * ne
- if(pid .eq. root) then
- error = 0
- nrecords = 1
- data_ = (/ scalar_record(dump_idx, mpi_wtime()-start_time,&
- basic_steps, time, be, ve, ne, msf) /)
- call open_file_hdf5(fname, file_id, error)
- call h5gopen_f(file_id, "scalars", group_id, error)
- call append_records_scalars(group_id, nrecords, data_, error)
- call h5gclose_f(group_id, error)
- call close_file_hdf5(file_id, error)
- endif
- end subroutine dump_scalars_hdf5_
- end module input_output_hdf5