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