118 lines
3.8 KiB
FortranFixed
118 lines
3.8 KiB
FortranFixed
|
module verhoeff_mod
|
|||
|
|
implicit none
|
|||
|
|
|
|||
|
|
!----------------------------------------------------------------
|
|||
|
|
! Zero-based Verhoeff tables d, inv, p
|
|||
|
|
!----------------------------------------------------------------
|
|||
|
|
integer, parameter :: d1 = 10, d2 = 10
|
|||
|
|
integer, parameter :: d(0:d1 - 1, 0:d2 - 1) = reshape([ &
|
|||
|
|
! 10 rows of 10 ints each — exactly as in VB,
|
|||
|
|
! listed row-major so we use ORDER=[2,1] below
|
|||
|
|
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, &
|
|||
|
|
1, 2, 3, 4, 0, 6, 7, 8, 9, 5, &
|
|||
|
|
2, 3, 4, 0, 1, 7, 8, 9, 5, 6, &
|
|||
|
|
3, 4, 0, 1, 2, 8, 9, 5, 6, 7, &
|
|||
|
|
4, 0, 1, 2, 3, 9, 5, 6, 7, 8, &
|
|||
|
|
5, 9, 8, 7, 6, 0, 4, 3, 2, 1, &
|
|||
|
|
6, 5, 9, 8, 7, 1, 0, 4, 3, 2, &
|
|||
|
|
7, 6, 5, 9, 8, 2, 1, 0, 4, 3, &
|
|||
|
|
8, 7, 6, 5, 9, 3, 2, 1, 0, 4, &
|
|||
|
|
9, 8, 7, 6, 5, 4, 3, 2, 1, 0 ], shape=[d1, d2], order=[2, 1])
|
|||
|
|
|
|||
|
|
integer, parameter :: inv(0:d1 - 1) = [0, 4, 3, 2, 1, 5, 6, 7, 8, 9]
|
|||
|
|
|
|||
|
|
integer, parameter :: r = 8, c = 10
|
|||
|
|
integer, parameter :: p(0:r - 1, 0:c - 1) = reshape([ &
|
|||
|
|
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, &
|
|||
|
|
1, 5, 7, 6, 2, 8, 3, 0, 9, 4, &
|
|||
|
|
5, 8, 0, 3, 7, 9, 6, 1, 4, 2, &
|
|||
|
|
8, 9, 1, 6, 0, 4, 3, 5, 2, 7, &
|
|||
|
|
9, 4, 5, 3, 1, 2, 6, 8, 7, 0, &
|
|||
|
|
4, 2, 8, 6, 5, 7, 3, 9, 0, 1, &
|
|||
|
|
2, 7, 9, 3, 8, 0, 6, 4, 1, 5, &
|
|||
|
|
7, 0, 4, 6, 9, 1, 3, 2, 5, 8 ], shape=[r, c], order=[2, 1])
|
|||
|
|
|
|||
|
|
contains
|
|||
|
|
|
|||
|
|
!----------------------------------------------------------------
|
|||
|
|
! verhoeff()
|
|||
|
|
! s : input digit-string
|
|||
|
|
! validate : .TRUE. for check, .FALSE. to compute digit
|
|||
|
|
! table : .TRUE. to dump tables, .FALSE. to skip
|
|||
|
|
! returns
|
|||
|
|
! if(validate) 1=>valid, 0=>invalid
|
|||
|
|
! if(.not.validate) the computed check digit (0–9)
|
|||
|
|
!----------------------------------------------------------------
|
|||
|
|
function verhoeff(s, validate, table) result(res)
|
|||
|
|
implicit none
|
|||
|
|
character(len=*), intent(in) :: s
|
|||
|
|
logical, intent(in) :: validate, table
|
|||
|
|
integer :: res
|
|||
|
|
|
|||
|
|
integer :: c, lens, k, digit, pi
|
|||
|
|
character(len=:), allocatable :: str
|
|||
|
|
res = 0
|
|||
|
|
|
|||
|
|
! Append '0' when generating the check digit
|
|||
|
|
if (.not.validate) then
|
|||
|
|
str = trim(s) // '0'
|
|||
|
|
else
|
|||
|
|
str = trim(s)
|
|||
|
|
end if
|
|||
|
|
lens = len_trim(str)
|
|||
|
|
c = 0
|
|||
|
|
|
|||
|
|
! Main Verhoeff loop: right-to-left over str
|
|||
|
|
do k = lens, 1, -1
|
|||
|
|
digit = ichar(str(k:k)) - ichar('0')
|
|||
|
|
pi = p(mod(lens - k, size(p, 1)), digit)
|
|||
|
|
c = d(c, pi)
|
|||
|
|
if (table) then
|
|||
|
|
write(*, '(I2,1X,I2,2X,I2,2X,I2)') lens - k, digit, pi, c
|
|||
|
|
end if
|
|||
|
|
end do
|
|||
|
|
|
|||
|
|
if (.not.validate) then
|
|||
|
|
! computing check digit
|
|||
|
|
res = inv(c)
|
|||
|
|
else
|
|||
|
|
! validating: success only if c==0
|
|||
|
|
res = merge(1, 0, c == 0)
|
|||
|
|
end if
|
|||
|
|
|
|||
|
|
end function verhoeff
|
|||
|
|
|
|||
|
|
end module verhoeff_mod
|
|||
|
|
|
|||
|
|
program test_verhoeff
|
|||
|
|
use verhoeff_mod
|
|||
|
|
implicit none
|
|||
|
|
|
|||
|
|
character(len=20), parameter :: inputs(3) = [character(len=20) :: '236', '12345', '123456789012' ]
|
|||
|
|
logical, parameter :: showtable(3) = [ .true., .true., .false. ]
|
|||
|
|
|
|||
|
|
integer :: i, chk, ok
|
|||
|
|
character(len=:), allocatable :: withchk, with9
|
|||
|
|
|
|||
|
|
do i = 1, 3
|
|||
|
|
! Compute the check digit
|
|||
|
|
chk = verhoeff(inputs(i), .false., showtable(i))
|
|||
|
|
write(*, '(3A,I1)') 'Check digit for "', trim(inputs(i)), '" is ', chk
|
|||
|
|
|
|||
|
|
! Test two variants: one with the computed digit, one with '9'
|
|||
|
|
withchk = trim(inputs(i)) // achar(ichar('0') + chk)
|
|||
|
|
with9 = trim(inputs(i)) // '9'
|
|||
|
|
|
|||
|
|
ok = verhoeff(withchk, .true., showtable(i))
|
|||
|
|
write(*, '(4A)') 'Validation for "', trim(withchk), '" : ', &
|
|||
|
|
merge(' correct ', 'incorrect', ok == 1)
|
|||
|
|
|
|||
|
|
ok = verhoeff(with9, .true., showtable(i))
|
|||
|
|
write(*, '(4A)') 'Validation for "', trim(with9), '" : ', &
|
|||
|
|
merge(' correct ', 'incorrect', ok == 1)
|
|||
|
|
|
|||
|
|
write(*, *)
|
|||
|
|
end do
|
|||
|
|
|
|||
|
|
end program test_verhoeff
|