Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/daname.for
There are 2 other files named daname.for in the archive.  Click here to see a list.
      SUBROUTINE DANAME(IRAPID,LOCATN,LRGNUM,NUMUSD,NUMSTR,
         1    LRGLTR,MAXSUB,INITAL,KOUNT ,LTRINI,NUMINI,KNTSUB,
         2    NOWSUB)
 C     RENBR(/GET NAME + SUBSCRIPTS FROM BUFFER SUBSCRIPT)
 C
  C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
  C     DANAME CONVERTS A SUBSCRIPT OF A  SINGLY  SUBSCRIPTED
    C     BUFFER  WHICH  IS  CONSIDERED  TO  HOLD  ONE  OR MORE
    C     POSSIBLY MULTIPLY SUBSCRIPTED ARRAYS INTO  THE  ARRAY
    C     NAME  AND ITS SUBSCRIPTS AS DEFINED BY THE DICTIONARY
    C     CONSTRUCTED BY THE DALOAD ROUTINE.   THIS  CONVERSION
                                                      C     IS  THE  OPPOSITE  OF  THAT  PERFORMED  BY THE DASITE
    C     ROUTINE.
    C
  C     SINCE THE DICTIONARY CONSTRUCTED BY DALOAD IS DIVIDED
    C     INTO  LOGICAL  GROUPS  OF  ARRAY  NAMES,  THE  PROPER
    C     LOGICAL GROUP MUST BE LOCATED BY CALLING  THE  DABASE
    C     ROUTINE  PRIOR TO THE FIRST CALL TO DANAME, UNLESS IT
    C     IS KNOWN THAT THE DESIRED LOGICAL GROUP IS THE  FIRST
    C     (OR ONLY) GROUP IN THE DICTIONARY.
   C
  C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY  AND  ARE
    C     RETURNED UNCHANGED.
   C
  C     IRAPID = 0, MULTIPLY SUBSCRIPTED  ARRAYS  HAVE  THEIR
              C              LEFT SUBSCRIPTS VARY MOST RAPIDLY
C            = 1, MULTIPLY SUBSCRIPTED  ARRAYS  HAVE  THEIR
    C              RIGHT SUBSCRIPTS VARY MOST RAPIDLY.
   C
  C     LOCATN = THE VALUE OF SUBSCRIPT OF SINGLY SUBSCRIPTED
    C              BUFFER   WHICH   IS   TO   BE  CONVERTED  TO
    C              CORRESPONDING ARRAY NAME AND ITS SUBSCRIPTS.
    C
  C     LRGNUM = SUBSCRIPT OF  NUMSTR  ARRAY  LOCATION  WHICH
    C              CONTAINS   FIRST   OF   NUMERIC  INFORMATION
    C              ASSOCIATED WITH LOGICAL GROUP  OF  NAMES  OF
    C              ARRAYS VALUES OF WHICH ARE EQUIVALENCED WITH
         C              OR OTHERWISE CONTAINED IN SINGLY SUBSCRIPTED
    C              BUFFER.    NUMSTR(LRGNUM)  CONTAINS  AS  ITS
    C              ABSOLUTE VALUE NUMBER  OF  CHARACTERS  WHICH
    C              ARE  CONTAINED  IN  NAME, IF ANY, OF LOGICAL
    C              GROUP.
  C
  C     NUMUSD = HIGHEST SUBSCRIPT  OF  LOCATIONS  IN  NUMSTR
    C              ARRAY    CONTAINING    NUMERIC   INFORMATION
    C              CORRESPONDING    TO    POSSIBLY     MULTIPLY
    C              SUBSCRIPTED   ARRAYS  VALUES  OF  WHICH  ARE
    C              EQUIVALENCED WITH OR OTHERWISE CONTAINED  IN
                             C              SINGLY   SUBSCRIPTED   BUFFER.    NUMUSD  IS
    C              HIGHEST SUBSCRIPT USED IN NUMSTR  ARRAY  FOR
    C              STORAGE  OF  INFORMATION  ABOUT ANY ARRAY IN
    C              ANY LOGICAL GROUP, AND  IS  NOT  NECESSARILY
    C              HIGHEST  SUBSCRIPT  USED IN NUMSTR ARRAY FOR
    C              STORAGE  OF  INFORMATION  ABOUT   ARRAY   IN
    C              CURRENT LOGICAL GROUP.
 C
  C     NUMSTR = THE  ARRAY  CONTAINING  NUMERIC  INFORMATION
    C              CORRESPONDING     TO    POSSIBLY    MULTIPLY
    C              SUBSCRIPTED  ARRAYS  VALUES  OF  WHICH   ARE
              C              EQUIVALENCED  WITH OR OTHERWISE CONTAINED IN
    C              SINGLY SUBSCRIPTED BUFFER.  CONSTRUCTION  OF
    C              NUMSTR  ARRAY  IS  DESCRIBED  IN  DETAIL  IN
    C              DALOAD  DOCUMENTATION.   FOR  EACH  NAME  IN
    C              DICTIONARY, NUMSTR ARRAY CONTAINS
