CTITLESAHZQC -- HORIZON DEPTH QC PRINTER PLOT C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA DESIGNER JAMES SUN CA AUTHOR JAMES SUN CA LANGUAGE 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 ZQC TO SAHZQC. C REVISED 06/24/90 JJC - ADDED A DUMM ARGUMENT ZDTM. C REVISED 07/23/90 CLJ - ALLOW PREP TO RUN ON THE IBM C CA CA CALLING PROCEDURE: CA SUBROUTINE SAHZQC(IZ,NXMOD,NZ,NH,IXBEG,ISINC,INDXA,INDXB,DZ, GS) CA IPR,NGS,ZDTM) CA C CALLING ARGUMENTS CA CA INPUT IZ = DEPTH ARRAY I4 CA INPUT NXMOD = NO. OF X GRIDS OF THE MODEL I4 CA INPUT NZ = NO. OF DEPTH STEPS I4 CA INPUT NH = NO. OF HORIZON I4 CA INPUT IXBEG = STARTING DEPTH POINT I4 CA INPUT ISINC = INCREMENT DEPTH POINT I4 CA INPUT INDXA = INDEX CORRESPOING TO IXBEG I4 CA INPUT INDXB = INDEX CORRESPOING TO IXEND I4 CA INPUT DZ = DEPTH STEP SIZE (FT) R4 CA INPUT IPR = PRINT UNIT I4 CA INPUT NGS = NO. OF SHOTS PADDED FOR EACH SIDE I4 CA (USED ONLY FOR PRESTACK DEPTH MIGRATION VADM) CA INPUT ZDTM = REPLACEMENT VELOCITY (ONLY FOR VADM) R4 C SUBROUTINE SAHZQC(IZ,NXMOD,NZ,NH,IXBEG,ISINC,INDXA,INDXB,DZ, 10340000 + IPR,NGS,ZDTM) C 10350000 IMPLICIT INTEGER(A-Z) C REAL DZ REAL T REAL TIC REAL FLOAT REAL AIZ REAL ZDTM C CHARACTER*1 DASH,BAR,BLANK,ALINE(101),STAR 10360000 CHARACTER*1 AA(36) 10370000 C 10380000 C DIMENSION IZ(NXMOD,1),T(11) 10390000 DATA DASH/'-'/,BAR/'I'/,BLANK/' '/ 10400000 DATA AA/'1','2','3','4','5','6','7','8','9','0','A','B','C','D', 10410000 + 'E','F','G','H','I','J','K','L','M','N','O','P','Q','R', 10420000 + 'S','T','U','V','W','X','Y','Z'/ 10430000 DATA STAR/'*'/ 10400000 C 10440000 C 10450000 IF(INDXA.LE.INDXB) THEN IXA=MAX0(INDXA-NGS,1) IXB=MIN0(INDXB+NGS,NXMOD) NXSKIP=(IXB-IXA)/100+1 11152000 KSIGN=ISIGN(1,ISINC) ELSE IXB=MAX0(INDXB-NGS,1) IXA=MIN0(INDXA+NGS,NXMOD) NXSKIP=(IXB-IXA)/100-1 11152000 KSIGN=-ISIGN(1,ISINC) ENDIF C 10480000 C WRITE(IPR,8000) 10470000 C 10480000 C WRITE(IPR,8120) STAR 10470000 DO 100 IH=1,NH 10490000 100 WRITE(IPR,8020) IH,AA(IH) 10500000 C 10510000 C WRITE(IPR,8080) 10520000 C 10530000 C TIC=NZ*DZ/10000. 10540000 DO 120 I=1,11 10550000 120 T(I)=FLOAT(11-I)*TIC+ZDTM/1000. 10560000 WRITE(IPR,8100) (T(I),I=1,11) 10570000 C 10580000 C DO 140 I=1,101 10590000 ALINE(I)=DASH 10600000 IF(MOD(I-1,10) .EQ. 0) THEN 10610000 ALINE(I)=BAR 10620000 ENDIF 10630000 140 CONTINUE 10640000 WRITE(IPR,8040) (ALINE(I),I=1,101) 10650000 C 10660000 C DO 200 IX=IXA,IXB,NXSKIP 10670000 JX=(IX-INDXA)*KSIGN*IABS(ISINC)+IXBEG 10680000 DO 160 I=1,101 10690000 160 ALINE(I)=BLANK 10700000 ALINE( 1)=BAR 10710000 ALINE(101)=BAR 10720000 IF(IZ(IX,1).EQ.1) THEN ALINE(101)=BAR ELSE ALINE(101)=STAR ENDIF DO 180 IH=1,NH 10730000 IF(IZ(IX,IH).GT.0 .AND. IZ(IX,IH).LE.NZ) THEN 10740000 AIZ=FLOAT(IZ(IX,IH)-1)/FLOAT(NZ)*100. 10750000 JZ=101.-AIZ 10760000 ALINE(JZ)=AA(IH) 10770000 ENDIF 10780000 180 CONTINUE 10790000 200 WRITE(IPR,8060) JX,(ALINE(I),I=1,101),JX 10800000 C 10810000 C DO 220 I=1,101 10820000 ALINE(I)=DASH 10830000 IF(MOD(I-1,10) .EQ. 0) THEN 10840000 ALINE(I)=BAR 10850000 ENDIF 10860000 220 CONTINUE 10870000 WRITE(IPR,8040) (ALINE(I),I=1,101) 10880000 C 10890000 C 8000 FORMAT(//,' ------------------------------------------------', 10900000 + /,' I HORIZON DEPTH QC PLOT I', 10910000 + /,' ------------------------------------------------',/) 10920000 8020 FORMAT(' HORIZON',I3,' ==> ',A1) 10930000 8040 FORMAT(10X,101A1) 10940000 8060 FORMAT(4X,I5,1X,101A1,I5) 10950000 8080 FORMAT(/,5X,' SPN DEPTH (1000 FT)') 10960000 8100 FORMAT(7X,11(F5.1,5X)) 10970000 8120 FORMAT(2X,A1,'<== DATUM SURFACE') 10970000 C 10980000 C RETURN 10990000 END 11000000