subroutine read_periodic_operator_cache( &
path, fingerprint, target_nodes, operator, status, expected_ncoef, expected_ntarget &
)
character(len=*), intent(in) :: path, fingerprint
integer(i32), allocatable, intent(out) :: target_nodes(:)
real(dp), allocatable, intent(out) :: operator(:, :, :)
integer(i32), intent(out) :: status
integer(i32), intent(in), optional :: expected_ncoef, expected_ntarget
character(len=16) :: stored_magic
character(len=128) :: stored_fingerprint
integer(i32) :: stored_version, ncoef, ntarget
integer(int64) :: stored_checksum, file_size, expected_size
integer :: unit, ios
logical :: exists
inquire (file=trim(path), exist=exists)
if (.not. exists) then
status = periodic_cache_miss
return
end if
open (newunit=unit, file=trim(path), access='stream', form='unformatted', status='old', action='read', iostat=ios)
if (ios /= 0) then
status = periodic_cache_io_error
return
end if
read (unit, iostat=ios) stored_magic, stored_version, stored_fingerprint, ncoef, ntarget, stored_checksum
if (ios /= 0 .or. stored_magic /= cache_magic .or. stored_version /= periodic_cache_format_version .or. &
trim(stored_fingerprint) /= trim(fingerprint) .or. ncoef <= 0_i32 .or. ntarget <= 0_i32 .or. &
ncoef > cache_max_ncoef .or. ntarget > cache_max_ntarget) then
close (unit)
status = periodic_cache_invalid
return
end if
if (present(expected_ncoef)) then
if (ncoef /= expected_ncoef) then
close (unit)
status = periodic_cache_invalid
return
end if
end if
if (present(expected_ntarget)) then
if (ntarget /= expected_ntarget) then
close (unit)
status = periodic_cache_invalid
return
end if
end if
inquire (file=trim(path), size=file_size, iostat=ios)
expected_size = 16_int64 + 3_int64*int(storage_size(0_i32)/8, int64) + 128_int64 + &
int(storage_size(0_int64)/8, int64) + &
int(ntarget, int64)*int(storage_size(0_i32)/8, int64) + &
int(ncoef, int64)*int(ncoef, int64)*int(ntarget, int64)* &
int(storage_size(0.0_dp)/8, int64)
if (ios /= 0 .or. file_size /= expected_size) then
close (unit)
status = periodic_cache_invalid
return
end if
allocate (target_nodes(ntarget), operator(ncoef, ncoef, ntarget), stat=ios)
if (ios /= 0) then
close (unit)
status = periodic_cache_io_error
return
end if
read (unit, iostat=ios) target_nodes
if (ios == 0) read (unit, iostat=ios) operator
close (unit)
if (ios /= 0 .or. periodic_operator_checksum(target_nodes, operator) /= stored_checksum) then
deallocate (target_nodes, operator)
status = periodic_cache_invalid
return
end if
status = periodic_cache_ok
end subroutine read_periodic_operator_cache