C
  C                A. THE NUMBER OF CHARACTERS IN NAME
 C                B. AN INDICATION OF ASSOCIATED DATA TYPE
 C                C. THE NUMBER OF SUBSCRIPT RANGES
   C                D. PAIRS OF STARTING AND ENDING VALUES  OF
    C                   THESE RANGES.
C
                                                    C              IF NUMBER OF CHARACTERS IS INSTEAD  ZERO  OR
    C              NEGATIVE,  THEN ITS ABSOLUTE VALUE IS NUMBER
    C              OF CHARACTERS IN NAME OF  LOGICAL  GROUP  OF
    C              NAMES,   AND   NEXT  LOCATION,  RATHER  THAN
    C              INDICATING DATA  TYPE,  CONTAINS  NUMBER  OF
    C              LOCATIONS  WITHIN  SINGLY SUBSCRIPTED BUFFER
    C              WHICH WOULD BE NEEDED  TO  STORE  VALUES  OF
    C              MULTIPLY SUBSCRIPTED ARRAYS WHICH ARE WITHIN
    C              LOGICAL  GROUP  AND  EQUIVALENCED  WITH   OR
                                                           C              OTHERWISE    LOADED    INTO    SUCH   SINGLY
    C              SUBSCRIPTED BUFFER.
    C
  C     LRGLTR = THE SUBSCRIPT OF LTRSTR ARRAY (NOT  ARGUMENT
    C              OF THIS ROUTINE BUT CONSTRUCTED BY DALOAD IN
    C              PARALLEL WITH NUMSTR) WHICH  CONTAINS  FIRST
    C              LETTER OF NAME ASSOCIATED WITH LOGICAL GROUP
    C              OF NAMES IN DICTIONARY IF NUMSTR(LRGNUM)  IS
    C              NEGATIVE,  OR WHICH CONTAINS FIRST LETTER OF
    C              FIRST ARRAY NAME IN LOGICAL GROUP  OF  NAMES
    C              IF NUMSTR(LRGNUM) IS POSITIVE OR ZERO.
