function bank_check_digit_calculate ( s ) !*****************************************************************************80 ! !! bank_check_digit_calculate() returns the check digit of a bank checksum. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 October 2015 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, a string containing at least 8 digits. ! Dashes and other characters will be ignored. A 9th digit may be ! included, but it will be ignored. ! ! Output, integer BANK_CHECK_DIGIT_CALCULATE, the check digit. ! implicit none integer bank_check_digit_calculate integer d integer dvec(8) integer n character ( len = * ) s n = 8 call s_to_digits ( s, n, dvec ) d = 3 * sum ( dvec(1:7:3) ) & + 7 * sum ( dvec(2:8:3) ) & + sum ( dvec(3:6:3) ) d = mod ( d, 10 ) d = mod ( 10 - d, 10 ) bank_check_digit_calculate = d return end function bank_is_valid ( s ) !*****************************************************************************80 ! !! bank_is_valid() reports whether a bank checksum is valid. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 October 2015 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, a string containing 9 digits. ! Dashes and other characters will be ignored. ! ! Output, logical BANK_IS_VALID, is TRUE if the string ! is valid. ! implicit none integer bank_check_digit_calculate logical bank_is_valid integer d1 integer d2 integer dvec(9) integer n character ( len = * ) s logical value n = 9 call s_to_digits ( s, n, dvec ) d1 = bank_check_digit_calculate ( s ) d2 = dvec(9) if ( d1 == d2 ) then value = .true. else value = .false. end if bank_is_valid = value return end 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 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