IO: Fix the restart from the XML files with less processes.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
657a608ce0
commit
cc48f69803
@ -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
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user