CTITLESAFAN1 -- MATRIX RESAMPLING ROUTINE FOR USE BY FANA PROCESS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA 00020000 CA AUTHOR R. D. KNIGHT 00030000 CA DESIGNER R. D. KNIGHT 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA DATE WRITTEN 1981 00070000 C REVISED 11-25-86 ESN. FOR CONVERSION TO THE CRAY. 00080000 CA 00090000 CA 00100000 CA CALL SAFAN1 ( X, NX, NY, IS ) 00110000 CA 00120000 CA 00130000 CA IN/OUT ARG TYPE DESCRIPTION 00140000 CA 00150000 CA IN/OUT X R4 INPUT/OUTPUT ARRAY 00160000 CA IN/OUT NX I4 INPUT/OUTPUT ROW DIMENSION OF X 00170000 CA IN/OUT NY I4 INPUT/OUTPUT COLUMN DIMENSION OF X 00180000 CA IN IS I4 NUMERIC RESAMPLING FACTOR BY ROW OR COLUMN 00190000 CA POSITIVE INDICATES RESAMPLING BY ROW 00200000 CA NEGATIVE INDICATES RESAMPLING BY COLUMN 00210000 CA 00220000 CA 00230000 CA THIS PROGRAM RESAMPLES DATA WITHIN A 2-DIMENSIONAL ARRAY BY 00240000 CA EITHER ROW OR COLUMN. THE RESAMPLED MATRIX AND THE MODIFIED 00250000 CA NUMBER OF ROWS OR COLUMNS IS PASSED TO THE CALLING ROUTINE. 00260000 CA THE MATRIX IS ASSUMED TO BE STORED BY COLUMNS. 00270000 CA 00280000 SUBROUTINE SAFAN1 ( X, NX, NY, IS ) 00290000 C 00300000 C REAL ARRAYS--CALL LIST 00310000 C 00320000 DIMENSION X ( 1) 00330000 C 00340000 C DETERMINE TYPE OR RESAMPLING 00350000 C 00360000 IX = IS 00370000 IF(IX .GE. -1 .AND. IX .LE. 1) RETURN 00380000 IF(IX .LT. 0 ) GO TO 30 00390000 C 00400000 C RESAMPLE BY ROW 00410000 C 00420000 J = (NX-1)/IX 00430000 J1 = J + 1 00440000 C 00450000 L = 1 00460000 M = 1 00470000 C 00480000 DO 20 K = 1, NY 00490000 N = L 00500000 DO 10 I = 1 , J1 00510000 X(M) = X(N) 00520000 M = M + 1 00530000 10 N = N + IX 00540000 20 L = L + NX 00550000 C 00560000 NX = J1 00570000 RETURN 00580000 C 00590000 C RESAMPLE BY COLUMN 00600000 C 00610000 30 IX = IABS(IX) 00620000 J = (NY-1)/IX 00630000 K = 1 + IX*NX 00640000 L = 1 + NX 00650000 C 00660000 DO 40 I=1,J 00670000 CALL ARMVE ( X(K), X(L), NX ) 00680000 K = K + IX*NX 00690000 40 L = L + NX 00700000 C 00710000 NY = J + 1 00720000 C 00730000 RETURN 00740000 END 00750000