IO: Fix the restart from the XML files with less processes.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-30 22:53:53 -03:00
parent 657a608ce0
commit cc48f69803

View File

@ -1652,6 +1652,12 @@ module io
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')
@ -1665,6 +1671,18 @@ module io
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
@ -1690,7 +1708,7 @@ module io
if (status == 0) then
write(fname,sfmt) trim(dname), "datablock_ids", nproc, "bin"
write(fname,sfmt) trim(dname), "datablock_ids", n, "bin"
open(newunit=lun, file=fname, form='unformatted', access='stream')
read(lun) ids
close(lun)
@ -1705,7 +1723,7 @@ module io
call link_blocks(block_array(ids(l))%ptr, pdata)
write(fname,"(a,'datablock_prim_',i6.6,'_',i6.6,'.bin')") &
trim(dname), nproc, l
trim(dname), n, l
open(newunit=lun, file=fname, form='unformatted', access='stream')
read(lun) array(:,:,:,:,1)
close(lun)
@ -1727,7 +1745,7 @@ module io
end if
write(fname,"(a,'datablock_cons_',i6.6,'_',i6.6,'.bin')") &
trim(dname), nproc, l
trim(dname), n, l
open(newunit=lun, file=fname, form='unformatted', access='stream')
read(lun) array
close(lun)
@ -1758,29 +1776,8 @@ module io
end if
end if
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)
bytes = size(seeds, kind=8) * kind(seeds)
call check_digest(loc, fname, c_loc(seeds), bytes, hseed, dtype)
call set_seeds(lnseeds, seeds(:,:), .false.)
deallocate(seeds, stat=status)
if (status /= 0) &
call print_message(loc, "Could not release space of seeds!")
else
call print_message(loc, "Could not allocate space for seeds!")
end if
end do ! n = nl, nu
! restore seeds
!
allocate(seeds(4,lnseeds), stat=status)
if (status == 0) then
@ -1798,7 +1795,7 @@ module io
call print_message(loc, "Could not release space of seeds!")
else
call print_message(loc, "Could not allocate space for seeds!")
end if ! allocation
end if
end if ! nprocs >= lnprocs