CTITLESAAMPT -- PRODUCE A PRINTER AMPLITUDE SPECTRUM IN DB 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. CHEN 00020001 CA DESIGNER J. CHEN 00030001 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 11-14-87 00060001 CA REVISED 11-13-89 RDK. FOR CRAY CFT77 COMPATIBILITY. 00070003 CA 00160000 CA 00170000 CA CALL SAAMPT (Y, NPTS, XSTRT, XINC, ZFILL, MAXLIN, IPR) 00180001 CA INPUT Y = INPUT ARRAY. R4 00190000 CA INPUT NPTS = NUMBER OF POINTS IN Y (PROGRAM WILL I4 00200000 CA LIMIT TO 120) 00210000 CA INPUT XSTRT = FIRST VALUE FOR LABELLING X-AXIS. R4 00220000 CA INPUT XINC = INCREMENT ON X-AXIS. R4 00230000 CA INPUT ZFILL = 0 - DO NOT FILL FROM VALUE TO MIN LINE I4 00240001 CA 1 - FILL FROM VALUE TO MIN LINE 00250001 CA INPUT MAXLIN = MAXIMUM NUMBER OF LINES TO USE FOR PLOT I4 00260000 CA (PROGRAM WILL LIMIT TO 50) 00270000 CA INPUT IPR = PRINT UNIT I4 00280000 CA 00290000 CA 00300000 CA THIS SUBROUTINE PRODUCES AN X-Y PRINTER PLOT OF THE DATA IN 00310000 CA ARRAY Y. THE PLOT MAY BE A MAXIMUM OF 50 LINES (Y-DIRECTION) 00320000 CA BY 120 COLUMNS (X-DIRECTION). IF NPTS > 120 OR MAXLIN > 50 00330000 CA THE VALUES USED WILL BE 120 AND/OR 50 RESPECTIVELY. BOTH THE 00340000 CA X AND Y AXES WILL BE LABELLED. ONE EXTRA LINE IS USED TO LABEL 00350000 CA THE X AXIS (MAKING TOTAL PLOT SIZE 51 X 120). THE Y AXIS IS 00360000 CA LABELLED FROM THE MINIMUM TO MAXIMUM VALUES IN ARRAY Y. THE 00370001 CA INCREMENT IN Y WILL BE CALCULATED. THE CORRESPONDING VALUE OF 00380001 CA EACH INCREMENT IN Y WILL BE LABELLED. 00390001 C 00440000 C EJECT 00450000 C 00460000 C LOCAL CHARACTER ARRAYS AND CONSTANTS (INTERNAL TO SUBROUTINE). 00470000 C 00480000 C AXIS (125) = USED TO LABEL X-AXIS. (EQUIV. TO PAGE) A125 00490000 C PAGE (120, 50) = HOLDS ONE PAGE OF PRINT. A1 00500000 C BAR = CHARACTER ":" A1 00510000 C BLNK = CHARACTER BLANK. A1 00520000 C DASH = CHARACTER "-" A1 00530000 C STAR = CHARACTER "*" A1 00540000 C 00550000 C 00560000 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00570000 C 00580000 C IND = TEMPORARY LINE INDEX FOR CURRENT VALUE BEING PLOTTED I4 00590000 C LABI = COLUMN INDEX FOR FIRST LABEL ON X-AXIS I4 00600000 C MAXNY = MAXIMUM NUMBER OF LINES ALLOWED FOR PLOT I4 00610000 C MAXNX = MAXIMUM NUMBER OF COLUMNS ALLOWED FOR PLOT I4 00620000 C NX = NUMBER OF COLUMNS TO USE IN X DIRECTION I4 00670000 C NY = NUMBER OF LINES TO USE FOR PLOT (Y DIRECTION) I4 00680000 C POSY = LINE INDEX FOR PRINTING MID I4 00681001 C XV = TEMPORARY VALUE USED TO LABEL X AXIS R4 00690000 C YINC = INCREMENT ALONG Y AXIS R4 00700000 C ZPOSX = COLUMN INDEX FOR ZERO VALUE IN X DIRECTION I4 00710000 C ZPOSY = LINE INDEX FOR ZERO VALUE IN Y DIRECTION I4 00720000 C 00730000 C EJECT 00740000 SUBROUTINE SAAMPT (Y, NPTS, XSTRT, XINC, ZFILL, MAXLIN, IPR) 00750001 C 00760000 IMPLICIT INTEGER (A-Z) 00770000 C 00780000 C 00790000 C REAL ARRAYS IN PARAMETER LIST. 00800000 REAL Y (1) 00810000 C 00820000 C 00830000 C REAL VARIABLES IN PARAMETER LIST. 00840000 REAL XINC 00850000 REAL XSTRT 00860000 C 00870000 C 00880000 C REAL VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 00890000 REAL AMAX 00900001 REAL AMIN 00910001 REAL XV 00930000 REAL YINC 00940000 REAL YSCALE 00950001 REAL AA 00951001 C 00960000 C 00970000 C LOGICAL ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 00980000 CHARACTER*125 AXIS 00990000 CHARACTER*1 PAGE (120, 50) 01000000 C 01020000 C 01030000 C LOGICAL VARIABLES--LOCAL (INTERNAL TO SUBROUTINE). 01040000 CHARACTER*1 BAR 01050000 CHARACTER*1 BLNK 01060000 CHARACTER*1 DASH 01070000 CHARACTER*1 STAR 01080000 DATA BAR /':'/ 01090000 DATA BLNK /' '/ 01100000 DATA DASH /'-'/ 01110000 DATA STAR /'*'/ 01120000 C 01130000 C 01140000 C INTEGER VARIABLES--LOCAL (INTERNAL TO SUBROUTINE). 01150000 DATA MAXNY / 50/ 01160000 DATA MAXNX /120/ 01170000 C 01180000 NX = NPTS 01190000 IF (NPTS .GT. MAXNX) NX = MAXNX 01200000 NY = MAXLIN 01210000 IF (MAXLIN .LE. 0 .OR. MAXLIN .GT. MAXNY) NY = MAXNY 01220000 C 01230000 C FIND MINIMUM AND MAXIMUM VALUES IN Y 01240000 C 01250000 AMIN = 1.0E+60 01260001 AMAX = -1.0E+60 01270001 C 01280000 DO 10 01290000 * I = 1, NX 01300000 IF (Y(I) .LT. AMIN) AMIN = Y(I) 01310001 IF (Y(I) .GT. AMAX) AMAX = Y(I) 01320001 C 01330000 10 CONTINUE 01340000 C 01341001 C INITIALIZE THE MATRIX 01342001 C 01350000 DO 20 01600000 * I = 1, NX 01610000 C 01620000 DO 20 01630000 * J = 1, NY 01640000 PAGE(I,J) = BLNK 01650000 C 01660000 20 CONTINUE 01670000 C 01680000 C 01710000 DO 30 01720000 * I = 1, NX 01730000 C 01740000 PAGE(I,1) = DASH 01750001 PAGE(I,NY) = DASH 01751001 30 CONTINUE 01752001 C 01760000 ZPOSX = INT(- XSTRT / XINC + 1.5) 01770002 IF (ZPOSX .GT. NX) ZPOSX = NX 01780000 LABI = ZPOSX - (ZPOSX / 10) * 10 01790000 C 01800000 DO 40 01810000 * I = LABI, NX, 10 01820000 C 01830000 PAGE(I,1) = BAR 01831001 40 PAGE(I,NY) = BAR 01840001 C 01841001 C FIND THE MAX, MIN, AND SCALE IN Y DIRECTION 01842001 C 01843001 N = AMAX - AMIN + .999 01844001 INC = 6 01845001 IF (N .GT. 60) INC = 18 01846001 IF (AMAX .GT. 0.) MAX = (INT(AMAX / INC) + 1) * INC 01847001 IF (AMAX .LT. 0.) MAX = INT((AMAX / INC) * INC) 01848002 IF (AMIN .GT. 0.) MIN = INT((AMIN / INC) * INC) 01849002 IF (AMIN .LT. 0.) MIN = (INT(AMIN / INC) - 1) * INC 01849101 AMAX = MAX 01849201 AMIN = MIN 01849301 YSCALE = (NY-1) / (AMAX - AMIN) 01849401 K = NY - 1 01849501 C 01850000 DO 50 01860001 * I = 1, NX 01870000 IND = NY - (Y(I) - MIN) * YSCALE +0.5 01880001 IF (ZFILL .EQ. 1) THEN 01881001 DO 55 01882001 * J = IND, K 01883001 55 PAGE(I,J) = STAR 01890001 ENDIF 01891001 50 CONTINUE 01900001 AA = AMAX 01910001 YINC = 1. / YSCALE 01920001 POSY = 1 01930001 INCLN = INC * YSCALE + 0.5 01931001 C 01940000 DO 60 01950001 * I = 1, K 01960001 IF (I .EQ. 1) THEN 01970001 WRITE (IPR, 9000) AMAX, (PAGE(J,I),J =1, NX) 01980001 POSY = POSY + INCLN 01990001 AA = AA - YINC 02000001 ELSEIF (I .EQ. POSY) THEN 02010001 WRITE (IPR, 9000) AA, (PAGE(J,I),J = 1, NX) 02020001 POSY = POSY + INCLN 02030001 AA = AA - YINC 02040001 ELSE 02050001 WRITE (IPR, 9010) (PAGE(J,I),J =1, NX) 02060001 AA = AA - YINC 02070001 ENDIF 02080001 60 CONTINUE 02090001 C 02100000 WRITE (IPR, 9000 ) AMIN, (PAGE(J,NY), J = 1, NX) 02240001 C 02250000 C LABEL X-AXIS 02260000 C 02270000 WRITE (AXIS,FMT='(125X)') 02280000 C 02300000 DO 110 02310000 * I = LABI, NX, 10 02320000 XV = XSTRT + (I - 1) * XINC 02330000 WRITE (AXIS(I:I+4), 9020 ) XV 02340001 C 02350000 110 CONTINUE 02360000 C 02370000 WRITE (IPR, 9030 ) AXIS 02380001 C 02390000 120 RETURN 02400000 C 02410000 C 02450000 9000 FORMAT (1X,F8.3,1X,':',120A1) 02460001 C 02470000 9010 FORMAT (10X,':',120A1) 02480001 C 02490000 9020 FORMAT (F5.1) 02520001 C 02530000 9030 FORMAT (7X,A125) 02540001 C 02550000 END 02580000