35 lines
1.5 KiB
Fortran
35 lines
1.5 KiB
Fortran
CHARACTER*1 FUNCTION CUSIPCHECK(TEXT) !Determines the check sum character.
|
|
Committee on Uniform Security Identification Purposes, of the American (i.e. USA) Bankers' Association.
|
|
CHARACTER*8 TEXT !Specifically, an eight-symbol code.
|
|
CHARACTER*(*) VALID !These only are valid.
|
|
PARAMETER (VALID = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ*@#")
|
|
INTEGER I,V,S !Assistants.
|
|
S = 0 !Start the checksum.
|
|
DO I = 1,LEN(TEXT) !Step through the text.
|
|
V = INDEX(VALID,TEXT(I:I)) - 1 !Since counting starts with one.
|
|
IF (MOD(I,2).EQ.0) V = V*2 !V = V*(2 - MOD(I,2))?
|
|
S = S + V/10 + MOD(V,10) !Specified calculation.
|
|
END DO !On to the next character.
|
|
I = MOD(10 - MOD(S,10),10) + 1 !Again, counting starts with one.
|
|
CUSIPCHECK = VALID(I:I) !Thanks to the MOD 10, surely a digit.
|
|
END FUNCTION CUSIPCHECK !No checking for invalid input...
|
|
|
|
PROGRAM POKE !Just to try it out.
|
|
INTEGER I,N !Assistants.
|
|
PARAMETER (N = 6) !A whole lot of blather
|
|
CHARACTER*9 CUSIP(N) !Just to have an array of test codes.
|
|
DATA CUSIP/ !Here they are, as specified.
|
|
1 "037833100",
|
|
2 "17275R102",
|
|
3 "38259P508",
|
|
4 "594918104",
|
|
5 "68389X106",
|
|
6 "68389X105"/
|
|
CHARACTER*1 CUSIPCHECK !Needed as no use of the MODULE protocol.
|
|
|
|
DO I = 1,N !"More than two? Use a DO..."
|
|
WRITE (6,*) CUSIP(I),CUSIPCHECK(CUSIP(I)(1:8)).EQ.CUSIP(I)(9:9)
|
|
END DO
|
|
|
|
END
|