subroutine write_periodic_operator_cache(path, fingerprint, target_nodes, operator, status)
character(len=*), intent(in) :: path, fingerprint
integer(i32), intent(in) :: target_nodes(:)
real(dp), intent(in) :: operator(:, :, :)
integer(i32), intent(out) :: status
character(len=128) :: stored_fingerprint
character(len=:), allocatable :: temporary_path
integer(i32) :: ncoef, ntarget
integer(int64) :: checksum
integer :: unit, ios, rename_status
status = periodic_cache_invalid
ncoef = int(size(operator, 1), i32)
ntarget = int(size(operator, 3), i32)
if (ncoef <= 0_i32 .or. size(operator, 2) /= ncoef .or. ntarget /= size(target_nodes)) return
if (len_trim(path) == 0 .or. len_trim(fingerprint) == 0 .or. len_trim(fingerprint) > len(stored_fingerprint)) return
stored_fingerprint = ''
stored_fingerprint = trim(fingerprint)
checksum = periodic_operator_checksum(target_nodes, operator)
temporary_path = trim(path)//'.tmp'
open (newunit=unit, file=temporary_path, access='stream', form='unformatted', status='replace', action='write', iostat=ios)
if (ios /= 0) then
status = periodic_cache_io_error
return
end if
write (unit, iostat=ios) cache_magic, periodic_cache_format_version, stored_fingerprint, ncoef, ntarget, checksum
if (ios == 0) write (unit, iostat=ios) target_nodes
if (ios == 0) write (unit, iostat=ios) operator
close (unit)
if (ios /= 0) then
status = periodic_cache_io_error
return
end if
call atomic_rename(temporary_path, trim(path), rename_status)
if (rename_status /= filesystem_success) then
status = periodic_cache_io_error
return
end if
status = periodic_cache_ok
end subroutine write_periodic_operator_cache