SUBROUTINE STARPLOT ( title, DEV) C C This subroutine invokes the Cal Teck Graphics Package (ugh!) to make C a plot of visibility versus time or hour angle for several stars. C C 29 OCT 1988 Improved treatment of bad commands. C IMPLICIT UNDEFINED(A-Z) SAVE INCLUDE 'VPLOT.INC' INTEGER *4 NS, IPLOT(20), I, J, K, L, ICOLOR, SYMBOL(5) INTEGER *4 IBASE, ISTAR, N, ICHAN REAL *4 XMIN, XMAX, YMIN, YMAX, X(1000), Y(1000), RX, RY CHARACTER *(*) DEV, TITLE(6) CHARACTER *1 CH CHARACTER *5 STARNUMB CHARACTER *70 STARLIST LOGICAL HAPLOT, CAL, HCOPY, AUTO INCLUDE 'HARDCOPY.INC' C DATA SYMBOL / 16, 3, 5, 6, 13 / C----------------------------------------------------------------------- ICHAN = 2 IBASE = 1 HCOPY = .FALSE. AUTO = .FALSE. CAL = .FALSE. HAPLOT = .FALSE. 10 CONTINUE 120 CONTINUE NS = 0 WRITE(6,'(5I5)') ( SLIST(L),L=1,NSTAR ) 130 CONTINUE WRITE(6,*) '+Enter STAR NUMBER terminate list with 0:' READ (5,*) I IF ( I .EQ. 0 ) GO TO 150 DO 140 J = 1, NSTAR IF ( I .EQ. SLIST(J) ) THEN NS = NS + 1 IPLOT(NS) = I IF ( NS .LT. 10 ) GO TO 130 GO TO 150 END IF 140 CONTINUE WRITE(6,*) ' STAR NOT IN STAR LIST ' GO TO 130 150 CONTINUE IF ( NS .EQ. 0 ) GO TO 900 C PGBEGIN will initiate PGPLOT, open the output device, and set the C device type. Since this is an interactive option, the C device is the screen. C C C Determine the range of the data, and use PGENV to set the range of the C axes and to draw a box. PGLABEL is used to label it. C 600 CONTINUE IF ( HCOPY ) THEN NPLOTS= NPLOTS + 1 WRITE(PLOTFILE(6:8),'(I3.3)') NPLOTS CALL PGBEGIN(0, PLOTFILE//PLOT_DEV, 1, 1 ) ELSE CALL PGBEGIN(0, '/EGA', 1, 1) END IF 605 CONTINUE IF ( AUTO ) THEN YMAX = 0. YMIN = 2. DO 615 L = 1, NS DO 610 I = 1, ISCAN IF ( STAR(I) .NE. IPLOT(L) ) GO TO 610 IF ( OKSCAN(I) .NE. 0 ) GO TO 610 IF ( BASE(I) .NE. BLIST(IBASE) ) GO TO 610 IF ( CAL ) THEN YMIN = MIN ( YMIN, VCAL(I,ICHAN) ) YMAX = MAX ( YMAX, VCAL(I,ICHAN) ) ELSE YMIN = MIN ( YMIN, VIS(I,ICHAN) ) YMAX = MAX ( YMAX, VIS(I,ICHAN) ) END IF 610 CONTINUE 615 CONTINUE ELSE IF ( CAL ) THEN YMIN = 0. YMAX = 1.25 ELSE YMIN = 0. YMAX = 1.05 END IF IF ( HAPLOT ) THEN XMIN = -6. XMAX = 6. ELSE XMIN = 0. XMAX = 15. END IF RY = YMIN RX = XMIN C SET COLOR FOR BACKGROUND ICOLOR = 5 CALL PGSCI ( ICOLOR ) C C Set big letters so that PGENV will leave C more room around the plot. CALL PGSCH ( 1.5 ) CALL PGENV ( XMIN, XMAX, YMIN, YMAX, 0, 1 ) C C In order, TITLE contains X-axis label C Y-axis label C The big top label. C The second top label. C The right hand label. C Information line on bottom. C IF ( HAPLOT ) THEN TITLE(1) = 'HOUR ANGLE' ELSE TITLE(1) = 'TIME (HOURS)' END IF IF ( CAL ) THEN TITLE(2) = 'CALIBRATED VISIBILITY SQUARED' ELSE TITLE(2) = 'OBSERVED VISIBILITY SQUARED' END IF TITLE(3) = DATE WRITE(TITLE(4), 1305) ICHAN, FILTERID(ICHAN) WRITE(TITLE(5), 1306) BLIST(IBASE) TITLE(6) = ' ' CALL PGMTEXT ( 'T', 2.5, 0.5, 0.5, TITLE(3) ) CALL PGSCH ( 1.0 ) CALL PGMTEXT ( 'B', 3.5, 0.5, 0.5, TITLE(1) ) CALL PGMTEXT ( 'L', 3.5, 0.5, 0.5, TITLE(2) ) CALL PGMTEXT ( 'T', 1.5, 0.5, 0.5, TITLE(4) ) CALL PGMTEXT ( 'R', 2.5, 0.5, 0.5, TITLE(5) ) CALL PGMTEXT ( 'B', 5.0, 0.5, 0.5, TITLE(6) ) C Plot the data, one star at a time ICOLOR = 1 DO 680 J = 1, NS N = 0 DO 670 I = 1, ISCAN IF ( STAR(I) .NE. IPLOT(J) ) GO TO 670 IF ( OKSCAN(I) .NE. 0 ) GO TO 670 IF ( BASE(I) .NE. BLIST(IBASE) ) GO TO 670 N = N + 1 IF ( CAL ) THEN Y(N) = VCAL(I,ICHAN) ELSE Y(N) = VIS (I,ICHAN) END IF IF ( HAPLOT ) THEN X(N) = HA(I) ELSE X(N) = HOURS(I) END IF 670 CONTINUE C C Mark each point with a symbol and connect them with a line. C ICOLOR = ICOLOR + 1 CALL PGSCI ( ICOLOR ) C K = MOD( J, 5 ) + 1 K = 1 CALL PGPOINT( N, X, Y, SYMBOL(K) ) CALL PGSLS ( K ) CALL PGLINE ( N, X, Y ) C C Identify each line with the star number. Alternate ends of the C line to help the user with overlap problems. C WRITE(STARNUMB,'(I5)') IPLOT(J) IF ( MOD(J,2) .EQ. 0 ) THEN CALL PGTEXT ( X(1)-1., Y(1), STARNUMB ) ELSE CALL PGTEXT ( X(N)+.25, Y(N), STARNUMB ) END IF 680 CONTINUE IF ( HCOPY ) THEN CALL PGEND HCOPY = .FALSE. GO TO 600 END IF C C The plot is plotted, now ask for command C Switch to text mode C CALL EGA_RESTORE_DEFAULT CALL LOCATE(0,0) 685 CONTINUE CALL WRITE_STRING ( 'Command:' ) CALL PGCURSE(RX, RY, CH ) CALL CAPS ( CH ) IF ( CH .EQ. '?' ) THEN CALL LOCATE (0, 1) CALL WRITE_STRING ( ' ? Displays this ' ) CALL LOCATE (0, 2) CALL WRITE_STRING ( ' B toggle baseline ' ) CALL LOCATE (0, 3) CALL WRITE_STRING ( ' C toggle channel ' ) CALL LOCATE (0, 4) CALL WRITE_STRING ( ' Y toggle Y axis ' ) CALL LOCATE (0, 5) CALL WRITE_STRING ( ' X toggle X axis ' ) CALL LOCATE (0, 6) CALL WRITE_STRING ( ' H make hardcopy ' ) CALL LOCATE (0, 7) CALL WRITE_STRING ( ' A add a star ' ) CALL LOCATE (0, 8) CALL WRITE_STRING ( ' D delete a star ' ) CALL LOCATE (0, 9) CALL WRITE_STRING ( ' S Scale Y axis ' ) CALL LOCATE (0,10) CALL WRITE_STRING ( ' E quit ' ) CALL LOCATE (0,11) CALL WRITE_STRING ( ' Q quit ' ) CALL LOCATE (0,12) GO TO 685 ELSE IF ( CH .EQ. 'B' ) THEN IBASE = MOD( IBASE, NBASE ) + 1 ELSE IF ( CH .EQ. 'C' ) THEN ICHAN = MOD ( ICHAN, 4 ) + 1 ELSE IF ( CH .EQ. 'X' ) THEN HAPLOT = .NOT. HAPLOT ELSE IF ( CH .EQ. 'Y' ) THEN CAL = .NOT. CAL ELSE IF ( CH .EQ. 'H' ) THEN HCOPY = .TRUE. CALL PGEND GO TO 600 ELSE IF ( CH .EQ. 'A' ) THEN CALL LOCATE(0,0) WRITE(STARLIST,'(14I5)') (SLIST(L),L=1,MIN(NSTAR,14)) CALL WRITE_STRING ( STARLIST ) CALL LOCATE(0,1) IF ( NSTAR .GT. 14 ) THEN WRITE(STARLIST,'(14I5)') (SLIST(L),L=15,MIN(NSTAR,28)) CALL WRITE_STRING ( STARLIST ) CALL LOCATE(0,2) END IF CALL WRITE_STRING ( 'Add star:' ) READ (5,*) IPLOT(NS+1) C C Check to see if this is a valid star. C DO 700 J = 1, NSTAR IF ( IPLOT(NS+1) .EQ. SLIST(J) ) THEN NS = NS + 1 GO TO 701 END IF 700 CONTINUE 701 CONTINUE ELSE IF ( CH .EQ. 'D' ) THEN CALL LOCATE(0,0) CALL WRITE_STRING ( 'Delete star:' ) READ (5,*) ISTAR L = 0 DO 710 J = 1, NS IF ( IPLOT(J) .EQ. ISTAR ) L = J 710 CONTINUE IF ( L .EQ. NS ) THEN NS = NS - 1 ELSE IF ( L .GT. 0 ) THEN DO 720 J = L+1, NS IPLOT(J-1) = IPLOT(J) 720 CONTINUE NS = NS - 1 END IF ELSE IF ( CH .EQ. 'S' ) THEN AUTO = .NOT. AUTO ELSE IF ( CH .EQ. 'Q' ) THEN GO TO 900 ELSE IF ( CH .EQ. 'E' ) THEN GO TO 900 ELSE CALL LOCATE(0,1) CALL WRITE_STRING(' BAD COMMAND' ) END IF CALL PGASK ( .FALSE. ) CALL PGADVANCE GO TO 605 900 CONTINUE CALL PGEND RETURN 1305 FORMAT ( 'CHANNEL', I3, ' = ', A7, 20X ) 1306 FORMAT ( 'BASELINE NUMBER ', I4, 20X ) END