/* 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;