Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

TITLE	LOC - MACRO REWRITE OF SSP LOC
SUBTTL	TIM HILL, WCC  1973 AUG 19
COMMENT \
THE ORIGINAL AS COMPILED BY F40 IS 75 LOCATIONS LONG
AND EXECUTES FROM 32 TO 38 INSTRUCTIONS.
THE REWRITE IS 31 LOCATIONS LONG AND EXECUTES FROM 7 TO 12 INSTRUCTIONS.
THE ORIGINAL:
C
C     ..................................................................
C
C	 SUBROUTINE LOC
C
C	 PURPOSE
C	    COMPUTE A VECTOR SUBSCRIPT FOR AN ELEMENT IN A MATRIX OF
C	    SPECIFIED STORAGE MODE
C
C	 USAGE
C	    CALL LOC (I,J,IR,N,M,MS)
C
C	 DESCRIPTION OF PARAMETERS
C	    I	- ROW NUMBER OF ELEMENT
C	    J	- COLUMN NUMBER  OF ELEMENT
C	    IR	- RESULTANT VECTOR SUBSCRIPT
C	    N	- NUMBER OF ROWS IN MATRIX
C	    M	- NUMBER OF COLUMNS IN MATRIX
C	    MS	- ONE DIGIT NUMBER FOR STORAGE MODE OF MATRIX
C		   0 - GENERAL
C		   1 - SYMMETRIC
C		   2 - DIAGONAL
C
C	 REMARKS
C	    NONE
C
C	 SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C	    NONE
C
C	 METHOD
C	    MS=0   SUBSCRIPT IS COMPUTED FOR A MATRIX WITH N*M ELEMENTS
C		   IN STORAGE (GENERAL MATRIX)
C	    MS=1   SUBSCRIPT IS COMPUTED FOR A MATRIX WITH N*(N+1)/2 IN
C		   STORAGE (UPPER TRIANGLE OF SYMMETRIC MATRIX). IF
C		   ELEMENT IS IN LOWER TRIANGULAR PORTION, SUBSCRIPT IS
C		   CORRESPONDING ELEMENT IN UPPER TRIANGLE.
C	    MS=2   SUBSCRIPT IS COMPUTED FOR A MATRIX WITH N ELEMENTS
C		   IN STORAGE (DIAGONAL ELEMENTS OF DIAGONAL MATRIX).
C		   IF ELEMENT IS NOT ON DIAGONAL (AND THEREFORE NOT IN
C		   STORAGE), IR IS SET TO ZERO.
C
C     ..................................................................
C
      SUBROUTINE LOC(I,J,IR,N,M,MS)
C
      IX=I
      JX=J
      IF(MS-1) 10,20,30
   10 IRX=N*(JX-1)+IX
      GO TO 36
   20 IF(IX-JX) 22,24,24
   22 IRX=IX+(JX*JX-JX)/2
      GO TO 36
   24 IRX=JX+(IX*IX-IX)/2
      GO TO 36
   30 IRX=0
      IF(IX-JX) 36,32,36
   32 IRX=IX
   36 IR=IRX
      RETURN
      END
THE REWRITE:
\
ENTRY	LOC
LOC:	0-0		;JSA HERE (MUST BE CHANGED FOR FORTRAN-10)
	MOVE	0,@5(16)	;GET MS
	SOJL	0,GEN		;MS = 0 FOR GENERAL MATRIX
	JUMPE	0,SYM		;MS = 1 FOR SYMMETRICAL MATRIX
;HERE IF DIAGONAL MATRIX
	MOVE	0,@0(16)	;GET I
	CAME	0,@1(16)	;I = J ?
	SETZ	0,		;NO - INDICATE ELEMENT NOT IN STORAGE
	MOVEM	0,@2(16)	;RETURN IR
	JRA	16,6(16)
;HERE IF SYMMETRIC MATRIX
SYM:	MOVE	0,@0(16)	;GET I
	CAML	0,@1(16)	;I < J ?
	JRST	I.GE.J		;NO
	MOVE	1,@1(16)	;GET J
	SOJ	1,		;GIVING J - 1
	IMUL	1,@1(16)	;GIVING J * J - J
	ASH	1,-1		;DIVIDE BY 2
	ADD	0,1		;ADD TO I
	MOVEM	0,@2(16)	;RETURN IR
	JRA	16,6(16)
;HERE FOR ELEMENT IN OTHER HALF OF SYMMETRIC MATRIX
I.GE.J:	SOJ	0,		;GIVING I - 1
	IMUL	0,@0(16)	;GIVING I * I - I
	ASH	0,-1		;DIVIDE BY 2
	ADD	0,@1(16)	;ADD J
	MOVEM	0,@2(16)	;RETURN IR
	JRA	16,6(16)
;HERE FOR GENERAL MATRIX
GEN:	MOVE	0,@1(16)	;GET J
	SOJ	0,		;GIVING J - 1
	IMUL	0,@3(16)	;GIVING N * (J - 1)
	ADD	0,@0(16)	;GIVING IR
	MOVEM	0,@2(16)	;RETURN IR
	JRA	16,6(16)
END