CTITLESAWXYP -- WRITE X-Y RECORDS TO THE SEISPARM FILE FOR STAT 00000000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR P. COOPER 00000100 CA DESIGNER P. COOPER 00000200 CA LANGUAGE FORTRAN 00000300 CA SYSTEM IBM AND CRAY 00000412 CA WRITTEN 11-04-87 00000500 C RELEASED 12-24-87 00000611 C REVISED 02-01-88 CONVERTED FROM IBM TO CRAY 00000716 CA 00000800 CA 00000900 CA CALL SAWXYP (RVLSNO, RVX, RVY, RCMNDX, RCNRVS, DAP, *STMT) 00001010 CA 00001100 CA INPUT RVLSNO = RECEIVER LOCATION NUMBERS R4 00001200 CA INPUT RVELEV = SURVEY ELEVATIONS I4 00001300 CA INPUT RCMNDX = MINIMUM RECEIVER INDEX I4 00001400 CA INPUT RCNRVS = MAXIMUM NUMBER OF RECEIVERS I4 00001500 CA INPUT/OUTPUT DAP = DISK ADDRESS FOR WRITE I4 00001600 CA STMT = ERROR RETURN 00001700 CA 00001800 CA 00001900 CA WRITES 'GM3D' XYP PARAMETER RECORDS TO THE SEISPARM FILE. THESE00002000 CA RECORDS CONTAIN THE RECEIVER X-Y'S CREATED BY GM3D. 00002100 CAEND 00002200 C EJECT 00002300 CC ARRAYS 00002400 CC RVLSNO (1) = RECEIVER LOCATION NUMBERS R4 00002500 CC RVX (1) = SURVEY X'S R8 00002600 CC RVY (1) = SURVEY Y'S R8 00002700 CC DENTRY (104) = ARRAY CONTAINING ENTRY INFORMATION I4 00002800 CC DATTR (96) = ARRAY CONTAINING TRACE HEADER DATA I4 00002900 CC 00003000 CC VARIABLES AND CONSTANTS 00003100 CC DAP = DISK ADDRESS FOR WRITE I4 00003200 CC DCTYP = TYPE OF OUTPUT RECORD, IN THIS CASE "XYP " I4 00003300 CC NOPAR = NUMBER OF VALUES IN THE PARAMETER RECORD I4 00003400 CC RCMNDX = RECEIVER MINIMUM INDEX INTO ELEVATION ARRAY I4 00003500 CC RCNRVS = MAXIMUM INDEX INTO ELEVATION ARRAY I4 00003600 CC SRCV = STARTING RECEIVER NUMBER FOR THIS RECORD I4 00003700 C EJECT 00003800 C 00003900 SUBROUTINE SAWXYP (RVLSNO,RVX,RVY,RCMNDX,RCNRVS,DAP,*) 00004002 C 00004100 IMPLICIT INTEGER (A-Z) 00004200 C 00004300 C ARRAYS IN PARAMETER LIST. 00004400 C 00004500 REAL RVLSNO (1) 00004613 DOUBLE PRECISION RVX (1) 00004713 DOUBLE PRECISION RVY (1) 00004813 C 00004900 C INTEGER ARRAYS -- LOCAL 00005000 C 00005100 INTEGER DENTRY (104) 00005212 INTEGER DATTR (96) 00005312 C 00005400 C INTEGER VARIABLES AND CONSTANTS 00005500 C 00005600 INTEGER GM3D 00005712 INTEGER XYP 00005812 C 00006000 EQUIVALENCE (DCTYP ,DENTRY(03)) 00006100 EQUIVALENCE (SRCV ,DENTRY(04)) 00006200 CE EQUIVALENCE ( ,DENTRY(05)) 00006300 EQUIVALENCE (NOPAR ,DENTRY(06)) 00006400 CE EQUIVALENCE ( ,DENTRY(07)) 00006500 CE EQUIVALENCE ( ,DENTRY(08)) 00006600 EQUIVALENCE (DATTR(1) ,DENTRY(09)) 00006700 C 00006800 DATA GM3D /'GM3D'/ 00006912 DATA XYP /'XYP '/ 00007012 DATA DENTRY /104*0/ 00007114 C 00007300 C============================================================= 00007400 C 00007500 C 00007600 C WRITE OUT XYP PARAMETER RECORD 00007700 C ============================== 00007800 C 00007900 DENTRY(1) = GM3D 00008000 DENTRY(2) = 0 00008100 DCTYP = XYP 00008200 NOPAR = 96 00008300 NOPAR2 = 48 00008409 SRCV = RVLSNO(RCMNDX) 00008500 C 00008600 DO 100 00008700 * OUTNDX = RCMNDX, RCNRVS, 48 00008800 IF (OUTNDX+NOPAR2-1 .GT. RCNRVS) NOPAR = (RCNRVS-OUTNDX+1)*2 00009007 J = 1 00009103 DO 50 I = 1, NOPAR, 2 00010000 DATTR(I) = RVX(OUTNDX+J-1) + 0.5 00020007 DATTR(I+1) = RVY(OUTNDX+J-1) + 0.5 00030007 J = J + 1 00030303 50 CONTINUE 00030400 CALL FOWP (GM3D, 0, DAP, 104, DENTRY, *200) 00030905 SRCV = SRCV + 48 00031000 CALL ARSET (DATTR(1), 96, 0) 00031117 100 CONTINUE 00031518 C 00031600 C RETURN TO GM3D 00031700 C 00031800 GO TO 300 00031900 C 00032000 200 RETURN1 00032100 C 00032200 300 RETURN 00032300 END 00033000