/* Implements the subroutine CSHIFT according to the Fortran function CSHIFT. */ /* Copyright (c) 2003 by R. A. Vowels. Written 8th December 2003. */ /* Al rights reserved. */ /* The result is passed back as vector A. */ CSHIFT: PROCEDURE (A, Shift); DECLARE A (*) FLOAT (18), Shift FIXED BINARY (31); DECLARE B(LBOUND(A):HBOUND(A)) FLOAT (18); DECLARE J FIXED BINARY (31); IF Shift = 0 THEN RETURN; B = A; DO J = LBOUND(A) TO HBOUND(A); A(LBOUND(A)+MOD(J-Shift-LBOUND(A), HBOUND(A)-LBOUND(A)+1)) = B(J); END; END CSHIFT; /* An alternative is to use iSUB to define the relationship between */ /* Shift and A. For example: */ /* DECLARE A (*) FLOAT(18), */ /* B (*) DEFINED A(LBOUND(A)+MOD(1SUB-Shift-LBOUND(A), HBOUND(A)-LBOUND(A)+1)) FLOAT (18); */ /* CSHIFT for a matrix: */ /* The result is passed back as matrix A. */ CSHIFT2: PROCEDURE (A, Shift); DECLARE A (*,*) FLOAT (18), Shift FIXED BINARY (31); DECLARE B(LBOUND(A,1):HBOUND(A,1), LBOUND(A,2):HBOUND(A,2)) FLOAT (18); DECLARE J FIXED BINARY (31); IF Shift = 0 THEN RETURN; B = A; DO J = LBOUND(A,1) TO HBOUND(A,1); A(LBOUND(A,1)+MOD(J-Shift-LBOUND(A,1), HBOUND(A,1)-LBOUND(A,1)+1),*) = B(J,*); END; END CSHIFT2; /* An alternative is to use iSUB to define the relationship between */ /* Shift and A. For example: */ /* DECLARE A (*,*) FLOAT(18), */ /* B (*,*) DEFINED */ /* A(LBOUND(A,1)+MOD(1SUB-Shift-LBOUND(A,1), HBOUND(A,1)-LBOUND(A,1)+1),2SUB) FLOAT (18); */ /* Implements the subroutine EOSHIFT according to the Fortran function EOSHIFT. */ /* Copyright (c) 2003 by R. A. Vowels. Written 8th December 2003. */ /* All rights reserved. */ DECLARE EOSHIFT GENERIC ( EOSHIFT1 WHEN ((*), * ), EOSHIFT1B WHEN ((*), *, *), EOSHIFT2 WHEN ((*,*), * ), EOSHIFT2B WHEN ((*,*), *, *)); /* The result is passed back as vector A. */ EOSHIFT1: PROCEDURE (A, Shift); DECLARE A (*) FLOAT (18), Shift FIXED BINARY (31); CALL EOSHIFT1B (A, Shift, 0); END EOSHIFT1; /* The result is passed back as vector A. */ EOSHIFT1B: PROCEDURE (A, Shift, Boundary); DECLARE A (*) FLOAT (18), Shift FIXED BINARY (31), Boundary FLOAT (18); DECLARE B(LBOUND(A):HBOUND(A)) FLOAT (18); DECLARE J FIXED BINARY (31); IF Shift = 0 THEN RETURN; B = A; IF Shift > 0 THEN DO; DO J = LBOUND(A) TO HBOUND(A)-Shift; A(J) = B(J+Shift); END; DO J = J TO HBOUND(A); A(J) = Boundary; END; END; ELSE DO; DO J = HBOUND(A) TO LBOUND(A)-Shift BY -1; A(J) = B(J+Shift); END; DO J = J TO LBOUND(A) BY -1; A(J) = Boundary; END; END; END EOSHIFT1B; /* EOSHIFT for a matrix: */ /* The result is passed back as matrix A. */ EOSHIFT2: PROCEDURE (A, Shift); DECLARE A (*,*) FLOAT (18), Shift FIXED BINARY (31); CALL EOSHIFT2B (A, Shift, 0); END EOSHIFT2; /* EOSHIFT for a matrix: */ /* The result is passed back as matrix A. */ EOSHIFT2B: PROCEDURE (A, Shift, Boundary); DECLARE A (*,*) FLOAT (18), Shift FIXED BINARY (31), Boundary FLOAT (18); DECLARE B(LBOUND(A,1):HBOUND(A,1), LBOUND(A,2):HBOUND(A,2)) FLOAT (18); DECLARE J FIXED BINARY (31); IF Shift = 0 THEN RETURN; B = A; IF Shift > 0 THEN DO; DO J = LBOUND(A,1) TO HBOUND(A,1)-Shift; A(J,*) = A(J+Shift,*); END; DO J = J TO HBOUND(A,1); A(J,*) = Boundary; END; END; ELSE DO; DO J = HBOUND(A,1) TO LBOUND(A,1)-Shift BY -1; A(J,*) = A(J+Shift,*); END; DO J = J TO LBOUND(A,1) BY -1; A(J,*) = Boundary; END; END; END EOSHIFT2B; 