ASMB,R,L,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED "..MAP"   FTN4 1,2 & 3 ARRAY ADDRESS CALC. ROUTINE (DLB)
      NAM ..MAP,7 24998-1X029 REV.2001 751101 
      ENT ..MAP 
      SPC 1 
* 
      SPC 1 
*  PURPOSE: 
*    THIS ROUTINE IS USED BY FORTRAN IV COMPILED CODE TO CALCULATE
*    THE MEMORY ADDRESS OF AN ARRAY.
      SPC 1 
*  USED:
*    FORTRAN IV 
*      WHERE "ARRAY" CAN BE INTEGER, REAL, DOUBLE PRECISION OR COMPLEX
*      ARRAY(I) = VALUE 
*      ARRAY(I,J) = VALUE 
*      ARRAY(I,J,K) = VALUE 
      SPC 1 
*  CALLED:
*    ONE DIMENSION      TWO DIMENSIONS       THREE DIMENSIONS 
* 
*    CCA,<CLE>           CLA,<CCE>           CLA,INA,<CLE>
*    LDB WDSPD           LDB WDSPD           LDB WDSPD
*    JSB ..MAP           JSB ..MAP           JSB ..MAP
*    DEF BASEA           DEF BASEA           DEF BASEA
*    DEF ELEM1           DEF ELEM1           DEF ELEM1
*    <RETURN> P+3        DEF ELEM2           DEF ELEM2
*                        DEF DIMN1           DEF ELEM3
*                        <RETURN> P+5        DEF DIMN1
*                                            DEF DIMN2
*                                            <RETURN> P+7 
      SPC 1 
*  WHERE: 
*    WDSPD = NUMBER OF WORDS PER ELEMENT IN ARRAY (1,2,3 OR 4)
*    A-REG = NUMBER OF DIMENSIONS-2 IN THE ARRAY (-1,0,+1) FOR
*            1, 2 OR 3 DIMENSIONS 
*    E-REG = 1 IF A STORE TO THIS ELEMENT, OR 0 IF READ FROM ELEMENT
*    BASEA = POINTER TO "ADDRESS" OF 1ST ELEMENT OF ARRAY 
*    ELEM1 = POINTER TO "VALUE" OF 1ST SUBSCRIPT OF ARRAY 
*    ELEM2 = POINTER TO "VALUE" OF 2ND SUBSCRIPT OF ARRAY 
*    ELEM3 = POINTER TO "VALUE" OF 3RD SUBSCRIPT OF ARRAY 
*    DIMN1 = POINTER TO "VALUE" OF 1ST SUBSCRIPT DECLARATOR 
*    DIMN2 = POINTER TO "VALUE" OF 2ND SUBSCRIPT DECLARATOR 
      SPC 1 
*  RETURN:
*    A-REG = THE 15 BIT MEMORY ADDRESS OF THE ELEMENT OF THE ARRAY
* 
      SPC 1 
*  TIME:
*    ABOUT 40-50 2100A MACHING CYCLES FOR 1 DIMENSION ARRAYS. 
*    ABOUT 60-70 + 1 MPY INSTRUCTION FOR 2 DIMENSIONAL ARRAYS.
*    ABOUT 80-90 + 2 MPY INSTRUCTIONS FOR 3 DIMENSIONAL ARRAYS. 
      SPC 1 
*  NOTES: 
*    THE FORTRAN COMPILER MAY NOT USE THIS ROUTINE FOR ONE
*    DIMENSIONAL ARRAYS.  THE E-REGISTER MAY BE IGNORED IF THE
*    ENTIRE ARRAY IS CONTAINED IN ONE 32767 WORD ADDRESS SPACE. 
      SPC 1 
..MAP NOP           A=-1>1DIMS  A=0>2DIMS  A=1>3DIMS
      STB SLEN      SAVE # WORDS PER ELEMENT
      LDB ..MAP     SET THE SIGN BIT OF 
      ADB BIT15     P+1 POINTER FROM ..MAP
      STB BASE      SAVE INDIRECT POINTER TO BASE 
      INB           TO ALL THE "DEF'S" FOLLOWING
      STB S1        SAVE SUBSCRIPT ADDRESS
      SSA,RSS       CHECK IF ONE DIMENSION
      JMP T2OR3     NO, MUST BE 2 OR 3
ELSIZ INB           BUMP TO RETURN ADDRESS
      RBL,CLE,ERB   STRIP OFF BIT 15
      STB ..MAP     SET RETURN ADDRESS
      ADA S1,I      SUBSCRIPT AND ADD 
      LDB SLEN      MPY THE RESULTS BY THE NUMBER 
      CPB D1        AOF WORDS PER ELEMENT IN THE ARRAY. 
      JMP INTG      MPY BY ONE
      STA S1        SAVE A TEMP 
      CPB D4        MPY BY 4
      ALS           COMPLEX 
      ALS           MPY BY 2 (DEFAULT), REAL
      CPB D3
      ADA S1        MPY BY 3, DOUBLE PRECISION
INTG  ADA BASE,I    ADD IN THE BASE ADDRESS OF
      JMP ..MAP,I   THE ARRAY AND RETURN
      SPC 1 
T2OR3 ERA           SET E=0>2DIMS, E=1>DIMS 
      INB 
      STB S2        SUBSCRIPT 2 
      INB 
      CCA,SEZ       CHECK IF 2 OR 3 DIMENSIONS
      JMP THREE 
      STB DIM1      SAVE DIMENSION ONE LENGTH 
      STB RTN       SAVE RETURN ADDRESS 
      SPC 1 
CONT  ADA S2,I      DECREMENT SUBSCRIPT VALUE 
      MPY DIM1,I    MPY BY SUBSCRIPT 1 LENGTH 
DIM1  EQU *-1       DEFINE P+1 FROM MPY INSTRUCTION 
      ADA DM1       SUBTRACT ONE FROM 1ST 
      LDB RTN       RESTORE B-REG 
      JMP ELSIZ 
      SPC 1 
DM1   DEC -1
S1    NOP 
S2    NOP 
S3    NOP 
BASE  NOP 
BIT15 OCT 100000
SLEN  NOP 
D1    DEC 1 
D3    DEC 3 
D4    DEC 4 
      SPC 1 
THREE STB S3        SAVE 3RD SUBSCRIPT
      INB 
      STB DIM1      DIMENSION 1 LENGTH
      INB 
      STB DIM2      DIMENSION 2 LENGTH
      STB RTN       SAVE RETURN ADDRSESS
      ADA S3,I      DECREMENT 3RD SUBSCRIPT VALUE 
      MPY DIM2,I    MPY BY THE 2ND SUB DIMENSION VALUE
DIM2  EQU *-1       P+1 OF MPY INSTRUCTION
      ADA DM1       DECREMENT THE NEXT SUBSCRIPT
      JMP CONT      (EXTRA INSTR FOR TIME SAVE) 
RTN   NOP 
      END 
* 
* 
* 
* 
                              