/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/EDIT 4   9-25-70
       .TITLE .SS
/ OBJECT-TIME SYSTEM SUBROUTINE TO CALCULATE ARRAY ELEMENT ADDRESS
/ CALLING SEQUENCE...
/      JMS    .SS
/      .DSA   ARRAY          /ADDRESS (INDIRECT) OF ARRAY DESCRIPTION
/      LAC    S1             /SUBSCRIPT 1 (I)
/      LAC    S2             /SUBSCRIPT 2 (J)
/      LAC    S3             /SUBSCRIPT 3 (K)
/      DAC    .              /STORE ARRAY ELEMENT ADDRESS
/
       .GLOBL .SS,.AD
	.IFDEF TIME%
	.GLOBL TIMON,TIMOFF
	.ENDC
.SS    CAL    0
	.IFDEF TIME%
	JMS* TIMON
	.DSA 67
	.ENDC
	LAC* .SS	/INLINE .CB
	ISZ .SS
	DAC SCALC1
	SPA
	LAC* SCALC1
	DAC SCALC5		/SAVE POINTER
	TAD K00003
       DAC    SCALC1         /ADDRESS OF ARRAY DESCRIPTOR BLOCK (WD 1)
       XCT*   .SS
       TAD    K00001         / (I-1)
       DAC    SCALC2
	LAC*	SCALC1		/LOAD WORD 1
	RTL			/MODE NUMBER INTO LINK
	RTL			/AND BIT 0
	SNL!SMA!CML!CMA	/SKIP IF L=1 OR BIT 0=1
	JMP	SCALC3		/MODE NO. = 00 (INTEGER)
	SNL!SMA!CML		/SKP IF L=1 OR BIT 0=1
	JMP	SCALC3		/MODE NO. =11 (LOGICAL)
	LAC	SCALC2
	CLL!RAL!SZL		/(I-1)*2, MODE NO.=01(REAL)
	TAD	SCALC2		/(I-1)*3, MODE NO.=10(DOUBLE)
	DAC	SCALC2		/(I-1)*N
SCALC3 JMS    SCALC9         / (I-1)*N+(J-1)*N*IMAX
       JMS    SCALC9         / (I-1)*N+(J-1)*N*IMAX+(K-1)*N*IMAX*JMAX
	ISZ .SS		/BUMP TO DAC
SCALC4	LAC*   SCALC5         / ARRAY ELEMENT ADDRESS IS
       TAD    SCALC2         / ARRAY ADDRESS + SUBSCRIPT CALCULATION
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 67
	.ENDC
       JMP*   .SS
       .EJECT
/
/ SUBROUTINE TO CALCULATE ROW/COLUMN POSITION
/ CALLING SEQUENCE...
/      JMS    SCALC9
/
SCALC9 CAL    0
       ISZ    SCALC1
       LAC*   SCALC1         /ALL DIMENSION INFORMATION HAS BEEN
       ISZ    .SS
	SNA			/PROCESSED IF THE DESCRIPTION WORD IS ZERO.
	JMP SCALC4
       XCT*   .SS
       TAD    K00001         / (S-1)*D*N
       JMS*   .AD
       LAC*   SCALC1
       TAD    SCALC2
       DAC    SCALC2
       JMP*   SCALC9
K00001 .DSA   777777
SCALC2 .DSA   000000         /
SCALC1	.DSA	0	/ADDRESS OF ARRAY DESCRIPTION BLOCK (WD 4)
SCALC5	.DSA 0
K00003	.DSA 777775
       .END