Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50476/dapath.for
There are 2 other files named dapath.for in the archive. Click here to see a list.
      SUBROUTINE DAPATH(LOWVLU,KNTVLU,IVALUE,JSTIFY,IFILL ,
     1    IWIDTH,LFTCOL,MAXBFR,IBUFFR,KOUNT ,IERR  )
C     RENBR(/REPRESENT INTEGER SEQUENCE OF FORM 1.2.3)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     LOWVLU = SUBSCRIPT OF LOWEST LOCATION IN IVALUE ARRAY
C              WHICH  SPECIFIES PART OF INTEGER SEQUENCE TO
C              BE REPRESENTED.
C     KNTVLU = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  IVALUE
C              ARRAY   WHICH   SPECIFIES  PART  OF  INTEGER
C              SEQUENCE TO BE REPRESENTED.
C     IVALUE = ARRAY  CONTAINING  DESCRIPTION  OF   INTEGER
C              SEQUENCE IN LOCATIONS IVALUE(LOWVLU) THROUGH
C              IVALUE(KNTVLU).  VALUES EQUAL TO OR  GREATER
C              THAN   ZERO  ARE  REPRESENTED  DIRECTLY  AND
C              SEPARATED BY PERIODS.  VALUES LESS THAN ZERO
C              ARE  NOT  REPRESENTED,  BUT  SAME SEPARATING
C              PERIODS   APPEAR   AS   IF    VALUES    WERE
C              REPRESENTED.
C     JSTIFY = -1, LEFT JUSTIFY REPRESENTATION  OF  INTEGER
C              SEQUENCE     IN    FIELD    CONSISTING    OF
C              IBUFFR(LFTCOL+1)   THROUGH    IBUFFR(LFTCOL+
C              IWIDTH).
C            = 0, CENTER REPRESENTATION OF INTEGER SEQUENCE
C              IN   FIELD  CONSISTING  OF  IBUFFR(LFTCOL+1)
C              THROUGH IBUFFR(LFTCOL+IWIDTH).  IBUFFR ARRAY
C              LOCATIONS   TO  LEFT  OF  REPRESENTATION  OF
C              INTEGER SEQUENCE ARE FILLED WITH SPACES.
C            = 1, RIGHT JUSTIFY REPRESENTATION  OF  INTEGER
C              SEQUENCE     IN    FIELD    CONSISTING    OF
C              IBUFFR(LFTCOL+1)   THROUGH    IBUFFR(LFTCOL+
C              IWIDTH).   IBUFFR ARRAY LOCATIONS TO LEFT OF
C              REPRESENTATION  OF  INTEGER   SEQUENCE   ARE
C              FILLED WITH SPACES.
C     IFILL  = 0, DO NOT FILL PORTION  OF  FIELD  RIGHT  OF
C              REPRESENTATION   OF  INTEGER  SEQUENCE  WITH
C              SPACES.  VALUE OF IFILL  HAS  NO  EFFECT  ON
C              PRINTING  CHARACTERS  IN  REPRESENTATION  OF
C              INTEGER SEQUENCE.  KOUNT  WILL  BE  RETURNED
C              POINTING  TO RIGHTMOST PRINTING CHARACTER IN
C              REPRESENTATION OF INTEGER SEQUENCE.
C            = 1, FILL FIELD  RIGHT  OF  REPRESENTATION  OF
C              INTEGER   SEQUENCE   AND  EXTENDING  THROUGH
C              IBUFFR(LFTCOL+IWIDTH)  WITH  SPACES.   KOUNT
C              WILL   BE   RETURNED  RETURNED  POINTING  TO
C              IBUFFR(LFTCOL+IWIDTH).
C     IWIDTH = WIDTH, STATED AS NUMBER OF COLUMNS OR IBUFFR
C              ARRAY  LOCATIONS,  OF FIELD IN WHICH INTEGER
C              SEQUENCE IS TO BE REPRESENTATED.   RIGHTMOST
C              IBUFFR ARRAY LOCATION IN FIELD HAS SUBSCRIPT
C              LFTCOL+IWIDTH OR ELSE MAXBFR,  WHICHEVER  IS
C              SMALLER.
C     LFTCOL = SUBSCRIPT  OF  IBUFFR  ARRAY   LOCATION   TO
C              IMMEDIATE  LEFT  OF  LEFTMOST  IBUFFR  ARRAY
C              LOCATION  INTO   WHICH   EITHER   SPACE   OR
C              CHARACTER   OF   REPRESENTATION  OF  INTEGER
C              SEQUENCE CAN BE PLACED.
C     MAXBFR = SUBSCRIPT OF RIGHTMOST IBUFFR ARRAY LOCATION
C              WHICH  COULD BE PLACED SPACE OR CHARACTER OF
C              REPRESENTATION OF INTEGER SEQUENCE IF IWIDTH
C              IS LARGE ENOUGH.
C     IBUFFR = ARRAY IN  WHICH  REPRESENTATION  OF  INTEGER
C              SEQUENCE  IS RETURNED, 1 CHARACTER PER ARRAY
C              LOCATION AS THOUGH READ BY  MULTIPLE  OF  A1
C              FORMAT.
C     KOUNT  = RETURNED CONTAINING SUBSCRIPT  OF  RIGHTMOST
C              LOCATION   OF   IBUFFR   ARRAY   INTO  WHICH
C              CHARACTER HAS BEEN PLACED BY THIS ROUTINE.
C     IERR   = -1  RETURNED  IF  REPRESENTATION  OF  ENTIRE
C              INTEGER  SEQUENCE  WOULD  NOT FIT INTO FIELD
C              INDICATED BY LFTCOL AND BY EITHER IWIDTH  OR
C              MAXBFR,  WHICHEVER  INDICATES SMALLER FIELD.
C              IF  MAXBFR  IS  GREATER  THAN  OR  EQUAL  TO
C              LFTCOL+IWIDTH, THEN IBUFFR(LFTCOL+1) THROUGH
C              IBUFFR(LFTCOL+IWIDTH)      ARE      RETURNED
C              CONTAINING  ASTERISKS, AND KOUNT IS RETURNED
C              SET EQUAL TO LFTCOL+IWIDTH.   IF  MAXBFR  IS
C              LESS  THAN LFTCOL+IWIDTH, THEN THE ASTERISKS
C              EXTEND THROUGH IBUFFR(MAXBFR) AND  KOUNT  IS
C              RETURNED SET EQUAL TO MAXBFR.
C            = 0 RETURNED IF ENTIRE INTEGER SEQUENCE  COULD
C              BE REPRESENTED IN FIELD.
C
      DIMENSION IBUFFR(MAXBFR),IVALUE(KNTVLU)
      DATA IDOT/1H./
