CTITLESAHVQC -- HORIZON VELOCITY QC PRINTER PLOT C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA DESIGNER JAMES SUN CA AUTHOR JAMES SUN CA LANGUAGE CRAY FORTRAN CA SYSTEM IBM AND CRAY CA WRITTEN 02/08/89 CA C REVISED 03/31/89 JCS - REAPPLY MUTE TO THE DEPTH SECTION C REVISED 01/20/90 JJC - MODIFIED TO MEET EDP STANDARDS. C REVISED 02/05/90 JJC - RENAMED VQC TO SAHVQC. C REVISED 06/24/90 JJC - ADDED A DUMM ARGUMENT VDTM. C REVISED 07/23/90 CLJ - ALLOW PREP TO RUN ON THE IBM C CA CA CALLING PROCEDURE: CA SUBROUTINE SAHVQC(V,NXMOD,NZ,NH,IXBEG,ISINC,INDXA,INDXB,IPR,NGS, CA + VDTM) CA C CALLING ARGUMENTS CA CA INPUT V = INTERPOLATED VELOCITIES ARRAY R4 CA INPUT NXMOD = NO. OF X GRIDS OF THE MODEL I4 CA INPUT NZ = NO. OF DEPTH STEPS I4 CA INPUT NH = NO. OF HORIZONS I4 CA INPUT IXBEG = STARTING DEPTH POINT I4 CA INPUT ISINC = DEPTH POINT INCREMENT I4 CA INPUT INDXA = INDEX CORRESPONDING TO IXBEG I4 CA INPUT INDXB = INDEX CORRESPONDING TO IXEND I4 CA INPUT IPR = PRINT UNIT I4 CA INPUT NGS = NO. OF SHOTS PADDED ON EACH SIDE I4 CA (USED ONLY FOR PRESTACK DEPTH MIGRATION, VADM) CA INPUT VDTM = DATUM ELEVATION (ONLY FOR VADM) R4 C SUBROUTINE SAHVQC(V,NXMOD,NZ,NH,IXBEG,ISINC,INDXA,INDXB,IPR,NGS, 11040000 + VDTM) 11040000 C 11050000 IMPLICIT INTEGER(A-Z) C REAL V REAL T REAL VMIN REAL VMAX REAL TIC REAL VDTM C CHARACTER*1 DASH,BAR,BLANK,ALINE(101),STAR 11060000 CHARACTER*1 AA(36) 11070000 C 11080000 C DIMENSION V(NXMOD,1),T(11) 11090000 DATA DASH/'-'/,BAR/'I'/,BLANK/' '/ 11100000 DATA AA/'1','2','3','4','5','6','7','8','9','0','A','B','C','D', 11110000 + 'E','F','G','H','I','J','K','L','M','N','O','P','Q','R', 11120000 + 'S','T','U','V','W','X','Y','Z'/ 11130000 DATA STAR/'*'/ 11100000 C 11140000 C 11150000 IF(INDXA.LE.INDXB) THEN IXA=MAX0(INDXA-NGS,1) IXB=MIN0(INDXB+NGS,NXMOD) NXSKIP=(IXB-IXA)/100+1 11152000 JSIGN=1 KSIGN=ISIGN(1,ISINC) ELSE IXB=MAX0(INDXB-NGS,1) IXA=MIN0(INDXA+NGS,NXMOD) NXSKIP=(IXB-IXA)/100-1 11152000 JSIGN=-1 KSIGN=-ISIGN(1,ISINC) ENDIF C 11154000 C VMIN= 999999. 11160000 VMAX=-999999. 11170000 C C WRITE(IPR,7000) IXA,IXB,JSIGN,KSIGN 11310000 C7000 FORMAT(' IXA,IXB,JSIGN,KSIGN =',3I5) 11310000 C DO 100 IH=1,NH 11180000 DO 100 IX=IXA,IXB,JSIGN 11190000 IF(V(IX,IH) .NE. 0.) THEN 11200000 VMIN=AMIN1(VMIN,V(IX,IH)) 11210000 VMAX=AMAX1(VMAX,V(IX,IH)) 11220000 ENDIF 11230000 100 CONTINUE 11240000 C C IF(VDTM.NE.0.) THEN VMIN=AMIN1(VDTM,VMIN) VMAX=AMAX1(VDTM,VMAX) ENDIF C C C WRITE(IPR,7001) VMIN,VMAX 11310000 C CJCS IVMIN=((VMIN+0.00001)/1000.) 11250000 IVMIN=INT((VMIN+0.00001)/1000.) 11250000 CJCS IVMAX=((VMAX+999.+0.00001)/1000.) 11260000 IVMAX=INT((VMAX+999.+0.00001)/1000.) 11260000 IVMAX=MAX0(IVMAX,IVMIN+1) 11270000 VMIN=IVMIN*1000 11280000 VMAX=IVMAX*1000 11290000 NV=IVMAX-IVMIN 11300000 C C WRITE(IPR,7001) VMIN,VMAX 11310000 C7001 FORMAT(' VMIN, VMAX =',2E12.5) 11320000 C 11330000 WRITE(IPR,8000) 11350000 C 11360000 C IF(VDTM.NE.0.) THEN WRITE(IPR,8120) STAR 11360000 ENDIF C DO 120 IH=1,NH 11370000 120 WRITE(IPR,8020) IH,AA(IH) 11380000 C 11390000 C WRITE(IPR,8080) 11400000 C 11410000 C TIC=NV/10. 11420000 DO 140 I=1,11 11430000 140 T(I)=FLOAT(I-1)*TIC+IVMIN 11440000 WRITE(IPR,8100) (T(I),I=1,11) 11450000 C 11460000 C DO 160 I=1,101 11470000 ALINE(I)=DASH 11480000 IF(MOD(I-1,10) .EQ. 0) THEN 11490000 ALINE(I)=BAR 11500000 ENDIF 11510000 160 CONTINUE 11520000 WRITE(IPR,8040) (ALINE(I),I=1,101) 11530000 C 11540000 C WRITE(IPR,7002) IXA,IXB,NXSKIP 11310000 C7002 FORMAT(' IXA,IXB,NXSKIP =',3I5) 11310000 C DO 220 IX=IXA,IXB,NXSKIP 11550000 JX=(IX-INDXA)*KSIGN*IABS(ISINC)+IXBEG 11560000 DO 180 I=1,101 11570000 180 ALINE(I)=BLANK 11580000 ALINE( 1)=BAR 11590000 ALINE(101)=BAR 11600000 IF(VDTM.NE.0.) THEN JZ=NINT((VDTM-VMIN)/FLOAT(NV*1000)*100.+1) ALINE(JZ)=STAR ENDIF DO 200 IH=1,NH 11610000 IF(V(IX,IH) .NE. 0.) THEN 11620000 CJCS JZ=(V(IX,IH)-VMIN)/FLOAT(NV*1000)*100.+1.5 11630000 JZ=NINT((V(IX,IH)-VMIN)/FLOAT(NV*1000)*100.+1) 11630000 ALINE(JZ)=AA(IH) 11640000 ENDIF 11650000 200 CONTINUE 11660000 220 WRITE(IPR,8060) JX,(ALINE(I),I=1,101),JX 11670000 C 11680000 C DO 240 I=1,101 11690000 ALINE(I)=DASH 11700000 IF(MOD(I-1,10) .EQ. 0) THEN 11710000 ALINE(I)=BAR 11720000 ENDIF 11730000 240 CONTINUE 11740000 WRITE(IPR,8040) (ALINE(I),I=1,101) 11750000 C 11760000 C 8000 FORMAT(//,' ------------------------------------------------', 11770000 + /,' I HORIZON VELOCITY QC PLOT I', 11780000 + /,' ------------------------------------------------',/) 11790000 8020 FORMAT(' HORIZON',I3,' ==> ',A1) 11800000 8040 FORMAT(10X,101A1) 11810000 8060 FORMAT(4X,I5,1X,101A1,I5) 11820000 8080 FORMAT(/,5X,' SPN VELOCITY (1000 FT/SEC)') 11830000 8100 FORMAT(7X,11(F5.1,5X)) 11840000 8120 FORMAT(2X,A1,'<== REPLACEMENT VELOCITY') 11840000 C 11850000 C RETURN 11860000 END 11870000