117 lines
3.8 KiB
Fortran
117 lines
3.8 KiB
Fortran
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
|