CTITLESAPPLT -- PRINTER PLOT OF DEPTH-POINT DATUM ELEVATIONS 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR GALEN WHIPPLE 00000200 CA DESIGNER GALEN WHIPPLE 00000300 CA LANGUAGE S/370 FORTRAN H 00000400 CA SYSTEM IBM AND CRAY 00000500 CA WRITTEN 11-30-77 00000600 C REVISED MM/DD/YR BY PROGRAMMER 00000700 C REVISED 05-15-84 RDK. MADE CDPS FLOATING POINT. 00000800 C REVISED 03-12-86 DCB. CONVERTED CODE TO A SINGLE 00000900 C SOURCE FOR EXECUTION ON BOTH THE 00001000 C IBM AND CRAY SYSTEMS. 00001100 C REVISED 11-13-89 RDK. CRAY CFT77 COMPATIBILITY. 00001202 CA 00001300 CA 00001400 CA CALL SAPPLT (X,N,ANST,ANINCR,CDPS,IPR) 00001500 CA X = DATUM ELEVATION ARRAY. I2 00001600 CA N = NUMBER OF ELEMENTS IN INPUT ARRAY. I4 00001700 CA ANST = ANNOTATION START VALUE. I4 00001800 CA ANINCR = ANNOTATION INCREMENT. I4 00001900 CA CDPS = DEPTH POINT INTERVAL. R4 00002000 CA IPR = PRINTER UNIT. I4 00002100 CA 00002200 CA 00002300 CA THIS SUBROUTINE PRODUCES A PRINTER PLOT OF DEPTH-POINT 00002400 CA DATUM ELEVATIONS. 00002500 CAEND 00002600 C 00002700 C 00002800 SUBROUTINE SAPPLT (X, N, ANST, ANINCR, CDPS, IPR) 00002900 IMPLICIT INTEGER (A-Z) 00003000 INTEGER*2 X(1) 00003100 INTEGER LINE (118) 00003200 INTEGER POINT 00003300 INTEGER ASTER 00003400 INTEGER BLANK 00003500 INTEGER PLUS 00003600 REAL BB 00003700 REAL CDPS 00003800 DATA POINT /'....'/ 00003900 DATA ASTER /'****'/ 00004000 DATA BLANK /' '/ 00004100 DATA PLUS /'++++'/ 00004200 C 00004300 AMIN = 32767 00004400 AMAX = -32767 00004500 DO 10 I = 1, N 00004600 IF (X(I) .LT. AMIN) AMIN = X(I) 00004700 IF (X(I) .GT. AMAX) AMAX = X(I) 00004800 10 CONTINUE 00004900 C 00005000 BB = 10./(6.*CDPS) 00005100 BMAX = INT(117./BB) + AMIN 00005201 WRITE (IPR,9000) AMIN,CDPS,BMAX 00005300 C 00005400 IF (AMAX.EQ.0 .AND. AMIN .EQ. 0) WRITE (IPR, 9010 ) 00005500 IF (AMAX.EQ.0 .AND. AMIN .EQ. 0) GO TO 80 00005600 AA = ANST 00005700 C 00005800 DO 70 I = 1, N 00005900 C 00006000 DO 20 L = 1, 118 00006100 C 00006200 20 LINE(L) = BLANK 00006300 LINE(1) = POINT 00006400 LINE(118) = POINT 00006500 C 00006600 K = (X(I)-AMIN)*BB + 2 00006700 IF (K .LT. 118) GO TO 25 00006800 K = 116 00006900 LINE(117) = PLUS 00007000 25 CONTINUE 00007100 DO 30 L = 2, K 00007200 C 00007300 30 LINE(L) = ASTER 00007400 WRITE (IPR, 9020 ) AA,X(I), LINE 00007500 C 00007600 AA = AA + ANINCR 00007700 C 00007800 70 CONTINUE 00007900 80 RETURN 00008000 C 00008100 9000 FORMAT (//1X,' CDP',' ',' DATUM',1X,I6, 00008200 * T44,'DEPTH POINT INTERVAL =',F7.2, 00008300 * T127,I6/14X,118('-')) 00008400 C 00008500 9010 FORMAT (' PLOT SKIPPED, ALL ZEROES') 00008600 C 00008700 9020 FORMAT (1X,I6,'|',I6,118A1) 00008800 END 00008900