C
                 C     MAXSUB = HIGHEST  SUBSCRIPT  OF  LOCTIONS  IN  NOWSUB
    C              ARRAY  WHICH  CAN BE USED BY THIS ROUTINE TO
    C              STORE VALUES OF  SUBSCRIPTS  OF  ARRAY  NAME
    C              CORRESPONDING  TO  SUBSCRIPT (INPUT AS VALUE
    C              OF LOCATN) OF SINGLY SUBSCRIPTED BUFFER.
   C
  C     FOLLOWING ARGUMENTS  ARE  USED  FOR  BOTH  INPUT  AND
    C     OUTPUT.  IF THIS ROUTINE IS ASKED TO CONVERT VALUE OF
    C     LOCATN WHICH IS SUBSCRIPT OF LOCATION IN  OR  FURTHER
    C     BEYOND  ARRAY  IDENTIFIED  BY  PREVIOUS  CALL TO THIS
                                                           C     ROUTINE BUT WHICH IS STILL WITHIN SAME LOGICAL  GROUP
    C     OF  ARRAYS AS DEALT WITH BY PREVOUS CALL, THEN VALUES
    C     OF THESE ARGUMENTS AS OUTPUT  BY  PREVIOUS  CALL  ARE
    C     USED  AS NEW OFFSETS IN DICTIONARY AND BUFFER, RATHER
    C     THAN REPEATING  CALCULATIONS  FOR  LOWER  PORTION  OF
    C     LOGICAL GROUP.
   C
  C     INITAL = SHOULD BE SET TO  ZERO  BY  CALLING  PROGRAM
    C              BEFORE  THIS  ROUTINE  IS  FIRST CALLED, AND
    C              AGAIN SET TO ZERO WHENEVER THIS  ROUTINE  IS
    C              CALLED  TO REFERENCE DIFFERENT LOGICAL GROUP
                             C              OF ARRAY NAMES IN DICTIONARY.
    C            = RETURNED GREATER THAN ZERO IF  SUBSCRIPT  OF
    C              SINGLY  SUBSCRIPTED BUFFER INPUT AS VALUE OF
    C              ARGUMENT LOCATN COULD BE CONVERTED INTO NAME
    C              AND    SUBSCRIPTS   OF   POSSIBLY   MULTIPLY
    C              SUBSCRIPTED  ARRAY  EQUIVALENCED   WITH   OR
    C              OTHERWISE CONTAINED IN PART OR ALL OF SINGLY
    C              SUBSCRIPTED  BUFFER.   INITAL  IS   RETURNED
    C              CONTAINING  SUBSCRIPT  OF SINGLY SUBSCRIPTED
    C              BUFFER LOCATION WHICH CONTAINS START OF (THE
         C              FIRST  LOCATION  WITHIN)  POSSIBLY  MULTIPLY
    C              SUBSCRIPTED ARRAY SOME LOCATION WITHIN WHICH
    C              CORRESPONDS  TO  SINGLY  SUBSCRIPTED  BUFFER
    C              LOCATION HAVING AS ITS SUBSCRIPT INPUT VALUE
    C              OF  ARGUMENT  LOCATN.   IF POSSIBLY MULTIPLY
    C              SUBSCRIPTED ARRAY IDENTIFIED BY THIS ROUTINE
    C              CONSISTS  OF SINGLE LOCATION, THEN INITAL IS
    C              RETURNED CONTAINING INPUT VALUE OF LOCATN.
 C            = 0,   RETURNED   IF   SUBSCRIPT   OF   SINGLY
                                                                C              SUBSCRIPTED   BUFFER   INPUT   AS  VALUE  OF
    C              ARGUMENT LOCATN COULD NOT BE CONVERTED  INTO
    C              NAME  AND  SUBSCRIPTS  OF ARRAY EQUIVALENCED
    C              WITH OR OTHERWISE CONTAINED IN PART  OR  ALL
    C              OF  SINGLY  SUBSCRIPTED  BUFFER.   IN  OTHER
    C              WORDS, LOCATN WAS INPUT CONTAINING VALUE NOT
    C              INDICATED  BY  DICTIONARY  AS  BEING  WITHIN
    C              SINGLY SUBSCRIPTED BUFFER CONTAINING  ARRAYS
    C              FORMING LOGICAL GROUP.
 C            = -1, MAXSUB IS LESS THAN NUMBER OF SUBSCRIPTS
                   C              OF   POSSIBLY   MULTIPLY  SUBSCRIPTED  ARRAY
    C              IDENTIFIED BY THIS ROUTINE SO THAT  NOT  ALL
    C              OF SUBSCRIPTS COULD BE REPRESENTED IN NOWSUB
    C              ARRAY.
  C
  C     KOUNT  = INPUT VALUE IS IGNORED IF  INITAL  IS  INPUT
    C              CONTAINING   ZERO  OR  IF  INITAL  IS  INPUT
    C              GREATER THAN INPUT VALUE OF  LOCATN.   KOUNT
    C              IS  SET  BY  EACH  CALL TO THIS ROUTINE, AND
    C              SHOULD NEVER BE SET BY CALLING PROGRAM.
    C            = IF INITAL IS INPUT  GREATER  THAN  ZERO  BUT
                                  C              LESS THAN OR EQUAL TO LOCATN, THEN KOUNT, AS
    C              RETURNED BY PREVIOUS CALL TO  THIS  ROUTINE,
    C              IS  SEQUENCE  NUMBER  OF  POSSIBLY  MULTIPLY
    C              SUBSCRIPTED  ARRAY  CORRESPONDING  TO  INPUT
    C              VALUE OF INITAL.
  C            = RETURNED  CONTAINING  SEQUENCE   NUMBER   OF
    C              IDENTIFIED  ARRAY  RELATIVE TO ALL ARRAYS IN
    C              LOGICAL GROUP OF ARRAYS.  IF THIRD ARRAY  IN
    C              LOGICAL      GROUP     CONTAINS     LOCATION
    C              CORRESPONDING TO INPUT VALUE OF LOCATN, THEN
                        C              KOUNT IS RETURNED CONTAINING VALUE 3.
 C
  C     LTRINI = INPUT VALUE IS IGNORED IF  INITAL  IS  INPUT
    C              CONTAINING   ZERO  OR  IF  INITAL  IS  INPUT
    C              GREATER THAN INPUT VALUE OF LOCATN.   LTRINI
    C              IS  SET  BY  EACH  CALL TO THIS ROUTINE, AND
    C              SHOULD NEVER BE SET BY CALLING PROGRAM.
    C            = IF INITAL IS INPUT  GREATER  THAN  ZERO  BUT
    C              LESS  THAN  OR EQUAL TO LOCATN, THEN LTRINI,
    C              AS  RETURNED  BY  PREVIOUS  CALL   TO   THIS
    C              ROUTINE,  IS  SUBSCRIPT  OF  LTRSTR LOCATION
    C              CONTAINING 1ST  CHARACTER OF THE NAME OF THE
    C              POSSIBLY    MULTIPLY    SUBSCRIPTED    ARRAY
    C              CORRESPONDING TO INPUT VALUE OF INITAL.
    C            = RETURNED  CONTAINING  SUBSCRIPT  OF   LTRSTR
    C              ARRAY  LOCATION  CONTAINING 1ST CHARACTER OF
    C              NAME OF IDENTIFIED ARRAY.
   C
  C     NUMINI = INPUT VALUE IS IGNORED IF  INITAL  IS  INPUT
    C              CONTAINING   ZERO  OR  IF  INITAL  IS  INPUT
    C              GREATER THAN INPUT VALUE OF LOCATN.   NUMINI
    C              IS  SET  BY  EACH  CALL TO THIS ROUTINE, AND
              C              SHOULD NEVER BE SET BY CALLING PROGRAM.
    C            = IF INITAL IS INPUT  GREATER  THAN  ZERO  BUT
    C              LESS  THAN  OR EQUAL TO LOCATN, THEN NUMINI,
    C              AS  RETURNED  BY  PREVIOUS  CALL   TO   THIS
    C              ROUTINE,  IS  SUBSCRIPT  OF  NUMSTR LOCATION
    C              CONTAINING START OF NUMERIC  DESCRIPTION  OF
    C              POSSIBLY    MULTIPLY    SUBSCRIPTED    ARRAY
    C              CORRESPONDING TO INPUT VALUE OF INITAL.
    C            = RETURNED  CONTAINING  SUBSCRIPT  OF   NUMSTR
    C              ARRAY  LOCATION  CONTAINING START OF NUMERIC
    C              DESCRIPTION OF IDENTIFIED ARRAY.
 C
  C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT.   THEIR
    C     INPUT   VALUES  ARE  IGNORED.   THESE  ARGUMENTS  ARE
    C     RETURNED UNDEFINED IF INITAL IS RETURNED LESS THAN OR
    C     EQUAL TO ZERO.
   C
  C     KNTSUB = RETURNED CONTAINING NUMBER OF SUBSCRIPTS  OF
    C              IDENTIFIED ARRAY.  IF NUMSTR ARRAY INDICATES
    C              THAT  IDENTIFIED  ARRAY  IS  NONDIMENSIONED,
    C              THEN  KNTSUB  IS  RETURNED CONTAINING 1, AND
    C              NOWSUB(1) IS RETURNED ALSO CONTAINING 1.
   C
                                     C     NOWSUB = ARRAY  RETURNED  CONTAINING   IN   LOCATIONS
    C              NOWSUB(1)      THROUGH     AND     INCLUDING
    C              NOWSUB(KNTSUB)  VALUES  OF   SUBSCRIPTS   OF
    C              POSSIBLY MULTIPLY SUBSCRIPTED ARRAY LOCATION
    C              CORRESPONDING   TO   SUBSCRIPT   OF   SINGLY
    C              SUBSCRIPTED BUFFER INPUT AS ARGUMENT LOCATN.
    C
        DIMENSION NUMSTR(NUMUSD),NOWSUB(MAXSUB)
   C
        IF(INITAL.LE.0)GO TO 1
      IF(LOCATN.GE.INITAL)GO TO 2
