SUBROUTINE AUTOPED C C This subroutine runs a median filter over most of the point data C to eliminate really bad stuff. C C VERSION 1.0 19 March 1989 C IMPLICIT UNDEFINED (A-Z) SAVE INTEGER *4 NMAX PARAMETER ( NMAX = 15000 ) INCLUDE 'VPLOT.INC' INTEGER *4 ICHAN, SPTR, BPTR, ISTAR, IBASE, N INTEGER *4 HISTO(200,2), HISTON, DELETED INTEGER *4 IOK(NMAX), REC(NMAX), IS(NMAX), NPTS INTEGER *4 I, J, K, LINES(5), POINTS(5), POINTER(NMAX) INTEGER *4 SYMBOL(5), ICOLOR, MASK(4), IMARK(NMAX) INTEGER *4 THISMASK, UNMASK(4), WN, SERIES REAL *4 X(NMAX), Y(NMAX), NPHOT(NMAX,4), V(NMAX,4), PHASE(NMAX,2) REAL *4 XMIN, XMAX, YMIN, YMAX, XLO, XHI, YLO, YHI REAL *4 RX, RY, TIME(NMAX), NSIG, MEAN, RMS(50) REAL *4 WCNTR, CMAG, W1, W2, VISCNT, VISAVG, PEAK, UPLIM, LOLIM REAL *4 XPLOT(100), YPLOT(100), MINRAT, FACTOR REAL *4 XPORT(2), YPORT(2) CHARACTER *1 CH, ANS CHARACTER *60 TITLE(6) LOGICAL MARKED, SLOW, HCOPY INCLUDE 'HARDCOPY.INC' C********************************************************************** DATA SYMBOL / 2, 3, 6, 13, 16 / DATA LINES / 11, 22, 33, 44, 55 / DATA POINTS / 1, 2, 3, 4, 5 / DATA MASK / 1, 2, 4, 8 / DATA UNMASK / 14, 13, 11, 7 / DATA XPORT, YPORT / .10, .90, .10, .90 / DATA HCOPY / .FALSE. / C---------------------------------------------------------------------- C Initialize histograms for phase and laser rms C DO I = 1, 200 HISTO(I,1) = 0 HISTO(I,2) = 0 END DO C HISTON = 0 C NSIG = 3.5 ! Width of the median filter C C Set up graphics here C WRITE(6,*) ' SLOW GRAPHICS (Y/N)? ' READ (5,'(A)') CH CALL CAPS(CH) IF ( CH .EQ. 'Y' ) THEN SLOW = .TRUE. ELSE SLOW = .FALSE. END IF CALL PGBEGIN(0, '/EGA', 1, 1 ) CALL PGADVANCE C DO 220 SPTR = 1, NSTAR DO 210 BPTR = 1, NBASE C---------------------------------------------------------------------- C Edit data based on number of photons C ISTAR = SLIST(SPTR) IBASE = BLIST(BPTR) MARKED = .FALSE. CALL GETSTAR ( ISTAR, IBASE, NPTS, NMAX, NPHOT,IS, $ TIME, PHASE, V, REC, IOK ) C C Set up plot. four plots per page, one for each channel. C TITLE(1) = 'POINTS' TITLE(2) = 'NUMBER OF PHOTONS / 4 ms' WRITE(TITLE(3),1205) ISTAR, IBASE TITLE(4) = ' ' WRITE(TITLE(5),1215) DATE, 1 TITLE(6) = ' ' CALL PGSCI ( 5 ) CALL PGVPORT ( XPORT(1), XPORT(2), YPORT(1), YPORT(2) ) CALL PGSCH ( 1.5 ) CALL PGMTEXT ( 'B', 1.8, 0.5, 0.5, TITLE(1) ) CALL PGMTEXT ( 'L', 2.8, 0.5, 0.5, TITLE(2) ) CALL PGMTEXT ( 'T', 2.0, 0.5, 0.5, TITLE(3) ) CALL PGMTEXT ( 'R', 2.1, 0.5, 0.5, TITLE(5) ) CALL PGSCH ( 1.0 ) CALL PGMTEXT ( 'T', 1.9, 0.5, 0.5, TITLE(4) ) CALL PGMTEXT ( 'B', 4.0, 0.5, 0.5, TITLE(6) ) DO 205 ICHAN = 1, 4 C C If this scan was done through the NDF, or a small aperature, C multiply the number of photons by an appropriate amount so that C the photometry works out ok. C IF ( IAND(NDFSTATUS(IS(1)),MASK(ICHAN)) .NE. 0 ) THEN FACTOR = NDFRATIO(ICHAN) C WRITE(6,*) ' NDF FACTOR = ', FACTOR ELSE FACTOR = 1. END IF DELETED = 0 ICOLOR = 1 N = 0 C WRITE(6,*) ' START LOOP OVER POINTS CHANNEL ', ICHAN C WRITE(6,*) ' NPTS = ', NPTS DO 150 I = 1, NPTS IF ( (I.NE.1) .AND. (IS(I).NE.IS(I-1) ) ) THEN ICOLOR = ICOLOR + 1 IF ( IAND(NDFSTATUS(IS(I)),MASK(ICHAN)) .NE. 0 ) $ THEN FACTOR = NDFRATIO(ICHAN) ELSE FACTOR = 1. END IF END IF IF ( IAND(IOK(I),MASK(ICHAN)) .NE. 0 ) GO TO 150 IF ( PHASE(I,1).GT.PHIMAX .OR. PHASE(I,1).LT.PHIMIN) $ GO TO 150 N = N + 1 X(N) = FLOAT(I) Y(N) = FACTOR * NPHOT(I,ICHAN) POINTER(N) = I IMARK(N) = ICOLOR C C Accumulate data for phase rms histogram C IF ( ICHAN .EQ. 1 ) THEN K = 10.*PHASE(I,1) + 1.5 K = MIN ( 200, MAX(K,1) ) HISTO(K,1) = HISTO(K,1) + 1 C C and for the laser rms histogram C K = 10.*PHASE(I,2) + 1.5 K = MIN ( 200, MAX(K,1) ) HISTO(K,2) = HISTO(K,2) + 1 C HISTON = HISTON + 1 END IF 150 CONTINUE C WRITE(6,*) ' FINISHED LOOP OVER POINTS ' C WRITE(6,*) ' N = ', N C C Decide on range for plot C IF ( N .LT. 2 ) GO TO 199 YMIN = Y(1) YMAX = Y(1) XMIN = X(1) XMAX = X(1) DO I = 2, N YMIN = MIN ( YMIN, Y(I) ) YMAX = MAX ( YMAX, Y(I) ) XMIN = MIN ( XMIN, X(I) ) XMAX = MAX ( XMAX, X(I) ) END DO C C Delete all points if they are all the same C IF ( YMIN .EQ. YMAX ) THEN WRITE( TITLE(1),1510) YMIN CALL LOCATE ( 0, ICHAN ) CALL WRITE_STRING ( TITLE(1)(1:44) ) DO I = 1, NPTS IOK(I) = IOR( IOK(I),MASK(ICHAN) ) END DO GO TO 199 END IF C WRITE(TITLE(2),1202) ICHAN 1202 FORMAT( 'CHAN = ', I2 ) 1205 FORMAT( 5X, ' STAR = ', I5, ' BASELINE = ', I10 ) 1215 FORMAT( A15, ' INTEGRATION =', I3, ' SAMPLES' ) C CALL PGSCI ( 5 ) CALL PGSCH ( 1.0 ) YLO = YPORT(2) - .25*FLOAT(ICHAN) * ( YPORT(2)-YPORT(1) ) YHI = YPORT(2) - .25*FLOAT(ICHAN-1)* ( YPORT(2)-YPORT(1) ) CALL PGVPORT ( XPORT(1), XPORT(2), YLO, YHI ) CALL PGMTEXT ( 'L', 2.5, 0.5, 0.5, TITLE(2) ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGWINDOW ( XLO, XHI, YLO, YHI ) IF ( ICHAN .EQ. 1 ) THEN CALL PGBOX ( 'BCMST', 0.0, 0, 'BCNST', 0.0, 0 ) ELSE IF ( ICHAN .EQ. 4 ) THEN CALL PGBOX ( 'BCNST', 0.0, 0, 'BCNST', 0.0, 0 ) ELSE CALL PGBOX ( 'BCST', 0.0, 0, 'BCNST', 0.0, 0 ) END IF CALL PGSCI ( MOD(IMARK(1)-1, 14) + 2 ) CALL PGPOINT( 1, X(1), Y(1), SYMBOL(1) ) DO I = 2, N IF ( IMARK(I) .NE. IMARK(I-1) ) THEN CALL PGSCI ( MOD(IMARK(I)-1,14) + 2 ) END IF CALL PGPOINT( 1, X(I), Y(I), SYMBOL(1) ) END DO C WRITE(6,*) ' READY TO DELETE BAD POINTS channel ', ichan C C Delete descrepant data points. C The mean and rms of the remaining points are used to C determine an updated window for final editing. C C Modified 17 Nov 1990. remove window for expected flux. C C W1 = 0.5 C W2 = 1.E5 C CALL PGSCI ( 1 ) C C Series records the number of bad points on this scan. C If series is big, then the rms is recomputed for the C scan. C C If all points have the same Y value, then the calculation of the C RMS can fail because of round off errors. C DO 190 I = 1, ICOLOR 175 CONTINUE WN = 0 MEAN = 0. RMS(I) = 0. DO J = 1, N K = POINTER(J) IF ( ( IMARK(J) .EQ. I ) .AND. $ ( IAND(IOK(K),MASK(ICHAN)) .EQ. 0 ) ) THEN MEAN = MEAN + Y(J) RMS(I) = RMS(I) + Y(J)*Y(J) WN = WN + 1 END IF END DO IF ( WN .LT. 5 ) THEN MEAN = 10000. RMS(I) = 0. C ELSE IF ( YMAX .LE. YMIN ) THEN C WRITE( TITLE(1),1510) YMIN C CALL LOCATE ( 0, ICHAN ) C CALL WRITE_STRING ( TITLE(1)(1:44) ) C MEAN = 10000. C RMS(I) = 0. ELSE MEAN = MEAN / FLOAT(WN) RMS(I) = RMS(I)/FLOAT(WN) - MEAN*MEAN IF ( RMS(I) .LE. 0.D0 ) THEN C WRITE(6,*) ' RMS <,= 0 ! ' RMS(I) = 0.D0 MEAN = -10. ELSE RMS(I) = SQRT ( RMS(I) ) END IF END IF C WRITE(6,'(A,$)') ' DELETE BASED ON ' C WRITE(6,*) ' MEAN = ', MEAN, ' RMS = ', RMS(I) SERIES = 0 DO 185 J = 1, N IF ( IMARK(J) .NE. I ) GO TO 185 K = POINTER(J) IF ( IAND(IOK(K),MASK(ICHAN)) .NE. 0 ) GO TO 185 IF ( ABS(Y(J)-MEAN) .GT. NSIG*RMS(I) ) THEN IOK(K) = IOR ( IOK(K),MASK(ICHAN) ) CALL PGPOINT( 1, X(J), Y(J), SYMBOL(1) ) SERIES = SERIES + 1 MARKED = .TRUE. DELETED = DELETED + 1 END IF 185 CONTINUE IF ( SERIES .GT. 5 ) THEN C WRITE(6,*) SERIES, ' POINTS DELETED... REDO SCAN ',I GO TO 175 ELSE C WRITE(6,*) ' SCAN ', I, ' FINISHED ' END IF 190 CONTINUE C C Delete any scan if the rms of the scan is more than two and C one half the mean rms. C WN = 0 MEAN = 0. DO 192 I = 1, ICOLOR IF ( RMS(I) .NE. 0. ) THEN MEAN = MEAN + RMS(I) WN = WN + 1 END IF 192 CONTINUE IF ( WN .GT. 2 ) THEN MEAN = MEAN / FLOAT(WN) DO I = 1, ICOLOR IF ( RMS(I).GT. 2.5*MEAN ) THEN DO 197 J = 1, N IF ( IMARK(J) .NE. I ) GO TO 197 K = POINTER(J) IOK(K) = IOR ( IOK(K),MASK(ICHAN) ) CALL PGPOINT( 1, X(J), Y(J), SYMBOL(1) ) MARKED = .TRUE. DELETED = DELETED + 1 197 CONTINUE END IF END DO END IF 199 CONTINUE C WRITE(6,*) ' FINISHED PLOTTING LOOP FOR CHANNEL ', ICHAN CALL PGSCI ( 5 ) WRITE (TITLE(1),1500) DELETED CALL EGA_RESTORE_DEFAULT CALL LOCATE ( 0, ICHAN ) CALL WRITE_STRING ( TITLE(1)(1:15) ) 205 CONTINUE CALL PGASK (SLOW) CALL PGADVANCE IF ( MARKED ) THEN CALL DELPOINT( NPTS, REC, IOK ) END IF 210 CONTINUE 220 CONTINUE CALL PGEND 1500 FORMAT ( I5, ' POINTS DELETED' ) 1510 FORMAT ( ' YMIN = YMAX = ', 1PE15.5, ' SCAN DELETED ' ) C C Make histogram of phase rms C IF ( HISTON .LT. 5 ) GO TO 250 225 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 C YMIN = 0.0 YMAX = 0.0 XMIN = 9.0 XMAX = 0.0 PHIPEAK(1) = 0.0 DO I = 1, 200 X(I) = FLOAT(I-1) / 10. Y(I) = 10. * FLOAT( HISTO(I,1) ) / FLOAT(HISTON) IF ( Y(I) .GT. YMAX ) THEN PHIPEAK(1) = X(I) END IF YMAX = MAX( Y(I), YMAX ) IF ( Y(I) .GT. 0. ) XMIN = MIN ( X(I), XMIN ) IF ( Y(I) .GT. 0. ) XMAX = MAX ( X(I), XMAX ) END DO C TITLE(1) = 'FIRST LAG OF PHASE AUTOCORRELATION' TITLE(2) = 'RELATIVE FREQUENCY' TITLE(3) = 'ALL STARS' WRITE(TITLE(4),1600) XMIN, PHIPEAK(1), XMAX 1600 FORMAT ( ' PHI MIN = ', F6.2, ' PHI REF = ', F6.2 $ ' PHI MAX = ', F6.2 ) TITLE(6) = ' ' C C Set big BLUE letters so that PGENV will leave C more room around the plot. C ICOLOR = 5 CALL PGSCI ( ICOLOR ) CALL PGSCH ( 1.5 ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGENV ( XLO, XHI, YLO, YHI, 0, 1 ) 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) ) CALL PGSCI ( IMARK(1) ) CALL PGLINE( 200, X, Y ) C C Make a histogram of the laser rms C YMIN = 0.0 YMAX = 0.0 XMIN = 0.0 XMAX = 0.0 PHIPEAK(2) = 0.0 DO I = 1, 200 X(I) = FLOAT(I-1) / 10. Y(I) = 10. * FLOAT( HISTO(I,2) ) / FLOAT(HISTON) IF ( Y(I) .GT. YMAX ) THEN PHIPEAK(2) = X(I) END IF YMAX = MAX ( Y(I), YMAX ) IF ( Y(I) .GT. 0 ) XMIN = MIN ( X(I), XMIN ) IF ( Y(I) .GT. 0 ) XMAX = MAX ( X(I), XMAX ) END DO C TITLE(1) = 'LASER RMS' TITLE(2) = 'RELATIVE FREQUENCY' TITLE(3) = 'ALL STARS' WRITE(TITLE(4),1610) XMIN, PHIPEAK(2), XMAX 1610 FORMAT ( ' LASER MIN = ', F6.2, ' LASER REF = ', F6.2 $ ' LASER MAX = ', F6.2 ) TITLE(6) = ' ' C C Set big BLUE letters so that PGENV will leave C more room around the plot. C ICOLOR = 5 CALL PGSCI ( ICOLOR ) CALL PGSCH ( 1.5 ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGENV ( XLO, XHI, YLO, YHI, 0, 1 ) 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) ) CALL PGSCI ( IMARK(1) ) CALL PGLINE( 200, X, Y ) CALL PGEND IF ( HCOPY ) THEN HCOPY = .FALSE. ELSE 240 CONTINUE WRITE(6,'(A,$)') $ ' DO YOU WANT HARD COPIES OF THE HISTOGRAMS ? ' READ(5,'(A1)') ANS CALL CAPS ( ANS ) IF ( ANS .EQ. 'Y' ) THEN HCOPY = .TRUE. GO TO 225 ELSE IF ( ANS .NE. 'N' ) THEN GO TO 240 END IF END IF C 250 CONTINUE C----------------------------------------------------------------------- C Visibility editing. Since the visibility can change significantly C through the night, a mean vis is determined for each scan. In the C narrow band filters, data more than NSIG sigma from the mean are C deleted. Channel 1, the broad band filter is a bit more of a C problem case. Visibility histograms are drawn where the data in C each scan is normalized to the mean visibility in channel 2. The C position of the primary fringe is determined, and all data with a C visibility less than 0.65 of the primary fringe is deleted on all C 4 channels. C WRITE(6,'(A,$)') $ ' Do you want to delete the data not on the central fringe? ' READ (5,'(A1)') ANS CALL CAPS ( ANS ) IF ( ANS .EQ. 'N' ) GO TO 900 C WRITE(6,*) ' Central fringe ID. The visibility in channel 1' WRITE(6,*) ' is divided by the visibility in channel 2. The' WRITE(6,*) ' visibility scale is normalized so that the peak' WRITE(6,*) ' of a hisotgram of these ratioes is at 1. Scans' WRITE(6,*) ' are deleted if the ratio falls below some value.' WRITE(6,*) ' .65-.70 deletes 2 fringes off center. ' WRITE(6,*) ' .75-.80 deletes 1 fringe off center. ' 260 CONTINUE WRITE(6,*) ' Input minimum ratio. Recommended value = .65 ' READ (5,*) MINRAT IF ( ( MINRAT .GT. 1.) .OR. ( MINRAT .LT. 0. ) ) THEN WRITE(6,*) ' YOU''VE GOT TO BE JOKING ' GO TO 260 END IF CALL PGBEGIN(0, '/EGA', 1, 1) NSIG = 3. C C Set up graphics here DO 520 SPTR = 1, NSTAR DO 510 BPTR = 1, NBASE C C Get data for this star/baseline C Edit data based on channel 1 visibility C DO I = 1, 100 HISTO(I,1) = 0 END DO HISTON = 0 ISTAR = SLIST(SPTR) IBASE = BLIST(BPTR) MARKED = .FALSE. DELETED = 0 CALL GETSTAR ( ISTAR, IBASE, NPTS, NMAX, NPHOT,IS, $ TIME, PHASE, V, REC, IOK ) C ICOLOR = 1 N = 0 DO I = 1, NPTS IF ( (I.GT.1) .AND. (IS(I).NE.IS(I-1) ) ) THEN ICOLOR = ICOLOR + 1 END IF IF ( ( PHASE(I,1) .GT. PHIMIN ) .AND. $ ( PHASE(I,1). LT. PHIMAX ) .AND. $ ( IAND(IOK(I),MASK(1)) .EQ. 0 ) .AND. $ ( IAND(IOK(I),MASK(2)) .EQ. 0 ) ) THEN N = N + 1 X(N) = FLOAT(I) Y(N) = V(I,1) POINTER(N) = I IMARK(N) = ICOLOR END IF END DO C C Normalize the channel 1 visibility to the channel 2 visibility C and histogram the result C DO 340 I = 1, ICOLOR VISAVG = 0. VISCNT = 0. DO J = 1, N IF ( IMARK(J) .EQ. I ) THEN VISAVG = VISAVG + V(POINTER(J),2) VISCNT = VISCNT + 1. END IF END DO IF ( VISCNT .LT. 5. ) THEN VISAVG = 0. ELSE VISAVG = VISAVG / VISCNT END IF DO J = 1, N IF ( IMARK(J) .EQ. I ) THEN YPLOT(1) = Y(J) / VISAVG K = 50. * YPLOT(1) + 0.5 K = MAX ( 1, MIN(K,100) ) HISTO(K,1) = HISTO(K,1) + 1 HISTON = HISTON + 1 END IF END DO 340 CONTINUE C C Collect the data for a histogram of normalized visibilities. C IF ( HISTON .LT. 25 ) GO TO 500 YMIN = 0. YMAX = 0. XMIN = 0. XMAX = 0. PEAK = 0. DO I = 1, 100 YPLOT(I) = FLOAT( HISTO(I,1) ) XPLOT(I) = FLOAT(I) / 50. IF ( YPLOT(I) .GT. YMAX ) THEN YMAX = YPLOT(I) XMAX = XPLOT(I) PEAK = XPLOT(I) ELSE IF ( YPLOT(I) .GT. 0. ) THEN XMAX = XPLOT(I) END IF END DO C C Normalize the visibilities such that the mid-point C of the high end of the visibility histogram is at 1. C UPLIM = PEAK DO I = 1, 100 IF ( (XPLOT(I).GT.PEAK).AND.(YPLOT(I).GT..9*YMAX) ) THEN UPLIM = XPLOT(I) END IF IF ( (XPLOT(I).GT.PEAK).AND.(YPLOT(I).LT.0.1*YMAX) ) THEN LOLIM = XPLOT(I) GO TO 364 END IF END DO 364 CONTINUE PEAK = 0.5 * ( LOLIM + UPLIM ) C C WRITE(6,*) ' HISTOGRAM HAS NO UPPER EDGE ' C WRITE(6,*) ' AUTOPED GOES DOWN IN FLAMES ' C WRITE(6,*) ' PEAK, XMAX = ', PEAK, XMAX C WRITE(6,*) ' YMIN, YMAX = ', YMIN, YMAX C WRITE(6,*) ' Y LIMITS = ', LOLIM, UPLIM C WRITE(6,*) ' VISCNT = ', VISCNT C WRITE(6,*) ' HISTON = ', HISTON C DO I = 1, 100 XPLOT(I) = XPLOT(I) / PEAK END DO XMAX = XMAX / PEAK C C Delete all data when channel 1 vis is less than MINRAT of PEAK C DO I = 1, ICOLOR VISAVG = 0. VISCNT = 0. DO J = 1, N IF ( IMARK(J) .EQ. I ) THEN VISAVG = VISAVG + V(POINTER(J),2) VISCNT = VISCNT + 1. END IF END DO IF ( VISCNT .LT. 5. ) THEN VISAVG = 20.0 ELSE VISAVG = VISAVG / VISCNT END IF DO J = 1, N IF ( (IMARK(J) .EQ. I ) .AND. $ ( Y(J) .LT. MINRAT*PEAK*VISAVG ) ) THEN C C This is a bad point. Delete all four channels C IOK(POINTER(J)) = 15 MARKED = .TRUE. DELETED = DELETED + 1 END IF END DO END DO C TITLE(1) = 'VISIBILITY SQUARED' TITLE(2) = 'RELATIVE FREQUENCY' WRITE(TITLE(3),1205) ISTAR, IBASE WRITE(TITLE(4),1200) 1, FILTERID(1) WRITE(TITLE(5),1215) DATE, 1 1200 FORMAT( 5X, 'CHANNEL = ', I2, 4X, A7 ) TITLE(6) = ' ' C C Set big BLUE letters so that PGENV will leave C more room around the plot. C ICOLOR = 5 CALL PGSCI ( ICOLOR ) CALL PGSCH ( 1.5 ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGENV ( XLO, XHI, YLO, YHI, 0, 1 ) 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) ) CALL PGLINE ( 100, XPLOT, YPLOT ) CALL PGSCI ( 5 ) WRITE(6,*) ' PEAK = ', PEAK CALL PGASK(SLOW) IF ( .NOT. SLOW ) CALL PGADVANCE C C Plot the channel 1 visibilities to show deleted points C YMIN = Y(1) YMAX = Y(1) XMIN = X(1) XMAX = X(1) DO I = 2, N YMIN = MIN ( YMIN, Y(I) ) YMAX = MAX ( YMAX, Y(I) ) XMIN = MIN ( XMIN, X(I) ) XMAX = MAX ( XMAX, X(I) ) END DO TITLE(1) = 'POINT' TITLE(2) = 'VISIBILITY SQUARED' ICOLOR = 5 CALL PGSCI ( ICOLOR ) CALL PGSCH ( 1.5 ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGENV ( XLO, XHI, YLO, YHI, 0, 1 ) 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 C Mark the points, deleted points come out in white C CALL PGSCI ( MOD(IMARK(1)-1, 14) + 2 ) CALL PGPOINT( 1, X(1), Y(1), SYMBOL(1) ) DO I = 2, N IF ( IMARK(I) .NE. IMARK(I-1) ) THEN CALL PGSCI ( MOD(IMARK(I)-1, 14) + 2 ) END IF CALL PGPOINT( 1, X(I), Y(I), SYMBOL(1) ) END DO CALL PGSCI (1) DO I = 1, N J = POINTER(I) IF ( IAND(IOK(J),MASK(ICHAN)) .NE. 0 ) THEN CALL PGPOINT( 1, X(I), Y(I), SYMBOL(1) ) END IF END DO 500 CONTINUE IF ( MARKED ) THEN CALL DELPOINT( NPTS, REC, IOK ) MARKED = .FALSE. END IF 510 CONTINUE 520 CONTINUE C---------------------------------------------------------- 900 CONTINUE CALL PGEND RETURN END