function ch_is_digit ( ch ) !*****************************************************************************80 ! !! ch_is_digit() is TRUE if a character is a decimal digit. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 August 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character CH, the character to be analyzed. ! ! Output, logical CH_IS_DIGIT, is TRUE if the character is ! a digit. ! implicit none character ch logical ch_is_digit if ( lle ( '0', ch ) .and. lle ( ch, '9' ) ) then ch_is_digit = .true. else ch_is_digit = .false. end if return end subroutine ch_to_digit ( ch, digit ) !*****************************************************************************80 ! !! ch_to_digit() returns the value of a base 10 digit. ! ! Discussion: ! ! Instead of ICHAR, we now use the IACHAR function, which ! guarantees the ASCII collating sequence. ! ! Example: ! ! CH DIGIT ! --- ----- ! '0' 0 ! '1' 1 ! ... ... ! '9' 9 ! 'X' -1 ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 August 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character CH, the decimal digit, '0' through '9'. ! ! Output, integer DIGIT, the corresponding value. ! If CH was 'illegal', then DIGIT is -1. ! implicit none character ch integer digit if ( lle ( '0', ch ) .and. lle ( ch, '9' ) ) then digit = iachar ( ch ) - 48 else digit = - 1 end if return end subroutine i4vec_print ( n, a, title ) !*****************************************************************************80 ! !! i4vec_print() prints an I4VEC. ! ! Discussion: ! ! An I4VEC is a vector of I4's. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 May 2010 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer N, the number of components of the vector. ! ! Input, integer A(N), the vector to be printed. ! ! Input, character ( len = * ) TITLE, a title. ! implicit none integer n integer a(n) integer i character ( len = * ) title if ( 0 < len_trim ( title ) ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) trim ( title ) end if write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(2x,i8,a,2x,i12)' ) i, ':', a(i) end do return end function luhn_check_digit_calculate ( s ) !*****************************************************************************80 ! !! luhn_check_digit_calculate() determines the Luhn check digit of a string. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 September 2015 ! ! Reference: ! ! https://en.wikipedia.org/wiki/Luhn_algorithm ! ! Parameters: ! ! Input, character ( len = * ) S, the string of digits to be checked. ! ! Output, integer VALUE, the Luhn check digit for this string. ! implicit none integer luhn_check_digit_calculate integer luhn_checksum character ( len = * ) s integer s_len character ( len = 255 ) s2 integer value s_len = len_trim ( s ) s2 = '' s2(1:s_len) = s s2(s_len+1:s_len+1) = '0' value = luhn_checksum ( s2(1:s_len+1) ) if ( value .ne. 0 ) then value = 10 - value end if luhn_check_digit_calculate = value return end function luhn_checksum ( s ) !*****************************************************************************80 ! !! luhn_checksum() determines the Luhn checksum of a string. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 September 2015 ! ! Reference: ! ! https://en.wikipedia.org/wiki/Luhn_algorithm ! ! Parameters: ! ! Input, character ( len = * ) S, the string of digits to be checked. ! ! Output, integer VALUE, is the Luhn checksum for this string. ! implicit none integer d2 integer, allocatable :: dvec(:) integer i integer luhn_checksum integer n character ( len = * ) s integer s_digits_count integer value ! ! Count the digits in S. ! n = s_digits_count ( s ) ! ! Extract the digits from S. ! allocate ( dvec(1:n) ) call s_to_digits ( s, n, dvec ) ! ! Starting with the N-th digit, and going down by 2's, ! add the digit to the sum. ! value = sum ( dvec(n:1:-2) ) ! ! Starting with the (N-1)-th digit, and going down by 2's, ! double the digit, and ADD THE DIGITS to the sum. ! do i = n - 1, 1, -2 d2 = 2 * dvec(i) value = value + ( d2 / 10 ) + mod ( d2, 10 ) end do value = mod ( value, 10 ) luhn_checksum = value deallocate ( dvec ) return end function luhn_is_valid ( s ) !*****************************************************************************80 ! !! luhn_is_valid() determines whether a string with Luhn check digit is valid. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 September 2015 ! ! Reference: ! ! https://en.wikipedia.org/wiki/Luhn_algorithm ! ! Parameters: ! ! Input, character ( len = * ) S, the string of digits to be checked. ! ! Output, logical VALUE, TRUE if the string is valid. ! implicit none integer d integer luhn_checksum logical luhn_is_valid character ( len = * ) s logical value d = luhn_checksum ( s ) if ( d == 0 ) then value = .true. else value = .false. end if luhn_is_valid = value return end function s_digits_count ( s ) !*****************************************************************************80 ! !! s_digits_count() counts the digits in a string. ! ! Discussion: ! ! The string may include spaces, letters, and dashes, but only the ! digits 0 through 9 will be counted. ! ! Example: ! ! S => 34E94-70.6 ! N <= 7 ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 September 2015 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, the string. ! ! Output, integer S_DIGITS_COUNT, the number of digits. ! implicit none character c logical ch_is_digit integer n character ( len = * ) s integer s_digits_count integer s_len integer s_pos s_len = len_trim ( s ) s_pos = 0 n = 0 do while ( s_pos < s_len ) s_pos = s_pos + 1 c = s(s_pos:s_pos) if ( ch_is_digit ( c ) ) then n = n + 1 end if end do s_digits_count = n return end subroutine s_to_digits ( s, n, dvec ) !*****************************************************************************80 ! !! s_to_digits() extracts N digits from a string. ! ! Discussion: ! ! The string may include spaces, letters, and dashes, but only the ! digits 0 through 9 will be extracted. ! ! Example: ! ! S => 34E94-70.6 ! N => 5 ! D <= (/ 3, 4, 9, 4, 7 /) ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 September 2015 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, the string. ! ! Input, integer N, the number of digits to extract. ! ! Output, integer DVEC(N), the extracted digits. ! implicit none integer n character c logical ch_is_digit integer d integer d_pos integer dvec(n) integer lenc character ( len = * ) s integer s_pos lenc = len_trim ( s ) s_pos = 0 d_pos = 0 do while ( d_pos < n ) s_pos = s_pos + 1 if ( lenc < s_pos ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'S_TO_DIGITS - Fatal error!' write ( *, '(a)' ) ' Could not read enough data from string.' stop 1 end if c = s(s_pos:s_pos) if ( ch_is_digit ( c ) ) then d_pos = d_pos + 1 call ch_to_digit ( c, d ) dvec(d_pos) = d end if end do return end