C
  C     FIND NUMBER OF LOCATIONS BELOW CURRENT LOCATION
    1 NUMINI=LRGNUM
          LTRINI=LRGLTR
          KOUNT=0
      INITAL=1
        2 IF(NUMINI.GE.NUMUSD)GO TO 14
          KNTLTR=NUMSTR(NUMINI)
       IF(KNTLTR.GT.0)GO TO 3
      IF(NUMINI.NE.LRGNUM)GO TO 14
          KNTLTR=-KNTLTR
         GO TO 6
    3 KOUNT=KOUNT+1
          ISIZE=1
      INDEX=NUMINI+3
         LIMIT=NUMSTR(INDEX-1)
     4 IF(LIMIT.LE.0)GO TO 5
       JSIZE=NUMSTR(INDEX+1)-NUMSTR(INDEX)+1
      IF(JSIZE.LE.0)JSIZE=2-JSIZE
      ISIZE=ISIZE*JSIZE
      INDEX=INDEX+2
          LIMIT=LIMIT-1
          GO TO 4
    5 IF((INITAL+ISIZE).GT.LOCATN)GO TO 7
        INITAL=INITAL+ISIZE
       6 LTRINI=LTRINI+KNTLTR
                                                NUMINI=NUMINI+3+(2*NUMSTR(NUMINI+2))
       GO TO 2
