IO: Use action='read' explicitely when opening a file for read-only.
Additionally, unify formatting of statements OPEN, READ, WRITE, CLOSE, INQUIRE. Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
f0fbf04cb7
commit
9455f9be9a
290
sources/io.F90
290
sources/io.F90
@ -218,7 +218,7 @@ module io
|
||||
call get_parameter("generate_xdmf" , xdmf )
|
||||
|
||||
if (index(respath, '/', back = .true.) /= len(trim(respath))) then
|
||||
write(respath,"(a)") trim(adjustl(respath)) // '/'
|
||||
write (respath,"(a)") trim(adjustl(respath)) // '/'
|
||||
end if
|
||||
|
||||
call get_parameter("snapshot_format", sformat)
|
||||
@ -250,19 +250,19 @@ module io
|
||||
case(snapshot_hdf5)
|
||||
do while (test)
|
||||
nrest = nrest + 1
|
||||
write(dname, "(a,'r',i6.6,'_',i5.5,'.h5')") &
|
||||
write (dname, "(a,'r',i6.6,'_',i5.5,'.h5')") &
|
||||
trim(respath), nrest, nproc
|
||||
inquire(file=dname, exist=test)
|
||||
inquire (file=dname, exist=test)
|
||||
end do
|
||||
#endif /* HDF5 */
|
||||
case default
|
||||
do while (test)
|
||||
nrest = nrest + 1
|
||||
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest
|
||||
write (dname, "(a,'restart-',i5.5)") trim(respath), nrest
|
||||
#ifdef __INTEL_COMPILER
|
||||
inquire(directory=dname, exist=test)
|
||||
inquire (directory=dname, exist=test)
|
||||
#else /* __INTEL_COMPILER */
|
||||
inquire(file=dname, exist=test)
|
||||
inquire (file=dname, exist=test)
|
||||
#endif /* __INTEL_COMPILER */
|
||||
end do
|
||||
end select
|
||||
@ -533,7 +533,7 @@ module io
|
||||
mm = int(mod(6.0d+01 * hrest, 6.0d+01))
|
||||
ss = int(mod(3.6d+03 * hrest, 6.0d+01))
|
||||
sfmt = "(i2.2,'d',i2.2,'h',i2.2,'m',i2.2,'s')"
|
||||
write(msg,sfmt) dd, hh, mm, ss
|
||||
write (msg,sfmt) dd, hh, mm, ss
|
||||
call print_parameter(verbose, "restart interval" , msg )
|
||||
end if
|
||||
if (restart_from_snapshot()) then
|
||||
@ -1034,12 +1034,12 @@ module io
|
||||
!
|
||||
status = 0
|
||||
|
||||
write(snapshot_path, "(a,'restart-',i5.5)") trim(respath), nrest
|
||||
write (snapshot_path, "(a,'restart-',i5.5)") trim(respath), nrest
|
||||
|
||||
#ifdef __INTEL_COMPILER
|
||||
inquire(directory=snapshot_path, exist=test)
|
||||
inquire (directory=snapshot_path, exist=test)
|
||||
#else /* __INTEL_COMPILER */
|
||||
inquire(file=snapshot_path, exist=test)
|
||||
inquire (file=snapshot_path, exist=test)
|
||||
#endif /* __INTEL_COMPILER */
|
||||
if (.not. test) then
|
||||
call print_message(loc, trim(snapshot_path) // " does not exist!")
|
||||
@ -1049,7 +1049,7 @@ module io
|
||||
snapshot_path = trim(snapshot_path) // "/"
|
||||
file_path = trim(snapshot_path) // "metadata.xml"
|
||||
|
||||
inquire(file=file_path, exist=test)
|
||||
inquire (file=file_path, exist=test)
|
||||
if (.not. test) then
|
||||
call print_message(loc, "The file '" // trim(file_path) // &
|
||||
"' does not exist.")
|
||||
@ -1283,8 +1283,8 @@ module io
|
||||
|
||||
if (nl >= 0) then
|
||||
|
||||
write(file_path, sfmt) trim(snapshot_path), "datablocks", nl, "xml"
|
||||
inquire(file=file_path, exist=test)
|
||||
write (file_path, sfmt) trim(snapshot_path), "datablocks", nl, "xml"
|
||||
inquire (file=file_path, exist=test)
|
||||
if (.not. test) then
|
||||
call print_message(loc, "The file '" // trim(file_path) // &
|
||||
"' does not exist.")
|
||||
@ -1326,7 +1326,7 @@ module io
|
||||
call append_datablock(pdata, status)
|
||||
call link_blocks(block_array(ids(l))%ptr, pdata)
|
||||
|
||||
write(aname, "('prim_',i6.6)") l
|
||||
write (aname, "('prim_',i6.6)") l
|
||||
call read_binary_xml(snapshot_path, aname, c_loc(array), &
|
||||
bytes, xml_ptr, status)
|
||||
|
||||
@ -1344,7 +1344,7 @@ module io
|
||||
#endif /* NDIMS == 3 */
|
||||
end if
|
||||
|
||||
write(aname, "('cons_',i6.6)") l
|
||||
write (aname, "('cons_',i6.6)") l
|
||||
call read_binary_xml(snapshot_path, aname, c_loc(array), &
|
||||
bytes * nr, xml_ptr, status)
|
||||
|
||||
@ -1400,8 +1400,8 @@ module io
|
||||
|
||||
if (status == 0) then
|
||||
|
||||
write(file_path, sfmt) trim(snapshot_path), "datablocks", 0, "xml"
|
||||
inquire(file=file_path, exist=test)
|
||||
write (file_path, sfmt) trim(snapshot_path), "datablocks", 0, "xml"
|
||||
inquire (file=file_path, exist=test)
|
||||
if (.not. test) then
|
||||
call print_message(loc, "The file '" // trim(file_path) // &
|
||||
"' does not exist.")
|
||||
@ -1455,8 +1455,8 @@ module io
|
||||
|
||||
do n = nl, nu
|
||||
|
||||
write(file_path, sfmt) trim(snapshot_path), "datablocks", n, "xml"
|
||||
inquire(file=file_path, exist=test)
|
||||
write (file_path, sfmt) trim(snapshot_path), "datablocks", n, "xml"
|
||||
inquire (file=file_path, exist=test)
|
||||
if (.not. test) then
|
||||
call print_message(loc, "The file '" // trim(file_path) // &
|
||||
"' does not exist.")
|
||||
@ -1500,7 +1500,7 @@ module io
|
||||
call append_datablock(pdata, status)
|
||||
call link_blocks(block_array(ids(l))%ptr, pdata)
|
||||
|
||||
write(aname, "('prim_',i6.6)") l
|
||||
write (aname, "('prim_',i6.6)") l
|
||||
call read_binary_xml(snapshot_path, aname, c_loc(array), &
|
||||
bytes, xml_ptr, status)
|
||||
|
||||
@ -1518,7 +1518,7 @@ module io
|
||||
#endif /* NDIMS == 3 */
|
||||
end if
|
||||
|
||||
write(aname, "('cons_',i6.6)") l
|
||||
write (aname, "('cons_',i6.6)") l
|
||||
call read_binary_xml(snapshot_path, aname, c_loc(array), &
|
||||
bytes * nr, xml_ptr, status)
|
||||
|
||||
@ -1555,8 +1555,8 @@ module io
|
||||
|
||||
if (status == 0) then
|
||||
|
||||
write(file_path, sfmt) trim(snapshot_path), "datablocks", nproc, "xml"
|
||||
inquire(file=file_path, exist=test)
|
||||
write (file_path, sfmt) trim(snapshot_path), "datablocks", nproc, "xml"
|
||||
inquire (file=file_path, exist=test)
|
||||
if (.not. test) then
|
||||
call print_message(loc, "The file '" // trim(file_path) // &
|
||||
"' does not exist.")
|
||||
@ -1678,21 +1678,21 @@ module io
|
||||
|
||||
call hash_info("xxh64", htype, hsize)
|
||||
|
||||
write(str, "('restart-',i5.5,'/')") nrun
|
||||
write (str, "('restart-',i5.5,'/')") nrun
|
||||
rpath = trim(str)
|
||||
|
||||
cmd = "mkdir -p " // trim(rpath)
|
||||
#ifdef __INTEL_COMPILER
|
||||
inquire(directory=rpath, exist=test)
|
||||
inquire (directory=rpath, exist=test)
|
||||
do while(.not. test)
|
||||
if (.not. test) call execute_command_line(cmd)
|
||||
inquire(directory=rpath, exist=test)
|
||||
inquire (directory=rpath, exist=test)
|
||||
end do
|
||||
#else /* __INTEL_COMPILER */
|
||||
inquire(file=rpath, exist=test)
|
||||
inquire (file=rpath, exist=test)
|
||||
do while(.not. test)
|
||||
if (.not. test) call execute_command_line(cmd)
|
||||
inquire(file=rpath, exist=test)
|
||||
inquire (file=rpath, exist=test)
|
||||
end do
|
||||
#endif /* __INTEL_COMPILER */
|
||||
|
||||
@ -1962,9 +1962,9 @@ module io
|
||||
ids(l) = pdata%meta%id
|
||||
|
||||
bytes = size(pdata%q, kind=8) * kind(pdata%q)
|
||||
write(str,"('prim_',i6.6)") l
|
||||
write (str,"('prim_',i6.6)") l
|
||||
aname = trim(str)
|
||||
write(str,"('datablock_prim_',i6.6,'_',i6.6)") nproc, l
|
||||
write (str,"('datablock_prim_',i6.6,'_',i6.6)") nproc, l
|
||||
call write_binary_xml(rpath, aname, trim(str), c_loc(pdata%q), &
|
||||
bytes, "float64", shape(pdata%q), htype, &
|
||||
snapshot_compressor, compression_level, &
|
||||
@ -1973,9 +1973,9 @@ module io
|
||||
call print_message(loc, "Could not store primitive variables!")
|
||||
|
||||
bytes = size(pdata%uu, kind=8) * kind(pdata%uu)
|
||||
write(str,"('cons_',i6.6)") l
|
||||
write (str,"('cons_',i6.6)") l
|
||||
aname = trim(str)
|
||||
write(str,"('datablock_cons_',i6.6,'_',i6.6)") nproc, l
|
||||
write (str,"('datablock_cons_',i6.6,'_',i6.6)") nproc, l
|
||||
call write_binary_xml(rpath, aname, trim(str), c_loc(pdata%uu), &
|
||||
bytes, "float64", shape(pdata%uu), htype, &
|
||||
snapshot_compressor, compression_level, &
|
||||
@ -1988,7 +1988,7 @@ module io
|
||||
end do
|
||||
|
||||
bytes = size(ids, kind=8) * kind(ids)
|
||||
write(str,"('datablock_ids_',i6.6)") nproc
|
||||
write (str,"('datablock_ids_',i6.6)") nproc
|
||||
call write_binary_xml(rpath, "ids", trim(str), c_loc(ids), &
|
||||
bytes, "int32", shape(ids), htype, &
|
||||
snapshot_compressor, compression_level, &
|
||||
@ -2013,7 +2013,7 @@ module io
|
||||
call get_seeds(seeds(:,:))
|
||||
|
||||
bytes = size(seeds, kind=8) * kind(seeds)
|
||||
write(str,"('random_seeds_',i6.6)") nproc
|
||||
write (str,"('random_seeds_',i6.6)") nproc
|
||||
call write_binary_xml(rpath, 'seeds', trim(str), c_loc(seeds), &
|
||||
bytes, "int64", shape(seeds), htype, &
|
||||
snapshot_compressor, compression_level, &
|
||||
@ -2031,7 +2031,7 @@ module io
|
||||
|
||||
end if
|
||||
|
||||
write(str,"(a,'datablocks_',i6.6,'.xml')") trim(rpath), nproc
|
||||
write (str,"(a,'datablocks_',i6.6,'.xml')") trim(rpath), nproc
|
||||
|
||||
call XMLSaveTree(xml_ptr, trim(str))
|
||||
call XMLFreeTree(xml_ptr)
|
||||
@ -2103,28 +2103,28 @@ module io
|
||||
!
|
||||
status = 0
|
||||
|
||||
write(str, "('snapshot-',i9.9,'/')") isnap
|
||||
write (str, "('snapshot-',i9.9,'/')") isnap
|
||||
rpath = trim(str)
|
||||
|
||||
cmd = "mkdir -p " // trim(rpath)
|
||||
#ifdef __INTEL_COMPILER
|
||||
inquire(directory=rpath, exist=test)
|
||||
inquire (directory=rpath, exist=test)
|
||||
do while(.not. test)
|
||||
if (.not. test) call execute_command_line(cmd)
|
||||
inquire(directory=rpath, exist=test)
|
||||
inquire (directory=rpath, exist=test)
|
||||
end do
|
||||
#else /* __INTEL_COMPILER */
|
||||
inquire(file=rpath, exist=test)
|
||||
inquire (file=rpath, exist=test)
|
||||
do while(.not. test)
|
||||
if (.not. test) call execute_command_line(cmd)
|
||||
inquire(file=rpath, exist=test)
|
||||
inquire (file=rpath, exist=test)
|
||||
end do
|
||||
#endif /* __INTEL_COMPILER */
|
||||
|
||||
nd = get_dblocks()
|
||||
nl = get_nleafs()
|
||||
|
||||
write(str, "(20(a,1x))") pvars
|
||||
write (str, "(20(a,1x))") pvars
|
||||
vars = trim(str)
|
||||
|
||||
if (nproc == 0) then
|
||||
@ -2271,7 +2271,7 @@ module io
|
||||
end do ! data blocks
|
||||
|
||||
bytes = size(ids, kind=8) * kind(ids)
|
||||
write(str, "('datablock_ids_',i6.6)") nproc
|
||||
write (str, "('datablock_ids_',i6.6)") nproc
|
||||
call write_binary_xml(rpath, "ids", trim(str), c_loc(ids), &
|
||||
bytes, "int32", shape(ids), hash_type, &
|
||||
snapshot_compressor, compression_level, &
|
||||
@ -2293,7 +2293,7 @@ module io
|
||||
pdata => pdata%next
|
||||
end do
|
||||
|
||||
write(str,"('datablock_',a,'_',i6.6)") trim(pvars(p)), nproc
|
||||
write (str,"('datablock_',a,'_',i6.6)") trim(pvars(p)), nproc
|
||||
call write_binary_xml(rpath, pvars(p), trim(str), c_loc(array), &
|
||||
bytes, "float64", shape(array), hash_type, &
|
||||
snapshot_compressor, compression_level, &
|
||||
@ -2315,7 +2315,7 @@ module io
|
||||
|
||||
end if
|
||||
|
||||
write(str,"(a,'datablocks_',i6.6,'.xml')") trim(rpath), nproc
|
||||
write (str,"(a,'datablocks_',i6.6,'.xml')") trim(rpath), nproc
|
||||
|
||||
call XMLSaveTree(xml_ptr, trim(str))
|
||||
call XMLFreeTree(xml_ptr)
|
||||
@ -2385,7 +2385,7 @@ module io
|
||||
|
||||
call XMLGetElementValue(xml_ptr, 'BinaryFiles', array_name, str)
|
||||
file_path = trim(data_path) // trim(str)
|
||||
inquire(file=file_path, exist=test)
|
||||
inquire (file=file_path, exist=test)
|
||||
if (.not. test) then
|
||||
call print_message(loc, "The file '" // trim(file_path) // &
|
||||
"' does not exist.")
|
||||
@ -2420,9 +2420,9 @@ module io
|
||||
'compressed_size', csize)
|
||||
allocate(buffer(csize))
|
||||
|
||||
open(newunit=io, file=file_path, access='stream')
|
||||
read(io) buffer
|
||||
close(io)
|
||||
open (newunit=io, file=file_path, access='stream', action='read')
|
||||
read (io) buffer
|
||||
close (io)
|
||||
|
||||
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
|
||||
'digest_type', str)
|
||||
@ -2474,9 +2474,9 @@ module io
|
||||
end if
|
||||
|
||||
else
|
||||
open(newunit=io, file=file_path, access='stream')
|
||||
read(io) array
|
||||
close(io)
|
||||
open (newunit=io, file=file_path, access='stream', action='read')
|
||||
read (io) array
|
||||
close (io)
|
||||
end if
|
||||
|
||||
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
|
||||
@ -2611,9 +2611,9 @@ module io
|
||||
filename = trim(array_file) // '.bin' // file_suffix
|
||||
filepath = trim(data_path) // trim(filename)
|
||||
|
||||
open(newunit=io, file=filepath, access='stream')
|
||||
write(io) buffer(1:cbytes)
|
||||
close(io)
|
||||
open (newunit=io, file=filepath, access='stream')
|
||||
write (io) buffer(1:cbytes)
|
||||
close (io)
|
||||
|
||||
end if
|
||||
|
||||
@ -2646,9 +2646,9 @@ module io
|
||||
filename = trim(array_file) // '.bin'
|
||||
filepath = trim(data_path) // trim(filename)
|
||||
|
||||
open(newunit=io, file=filepath, access='stream')
|
||||
write(io) array
|
||||
close(io)
|
||||
open (newunit=io, file=filepath, access='stream')
|
||||
write (io) array
|
||||
close (io)
|
||||
|
||||
call XMLAddElement(xml_ptr, "BinaryFiles", array_name, &
|
||||
filename, array_dtype, array_bytes, &
|
||||
@ -2701,8 +2701,8 @@ module io
|
||||
|
||||
if (.not. master) return
|
||||
|
||||
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
|
||||
inquire(file=fname, exist=flag)
|
||||
write (fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
|
||||
inquire (file=fname, exist=flag)
|
||||
if (.not. flag) then
|
||||
call print_message(loc, "Restart snapshot " // trim(fname) // &
|
||||
" does not exist!")
|
||||
@ -2746,7 +2746,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(i0)") ival
|
||||
write (sval,"(i0)") ival
|
||||
call update_parameter("nfiles", trim(adjustl(sval)))
|
||||
|
||||
pname = "ncells"
|
||||
@ -2755,7 +2755,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(i0)") ival
|
||||
write (sval,"(i0)") ival
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "xblocks"
|
||||
@ -2764,7 +2764,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(i0)") ival
|
||||
write (sval,"(i0)") ival
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "yblocks"
|
||||
@ -2773,7 +2773,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(i0)") ival
|
||||
write (sval,"(i0)") ival
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
#if NDIMS == 3
|
||||
@ -2783,7 +2783,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(i0)") ival
|
||||
write (sval,"(i0)") ival
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
@ -2793,7 +2793,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(i0)") ival
|
||||
write (sval,"(i0)") ival
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "xmin"
|
||||
@ -2802,7 +2802,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(1es32.20)") rval
|
||||
write (sval,"(1es32.20)") rval
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "xmax"
|
||||
@ -2811,7 +2811,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(1es32.20)") rval
|
||||
write (sval,"(1es32.20)") rval
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "ymin"
|
||||
@ -2820,7 +2820,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(1es32.20)") rval
|
||||
write (sval,"(1es32.20)") rval
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "ymax"
|
||||
@ -2829,7 +2829,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(1es32.20)") rval
|
||||
write (sval,"(1es32.20)") rval
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
#if NDIMS == 3
|
||||
@ -2839,7 +2839,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(1es32.20)") rval
|
||||
write (sval,"(1es32.20)") rval
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
|
||||
pname = "zmax"
|
||||
@ -2848,7 +2848,7 @@ module io
|
||||
if (status /= 0) &
|
||||
call print_message(loc, "Failed to restore attribute" // &
|
||||
trim(pname) // "!")
|
||||
write(sval,"(1es32.20)") rval
|
||||
write (sval,"(1es32.20)") rval
|
||||
call update_parameter(pname, trim(adjustl(sval)))
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
@ -2909,8 +2909,8 @@ module io
|
||||
!
|
||||
!! 1. RESTORE PARAMETERS AND META BLOCKS FROM THE FIRST FILE
|
||||
!!
|
||||
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
|
||||
inquire(file=fname, exist=flag)
|
||||
write (fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
|
||||
inquire (file=fname, exist=flag)
|
||||
if (.not. flag) then
|
||||
call print_message(loc, &
|
||||
"Restart snapshot '" // trim(fname) // "' not found!")
|
||||
@ -2953,8 +2953,8 @@ module io
|
||||
!
|
||||
if (nfiles <= nprocs .and. nproc < nfiles) then
|
||||
|
||||
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, nproc
|
||||
inquire(file=fname, exist=flag)
|
||||
write (fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, nproc
|
||||
inquire (file=fname, exist=flag)
|
||||
if (.not. flag) then
|
||||
call print_message(loc, &
|
||||
"Restart snapshot '" // trim(fname) // "' not found!")
|
||||
@ -3021,8 +3021,8 @@ module io
|
||||
|
||||
do n = nl, nu
|
||||
|
||||
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, n
|
||||
inquire(file=fname, exist=flag)
|
||||
write (fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, n
|
||||
inquire (file=fname, exist=flag)
|
||||
if (.not. flag) then
|
||||
call print_message(loc, &
|
||||
"Restart snapshot '" // trim(fname) // "' not found!")
|
||||
@ -3107,7 +3107,7 @@ module io
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
write(fname, "('r',i6.6,'_',i5.5,'.h5')") nrun, nproc
|
||||
write (fname, "('r',i6.6,'_',i5.5,'.h5')") nrun, nproc
|
||||
|
||||
call h5fcreate_f(fname, H5F_ACC_TRUNC_F, file_id, status)
|
||||
if (status /= 0) then
|
||||
@ -3161,7 +3161,7 @@ module io
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
write(fname,"('p',i6.6,'_',i5.5,'.h5')") isnap, nproc
|
||||
write (fname,"('p',i6.6,'_',i5.5,'.h5')") isnap, nproc
|
||||
|
||||
call h5fcreate_f(fname, H5F_ACC_TRUNC_F, file_id, status)
|
||||
if (status < 0) then
|
||||
@ -4121,7 +4121,7 @@ module io
|
||||
end if
|
||||
|
||||
do l = 1, dblocks
|
||||
write(blk_name, "('datablock_', i0)") l
|
||||
write (blk_name, "('datablock_', i0)") l
|
||||
|
||||
call append_datablock(pdata, status)
|
||||
if (status /= 0) then
|
||||
@ -4246,7 +4246,7 @@ module io
|
||||
pdata => list_data
|
||||
do while(associated(pdata))
|
||||
l = l + 1
|
||||
write(blk_name, "('datablock_', i0)") l
|
||||
write (blk_name, "('datablock_', i0)") l
|
||||
call h5gcreate_f(grp_id, blk_name, blk_id, status)
|
||||
if (status == 0) then
|
||||
call store_attribute_h5(blk_id, 'meta', &
|
||||
@ -5188,22 +5188,22 @@ module io
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
write(fname, "('p',i6.6,'_',i5.5,'.xdmf')") isnap, nproc
|
||||
write(hname, "('p',i6.6,'_',i5.5,'.h5' )") isnap, nproc
|
||||
write (fname, "('p',i6.6,'_',i5.5,'.xdmf')") isnap, nproc
|
||||
write (hname, "('p',i6.6,'_',i5.5,'.h5' )") isnap, nproc
|
||||
|
||||
open (unit = xdmf, file = fname, status = 'replace')
|
||||
|
||||
! write the header
|
||||
!
|
||||
write(xdmf, "(a)") '<?xml version="1.0" encoding="UTF-8"?>'
|
||||
write(xdmf, "(a)") '<Xdmf Version="2.2"' &
|
||||
write (xdmf, "(a)") '<?xml version="1.0" encoding="UTF-8"?>'
|
||||
write (xdmf, "(a)") '<Xdmf Version="2.2"' &
|
||||
// ' xmlns:xi="http://www.w3.org/2003/XInclude">'
|
||||
write(xdmf, "(a)") ' <Domain>'
|
||||
write(stmp, "(1i16)") nproc
|
||||
write(xdmf, "(a)") ' <Grid Name="region_' // trim(adjustl(stmp)) &
|
||||
write (xdmf, "(a)") ' <Domain>'
|
||||
write (stmp, "(1i16)") nproc
|
||||
write (xdmf, "(a)") ' <Grid Name="region_' // trim(adjustl(stmp)) &
|
||||
// '" GridType="Collection" CollectionType="Spatial">'
|
||||
write(stmp, "(1g15.8)") time
|
||||
write(xdmf, "(a)") ' <Time TimeType="Single" Value="' &
|
||||
write (stmp, "(1g15.8)") time
|
||||
write (xdmf, "(a)") ' <Time TimeType="Single" Value="' &
|
||||
// trim(adjustl(stmp)) // '"/>'
|
||||
|
||||
! do not proceed if there are not data block on this processor
|
||||
@ -5219,26 +5219,26 @@ module io
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
#if NDIMS == 3
|
||||
write(stmp, "(1i8)") ni
|
||||
write(ttmp, "(1i8)") ni
|
||||
write (stmp, "(1i8)") ni
|
||||
write (ttmp, "(1i8)") ni
|
||||
stmp = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
write(ttmp, "(1i8)") ni
|
||||
write (ttmp, "(1i8)") ni
|
||||
#else /* NDIMS == 3 */
|
||||
write(stmp, "(1i8)") ni
|
||||
write(ttmp, "(1i8)") ni
|
||||
write (stmp, "(1i8)") ni
|
||||
write (ttmp, "(1i8)") ni
|
||||
#endif /* NDIMS == 3 */
|
||||
bdim = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
|
||||
#if NDIMS == 3
|
||||
write(stmp, "(1i8)") ni
|
||||
write (stmp, "(1i8)") ni
|
||||
#else /* NDIMS == 3 */
|
||||
write(stmp, "(1i8)") 1
|
||||
write (stmp, "(1i8)") 1
|
||||
#endif /* NDIMS == 3 */
|
||||
write(ttmp, "(1i8)") ni
|
||||
write (ttmp, "(1i8)") ni
|
||||
stmp = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
write(ttmp, "(1i8)") ni
|
||||
write (ttmp, "(1i8)") ni
|
||||
stmp = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
write(ttmp, "(1i8)") get_dblocks()
|
||||
write (ttmp, "(1i8)") get_dblocks()
|
||||
sdim = trim(adjustl(ttmp)) // ' ' // trim(adjustl(stmp))
|
||||
|
||||
! prepare slab indices
|
||||
@ -5257,52 +5257,52 @@ module io
|
||||
|
||||
! store block geometry information
|
||||
!
|
||||
write(stmp, "(1i16)") pdata%meta%id
|
||||
write(xdmf, "(a)") ' <Grid Name="block_' &
|
||||
write (stmp, "(1i16)") pdata%meta%id
|
||||
write (xdmf, "(a)") ' <Grid Name="block_' &
|
||||
// trim(adjustl(stmp)) // '">'
|
||||
#if NDIMS == 3
|
||||
write(stmp, "(1i8)") kp
|
||||
write(ttmp, "(1i8)") jp
|
||||
write (stmp, "(1i8)") kp
|
||||
write (ttmp, "(1i8)") jp
|
||||
stmp = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
write(ttmp, "(1i8)") ip
|
||||
write (ttmp, "(1i8)") ip
|
||||
stmp = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
write(xdmf, "(a)") ' <Topology TopologyType="3DCoRectMesh"' &
|
||||
write (xdmf, "(a)") ' <Topology TopologyType="3DCoRectMesh"' &
|
||||
// ' Dimensions="' // trim(adjustl(stmp)) // '"/>'
|
||||
write(xdmf, "(a)") ' <Geometry GeometryType="ORIGIN_DXDYDZ">'
|
||||
write(stmp, "(3es16.8)") pdata%meta%zmin, pdata%meta%ymin &
|
||||
write (xdmf, "(a)") ' <Geometry GeometryType="ORIGIN_DXDYDZ">'
|
||||
write (stmp, "(3es16.8)") pdata%meta%zmin, pdata%meta%ymin &
|
||||
, pdata%meta%xmin
|
||||
write(xdmf, "(a)") ' <DataItem Name="Origin" NumberType="Float"' &
|
||||
write (xdmf, "(a)") ' <DataItem Name="Origin" NumberType="Float"' &
|
||||
// ' Precision="4" Dimensions="3" Format="XML">' &
|
||||
// trim(adjustl(stmp)) // '</DataItem>'
|
||||
write(stmp, "(3es16.8)") adz(pdata%meta%level), ady(pdata%meta%level) &
|
||||
write (stmp, "(3es16.8)") adz(pdata%meta%level), ady(pdata%meta%level) &
|
||||
, adx(pdata%meta%level)
|
||||
write(xdmf, "(a)") ' <DataItem Name="Spacing" NumberType="Float"' &
|
||||
write (xdmf, "(a)") ' <DataItem Name="Spacing" NumberType="Float"' &
|
||||
// ' Precision="4" Dimensions="3" Format="XML">' &
|
||||
// trim(adjustl(stmp)) // '</DataItem>'
|
||||
#else /* NDIMS == 3 */
|
||||
write(stmp, "(1i8)") jp
|
||||
write(ttmp, "(1i8)") ip
|
||||
write (stmp, "(1i8)") jp
|
||||
write (ttmp, "(1i8)") ip
|
||||
stmp = trim(adjustl(stmp)) // ' ' // trim(adjustl(ttmp))
|
||||
write(xdmf, "(a)") ' <Topology TopologyType="2DCoRectMesh"' &
|
||||
write (xdmf, "(a)") ' <Topology TopologyType="2DCoRectMesh"' &
|
||||
// ' Dimensions="' // trim(adjustl(stmp)) // '"/>'
|
||||
write(xdmf, "(a)") ' <Geometry GeometryType="ORIGIN_DXDY">'
|
||||
write(stmp, "(2es16.8)") pdata%meta%ymin, pdata%meta%xmin
|
||||
write(xdmf, "(a)") ' <DataItem Name="Origin" NumberType="Float"' &
|
||||
write (xdmf, "(a)") ' <Geometry GeometryType="ORIGIN_DXDY">'
|
||||
write (stmp, "(2es16.8)") pdata%meta%ymin, pdata%meta%xmin
|
||||
write (xdmf, "(a)") ' <DataItem Name="Origin" NumberType="Float"' &
|
||||
// ' Precision="4" Dimensions="2" Format="XML">' &
|
||||
// trim(adjustl(stmp)) // '</DataItem>'
|
||||
write(stmp, "(2es16.8)") ady(pdata%meta%level), adx(pdata%meta%level)
|
||||
write(xdmf, "(a)") ' <DataItem Name="Spacing" NumberType="Float"' &
|
||||
write (stmp, "(2es16.8)") ady(pdata%meta%level), adx(pdata%meta%level)
|
||||
write (xdmf, "(a)") ' <DataItem Name="Spacing" NumberType="Float"' &
|
||||
// ' Precision="4" Dimensions="2" Format="XML">' &
|
||||
// trim(adjustl(stmp)) // '</DataItem>'
|
||||
#endif /* NDIMS == 3 */
|
||||
write(xdmf, "(a)") ' </Geometry>'
|
||||
write (xdmf, "(a)") ' </Geometry>'
|
||||
|
||||
! convert slab dimensions to string
|
||||
!
|
||||
slab(1) = l
|
||||
write(pdim, "(1i8)") slab(1)
|
||||
write (pdim, "(1i8)") slab(1)
|
||||
do p = 2, 12
|
||||
write(ttmp, "(1i8)") slab(p)
|
||||
write (ttmp, "(1i8)") slab(p)
|
||||
pdim = trim(adjustl(pdim)) // ' ' // trim(adjustl(ttmp))
|
||||
end do
|
||||
|
||||
@ -5310,27 +5310,27 @@ module io
|
||||
!
|
||||
do p = 1, nv
|
||||
|
||||
write(xdmf, "(a)") ' <Attribute Name="' &
|
||||
write (xdmf, "(a)") ' <Attribute Name="' &
|
||||
// trim(adjustl(pvars(p))) &
|
||||
// '" AttributeType="Scalar" Center="Cell">'
|
||||
write(xdmf, "(a)") ' <DataItem ItemType="Hyperslab"' &
|
||||
write (xdmf, "(a)") ' <DataItem ItemType="Hyperslab"' &
|
||||
// ' Dimensions="' // trim(adjustl(bdim)) &
|
||||
// '" Type="HyperSlab">'
|
||||
write(xdmf, "(a)") ' <DataItem Dimensions="3 4" Format="XML">' &
|
||||
write (xdmf, "(a)") ' <DataItem Dimensions="3 4" Format="XML">' &
|
||||
// trim(adjustl(pdim)) // '</DataItem>'
|
||||
write(ttmp, "(a,':/variables/',a)") trim(hname), trim(pvars(p))
|
||||
write(xdmf, "(a)") ' <DataItem NumberType="Float"' &
|
||||
write (ttmp, "(a,':/variables/',a)") trim(hname), trim(pvars(p))
|
||||
write (xdmf, "(a)") ' <DataItem NumberType="Float"' &
|
||||
// ' Precision="8" Dimensions="' &
|
||||
// trim(adjustl(sdim)) // '" Format="HDF">' &
|
||||
// trim(adjustl(ttmp)) // '</DataItem>'
|
||||
write(xdmf, "(a)") ' </DataItem>'
|
||||
write(xdmf, "(a)") ' </Attribute>'
|
||||
write (xdmf, "(a)") ' </DataItem>'
|
||||
write (xdmf, "(a)") ' </Attribute>'
|
||||
|
||||
end do
|
||||
|
||||
! close grid structure for the current block
|
||||
!
|
||||
write(xdmf,"(a)") ' </Grid>'
|
||||
write (xdmf,"(a)") ' </Grid>'
|
||||
|
||||
l = l + 1
|
||||
pdata => pdata%next
|
||||
@ -5340,11 +5340,11 @@ module io
|
||||
|
||||
! close the XDMF structures
|
||||
!
|
||||
write(xdmf, "(a)") ' </Grid>'
|
||||
write(xdmf, "(a)") ' </Domain>'
|
||||
write(xdmf, "(a)") '</Xdmf>'
|
||||
write (xdmf, "(a)") ' </Grid>'
|
||||
write (xdmf, "(a)") ' </Domain>'
|
||||
write (xdmf, "(a)") '</Xdmf>'
|
||||
|
||||
close(xdmf)
|
||||
close (xdmf)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
@ -5377,34 +5377,34 @@ module io
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
write(fname, "('p',i6.6,'.xdmf')") isnap
|
||||
write (fname, "('p',i6.6,'.xdmf')") isnap
|
||||
|
||||
open (unit = xdmf, file = fname, status = 'replace')
|
||||
|
||||
! write the header
|
||||
!
|
||||
write(xdmf, "(a)") '<?xml version="1.0" encoding="UTF-8"?>'
|
||||
write(xdmf, "(a)") '<Xdmf Version="2.2"' &
|
||||
write (xdmf, "(a)") '<?xml version="1.0" encoding="UTF-8"?>'
|
||||
write (xdmf, "(a)") '<Xdmf Version="2.2"' &
|
||||
// ' xmlns:xi="http://www.w3.org/2003/XInclude">'
|
||||
write(xdmf, "(a)") ' <Domain Name="GatherMPISubDomains">'
|
||||
write(xdmf, "(a)") ' <Grid Name="FullDomain"' &
|
||||
write (xdmf, "(a)") ' <Domain Name="GatherMPISubDomains">'
|
||||
write (xdmf, "(a)") ' <Grid Name="FullDomain"' &
|
||||
// ' GridType="Collection" CollectionType="Spatial">'
|
||||
|
||||
! write references to MPI subdomain files
|
||||
!
|
||||
do np = 0, npmax
|
||||
write(pname, "('p',i6.6,'_',i5.5,'.xdmf')") isnap, np
|
||||
write(xdmf, "(a)") ' <xi:include href="' // trim(pname) &
|
||||
write (pname, "('p',i6.6,'_',i5.5,'.xdmf')") isnap, np
|
||||
write (xdmf, "(a)") ' <xi:include href="' // trim(pname) &
|
||||
// '" xpointer="xpointer(//Xdmf/Domain/Grid)"/>'
|
||||
end do
|
||||
|
||||
! close the XDMF structures
|
||||
!
|
||||
write(xdmf, "(a)") ' </Grid>'
|
||||
write(xdmf, "(a)") ' </Domain>'
|
||||
write(xdmf, "(a)") '</Xdmf>'
|
||||
write (xdmf, "(a)") ' </Grid>'
|
||||
write (xdmf, "(a)") ' </Domain>'
|
||||
write (xdmf, "(a)") '</Xdmf>'
|
||||
|
||||
close(xdmf)
|
||||
close (xdmf)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user