C
C     PREPARE TO REPRESENT FIRST NUMBER IN SERIES
      LTREND=LFTCOL+IWIDTH
      IF(LTREND.GT.MAXBFR)LTREND=MAXBFR
      JPOINT=LFTCOL
      IERR=0
      IF(KNTVLU.LT.LOWVLU)GO TO 4
      INDEX=LOWVLU
C
C     REPRESENT NEXT NUMBER IN SERIES
    1 NUMBER=IVALUE(INDEX)
      IF(NUMBER.LT.0)GO TO 2
      INITAL=JPOINT
      CALL DANUMB(0,NUMBER,10,IBUFFR,JPOINT,INITAL,LTREND)
      IF(JPOINT.LE.INITAL)GO TO 3
    2 INDEX=INDEX+1
      IF(INDEX.GT.KNTVLU)GO TO 4
      IF(JPOINT.GE.LTREND)GO TO 3
      JPOINT=JPOINT+1
      IBUFFR(JPOINT)=IDOT
      GO TO 1
C
C     FILL FIELD WITH STARS IF SERIES WON'T FIT
    3 IERR=-1
C
C     JUSTIFY THE SERIES
    4 CALL DAMOVE(JSTIFY,IFILL ,LFTCOL,LTREND,IERR  ,
     1    IBUFFR,JPOINT )
C
C     RETURN TO CALLING PROGRAM
    5 KOUNT=JPOINT
      RETURN
C223649117134
      END