C
  C     FIND SUBSCRIPTS CORRESPONDING TO CURRENT LOCATION
       7 LOCAL=LOCATN-INITAL
         LIMIT=NUMSTR(NUMINI+2)
      IF(LIMIT.LE.0)GO TO 12
      IF(LIMIT.GT.MAXSUB)GO TO 13
      KNTSUB=LIMIT
      IF(IRAPID.LE.0)GO TO 8
      ICHANG=-2
         INDEX=NUMINI+1+LIMIT+LIMIT
       JCHANG=-1
         LOCSUB=LIMIT
      GO TO 9
    8 ICHANG=2
          INDEX=NUMINI+3
         JCHANG=1
          LOCSUB=1
        9 IF(LIMIT.LE.0)GO TO 15
      INISUB=NUMSTR(INDEX)
        ISIZE=NUMSTR(INDEX+1)-INISUB+1
        NEWSUB=LOCAL
                               IF(ISIZE.GT.0)GO TO 10
      ISIZE=2-ISIZE
          LOCAL=LOCAL/ISIZE
      NOWSUB(LOCSUB)=INISUB-NEWSUB+(ISIZE*LOCAL)
      GO TO 11
       10 LOCAL=LOCAL/ISIZE
      NOWSUB(LOCSUB)=INISUB+NEWSUB-(ISIZE*LOCAL)
   11 LIMIT=LIMIT-1
          INDEX=INDEX+ICHANG
          LOCSUB=LOCSUB+JCHANG
        GO TO 9
C
  C     SIMULATE SUBSCRIPT IF NAME IS UNDIMENSIONED
       12 IF(MAXSUB.LE.0)GO TO 13
          KNTSUB=1
          NOWSUB(1)=1
       GO TO 15
    C
  C     NOWSUB ARRAY TOO SMALL
   13 INITAL=-1
         GO TO 15
    C
  C     LOCATION NOT IN LOGICAL GROUP
      14 INITAL=0
    C
                 C     RETURN TO CALLING PROGRAM
     15 RETURN
 C445857737136
      END