Merge branch 'master' into flux-tubes
This commit is contained in:
commit
04bc74bead
sources
315
sources/io.F90
315
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
|
||||
@ -874,10 +874,9 @@ module io
|
||||
|
||||
integer, intent(inout) :: status
|
||||
|
||||
logical :: test
|
||||
logical :: exists
|
||||
character(len=255) :: dname, fname, line
|
||||
integer(kind=4) :: lun = 103
|
||||
integer :: n, l, u
|
||||
integer :: io, n, l, u
|
||||
|
||||
character(len=8), dimension(14) :: keys = &
|
||||
[ "problem ", "eqsys ", "eos ", &
|
||||
@ -896,22 +895,22 @@ module io
|
||||
|
||||
! check if the snapshot directory and metafile exist
|
||||
!
|
||||
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=exists)
|
||||
#else /* __INTEL_COMPILER */
|
||||
inquire(file = dname, exist = test)
|
||||
inquire (file=dname, exist=exists)
|
||||
#endif /* __INTEL_COMPILER */
|
||||
if (.not. test) then
|
||||
if (.not. exists) then
|
||||
call print_message(loc, trim(dname) // " does not exist!")
|
||||
status = 121
|
||||
return
|
||||
end if
|
||||
|
||||
write(fname,"(a,'/metadata.xml')") trim(dname)
|
||||
inquire(file = fname, exist = test)
|
||||
if (.not. test) then
|
||||
write (fname,"(a,'/metadata.xml')") trim(dname)
|
||||
inquire (file=fname, exist=exists)
|
||||
if (.not. exists) then
|
||||
call print_message(loc, trim(fname) // " does not exist!")
|
||||
status = 121
|
||||
return
|
||||
@ -919,8 +918,8 @@ module io
|
||||
|
||||
! read requested parameter from the file
|
||||
!
|
||||
open(newunit = lun, file = fname, status = 'old')
|
||||
10 read(lun, fmt = "(a)", end = 20) line
|
||||
open (newunit=io, file=fname, status='old', action='read')
|
||||
10 read (io, fmt="(a)", end=20) line
|
||||
do n = 1, size(keys)
|
||||
l = index(line, trim(keys(n)))
|
||||
if (l > 0) then
|
||||
@ -936,7 +935,7 @@ module io
|
||||
end if
|
||||
end do
|
||||
go to 10
|
||||
20 close(lun)
|
||||
20 close (io)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
@ -1035,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!")
|
||||
@ -1050,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.")
|
||||
@ -1284,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.")
|
||||
@ -1327,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)
|
||||
|
||||
@ -1345,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)
|
||||
|
||||
@ -1401,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.")
|
||||
@ -1456,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.")
|
||||
@ -1501,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)
|
||||
|
||||
@ -1519,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)
|
||||
|
||||
@ -1556,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.")
|
||||
@ -1679,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 */
|
||||
|
||||
@ -1963,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, &
|
||||
@ -1974,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, &
|
||||
@ -1989,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, &
|
||||
@ -2014,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, &
|
||||
@ -2032,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)
|
||||
@ -2104,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
|
||||
@ -2272,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, &
|
||||
@ -2294,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, &
|
||||
@ -2316,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)
|
||||
@ -2386,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.")
|
||||
@ -2421,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)
|
||||
@ -2475,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, &
|
||||
@ -2612,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
|
||||
|
||||
@ -2647,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, &
|
||||
@ -2702,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!")
|
||||
@ -2747,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"
|
||||
@ -2756,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"
|
||||
@ -2765,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"
|
||||
@ -2774,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
|
||||
@ -2784,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 */
|
||||
|
||||
@ -2794,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"
|
||||
@ -2803,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"
|
||||
@ -2812,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"
|
||||
@ -2821,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"
|
||||
@ -2830,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
|
||||
@ -2840,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"
|
||||
@ -2849,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 */
|
||||
|
||||
@ -2910,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!")
|
||||
@ -2954,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!")
|
||||
@ -3022,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!")
|
||||
@ -3108,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
|
||||
@ -3162,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
|
||||
@ -4122,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
|
||||
@ -4247,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', &
|
||||
@ -5189,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
|
||||
@ -5220,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
|
||||
@ -5258,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
|
||||
|
||||
@ -5311,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
|
||||
@ -5341,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)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
@ -5378,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)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
|
||||
@ -123,7 +123,7 @@ module parameters
|
||||
parameter_file = trim(arg)
|
||||
else
|
||||
if (verbose) &
|
||||
write(error_unit,*) &
|
||||
write (error_unit,*) &
|
||||
"The option '--input' or '-i' requires an argument. Exiting..."
|
||||
status = 112
|
||||
return
|
||||
@ -132,12 +132,12 @@ module parameters
|
||||
end if
|
||||
end do
|
||||
|
||||
inquire(file=parameter_file, exist=info)
|
||||
inquire (file=parameter_file, exist=info)
|
||||
|
||||
if (info) then
|
||||
call parse_parameters(status)
|
||||
else
|
||||
write(error_unit,*) "The parameter file '" // parameter_file // &
|
||||
write (error_unit,*) "The parameter file '" // parameter_file // &
|
||||
"' does not exist. Exiting..."
|
||||
status = 111
|
||||
end if
|
||||
@ -228,20 +228,20 @@ module parameters
|
||||
n = 0
|
||||
j = 1024
|
||||
|
||||
inquire(file=parameter_file, size=j)
|
||||
inquire (file=parameter_file, size=j)
|
||||
|
||||
allocate(character(len=j) :: line)
|
||||
|
||||
open(newunit=io, file=parameter_file, err=30)
|
||||
open (newunit=io, file=parameter_file, action='read', err=30)
|
||||
|
||||
10 read(io, fmt="(a)", end=20) line
|
||||
10 read (io, fmt="(a)", end=20) line
|
||||
|
||||
n = n + 1
|
||||
|
||||
! remove comments
|
||||
!
|
||||
i = index(line, '#')
|
||||
if (i > 0) write(line,"(a)") trim(adjustl(line(:i-1)))
|
||||
if (i > 0) write (line,"(a)") trim(adjustl(line(:i-1)))
|
||||
|
||||
! skip empty lines
|
||||
!
|
||||
@ -278,7 +278,7 @@ module parameters
|
||||
end if
|
||||
|
||||
if (status > 0) then
|
||||
write(error_unit,"('[',a,']: ',a)") loc, &
|
||||
write (error_unit,"('[',a,']: ',a)") loc, &
|
||||
"Wrong parameter format in '" // parameter_file // "'."
|
||||
write (error_unit,"('[',a,']: ',a,i0,':')") loc, "Verify line ", n
|
||||
write (error_unit,"('[',a,']: ',a)") loc, trim(adjustl(line))
|
||||
@ -298,7 +298,7 @@ module parameters
|
||||
item_ptr => item_ptr%next
|
||||
end do
|
||||
if (exists) then
|
||||
write(error_unit,"('[',a,']: ',a)") loc, "Parameter '" // key // &
|
||||
write (error_unit,"('[',a,']: ',a)") loc, "Parameter '" // key // &
|
||||
"' appears multiple times. " // &
|
||||
"Only the value of the first occurrence is considered."
|
||||
else
|
||||
@ -311,13 +311,13 @@ module parameters
|
||||
|
||||
go to 10
|
||||
|
||||
20 close(io)
|
||||
20 close (io)
|
||||
|
||||
deallocate(line)
|
||||
|
||||
return
|
||||
|
||||
30 write(error_unit,"('[',a,']: ',a)") loc, &
|
||||
30 write (error_unit,"('[',a,']: ',a)") loc, &
|
||||
"Unable to open the parameter file '" // &
|
||||
parameter_file // "'!"
|
||||
|
||||
@ -418,7 +418,7 @@ module parameters
|
||||
item_ptr => parameter_list
|
||||
do while(associated(item_ptr))
|
||||
if (item_ptr%key == key) then
|
||||
read(item_ptr%val, err=10, fmt=*) val
|
||||
read (item_ptr%val, err=10, fmt=*) val
|
||||
exit
|
||||
end if
|
||||
item_ptr => item_ptr%next
|
||||
@ -426,7 +426,7 @@ module parameters
|
||||
|
||||
return
|
||||
|
||||
10 write(error_unit,"('[',a,']: ',a)") loc, &
|
||||
10 write (error_unit,"('[',a,']: ',a)") loc, &
|
||||
"Incorrect format for the integer parameter '" // key // &
|
||||
"', or its value is either too small or too large!"
|
||||
|
||||
@ -468,7 +468,7 @@ module parameters
|
||||
item_ptr => parameter_list
|
||||
do while(associated(item_ptr))
|
||||
if (item_ptr%key == key) then
|
||||
read(item_ptr%val, err=10, fmt=*) val
|
||||
read (item_ptr%val, err=10, fmt=*) val
|
||||
exit
|
||||
end if
|
||||
item_ptr => item_ptr%next
|
||||
@ -476,7 +476,7 @@ module parameters
|
||||
|
||||
return
|
||||
|
||||
10 write(error_unit,"('[',a,']: ',a)") loc, &
|
||||
10 write (error_unit,"('[',a,']: ',a)") loc, &
|
||||
"Incorrect format for the float parameter '" // key // &
|
||||
"', or its value is either too small or too large!"
|
||||
|
||||
@ -585,7 +585,7 @@ module parameters
|
||||
if (master) then
|
||||
item_ptr => parameter_list
|
||||
do while(associated(item_ptr))
|
||||
write(str,"(a)") item_ptr%key // '|' // item_ptr%val
|
||||
write (str,"(a)") item_ptr%key // '|' // item_ptr%val
|
||||
|
||||
call broadcast(str)
|
||||
|
||||
|
||||
@ -133,13 +133,13 @@ contains
|
||||
!
|
||||
status = 0
|
||||
|
||||
inquire(file=filename, size=filesize)
|
||||
inquire (file=filename, size=filesize)
|
||||
|
||||
allocate(character(filesize) :: content)
|
||||
|
||||
open(newunit=io, file=filename, access='stream')
|
||||
read(io) content
|
||||
close(io)
|
||||
open (newunit=io, file=filename, access='stream', action='read')
|
||||
read (io) content
|
||||
close (io)
|
||||
|
||||
ibeg = index(content, '<?xml')
|
||||
if (ibeg <= 0) then
|
||||
@ -308,10 +308,10 @@ contains
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
open(newunit=io, file=filename)
|
||||
open (newunit=io, file=filename)
|
||||
write (io,"(a)") '<?xml version="1.0" encoding="utf-8"?>'
|
||||
call XMLSaveNode(io, 1, root_ptr)
|
||||
close(io)
|
||||
close (io)
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
@ -709,24 +709,24 @@ contains
|
||||
node_name = trim(node_ptr%name)
|
||||
end if
|
||||
|
||||
write(io, '(A)', advance='no') "<" // node_name
|
||||
write (io, '(A)', advance='no') "<" // node_name
|
||||
|
||||
if (level > 2) then
|
||||
write(io,"(1x,a,'=',a)", advance='no') &
|
||||
write (io,"(1x,a,'=',a)", advance='no') &
|
||||
'name', '"' // trim(node_ptr%name) // '"'
|
||||
end if
|
||||
|
||||
attr_ptr => node_ptr%attributes
|
||||
do while (associated(attr_ptr))
|
||||
write(io,"(1x,a,'=',a)", advance='no') trim(attr_ptr%name), &
|
||||
write (io,"(1x,a,'=',a)", advance='no') trim(attr_ptr%name), &
|
||||
'"' // trim(attr_ptr%value) // '"'
|
||||
attr_ptr => attr_ptr%next
|
||||
end do
|
||||
|
||||
if (level > 2) then
|
||||
write(io,'(a,a,a)') ">", trim(node_ptr%value), "</" // node_name // ">"
|
||||
write (io,'(a,a,a)') ">", trim(node_ptr%value), "</" // node_name // ">"
|
||||
else
|
||||
write(io,'(a)') ">"
|
||||
write (io,'(a)') ">"
|
||||
|
||||
child_ptr => node_ptr%children
|
||||
do while(associated(child_ptr))
|
||||
@ -734,7 +734,7 @@ contains
|
||||
child_ptr => child_ptr%next
|
||||
end do
|
||||
|
||||
write(io,'(a)') "</" // node_name // ">"
|
||||
write (io,'(a)') "</" // node_name // ">"
|
||||
end if
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -954,7 +954,7 @@ contains
|
||||
call XMLAddChild(root_ptr, node_ptr)
|
||||
end if
|
||||
|
||||
write(str,"(i0)") element_value
|
||||
write (str,"(i0)") element_value
|
||||
call XMLNodeInit(elem_ptr, element_name, trim(adjustl(str)))
|
||||
call XMLAttributeInit(attr_ptr, "type", "integer")
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
@ -1014,7 +1014,7 @@ contains
|
||||
call XMLAddChild(root_ptr, node_ptr)
|
||||
end if
|
||||
|
||||
write(str,"(1es32.20)") element_value
|
||||
write (str,"(1es32.20)") element_value
|
||||
call XMLNodeInit(elem_ptr, element_name, trim(adjustl(str)))
|
||||
call XMLAttributeInit(attr_ptr, "type", "double")
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
@ -1103,10 +1103,10 @@ contains
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
call XMLAttributeInit(attr_ptr, "data_type", element_dtype)
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
write(str,"(i0)") element_size
|
||||
write (str,"(i0)") element_size
|
||||
call XMLAttributeInit(attr_ptr, "size", trim(adjustl(str)))
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
write(str,"(8(i0,1x))") element_dims
|
||||
write (str,"(8(i0,1x))") element_dims
|
||||
call XMLAttributeInit(attr_ptr, "dimensions", trim(adjustl(str)))
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
call XMLAttributeInit(attr_ptr, "digest_type", trim(element_digest))
|
||||
@ -1117,7 +1117,7 @@ contains
|
||||
call XMLAttributeInit(attr_ptr, "compression_format", trim(compressor))
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
if (present(compressed_size)) then
|
||||
write(str,"(i0)") compressed_size
|
||||
write (str,"(i0)") compressed_size
|
||||
call XMLAttributeInit(attr_ptr, "compressed_size", trim(adjustl(str)))
|
||||
call XMLAddAttribute(elem_ptr, attr_ptr)
|
||||
end if
|
||||
@ -1180,7 +1180,7 @@ contains
|
||||
|
||||
if (associated(attr_ptr)) then
|
||||
if (trim(attr_ptr%value) == 'double') then
|
||||
read(node_ptr%value,*) element_value
|
||||
read (node_ptr%value,*) element_value
|
||||
else
|
||||
call print_message(loc, "The value of element '" // &
|
||||
trim(element_name) // &
|
||||
@ -1236,7 +1236,7 @@ contains
|
||||
|
||||
if (associated(attr_ptr)) then
|
||||
if (trim(attr_ptr%value) == 'integer') then
|
||||
read(node_ptr%value,*) element_value
|
||||
read (node_ptr%value,*) element_value
|
||||
else
|
||||
call print_message(loc, "The value of element '" // &
|
||||
trim(element_name) // "' is not an integer!")
|
||||
@ -1291,7 +1291,7 @@ contains
|
||||
|
||||
if (associated(attr_ptr)) then
|
||||
if (trim(attr_ptr%value) == 'string') then
|
||||
read(node_ptr%value,*) element_value
|
||||
read (node_ptr%value,*) element_value
|
||||
else
|
||||
call print_message(loc, "The value of element '" // &
|
||||
trim(element_name) // "' is not a string!")
|
||||
@ -1395,7 +1395,7 @@ contains
|
||||
if (associated(node_ptr)) then
|
||||
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
||||
|
||||
if (associated(attr_ptr)) read(attr_ptr%value, *) attribute_value
|
||||
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
||||
end if
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -1442,7 +1442,7 @@ contains
|
||||
if (associated(node_ptr)) then
|
||||
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
||||
|
||||
if (associated(attr_ptr)) read(attr_ptr%value, *) attribute_value
|
||||
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
||||
end if
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -1489,7 +1489,7 @@ contains
|
||||
if (associated(node_ptr)) then
|
||||
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
||||
|
||||
if (associated(attr_ptr)) read(attr_ptr%value, *) attribute_value
|
||||
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
||||
end if
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
@ -1536,7 +1536,7 @@ contains
|
||||
if (associated(node_ptr)) then
|
||||
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
||||
|
||||
if (associated(attr_ptr)) read(attr_ptr%value, *) attribute_value
|
||||
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
||||
end if
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user