Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50476/dacase.for
There are 2 other files named dacase.for in the archive. Click here to see a list.
SUBROUTINE DACASE(MINBFR,MAXBFR,IBUFFR)
C RENBR(/CONVERT LOWER CASE LETTERS TO UPPER)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C MINBFR = SUBSCRIPT OF FIRST LOCATION IN IBUFFR ARRAY
C CONTAINING CHARACTER TO BE CONVERTED TO
C UPPER CASE. MINBFR IS RETURNED UNCHANGED.
C MAXBFR = SUBSCRIPT OF FINAL LOCATION IN IBUFFR ARRAY
C CONTAINING CHARACTER TO BE CONVERTED TO
C UPPER CASE. MAXBFR IS RETURNED UNCHANGED.
C IBUFFR = ARRAY CONTAINING IN LOCATIONS HAVING
C SUBSCRIPTS MINBFR THROUGH MAXBFR CHARACTERS
C READ BY MULTPLE OF 1A FORMAT WHICH ARE TO BE
C CONVERTED TO UPPER CASE IF INPUT IN LOWER
C CASE.
C
DIMENSION IBUFFR(MAXBFR),KAPITL(26),LOWER(26)
C
C CCCC AAA UU UU TTTTTTTT IIII OOOO NN NN
C CC AAAA UU UU TT II OO OO NNN NN
C CC AA AA UU UU TT II OO OO NNNN NN
C CC AA AA UU UU TT II OO OO NN NN NN
C CC AAAAAAA UU UU TT II OO OO NN NNNN
C CC AA AA UU UU TT II OO OO NN NNN
C CCCC AA AA UUU TT IIII OOOO NN NN
C
C TO CONVERT LOWER CASE LETTERS IN THE INPUT TEXT
C BUFFER INTO UPPER CASE LETTERS, THIS ROUTINE COMPARES
C THE CHARACTERS IN THE INPUT TEXT BUFFER AGAINST THE
C LOWER CASE LETTERS IN THE LOWER ARRAY. THE LETTERS
C IN THE LOWER ARRAY MUST BE ARRANGED IN INCREASING
C NUMERICAL ORDER. IF THE NUMERICAL ORDER IS NOT THE
C SAME AS THE ALPHABETICAL ORDER, THEN THE DATA
C STATEMENTS APPEARING BELOW MUST BE CHANGED OR ELSE
C SOME OR ALL LOWER CASE LETTERS IN THE INPUT TEXT
C BUFFER WILL NOT BE CONVERTED INTO THE CORRESPONDING
C UPPER CASE LETTERS. ONCE THE LETTERS IN THE LOWER
C ARRAY ARE SORTED INTO INCREASING NUMERICAL ORDER, THE
C UPPER CASE LETTERS IN THE KAPITL ARRAY SHOULD BE
C REARRANGED SO THAT LOWER AND UPPER CASE VERSIONS OF
C EACH LETTER APPEAR IN LOCATIONS IN THE LOWER AND
C KAPITL ARRAYS HAVING THE SAME SUBSCRIPTS.
C
C IF THE COMPUTER UPON WHICH THIS ROUTINE IS USED DOES
C NOT SUPPORT LOWER CASE LETTERS, THEN BOTH THE LOWER
C AND KAPITL ARRAYS CAN CONTAIN THE LETTERS 1HA THROUGH
C 1HZ IN ALPHABETICAL ORDER (EVEN IF THIS IS NOT THE
C NUMERICALLY SORTED ORDER).
C
C KAPITL = UPPER CASE LETTERS A THROUGH Z SORTED ON
C LOWER ARRAY
DATA KAPITL/
11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
31HU,1HV,1HW,1HX,1HY,1HZ/
C
C LOWER = LOWER CASE LETTERS A THROUGH Z SORTED INTO
C NUMERICALLY INCREASING ORDER
DATA LOWER/
11Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
21Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
31Hu,1Hv,1Hw,1Hx,1Hy,1Hz/
C
C THIS IS A TERNARY SEARCH TAKING ADVANTAGE OF THE SIZE
C OF ALPHABET BEING NEARLY 3**3. THE 3RD OF THE ARRAY
C CONTAINING THE DESIRED LETTER IS FIRST LOCATED, THEN
C THE 3RD OF THIS 3RD, AND FINALLY EACH OF THE
C REMAINING 3 LETTERS ARE TESTED INDIVIDUALLY. TO
C PREVENT TESTING AGAINST THE 27TH LETTER WHICH DOES
C NOT EXIST, UPPER 3RD IS TAKEN AS UPPER 9 SORTED
C LETTERS, RATHER THAN FROM 19TH THROUGH 27TH LETTERS,
C SO THAT LOWER(18) IS TESTED AGAINST IN UPPER 3RD EVEN
C THOUGH LETTER BEING MATCHED HAS ALREADY BEEN FOUND TO
C BE LARGER THAN THIS.
INDEX=MINBFR
1 IF(INDEX.GT.MAXBFR)GO TO 8
LETTER=IBUFFR(INDEX)
IF(LETTER.GT.LOWER(18))GO TO 3
IF(LETTER.GT.LOWER(9))GO TO 2
IF(LETTER.LT.LOWER(1))GO TO 7
J=3
GO TO 4
2 J=12
GO TO 4
3 IF(LETTER.GT.LOWER(26))GO TO 7
J=20
4 IF(LETTER.LE.LOWER(J))GO TO 5
J=J+3
IF(LETTER.GT.LOWER(J))J=J+3
5 IF(LETTER.EQ.LOWER(J))GO TO 6
J=J-1
IF(LETTER.EQ.LOWER(J))GO TO 6
J=J-1
IF(LETTER.NE.LOWER(J))GO TO 7
6 IBUFFR(INDEX)=KAPITL(J)
7 INDEX=INDEX+1
GO TO 1
8 RETURN
C
C THE FOLLOWING BINARY SEARCH COULD BE USED AS A MODEL
C IF A LARGER ALPHABET HAD TO BE CONVERTED
C INDEX=MINBFR
C GO TO 3
C 1 IBUFFR(INDEX)=KAPITL(NOWTST)
C 2 INDEX=INDEX+1
C 3 IF(INDEX.GT.MAXBFR)GO TO 7
C LETTER=IBUFFR(INDEX)
C IF(LETTER.LT.LOWER(1))GO TO 2
C IF(LETTER.GT.LOWER(26))GO TO 2
C MAXTST=26
C MINTST=1
C NOWTST=MINTST
C GO TO 5
C 4 MAXTST=NOWTST
C 5 LNGTST=(MAXTST-MINTST)/2
C NOWTST=MAXTST-LNGTST
C IF(LETTER.EQ.LOWER(NOWTST))GO TO 1
C IF(LETTER.GT.LOWER(NOWTST))GO TO 6
C IF(LNGTST.GT.0)GO TO 4
C IF(MAXTST.LE.MINTST)GO TO 2
C NOWTST=MINTST
C GO TO 4
C 6 IF(LNGTST.LE.0)GO TO 2
C MINTST=NOWTST
C GO TO 5
C 7 RETURN
C349007223700abcdefghijklmnopqrstuvwxyz
END