Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/a5toa1.for
There are 2 other files named a5toa1.for in the archive. Click here to see a list.
      SUBROUTINE A5TOA1(IPACKD,LMTPKD,LMTWRD,LMTKNT,MAXWRD,
     1    MAXKNT,IWORD ,KNTLTR)
C     RENBR(/CONVERT A5 DEFINED ARRAY TO A1)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO RESTRUCTURE DICTIONARY, SPECIFIED AS WORDS
C     SEPARATED   BY   SPACES   CONTAINED  IN  SINGLE  LONG
C     HOLLERITH STRING OR IN SINGLE LONG TEXT STRING QUOTED
C     WITH   APOSTROPHES,   INTO   IWORD  ARRAY  OF  SINGLE
C     CHARACTERS AND INTO KNTLTR ARRAY OF CHARACTER  COUNTS
C     PER  WORD  NEEDED  BY  DAVERB.   SECOND APPEARANCE OF
C     FIRST PRINTING CHARACTER MARKS END OF STRING.
C
C     INEACH IS NUMBER OF CHARACTERS IN EACH HOLLERITH WORD
      DIMENSION IPACKD(LMTPKD),KNTLTR(LMTKNT),IWORD(LMTWRD)
      DATA INEACH/5/,IBLANK/1H /
      KNTPKD=0
      LOCAL=-1
      LIMIT=LMTPKD
C
C     GET NEXT GROUP OF CHARACTERS
    1 NEEDED=LMTWRD-MAXWRD
      IF(NEEDED.GT.INEACH)NEEDED=INEACH
      IF(NEEDED.GT.LIMIT)NEEDED=LIMIT
      IF(NEEDED.LE.0)GO TO 8
      KNTPKD=KNTPKD+1
      ISTART=MAXWRD+1
      IEND=MAXWRD+NEEDED
      LIMIT=LIMIT-NEEDED
C
C     READ ALPHAMERIC  INFORMATION FROM IPACKD(KNTPKD) INTO
C     IWORD(ISTART)  THROUGH IWORD(IEND)  VIA THE INDICATED
C     FORMAT.   NEEDED IS THE NUMBER OF CHARACTERS TO READ.
      DECODE(NEEDED,2,IPACKD(KNTPKD))
     1(IWORD(I),I=ISTART,IEND)
    2 FORMAT(100A1)
C
C     FIND WORDS OR DELIMITER CHARACTERS
    3 IF(ISTART.GT.IEND)GO TO 1
      IF(LOCAL.LT.0)GO TO 5
      IF(IWORD(ISTART).EQ.IFINAL)GO TO 8
      IF(IWORD(ISTART).EQ.IBLANK)GO TO 6
      IF(LOCAL.GT.0)GO TO 4
      IF(MAXKNT.GE.LMTKNT)GO TO 8
      MAXKNT=MAXKNT+1
      KNTLTR(MAXKNT)=0
      LOCAL=1
    4 KNTLTR(MAXKNT)=KNTLTR(MAXKNT)+1
      MAXWRD=MAXWRD+1
      IWORD(MAXWRD)=IWORD(ISTART)
      GO TO 7
    5 IF(IWORD(ISTART).EQ.IBLANK)GO TO 7
      IFINAL=IWORD(ISTART)
    6 LOCAL=0
    7 ISTART=ISTART+1
      GO TO 3
    8 RETURN
C283250238701
      END