CTITLESAINTS -- INTERPOLATE STATICS INFORMATION BASED ON X-Y POSITIONS 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR P. COOPER 00020000 CA DESIGNER P. COOPER 00030000 CA LANGUAGE VSFORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050001 CA WRITTEN 09-21-87 00060000 C RELEASED 12-24-87 00061001 C REVISED MM-DD-YY BY PROGRAMMER FOR REASON. 00070000 C REVISED 03-04-88 JJC; FOR CRAY COMPATABILITY 00071001 C REVISED 11-13-89 RDK; FOR CRAY CFT77 COMPATIBILITY. 00072002 CA 00080000 CA 00090000 CA 00100000 CA CALL SAINTS(IPR,IXARR,IYARR,ZARR,NPTS,XMIN,XMAX,YMIN,YMAX, 00110001 CA XINT,YINT,*STMT) 00120001 CA 00130000 CA INPUT IPR = INTERNAL PRINTER UNIT I4 00140000 CA INPUT IXARR = ARRAY OF ORIGINAL X VALUES I4 00150001 CA INPUT IYARR = ARRAY OF ORIGINAL Y VALUES I4 00160001 CA INPUT ZARR = ARRAY OF ORIGINAL Z VALUES R4 00170001 CA INPUT NPTS = NUMBER OF POINTS INPUT I4 00180000 CA INPUT XMIN = MINIMUM X R4 00190000 CA INPUT XMAX = MAXIMUM X R4 00200000 CA INPUT YMIN = MINIMUM Y R4 00210000 CA INPUT YMAX = MAXIMUM Y R4 00220000 CA INPUT XINT = X INTERVAL R4 00230001 CA INPUT YINT = Y INTERVAL R4 00240001 CA INPUT *STMT = ERROR RETURN STATEMENT 00250001 CA 00260000 CA SAINTS INTERPOLATES THE SPARSELY SAMPLED INPUT DATA TO A 00270001 CA MORE FINELY SAMPLED OUTPUT GRID. 00280000 CAEND 00290000 SUBROUTINE SAINTS 00300001 * (IPR, IXARR, IYARR, ZARR, NPTS, XMIN, XMAX, YMIN, YMAX, 00310001 * XINT, YINT, *) 00320001 C 00330000 IMPLICIT INTEGER (A-Z) 00340000 C 00350000 COMMON COM(1) 00360001 C 00370001 C ARRAYS IN PARAMETER LIST 00380000 C 00390000 INTEGER IXARR (NPTS) 00400001 INTEGER IYARR (NPTS) 00410001 REAL ZARR (NPTS) 00420001 C 00430001 C REAL ARRAYS 00440001 C 00450001 REAL XTEMP (5000) 00460001 REAL YTEMP (5000) 00470001 REAL ZTEMP (5000) 00480001 REAL XCOM (1000) 00490001 EQUIVALENCE (COM(1), XCOM(1)) 00500001 C 00510000 C REAL VARIABLES 00520000 C 00530000 REAL XMIN 00540000 REAL XMAX 00550000 REAL XMAX1 00560001 REAL YMIN 00570000 REAL YMAX 00580000 REAL YMAX1 00590001 REAL ZMIN 00600000 REAL ZMAX 00610000 REAL XINT 00620000 REAL YINT 00630000 REAL RNINES 00640001 C 00650001 INTEGER FCF 00660001 DATA FCF /0/ 00661001 C 00670001 C INITIALIZE VARIABLES 00680001 C 00690001 NINES = -9999 00700001 RNINES = -9999. 00710001 ZMIN = 999999999 00720001 ZMAX = -999999999 00730001 C 00740001 C GET WORK SPACE 00750001 C 00760001 NPX = INT((XMAX - XMIN) / XINT) + 2 00770001 XMAX1 = XMIN + NPX * XINT 00780001 NPY = INT((YMAX - YMIN) / YINT) + 2 00790001 YMAX1 = YMIN + NPY * YINT 00800001 NWORDS = NPX * NPY 00830001 CALL GETMN2 (COM, NWORDS, IC, NWORDO) 00840001 IF (NWORDO .LT. NWORDS) THEN 00850001 WRITE (IPR, 9000) NWORDS, NWORDO 00860001 GO TO 60 00870001 ENDIF 00880001 OUTARR = IC + 1 00890001 C 00900001 C SET UP INPUT ARRAYS 00910001 C 00920001 INDX = 0 00930001 C 00940001 DO 10 I = 1, NPTS 00950001 IF (ZARR(I) .EQ. RNINES) GO TO 10 00960001 IF (IXARR(I) .EQ. NINES .AND. IYARR(I) .EQ. NINES) GO TO 10 00970001 INDX = INDX + 1 00980001 IF (INDX .GT. 5000) THEN 00990001 INDX = 5000 01000001 WRITE (IPR, 9010) INDX 01010001 GO TO 20 01020001 ENDIF 01030001 XTEMP(INDX) = IXARR(I) 01040001 YTEMP(INDX) = IYARR(I) 01050001 ZTEMP(INDX) = ZARR(I) 01060001 IF (ZTEMP(INDX) .LT. ZMIN) ZMIN = ZTEMP(INDX) 01070001 IF (ZTEMP(INDX) .GT. ZMAX) ZMAX = ZTEMP(INDX) 01080001 10 CONTINUE 01090001 C 01100001 C CHECK FOR NO INTERPOLATION 01110001 C 01120001 20 IF (ZMIN .EQ. ZMAX) THEN 01130001 CALL ARSET (ZARR(1), NPTS, ZMIN) 01140001 GO TO 40 01150001 ENDIF 01160001 IF (INDX .EQ. 0) GO TO 40 01170001 C 01180000 C INITIALIZE GEOPAK 01190000 C 01200000 IF (FCF .EQ. 0) THEN 01210001 CALL GPRINT (0) 01211001 CALL GROUTE ('SEL MDUMDR;EXIT') 01220001 CALL GUNIT (1, IPR) 01230001 CALL GUNIT (11, IPR) 01240001 CALL GOPEN 01250001 FCF = 1 01260001 ENDIF 01270001 C 01300000 C INTERPOLATE MISSING GRID POINTS 01310000 C USING DOUBLE LINEAR INTERPOLATION 01320001 C 01320101 CALL GBLKSI (XINT, YINT, 0.0) 01321901 CALL GLIMIT (XMIN, XMAX1, YMIN, YMAX1, ZMIN, ZMAX) 01322001 CALL GUNDEF (-9999., 0) 01330001 CALL GSMTH (-2) 01331001 CALL GINTPF(XTEMP, YTEMP, ZTEMP, INDX, XCOM(OUTARR), NPX, NPY) 01340001 CI CALL GINTP1(XTEMP, YTEMP, ZTEMP, INDX, XCOM(OUTARR), NPX, NPY) 01340101 C 01350001 C PULL OFF POINTS NEEDED 01360001 C 01370001 DO 30 I = 1, NPTS 01380001 IF (IXARR(I) .EQ. NINES .AND. 01380101 * IYARR(I) .EQ. NINES) GO TO 30 01380201 INL = INT((IXARR(I) - XMIN) / XINT + .999) 01381001 CRL = INT((IYARR(I) - YMIN) / YINT + .999) 01382001 IF (ZARR(I) .NE. RNINES) GO TO 30 01390001 INDX = INL + CRL * NPX 01440001 ZARR(I) = XCOM(OUTARR + INDX) 01450001 30 CONTINUE 01460001 C 01470001 40 CALL FREMN2 (COM(OUTARR), NWORDO) 01480001 C 01490001 RETURN 01500001 C 01510001 60 RETURN1 01520001 C 01530000 C --- FORMAT STATEMENTS --- 01540000 C 01550000 9000 FORMAT (' *** NOT ENOUGH MEMORY FOR 3D INTERPOLATION ***', 01560001 * /,' *** NEEDED ',I9,' WORDS AND ONLY GOT ',I9,' ***') 01570001 C 01580001 9010 FORMAT (' *** MORE THAN 5000 CONTROL POINTS FOR THE 3D INTERPO', 01590001 * 'LATION. ONLY THE FIRST 5000 USED. ***','*** INDX ', I5) 01600001 C 01610000 END 01620000