CTITLESAGXYP -- PLOTTING ROUTINE FOR GM3D 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. MENDEKE 00000020 CA DESIGNER J. MENDEKE 00000030 CA LANGUAGE FORTRAN 00000040 CA SYSTEM IBM AND CRAY 00000041 CA WRITTEN 01/05/78 00000050 C REVISED 06/06/78 MENDEKE - CHANGED PLOT SCALE TO 9.0 IN. 00000060 C REVISED 06/12/78 MENDEKE - SET STRAIGHT LINE AT ANY 00000070 C AZIMUTH TO CENTER OF PLOT. 00000080 C REVISED 07/11/78 MENDEKE - REMOVED DWAT FROM PARM. LIST AND 00000090 C ASSOCIATED CODE. ALSO ADDED CODE 00000100 C TO PLOT COMPUTED X, Y FROM 'SVR' 00000110 C CARDS. 00000120 C REVISED 08/10/78 MENDEKE - FIXED TO PLOT SHOT BETWEEN STA. 00000130 C REVISED 03/24/81 EUBANKS - REVISED TO EXCEPT THE PROCESS 00000140 C OF DATA FOR ONE SHOTPOINT. 00000145 C REVISED 06/28/84 GRAY - CORRECTED ROUNDING OF SHOT X AND Y00000146 C COORDINATES TO NEAREST INTEGER. 00000147 C REVISED 11/15/84 GRAY - CORRECTED ROUNDING OF RECEIVER 00000149 C X AND Y COORDINATES TO NEAREST 00000150 C INTEGER. CORRECTED VS FORTRAN 00000151 C COMPILE ERRORS. 00000152 C REVISED 03/01/85 KNIGHT - DUAL IBM/CRAY VERSION. 00000153 C REVISED 03/20/89 TRULOCK -SINGLE SOURCE CODE FOR IBM AND CRAY00000153 C REVISED 11/13/89 KNIGHT -FOR CRAY CFT77 COMPATIBILITY. 00000153 C REVISED 02/22/90 COMPTON - ADD INDEX ARRAY TO USE WITH SHOTX 00000153 C AND SHOTY. CA 00000154 CA CALL SAGXYP (AZMTH, LINT, FILENO, SHOTPT,SHOTX,SHOTY,NOSHOT, 00000160 CA GPHONE,PHONEX,PHONEY,NOFONS,REFSH,REFGP,IPR,GRPDIS,00000180 CA NXARR) 00000180 CA INPUT AZMTH = DIRECTIONAL AZMTH OF THE LINE I4 00000200 CA INPUT LINT = LINE INTERVAL (3-D) R4 00000210 CA INPUT FILENO = ARRAY CONTAINING TAPE FILE NUMBERS. I4 00000220 CA INPUT SHOTP = ARRAY CONTAINING SHOTPOINT NUMBERS. I4 00000230 CA INPUT SHOTX = ARRAY CONTAINING X-COORDINATES OF R8 00000240 CA SHOTPOINT LOCATIONS. 00000250 CA INPUT SHOTY = ARRAY CONTAINING Y-COORDINATES OF R8 00000260 CA SHOTPOINT LOCATIONS. 00000270 CA INPUT NOSHOT = NUMBER OF SHOTPOINTS. I4 00000280 CA INPUT GPHONE = ARRAY CONTAINING GEOPHONE NUMBERS. I4 00000290 CA INPUT PHONEX = ARRAY CONTAINING X-COORDINATES OF R8 00000300 CA GEOPHONE LOCATIONS. 00000310 CA INPUT PHONEY = ARRAY CONTAINING Y-COORDINATES OF R8 00000320 CA GEOPHONE LOCATIONS. 00000330 CA INPUT NOFONS = NUMBER OF GEOPHONES. I4 00000340 CA INPUT REFSH = ARRAY CONTAINING SHOTPOINT R4 00000350 CA REFERENCE NUMBERS. 00000360 CA INPUT REFGP = ARRAY CONTAINING GEOPHONE R4 00000370 CA REFERENCE NUMBERS. 00000380 CA INPUT IPR = OUTPUT PRINTER UNIT I4 00000390 CA INPUT GRPDIS = GROUP INTERVAL (RECEIVER INTERVAL) R4 00000400 CA INPUT NXARR = INDEX ARRAY TO USE WITH SHOTX AND SHOTYI4 00000400 CA 00000410 CA SAGXYP IS CALLED BY PREPARATION ROUTINE 'GM3D' TO 00000420 CA PRODUCE A PRINTER PLOT OF SHOTPOINTS AND RECEIVER 00000430 CA STATIONS ON AN X-Y COORDINATE SYSTEM. 00000440 CC EJECT 00000450 C 00000451 SUBROUTINE SAGXYP (AZMTH,LINT,FILENO,SHOTPT,SHOTX,SHOTY,NOSHOT, 00000460 * GPHONE,PHONEX,PHONEY,NOFONS,REFSH,REFGP,IPR,GRPDIS, 00000480 * NXARR) 00000480 C 00000500 IMPLICIT INTEGER (A-Z) 00000510 C EXTERNAL S1ATP 00000520 C 00000530 C REAL ARRAYS IN PARAMETER LIST. 00000540 C 00000550 DOUBLE PRECISION SHOTX (1) 00000560 DOUBLE PRECISION SHOTY (1) 00000570 DOUBLE PRECISION PHONEX (1) 00000580 DOUBLE PRECISION PHONEY (1) 00000590 C 00000591 REAL REFSH (1) 00000600 REAL REFGP (1) 00000610 C 00000620 C INTEGER ARRAYS IN PARAMETER LIST. 00000630 C 00000640 INTEGER FILENO (1) 00000660 INTEGER SHOTPT (1) 00000670 INTEGER GPHONE (1) 00000680 INTEGER NXARR (1) 00000680 C 00000690 C INTEGER ARRAYS--LOCAL 00000700 C 00000710 INTEGER T (3) 00000740 C 00000741 C CHARACTER ARRAY -- LOCAL 00000742 C 00000743 CHARACTER*4 LINE (91) 00000744 C 00000750 C REAL VARIABLES AND CONSTANTS 00000760 C 00000770 REAL TWOPI 00000780 REAL XMAXD 00000800 REAL RINC 00000810 REAL RNUM 00000820 REAL COSANG 00000920 REAL SINANG 00000930 REAL ANG 00000940 REAL Y 00000960 REAL X 00000970 REAL DIFF 00000980 REAL MIND 00000990 REAL MAXD 00001000 REAL MINNO 00001010 REAL MAXNO 00001020 REAL GRPDIS 00001030 REAL LINT 00001040 REAL SCALY 00001050 C 00001051 DOUBLE PRECISION MINY 00001060 DOUBLE PRECISION MINX 00001070 DOUBLE PRECISION AVDEV 00001080 DOUBLE PRECISION PT5 00001081 C 00001090 C CHARACTER VARIABLES AND CONSTANTS 00001100 C 00001110 CHARACTER*4 SSSS 00001120 CHARACTER*4 OOOO 00001130 CHARACTER*4 XXXX 00001140 CHARACTER*4 PROFIL 00001160 CHARACTER*4 BLANK 00001170 CHARACTER*4 STAR 00001180 CHARACTER*4 ZERO 00001190 CHARACTER*4 ONE 00001200 CHARACTER*4 TWO 00001210 CHARACTER*4 THREE 00001220 CHARACTER*4 FOUR 00001230 CHARACTER*4 FIVE 00001240 CHARACTER*4 SIX 00001250 CHARACTER*4 SEVEN 00001260 CHARACTER*4 EIGHT 00001270 CHARACTER*4 NINE 00001280 C 00001281 C INITIALIZATION 00001282 C 00001283 DATA INTLMT / 32 / 00001340 DATA PT5 / 0.5 / 00001284 DATA TWOPI /6.283185307/ 00001285 DATA SSSS /'SSSS'/ 00001288 DATA OOOO /'OOOO'/ 00001289 DATA XXXX /'XXXX'/ 00001290 DATA PROFIL /'||||'/ 00001291 DATA BLANK /' '/ 00001292 DATA STAR /'****'/ 00001293 DATA ZERO /'0000'/ 00001294 DATA ONE /'1111'/ 00001295 DATA TWO /'2222'/ 00001296 DATA THREE /'3333'/ 00001297 DATA FOUR /'4444'/ 00001298 DATA FIVE /'5555'/ 00001299 DATA SIX /'6666'/ 00001300 DATA SEVEN /'7777'/ 00001301 DATA EIGHT /'8888'/ 00001302 DATA NINE /'9999'/ 00001303 C 00001350 C 00001350 C DETERMINE THE LINE DIRECTION 00001360 C 00001370 IF (1.EQ.2) CALL S1ATP C BNGSAV = AZMTH 00001380 IF (LINT .GT. 0.) GO TO 25 00001390 C 00001400 ANG = 450 - BNGSAV 00001410 IF (ANG .GE. 360.) ANG = ANG - 360. 00001430 ANG = ANG * TWOPI / 360. 00001440 COSANG = COS(ANG) 00001460 SINANG = SIN(ANG) 00001470 C 00001480 25 CONTINUE 00001490 C 00001500 C FIND PLOT LIMITS 00001510 C 00001520 MIND = 999999999. 00001530 MAXD = 0. 00001540 MINNO = REFSH(1) 00001550 MAXNO = REFSH(1) 00001560 C 00001574 DO 50 00001580 * I = 2,NOSHOT 00001590 IF(REFSH(I).LT.MINNO.AND.REFSH(I).GT.0) MINNO = REFSH(I) 00001600 IF(REFSH(I).GT.MAXNO) MAXNO = REFSH(I) 00001610 50 CONTINUE 00001630 C 00001646 IF(REFGP(1) .LT. MINNO) MINNO = REFGP(1) 00001650 IF(REFGP(1) .GT. MAXNO) MAXNO = REFGP(1) 00001660 MINY = PHONEY(1) 00001670 MINX = PHONEX(1) 00001680 C 00001690 DO 60 00001700 * I = 2,NOFONS 00001710 DIFF = ABS (REFGP(I)-REFGP(I-1)) 00001720 IF(DIFF .LT. MIND .AND. DIFF .NE. 0) MIND = DIFF 00001730 IF(DIFF .GT. MAXD) MAXD = DIFF 00001740 IF (PHONEY(I) .LT. MINY) MINY = PHONEY(I) 00001750 IF (PHONEX(I) .LT. MINX) MINX = PHONEX(I) 00001760 IF(REFGP(I).LT.MINNO) MINNO = REFGP(I) 00001770 IF(REFGP(I).GT.MAXNO) MAXNO = REFGP(I) 00001780 60 CONTINUE 00001800 C 00001810 DO 65 00001830 * I =1, NOSHOT 00001840 DO 65 00001850 * J = 1, NOFONS 00001860 DIFF = ABS(REFSH(I) - REFGP(J)) 00001870 IF (DIFF .LT. MIND .AND. 00001880 * DIFF .GT. .1) MIND = DIFF 00001890 C 00001900 65 CONTINUE 00001910 C 00001930 INT = MAXD / MIND + 0.5 00001940 IF(INT .GT. INTLMT) INT = INTLMT 00001941 XMAXD = MAXD 00001960 RINC = XMAXD / INT 00001970 IF(RINC .EQ. 0.) RINC = MINNO 00001980 BIGDIF = MAXNO - MINNO 00001990 C 00002000 C SET VERT AND HORZ SCALE EQUAL (6 LINES = 10 CHAR = 1.0 INCH) 00002010 C 00002020 MIN = -RINC * GRPDIS * 45 * .6 00002030 MAX = -MIN 00002040 C 00002060 C MAX FOR PRINT DO LOOP IS TOPS 00002070 C 00002080 TOPS = (BIGDIF*INT) / MAXD + 1.5 00002090 ADDON = 46.5 00002100 SCALY = RINC * GRPDIS * .6 00002110 C 00002120 C FIND AVERAGE DEVIATION FROM ROTATED X-AXIS 00002130 AVDEV = 0. 00002140 DO 68 00002150 * I = 1, NOFONS 00002160 AVDEV = AVDEV + (PHONEY(I)-MINY)*COSANG - (PHONEX(I)-MINX)*SINANG 00002170 68 CONTINUE 00002180 C 00002190 AVDEV = AVDEV / NOFONS 00002200 C 00002210 C PRINT THE PLOT HEADING 00002220 C 00002230 WRITE (IPR,9010) MIN,BNGSAV,MAX 00002240 C 00002260 C PLOT THE SHOTPOINT AND GEOPHONE LOCATIONS. 00002270 C 00002290 NN = 1 00002300 RNUM = MINNO 00002310 C 00002320 DO 140 00002330 * I = 1,TOPS 00002340 C 00002350 DO 70 00002360 * J = 1,91 00002370 70 LINE(J) = BLANK 00002390 C 00002410 N = 1 00002420 TEMP = 0 00002430 C 00002440 75 IF (N .GT. NOSHOT) GO TO 90 00002450 IF (SHOTPT(N) .LT. 0) GO TO 74 00002460 IF(REFSH(N).GE.RNUM-(RINC/2.0)) GO TO 78 00002470 74 N = N + 1 00002480 C 00002490 GO TO 75 00002500 78 IF(REFSH(N).LT.RNUM-(RINC/2.0).OR. 00002510 * REFSH(N).GE.RNUM+(RINC/2.0)) GO TO 74 00002520 IF(SHOTPT(N) .LT. 0) GO TO 74 00002530 TEMP = 1 00002540 C LWC SX = SHOTX(N) + DSIGN( PT5, SHOTX(N) ) 00002561 C LWC SY = SHOTY(N) + DSIGN( PT5, SHOTY(N) ) 00002571 SX = SHOTX(NXARR(N)) + DSIGN( PT5, SHOTX(NXARR(N)) ) 00002561 SY = SHOTY(NXARR(N)) + DSIGN( PT5, SHOTY(NXARR(N)) ) 00002561 J = ADDON 00002580 IF (LINT .GT. 0.) GO TO 76 00002590 C 00002600 C LWC Y = SHOTY(N) - MINY 00002610 C LWC X = SHOTX(N) - MINX 00002620 Y = SHOTY(NXARR(N)) - MINY 00002610 X = SHOTX(NXARR(N)) - MINX 00002610 Y = Y*COSANG - X*SINANG - AVDEV 00002640 Y = Y / SCALY 00002650 IF (ABS(Y) .LT. .5) Y = 0.0 00002660 J = Y + ADDON 00002670 C 00002680 76 CONTINUE 00002690 IF(J .LT. 1) LINE(1) = XXXX 00002700 IF(J .LT. 1) LINE(2) = STAR 00002710 IF(J .LT. 1) J = 1 00002720 IF(J .GT. 91) LINE(90) = XXXX 00002730 IF(J .GT. 91) LINE(91) = STAR 00002740 IF(J .GT. 91) J = 91 00002750 IF(J.GE.1 .AND. J.LE.91) LINE(J) = XXXX 00002760 CALL S1BNCV (SHOTPT(N),T,1,5) 00002770 IF(J .GT. 8) CNT = J-8 00002780 IF(J .LE. 8) CNT = J+2 00002790 KNT = 1 00002800 LINE(CNT) = SSSS 00002810 CNT = CNT + 1 00002820 LINE(CNT) = BLANK 00002830 CNT = CNT + 1 00002840 C 00002850 DO 80 00002860 * II = 1,5 00002870 LINE(CNT) = ZERO 00002880 IF(S1CPCH(T,KNT,'1',1,1).EQ.0) LINE(CNT)=ONE 00002890 IF(S1CPCH(T,KNT,'2',1,1).EQ.0) LINE(CNT)=TWO 00002900 IF(S1CPCH(T,KNT,'3',1,1).EQ.0) LINE(CNT)=THREE 00002910 IF(S1CPCH(T,KNT,'4',1,1).EQ.0) LINE(CNT)=FOUR 00002920 IF(S1CPCH(T,KNT,'5',1,1).EQ.0) LINE(CNT)=FIVE 00002930 IF(S1CPCH(T,KNT,'6',1,1).EQ.0) LINE(CNT)=SIX 00002940 IF(S1CPCH(T,KNT,'7',1,1).EQ.0) LINE(CNT)=SEVEN 00002950 IF(S1CPCH(T,KNT,'8',1,1).EQ.0) LINE(CNT)=EIGHT 00002960 IF(S1CPCH(T,KNT,'9',1,1).EQ.0) LINE(CNT)=NINE 00002970 C 00002980 KNT = KNT + 1 00002990 CNT = CNT + 1 00003000 C 00003010 80 CONTINUE 00003020 C 00003030 WRITE (IPR, 9020 ) FILENO(N),SX,SY, LINE 00003040 WRITE (IPR, 9030 ) LINE 00003060 C 00003080 90 IF(REFGP(NN).LT.RNUM-(RINC/2.0) .OR. 00003090 * REFGP(NN).GE.RNUM+(RINC/2.0)) GO TO 120 00003100 C 00003110 J = ADDON 00003120 PX = PHONEX(NN) + DSIGN( PT5, PHONEX(NN) ) 00003130 PY = PHONEY(NN) + DSIGN( PT5, PHONEY(NN) ) 00003140 IF (LINT .GT. 0.) GO TO 95 00003160 C 00003170 Y = PHONEY(NN) - MINY 00003180 X = PHONEX(NN) - MINX 00003190 Y = Y*COSANG - X*SINANG - AVDEV 00003210 Y = Y / SCALY 00003220 IF (ABS(Y) .LT. .5) Y = 0.0 00003230 J = Y + ADDON 00003240 C 00003250 95 IF(J .LT. 1) LINE(1) = OOOO 00003260 IF(J .LT. 1) LINE(2) = STAR 00003270 IF(J .GT. 91) LINE(90) = OOOO 00003280 IF(J .GT. 91) LINE(91) = STAR 00003290 IF(J.GE.1 .AND. J.LE.91) LINE(J) = OOOO 00003300 IF(TEMP .EQ. 1) GO TO 100 00003320 C 00003310 WRITE (IPR, 9040 ) GPHONE(NN),PX,PY,LINE 00003330 GO TO 110 00003340 C 00003350 100 WRITE (IPR, 9050 ) GPHONE(NN),PX,PY,LINE 00003360 C 00003370 110 NN = NN + 1 00003380 GO TO 130 00003390 C 00003400 120 IF(TEMP .EQ. 0) WRITE(IPR, 9060 ) LINE 00003410 C 00003420 130 RNUM = RNUM + RINC 00003430 C 00003440 LINE (1) = PROFIL 00003450 LINE (46)= PROFIL 00003460 LINE (91)= PROFIL 00003470 WRITE (IPR,9030) LINE 00003480 C 00003520 140 CONTINUE 00003530 C 00003540 WRITE (IPR, 9070 ) MIN,BNGSAV,MAX 00003550 C 00003560 RETURN 00003570 C 00003580 C ****** FORMATS ****** 00003620 C 00003620 9010 FORMAT (1X,132('-'),/,' FILE',7X,'SHOTPOINT|', 00003630 * ' RECEIVER STATION |MIN =',I8,20X,'LINE AZIMUTH =', 00003640 * I4,' DEGREES',T120,'MAX =',I8,'|', 00003650 * /,' NO.',7X,'X',7X,'Y| NO.',7X,'X',7X, 00003660 * 'Y|',T133,'|',/1X,132('-'),/21X,'|',20X,'|',T133,'|') 00003670 C 00003690 9020 FORMAT (' ',I4,2I8,'|',20X,91A1) 00003700 C 00003710 9030 FORMAT ('+',41X,91A1) 00003720 C 00003730 9040 FORMAT (21X,'|',I4,2I8,91A1) 00003740 C 00003750 9050 FORMAT ('+',20X,'|',I4,2I8,91A1) 00003760 C 00003770 9060 FORMAT (21X,'|',20X,91A1) 00003780 C 00003800 9070 FORMAT (1X,132('-'),/,' FILE',7X,'SHOTPOINT|', 00003810 * ' RECEIVER STATION |MIN =',I8,20X,'LINE AZIMUTH =', 00003820 * I4,' DEGREES',T120,'MAX =',I8,'|', 00003830 * /,' NO.',7X,'X',7X,'Y| NO.',7X,'X',7X, 00003840 * 'Y|',T133,'|',/1X,132('-')) 00003850 C 00003870 END 00003880