Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0141/dalist.for
There are 2 other files named dalist.for in the archive. Click here to see a list.
      SUBROUTINE DALIST(JTTY  ,LTRLOW,LTRUSD,LTRSTR,NUMLOW,
     1NUMUSD,NUMSTR,NAMMAX,NAME)
C     RENBR(/LIST ARRAY MANIPULATION DICTIONARY)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
      DIMENSION LTRSTR(LTRUSD),NUMSTR(NUMUSD),NAME(NAMMAX)
      DATA ISPACE/1H /
C
C     LOCATIONS OF INITIAL NUMBER AND INITIAL CHARACTER
      NUMNXT=NUMLOW
      LTRNXT=LTRLOW
      NAMUSD=0
C
C     GET INFORMATION ABOUT NEXT ARRAY
    1 NUMINI=NUMNXT
      IF(NUMINI.GT.NUMUSD)GO TO 3
      LTRINI=LTRNXT
      LTRKNT=NUMSTR(NUMINI)
      KNTSUB=NUMSTR(NUMINI+2)
      IF(KNTSUB.LT.0)GO TO 8
      NUMNXT=NUMINI+3+KNTSUB+KNTSUB
      IF(NUMNXT.GT.(NUMUSD+1))GO TO 8
      IF(LTRKNT.GT.0)GO TO 2
C
C     START OF RECORD DESCRIPTION
      LTRNXT=LTRNXT-LTRKNT
      GO TO 3
C
C     PRINT PREVIOUS LINE OF DESCRIPTIONS IF LINE FULL
    2 LTRNXT=LTRINI+LTRKNT
      IF(LMTTYP.EQ.-2)GO TO 3
      IF(LSTTYP.NE.NUMSTR(NUMINI+1))GO TO 3
      IF(NAMUSD.LE.0)GO TO 5
      IF(NAMUSD.LT.NAMMAX)GO TO 6
    3 IF(NAMUSD.GT.0)WRITE(JTTY,4)(NAME(I),I=1,NAMUSD)
    4 FORMAT(1X,100A1)
      IF(NUMINI.GT.NUMUSD)GO TO 10
      NAMUSD=0
    5 LMTTYP=-2
      GO TO 7
C
C     INSERT NEXT DESCRIPTION INTO LINE
    6 NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ISPACE
    7 LSTBFR=NAMUSD
      CALL DALONE(LMTTYP,LTRINI,LTRUSD,LTRSTR,NUMINI,
     1NUMUSD,NUMSTR,1,NUMSTR,NAMMAX,NAME,NAMUSD)
      IF(NAMUSD.LE.0)GO TO 8
      IF(NAMUSD.LE.LSTBFR)GO TO 3
      LMTTYP=-1
      LSTTYP=NUMSTR(NUMINI+1)
      IF(NUMSTR(NUMINI).LE.0)LMTTYP=-2
      GO TO 1
C
C     RETURN TO CALLING PROGRAM
    8 WRITE(JTTY,9)
    9 FORMAT(' DALIST - ARRAY DESCRIPTION ERROR')
   10 RETURN
C400023395953'
      END