diff --git a/sources/io.F90 b/sources/io.F90 index 6404f79..a0c5e8e 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1103,7 +1103,6 @@ module io use evolution , only : step, time, dt, dth, dte use evolution , only : niterations, nrejections, errs use forcing , only : nmodes, fcoefs, einj - use hash , only : hash_info, check_digest, digest_integer use helpers , only : print_message use iso_c_binding, only : c_loc #ifdef MPI @@ -1111,33 +1110,30 @@ module io #endif /* MPI */ use mpitools , only : nprocs, nproc use random , only : gentype, set_seeds + use XML , only : XMLNode, XMLParseFile, XMLFreeTree, & + XMLGetElementValue implicit none integer, intent(out) :: status + type(XMLNode), pointer :: xml_ptr + logical :: test - character(len=255) :: dname, fname, line, sname, svalue + character(len=256) :: snapshot_path, file_path + character(len= 16) :: aname integer :: il, iu, nl, nx, nm, nd, nv, i, j, l, n, p, nu, nr #if NDIMS == 3 integer :: k #endif /* NDIMS == 3 */ integer(kind=4) :: lndims, lnprocs, lnproc, lmblocks, lnleafs, llast_id - integer(kind=4) :: ldblocks, lncells, lnghosts, lnseeds, lnmodes + integer(kind=4) :: lncells, lnghosts, lnseeds, lnmodes + integer(kind=8) :: bytes real(kind=8) :: deinj type(block_meta), pointer :: pmeta type(block_data), pointer :: pdata - integer :: dtype, dlen - - integer(kind=4) :: lun = 104 - integer(kind=8) :: bytes, pbytes, ubytes - - integer(kind=8) :: hfield, hchild, hface, hedge, hcorner, hbound - integer(kind=8) :: hids, hseed, hforce - - integer(kind=8), dimension(:) , allocatable :: hprim, hcons integer(kind=4), dimension(:) , allocatable, target :: ids integer(kind=4), dimension(:,:) , allocatable, target :: fields integer(kind=4), dimension(:,:) , allocatable, target :: children @@ -1162,141 +1158,65 @@ module io ! status = 0 - write(dname, "(a,'restart-',i5.5)") trim(respath), nrest + write(snapshot_path, "(a,'restart-',i5.5)") trim(respath), nrest #ifdef __INTEL_COMPILER - inquire(directory=dname, exist=test) + inquire(directory=snapshot_path, exist=test) #else /* __INTEL_COMPILER */ - inquire(file=dname, exist=test) + inquire(file=snapshot_path, exist=test) #endif /* __INTEL_COMPILER */ if (.not. test) then - call print_message(loc, trim(dname) // " does not exist!") + call print_message(loc, trim(snapshot_path) // " does not exist!") status = 121 return end if - dname = trim(dname) // "/" + snapshot_path = trim(snapshot_path) // "/" + file_path = trim(snapshot_path) // "metadata.xml" - write(fname,"(a,'metadata.xml')") trim(dname) - inquire(file=fname, exist=test) + inquire(file=file_path, exist=test) if (.not. test) then - call print_message(loc, trim(fname) // " does not exist!") + call print_message(loc, "The file '" // trim(file_path) // & + "' does not exist.") status = 121 return end if - open(newunit=lun, file=fname, status='old') -10 read(lun, fmt="(a)", end=20) line - if (index(line, ' 0) then - il = index(line, 'name="') - if (il > 0) then - il = il + 6 - iu = index(line(il:), '"') + il - 2 - write(sname,*) line(il:iu) - il = index(line, '>') + 1 - iu = index(line, '<', back=.true.) - 1 - write(svalue,*) line(il:iu) + call XMLParseFile(file_path, xml_ptr, status) - select case(trim(adjustl(sname))) - case('ndims') - read(svalue, fmt=*) lndims - case('nprocs') - read(svalue, fmt=*) lnprocs - case('nproc') - read(svalue, fmt=*) lnproc - case('mblocks') - read(svalue, fmt=*) lmblocks - case('dblocks') - read(svalue, fmt=*) ldblocks - case('nleafs') - read(svalue, fmt=*) lnleafs - case('last_id') - read(svalue, fmt=*) llast_id - case('ncells') - read(svalue, fmt=*) lncells - case('nghosts') - read(svalue, fmt=*) lnghosts - case('nseeds') - read(svalue, fmt=*) lnseeds - case('step') - read(svalue, fmt=*) step - case('isnap') - read(svalue, fmt=*) isnap - case('nvars') - read(svalue, fmt=*) nv - case('nmodes') - read(svalue, fmt=*) lnmodes - case('xmin') - read(svalue, fmt=*) xmin - case('xmax') - read(svalue, fmt=*) xmax - case('ymin') - read(svalue, fmt=*) ymin - case('ymax') - read(svalue, fmt=*) ymax - case('zmin') - read(svalue, fmt=*) zmin - case('zmax') - read(svalue, fmt=*) zmax - case('time') - read(svalue, fmt=*) time - case('dt') - read(svalue, fmt=*) dt - case('dth') - read(svalue, fmt=*) dth - case('dte') - read(svalue, fmt=*) dte - case('cmax') - read(svalue, fmt=*) cmax - cmax2 = cmax * cmax - case('cglm') - read(svalue, fmt=*) cglm - case('niterations') - read(svalue, fmt=*) niterations - case('nrejections') - read(svalue, fmt=*) nrejections - case('errs(1)') - read(svalue, fmt=*) errs(1) - case('errs(2)') - read(svalue, fmt=*) errs(2) - case('errs(3)') - read(svalue, fmt=*) errs(3) - case('fields') - il = index(line, 'digest_type="') + 13 - iu = index(line(il:), '"') + il - 2 - call hash_info(line(il:iu), dtype, dlen) + call XMLGetElementValue(xml_ptr, 'Parallelization', 'nprocs' , lnprocs) + call XMLGetElementValue(xml_ptr, 'Parallelization', 'nproc' , lnproc) + call XMLGetElementValue(xml_ptr, 'Physics' , 'nvars' , nv) + call XMLGetElementValue(xml_ptr, 'Geometry' , 'ndims' , lndims) + call XMLGetElementValue(xml_ptr, 'Geometry' , 'xmin' , xmin) + call XMLGetElementValue(xml_ptr, 'Geometry' , 'xmax' , xmax) + call XMLGetElementValue(xml_ptr, 'Geometry' , 'ymin' , ymin) + call XMLGetElementValue(xml_ptr, 'Geometry' , 'ymax' , ymax) +#if NDIMS == 3 + call XMLGetElementValue(xml_ptr, 'Geometry' , 'zmin' , zmin) + call XMLGetElementValue(xml_ptr, 'Geometry' , 'zmax' , zmax) +#endif /* NDIMS == 3 */ + call XMLGetElementValue(xml_ptr, 'Mesh' , 'ncells' , lncells) + call XMLGetElementValue(xml_ptr, 'Mesh' , 'nghosts' , lnghosts) + call XMLGetElementValue(xml_ptr, 'Mesh' , 'mblocks' , lmblocks) + call XMLGetElementValue(xml_ptr, 'Mesh' , 'nleafs' , lnleafs) + call XMLGetElementValue(xml_ptr, 'Mesh' , 'last_id' , llast_id) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'step' , step) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'time' , time) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'dt' , dt) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'dth' , dth) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'dte' , dte) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'cmax' , cmax) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'cglm' , cglm) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'niterations', niterations) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'nrejections', nrejections) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'errs(1)' , errs(1)) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'errs(2)' , errs(2)) + call XMLGetElementValue(xml_ptr, 'Evolution' , 'errs(3)' , errs(3)) + call XMLGetElementValue(xml_ptr, 'Forcing' , 'nmodes' , lnmodes) + call XMLGetElementValue(xml_ptr, 'Random' , 'nseeds' , lnseeds) + call XMLGetElementValue(xml_ptr, 'Snapshots' , 'isnap' , isnap) - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hfield) - case('children') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hchild) - case('faces') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hface) - case('edges') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hedge) - case('corners') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hcorner) - case('bounds') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hbound) - case('forcing') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hforce) - end select - end if - end if - go to 10 -20 close(lun) + cmax2 = cmax * cmax if (lndims /= NDIMS) then call print_message(loc, "The number of dimensions does not match!") @@ -1332,44 +1252,31 @@ module io if (status == 0) then - write(fname,"(a,'metablock_fields.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) fields - close(lun) bytes = size(fields, kind=8) * kind(fields) - call check_digest(loc, fname, c_loc(fields), bytes, hfield, dtype) - write(fname,"(a,'metablock_children.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) children - close(lun) + call read_binary_xml(snapshot_path, 'fields' , c_loc(fields), & + bytes, xml_ptr, status) + bytes = size(children, kind=8) * kind(children) - call check_digest(loc, fname, c_loc(children), bytes, hchild, dtype) + call read_binary_xml(snapshot_path, 'children', c_loc(children), & + bytes, xml_ptr, status) + #if NDIMS == 3 - write(fname,"(a,'metablock_faces.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) faces - close(lun) bytes = size(faces, kind=8) * kind(faces) - call check_digest(loc, fname, c_loc(faces), bytes, hface, dtype) + call read_binary_xml(snapshot_path, 'faces' , c_loc(faces), & + bytes, xml_ptr, status) + #endif /* NDIMS == 3 */ - write(fname,"(a,'metablock_edges.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) edges - close(lun) bytes = size(edges, kind=8) * kind(edges) - call check_digest(loc, fname, c_loc(edges), bytes, hedge, dtype) - write(fname,"(a,'metablock_corners.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) corners - close(lun) + call read_binary_xml(snapshot_path, 'edges' , c_loc(edges), & + bytes, xml_ptr, status) + bytes = size(corners, kind=8) * kind(corners) - call check_digest(loc, fname, c_loc(corners), bytes, hcorner, dtype) - write(fname,"(a,'metablock_bounds.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) bounds - close(lun) + call read_binary_xml(snapshot_path, 'corners' , c_loc(corners), & + bytes, xml_ptr, status) + bytes = size(bounds, kind=8) * kind(bounds) - call check_digest(loc, fname, c_loc(bounds), bytes, hbound, dtype) + call read_binary_xml(snapshot_path, 'bounds' , c_loc(bounds), & + bytes, xml_ptr, status) l = 0 pmeta => list_meta @@ -1453,14 +1360,14 @@ module io if (lnmodes == nmodes) then if (lnmodes > 0) then + allocate(lfcoefs(lnmodes,lndims), stat=status) if (status == 0) then - write(fname,"(a,'forcing_coefficients.bin')") trim(dname) - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) lfcoefs - close(lun) + bytes = size(lfcoefs, kind=8) * kind(lfcoefs) * 2 - call check_digest(loc, fname, c_loc(lfcoefs), bytes, hforce, dtype) + call read_binary_xml(snapshot_path, 'forcing', c_loc(lfcoefs), & + bytes, xml_ptr, status) + fcoefs = lfcoefs deallocate(lfcoefs, stat=status) if (status /= 0) & @@ -1475,6 +1382,10 @@ module io call print_message(loc, "The number of forcing modes does not match!") end if +! release the XML tree for 'metadata.xml' file +! + call XMLFreeTree(xml_ptr) + if (nprocs >= lnprocs) then ! spread the restart snapshots reading across new processes so we do not @@ -1496,64 +1407,20 @@ module io if (nl >= 0) then - write(fname,sfmt) trim(dname), "datablocks", nl, "xml" - inquire(file=fname, exist=test) + write(file_path, sfmt) trim(snapshot_path), "datablocks", nl, "xml" + inquire(file=file_path, exist=test) if (.not. test) then - write(*,*) trim(fname) // " does not exist!" + call print_message(loc, "The file '" // trim(file_path) // & + "' does not exist.") status = 121 return end if - open(newunit=lun, file=fname, status='old') -30 read(lun, fmt="(a)", end=40) line - if (index(line, ' 0) then - il = index(line, 'name="') - if (il > 0) then - il = il + 6 - iu = index(line(il:), '"') + il - 2 - write(sname,*) line(il:iu) - il = index(line, '>') + 1 - iu = index(line, '<', back=.true.) - 1 - write(svalue,*) line(il:iu) + call XMLParseFile(file_path, xml_ptr, status) - select case(trim(adjustl(sname))) - case('dblocks') - read(svalue, fmt=*) nd - if (nd > 0) then - allocate(hprim(nd), hcons(nd), stat=status) - if (status /= 0) & - call print_message(loc, & - "Could not allocate space for hashes!") - end if - case('nregs') - read(svalue, fmt=*) nr - case('einj') - read(svalue, fmt=*) einj - case('ids') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hids) - case('seeds') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hseed) - end select - if (index(sname, 'prim') > 0) then - read(sname(7:), fmt=*) l - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hprim(l)) - end if - if (index(sname, 'cons') > 0) then - read(sname(7:), fmt=*) l - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hcons(l)) - end if - end if - end if - go to 30 -40 close(lun) + call XMLGetElementValue(xml_ptr, 'DataBlocks', 'dblocks', nd) + call XMLGetElementValue(xml_ptr, 'DataBlocks', 'nregs' , nr) + call XMLGetElementValue(xml_ptr, 'Forcing' , 'einj' , einj) nm = lncells + 2 * lnghosts if (lnghosts >= nghosts) then @@ -1574,27 +1441,18 @@ module io if (status == 0) then - write(fname,sfmt) trim(dname), "datablock_ids", nl, "bin" - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) ids - close(lun) bytes = size(ids, kind=8) * kind(ids) - call check_digest(loc, fname, c_loc(ids), bytes, hids, dtype) - - ubytes = size(array, kind=8) * kind(array) - pbytes = ubytes / nr + call read_binary_xml(snapshot_path, 'ids', c_loc(ids), & + bytes, xml_ptr, status) + bytes = size(array, kind=8) * kind(array) / nr do l = 1, nd call append_datablock(pdata, status) call link_blocks(block_array(ids(l))%ptr, pdata) - write(fname,"(a,'datablock_prim_',i6.6,'_',i6.6,'.bin')") & - trim(dname), nl, l - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) array(:,:,:,:,1) - close(lun) - call check_digest(loc, fname, c_loc(array), & - pbytes, hprim(l), dtype) + write(aname, "('prim_',i6.6)") l + call read_binary_xml(snapshot_path, aname, c_loc(array), & + bytes, xml_ptr, status) if (lnghosts >= nghosts) then #if NDIMS == 3 @@ -1610,13 +1468,9 @@ module io #endif /* NDIMS == 3 */ end if - write(fname,"(a,'datablock_cons_',i6.6,'_',i6.6,'.bin')") & - trim(dname), nl, l - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) array - close(lun) - call check_digest(loc, fname, c_loc(array), & - ubytes, hcons(l), dtype) + write(aname, "('cons_',i6.6)") l + call read_binary_xml(snapshot_path, aname, c_loc(array), & + bytes * nr, xml_ptr, status) p = min(nregs, nr) if (lnghosts >= nghosts) then @@ -1634,7 +1488,7 @@ module io end if end do - deallocate(ids, array, hprim, hcons, stat=status) + deallocate(ids, array, stat=status) if (status /= 0) & call print_message(loc, "Could not release space of datablocks!") else @@ -1646,12 +1500,9 @@ module io if (status == 0) then - write(fname,sfmt) trim(dname), "random_seeds", nl, "bin" - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) seeds - close(lun) bytes = size(seeds, kind=8) * kind(seeds) - call check_digest(loc, fname, c_loc(seeds), bytes, hseed, dtype) + call read_binary_xml(snapshot_path, 'seeds', c_loc(seeds), & + bytes, xml_ptr, status) call set_seeds(lnseeds, seeds(:,:), .false.) deallocate(seeds, stat=status) @@ -1661,40 +1512,11 @@ module io call print_message(loc, "Could not allocate space for seeds!") end if + call XMLFreeTree(xml_ptr) + else ! nl < 0 - write(fname,sfmt) trim(dname), "datablocks", 0, "xml" - inquire(file=fname, exist=test) - if (.not. test) then - write(*,*) trim(fname) // " does not exist!" - status = 121 - return - end if - - open(newunit=lun, file=fname, status='old') -50 read(lun, fmt="(a)", end=60) line - if (index(line, ' 0) then - il = index(line, 'name="') - if (il > 0) then - il = il + 6 - iu = index(line(il:), '"') + il - 2 - write(sname,*) line(il:iu) - il = index(line, '>') + 1 - iu = index(line, '<', back=.true.) - 1 - write(svalue,*) line(il:iu) - - select case(trim(adjustl(sname))) - case('seeds') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hseed) - end select - end if - end if - go to 50 -60 close(lun) - -! restore PRNG seeds for remaining processes +! restore PRNG seeds for the remaining processes ! if (trim(gentype) == "same") then @@ -1702,14 +1524,24 @@ module io if (status == 0) then - write(fname,sfmt) trim(dname), "random_seeds", 0, "bin" - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) seeds - close(lun) + 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.") + status = 121 + return + end if + + call XMLParseFile(file_path, xml_ptr, status) + bytes = size(seeds, kind=8) * kind(seeds) - call check_digest(loc, fname, c_loc(seeds), bytes, hseed, dtype) + call read_binary_xml(snapshot_path, 'seeds', c_loc(seeds), & + bytes, xml_ptr, status) call set_seeds(lnseeds, seeds(:,:), .false.) + call XMLFreeTree(xml_ptr) + deallocate(seeds, stat=status) if (status /= 0) & call print_message(loc, "Could not release space of seeds!") @@ -1747,66 +1579,21 @@ module io do n = nl, nu - write(fname,sfmt) trim(dname), "datablocks", n, "xml" - inquire(file=fname, exist=test) + write(file_path, sfmt) trim(snapshot_path), "datablocks", n, "xml" + inquire(file=file_path, exist=test) if (.not. test) then - write(*,*) trim(fname) // " does not exist!" + call print_message(loc, "The file '" // trim(file_path) // & + "' does not exist.") status = 121 return end if -! read attributes from the metadata file -! - open(newunit=lun, file=fname, status='old') -70 read(lun, fmt="(a)", end=80) line - if (index(line, ' 0) then - il = index(line, 'name="') - if (il > 0) then - il = il + 6 - iu = index(line(il:), '"') + il - 2 - write(sname,*) line(il:iu) - il = index(line, '>') + 1 - iu = index(line, '<', back=.true.) - 1 - write(svalue,*) line(il:iu) + call XMLParseFile(file_path, xml_ptr, status) + + call XMLGetElementValue(xml_ptr, 'DataBlocks', 'dblocks', nd) + call XMLGetElementValue(xml_ptr, 'DataBlocks', 'nregs' , nr) + call XMLGetElementValue(xml_ptr, 'Forcing' , 'einj' , deinj) - select case(trim(adjustl(sname))) - case('dblocks') - read(svalue, fmt=*) nd - if (nd > 0) then - allocate(hprim(nd), hcons(nd), stat=status) - if (status /= 0) & - call print_message(loc, & - "Could not allocate space for hashes!") - end if - case('nregs') - read(svalue, fmt=*) nr - case('einj') - read(svalue, fmt=*) deinj - case('ids') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hids) - case('seeds') - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hseed) - end select - if (index(sname, 'prim') > 0) then - read(sname(7:), fmt=*) l - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hprim(l)) - end if - if (index(sname, 'cons') > 0) then - read(sname(7:), fmt=*) l - il = index(line, 'digest="') + 8 - iu = index(line(il:), '"') + il - 2 - call digest_integer(line(il:iu), hcons(l)) - end if - end if - end if - go to 70 -80 close(lun) einj = einj + deinj nm = lncells + 2 * lnghosts @@ -1828,27 +1615,18 @@ module io if (status == 0) then - write(fname,sfmt) trim(dname), "datablock_ids", n, "bin" - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) ids - close(lun) bytes = size(ids, kind=8) * kind(ids) - call check_digest(loc, fname, c_loc(ids), bytes, hids, dtype) - - ubytes = size(array, kind=8) * kind(array) - pbytes = ubytes / nr + call read_binary_xml(snapshot_path, 'ids', c_loc(ids), & + bytes, xml_ptr, status) + bytes = size(array, kind=8) * kind(array) / nr do l = 1, nd call append_datablock(pdata, status) call link_blocks(block_array(ids(l))%ptr, pdata) - write(fname,"(a,'datablock_prim_',i6.6,'_',i6.6,'.bin')") & - trim(dname), n, l - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) array(:,:,:,:,1) - close(lun) - call check_digest(loc, fname, c_loc(array), & - pbytes, hprim(l), dtype) + write(aname, "('prim_',i6.6)") l + call read_binary_xml(snapshot_path, aname, c_loc(array), & + bytes, xml_ptr, status) if (lnghosts >= nghosts) then #if NDIMS == 3 @@ -1864,13 +1642,9 @@ module io #endif /* NDIMS == 3 */ end if - write(fname,"(a,'datablock_cons_',i6.6,'_',i6.6,'.bin')") & - trim(dname), n, l - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) array - close(lun) - call check_digest(loc, fname, c_loc(array), & - ubytes, hcons(l), dtype) + write(aname, "('cons_',i6.6)") l + call read_binary_xml(snapshot_path, aname, c_loc(array), & + bytes * nr, xml_ptr, status) p = min(nregs, nr) if (lnghosts >= nghosts) then @@ -1888,28 +1662,41 @@ module io end if end do - deallocate(ids, array, hprim, hcons, stat=status) + deallocate(ids, array, stat=status) if (status /= 0) & call print_message(loc, "Could not release space of datablocks!") else call print_message(loc, "Could not allocate space for datablocks!") end if + end if + call XMLFreeTree(xml_ptr) + end do ! n = nl, nu allocate(seeds(4,lnseeds), stat=status) if (status == 0) then - write(fname,sfmt) trim(dname), "random_seeds", nproc, "bin" - open(newunit=lun, file=fname, form='unformatted', access='stream') - read(lun) seeds - close(lun) + 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.") + status = 121 + return + end if + + call XMLParseFile(file_path, xml_ptr, status) + bytes = size(seeds, kind=8) * kind(seeds) - call check_digest(loc, fname, c_loc(seeds), bytes, hseed, dtype) + call read_binary_xml(snapshot_path, 'seeds', c_loc(seeds), & + bytes, xml_ptr, status) call set_seeds(lnseeds, seeds(:,:), .false.) + call XMLFreeTree(xml_ptr) + deallocate(seeds, stat=status) if (status /= 0) & call print_message(loc, "Could not release space of seeds!") @@ -2949,7 +2736,7 @@ module io integer :: io, item_size integer :: digest_type, digest_length integer :: compressor_id, encoder_id - integer(kind=8) :: hash, usize, csize, dsize + integer(kind=8) :: hash, usize, csize integer(kind=1), dimension(:), pointer :: array integer(kind=1), dimension(:), allocatable, target :: buffer