SUBROUTINE NCALIB C C This subroutine plots system sensitivity versus color C does a linear fit to the data, allows the user to delete C points and and will make hard copies on request. C IMPLICIT UNDEFINED(A-Z) SAVE INCLUDE 'VPLOT.INC' INTEGER *4 I, J, ICOLOR, SYMBOL(5), ICHAN, IPLOT, K INTEGER *4 WHATSCAN(CNT), MASK(4), OKFLUX(CNT), COUNT(CNT) INTEGER *4 ISTAR, IMARK, ICUR REAL *4 XMIN, XMAX, YMIN, YMAX, RX, RY, DX, DY, XLO, XHI REAL *4 YLO, YHI, RMS, BARX(2), BARY(2), DELTA, CHISQ REAL *4 NEWMAG, NEWBV, GOODRMS, AVG, MINERR REAL *4 DIST, DIST2, XPLOT(CNT), YPLOT(CNT), YFIT(CNT) REAL *4 XLINE(2), YLINE(2), ERROR(CNT), SCALE, NPHOT, MAGLIM CHARACTER *40 TITLE(6), INS, LINE CHARACTER * 1 CH LOGICAL HCOPY INCLUDE 'HARDCOPY.INC' C DATA SYMBOL / 16, 3, 5, 6, 13 / DATA ICHAN / 1 / DATA MASK / 1, 2, 4, 8 / DATA MINERR / .02 / C----------------------------------------------------------------------- ICUR = 1 HCOPY = .FALSE. C C OKFLUX marks deleted scans. Scans deleted with the delete options C within this subroutine are restored before returning to the main C program C DO I = 1, ISCAN OKFLUX(I) = OKSCAN(I) DO J = 1, 4 IF ( D(I,J) .GE. BDEN(I,J) ) $ OKFLUX(I) = IOR( OKFLUX(I),MASK(J) ) END DO END DO C 200 CONTINUE IF ( HCOPY ) THEN NPLOTS= NPLOTS + 1 WRITE(PLOTFILE(6:8),'(I3.3)') NPLOTS CALL PGBEGIN(0, PLOTFILE//PLOT_DEV, 1, 1 ) WRITE(6,*) ' CREATING FILE ', PLOTFILE ELSE CALL PGBEGIN(0, '/EGA', 1, 1) END IF 210 CONTINUE C----------------------------------------------------------------------- C Determine the observed magnitude and error for each star IF ( NDFRATIO(ICHAN) .EQ. 0. ) NDFRATIO(ICHAN) = 1. DO 240 I = 1, NSTAR XPLOT(I) = 0. YPLOT(I) = 0. ERROR(I) = 0. COUNT(I) = 0 DO 230 K = 1, ISCAN IF ( STAR(K) .NE. SLIST(I) ) GO TO 230 IF ( IAND(OKFLUX(K),MASK(ICHAN)) .NE. 0 ) GO TO 230 NPHOT = BDEN(K,ICHAN) - D(K,ICHAN) IF ( IAND(NDFSTATUS(K),MASK(ICHAN)) .NE. 0 ) THEN NPHOT = NDFRATIO(ICHAN) * NPHOT END IF YPLOT(I) = YPLOT(I) + NPHOT ERROR(I) = ERROR(I) + NPHOT*NPHOT COUNT(I) = COUNT(I) + 1 230 CONTINUE 240 CONTINUE YMAX = -1.E6 YMIN = 1.E6 XMAX = -1.E6 XMIN = 1.E6 DO 260 I = 1, NSTAR IF (COUNT(I) .GT. 1 ) THEN XPLOT(I) = BV(I) NPHOT = YPLOT(I) / FLOAT(COUNT(I)) ERROR(I) = SQRT( ERROR(I)/FLOAT(COUNT(I)) - NPHOT*NPHOT ) C C Convert from number of photons to magnitude C IF ( NPHOT .LT. 0. ) THEN YPLOT(I) = 1.E6 XPLOT(I) = 1.E6 ELSE MAGLIM = 2.5*LOG10( NPHOT ) YPLOT(I) = MAGLIM + MAG(I) ERROR(I) = 2.5*LOG10( NPHOT+ERROR(I) ) - MAGLIM ERROR(I) = MAX ( ERROR(I), MINERR ) XMAX = MAX ( XMAX, XPLOT(I) ) XMIN = MIN ( XMIN, XPLOT(I) ) YMAX = MAX ( YMAX, YPLOT(I) ) YMIN = MIN ( YMIN, YPLOT(I) ) END IF ELSE YPLOT(I) = 1.E6 XPLOT(I) = 1.E6 END IF 260 CONTINUE XLINE(1) = XMIN XLINE(2) = XMAX C----------------------------------------------------------------------- C Fit a line through the data, determine the color term and C system magnitude for this channel C CALL POLYFIT( XPLOT, YPLOT, ERROR, YFIT, NSTAR, XMIN, XMAX, $ YMIN, YMAX, 1, XLINE, YLINE, 2, NCAL_RMS(ICHAN)) CTERM(ICHAN) = (YLINE(2) - YLINE(1)) / (XLINE(2) - XLINE(1) ) MAG0 (ICHAN) = YLINE(1) - CTERM(ICHAN)*XLINE(1) C----------------------------------------------------------------------- C Make the plot 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, YHI, YLO, 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 TITLE(1) = '(B-V)' TITLE(2) = 'MAGNITUDE FOR 1 COUNT / 4 MS' TITLE(3) = DATE WRITE(TITLE(4), 1305) ICHAN, FILTERID(ICHAN) TITLE(5) = ' ' WRITE( TITLE(6),1310) MAG0(ICHAN), CTERM(ICHAN), NCAL_RMS(ICHAN) 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 CALL PGSCI ( 2 ) CALL PGLINE( 2, XLINE, YLINE ) CALL PGSCI ( 3 ) DO 280 I = 1, NSTAR IF ( XPLOT(I) .GT. XMAX ) GO TO 280 BARX(1) = XPLOT(I) BARX(2) = XPLOT(I) BARY(1) = YPLOT(I) - ERROR(I) BARY(2) = YPLOT(I) + ERROR(I) CALL PGLINE( 2, BARX, BARY ) 280 CONTINUE C----------------------------------------------------------------------- C process hard copy request IF ( HCOPY ) THEN CALL PGEND HCOPY = .FALSE. GO TO 200 END IF C----------------------------------------------------------------------- C ask for command 300 CONTINUE RX = XPLOT(ICUR) RY = YPLOT(ICUR) CALL EGA_RESTORE_DEFAULT 320 CONTINUE CALL LOCATE(0,0) CALL WRITE_STRING ( 'Command:' ) CALL PGCURSE(RX, RY, CH ) CALL CAPS ( CH ) C----------------------------------------------------------------------- C Display help IF ( CH .EQ. '?' ) THEN CALL LOCATE (0, 1) CALL WRITE_STRING ( ' ? Displays this ' ) CALL LOCATE (0, 2) CALL WRITE_STRING ( ' C change channel ' ) CALL LOCATE (0, 3) CALL WRITE_STRING ( ' H make hardcopy ' ) CALL LOCATE (0, 4) CALL WRITE_STRING ( ' I identify nearest point' ) CALL LOCATE (0, 5) CALL WRITE_STRING ( ' D delete nearest point ' ) CALL LOCATE (0, 6) CALL WRITE_STRING ( ' E expand ' ) CALL LOCATE (0, 7) CALL WRITE_STRING ( ' N NDF flag ' ) CALL LOCATE (0, 8) CALL WRITE_STRING ( ' F fit magnitude/color ' ) CALL LOCATE (0, 9) CALL WRITE_STRING ( ' Q quit ' ) CALL LOCATE (0,10) GO TO 320 C----------------------------------------------------------------------- C change channels ELSE IF ( CH .EQ. 'C' ) THEN ICHAN = MOD ( ICHAN, 4 ) + 1 C----------------------------------------------------------------------- C Make a hard copy ELSE IF ( CH .EQ. 'H' ) THEN HCOPY = .TRUE. CALL PGEND GO TO 200 C----------------------------------------------------------------------- C Go to the next star C ELSE IF ( CH .EQ. 'R' ) THEN ICUR = MOD(ICUR,NSTAR) + 1 CALL LOCATE ( 1, 0 ) WRITE(6,*) ' STAR ', SLIST(ICUR), ' ', COUNT(ICUR), ' SCANS' GO TO 300 C----------------------------------------------------------------------- C identify the closest plotted point ELSE IF ( CH .EQ. 'I' ) THEN SCALE = (XMAX-XMIN)*(XMAX-XMIN) / ((YMAX-YMIN)*(YMAX-YMIN)) DIST = (XMAX-XMIN)*(XMAX-XMIN) + $ SCALE*(YMAX-YMIN)*(YMAX-YMIN) J = 0 DO I = 1, NSTAR DX = XPLOT(I) - RX DY = YPLOT(I) - RY DIST2 = DX*DX + SCALE*DY*DY IF ( DIST2 .LT. DIST ) THEN DIST = DIST2 J = I END IF END DO IF ( J .EQ. 0 ) THEN WRITE(6,*) ' INTERNAL ERROR IN IDENTIFY ROUTINE ' ELSE WRITE(6,*) ' THIS POINT IS FOR STAR ', SLIST(J) WRITE(6,*) ' THERE ARE ', COUNT(J), ' SCANS ON THIS STAR' ICUR = J RX = XPLOT(J) RY = YPLOT(J) END IF GO TO 320 C----------------------------------------------------------------------- C delete the closest plotted point C This is from this plotting only ELSE IF ( CH .EQ. 'D' ) THEN SCALE = (XMAX-XMIN)*(XMAX-XMIN) / ((YMAX-YMIN)*(YMAX-YMIN)) DIST = (XMAX-XMIN)*(XMAX-XMIN) + $ SCALE*(YMAX-YMIN)*(YMAX-YMIN) J = 0 DO 420 I = 1, NSTAR DX = XPLOT(I) - RX DY = YPLOT(I) - RY DIST2 = DX*DX + SCALE*DY*DY IF ( DIST2 .LT. DIST ) THEN DIST = DIST2 J = I END IF 420 CONTINUE IF ( J .EQ. 0 ) THEN WRITE(6,*) ' INTERNAL ERROR IN DELETE ROUTINE ' GO TO 320 ELSE ISTAR = SLIST(J) END IF DO 430 I = 1, ISCAN IF ( ISTAR .EQ. STAR(I) ) THEN OKFLUX(I) = IOR ( OKFLUX(I), MASK(ICHAN) ) END IF 430 CONTINUE C----------------------------------------------------------------------- C Expand/ edit the data for the nearest star. C ELSE IF ( CH .EQ. 'E' ) THEN SCALE = (XMAX-XMIN)*(XMAX-XMIN) / ((YMAX-YMIN)*(YMAX-YMIN)) DIST = (XMAX-XMIN)*(XMAX-XMIN) + $ SCALE*(YMAX-YMIN)*(YMAX-YMIN) J = 0 DO 440 I = 1, NSTAR DX = XPLOT(I) - RX DY = YPLOT(I) - RY DIST2 = DX*DX + SCALE*DY*DY IF ( DIST2 .LT. DIST ) THEN DIST = DIST2 J = I END IF 440 CONTINUE IF ( J .EQ. 0 ) THEN WRITE(6,*) ' INTERNAL ERROR IN EXPAND ROUTINE ' GO TO 320 END IF ISTAR = SLIST(J) IMARK = 1 C C Plot the magnitude of this star versus time. C 450 CONTINUE YMIN = 1.E6 YMAX = -1.E6 IPLOT = 0 DO 460 I = 1, ISCAN IF ( STAR(I) .NE. ISTAR ) GO TO 460 IF ( IAND(OKFLUX(I),MASK(ICHAN)) .NE. 0 ) GO TO 460 IPLOT = IPLOT + 1 XPLOT(IPLOT) = HOURS(I) NPHOT = BDEN(I,ICHAN) - D(I,ICHAN) YPLOT(IPLOT) = MAG(J) + 2.5*LOG10( NPHOT ) WHATSCAN(IPLOT) = I YMIN = MIN ( YMIN, YPLOT(IPLOT) ) YMAX = MAX ( YMAX, YPLOT(IPLOT) ) 460 CONTINUE XMIN = XPLOT(1) XMAX = XPLOT(IPLOT) TITLE(1) = 'TIME (HOURS) ' TITLE(6) = ' ' CALL PGSCI ( 5 ) CALL PGSCH ( 1.5 ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGENV ( XLO, XHI, YHI, YLO, 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 ( 2 ) CALL PGLINE ( IPLOT, XPLOT, YPLOT ) CALL PGPOINT( IPLOT, XPLOT, YPLOT, SYMBOL(1) ) RX = XPLOT(IMARK) RY = YPLOT(IMARK) CALL EGA_RESTORE_DEFAULT CALL LOCATE(0,0) CALL WRITE_STRING ( 'Any character to continue' ) CALL PGCURSE(RX, RY, CH ) CALL CAPS ( CH ) IF ( CH .EQ. '?' ) THEN CALL LOCATE ( 0, 0 ) CALL WRITE_STRING( ' ? this help screen ' ) CALL LOCATE ( 0, 1 ) CALL WRITE_STRING( ' R move curser to right ' ) CALL LOCATE ( 0, 2 ) CALL WRITE_STRING( ' D delete marked scan ' ) CALL LOCATE ( 0, 3 ) CALL WRITE_STRING( ' E exit to main menu ' ) ELSE IF ( CH .EQ. 'R' ) THEN IMARK = MOD(IMARK,IPLOT) + 1 ELSE IF ( CH .EQ. 'D' ) THEN OKFLUX(WHATSCAN(IMARK)) = $ IOR ( OKFLUX(WHATSCAN(IMARK)),MASK(ICHAN) ) ELSE IF ( CH .EQ. 'Q' ) THEN GO TO 210 ELSE WRITE(6,*) ' BAD COMMAND ' END IF GO TO 450 C----------------------------------------------------------------------- C Flag scans that had the neutral density filter in place. C ELSE IF ( CH .EQ. 'N' ) then YMIN = 1.E36 YMAX = -1.E36 XMIN = 1.E36 XMAX = -1.E36 DO I = 1, ISCAN XPLOT(I) = HOURS(I) YPLOT(I) = -999. NPHOT = BDEN(I,ICHAN) - D(I,ICHAN) IF ( ( IAND(OKSCAN(I),MASK(ICHAN)) .EQ. 0 ) .AND. $ ( NPHOT .GT. 0. ) ) THEN DO J = 1, NSTAR IF ( STAR(I) .EQ. SLIST(J) ) THEN YPLOT(I) = MAG(J) + 2.5*LOG10(NPHOT) $ - MAG0(ICHAN) - CTERM(ICHAN)*BV(J) END IF END DO YMIN = MIN ( YMIN, YPLOT(I) ) YMAX = MAX ( YMAX, YPLOT(I) ) XMIN = MIN ( XMIN, XPLOT(I) ) XMAX = MAX ( XMAX, XPLOT(I) ) END IF END DO C----------------------------------------------------------------------- C Plot the reduced system magnitude versus time 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, YHI, YLO, 0, 1 ) TITLE(1) = 'TIME(HOURS)' TITLE(2) = 'REDUCED SYSTEM MAGNITUDE' TITLE(3) = DATE WRITE(TITLE(4), 1305) ICHAN, FILTERID(ICHAN) TITLE(5) = ' ' 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) ) CALL PGSCI ( 3 ) DO I = 1, ISCAN IF ( IAND( NDFSTATUS(I),MASK(ICHAN) ) .EQ. 0 ) THEN CALL PGSCI(5) ELSE CALL PGSCI(2) END IF CALL PGPOINT( 1, XPLOT(I), YPLOT(I), 9 ) END DO C C ask for command I = 1 520 CONTINUE RX = XPLOT(I) RY = YPLOT(I) CALL EGA_RESTORE_DEFAULT CALL PGCURSE(RX, RY, CH ) CALL CAPS ( CH ) IF ( CH .EQ. 'R' ) THEN C Move cursor to right I = MOD(I,ISCAN) + 1 ELSE IF( CH .EQ. 'L' ) THEN C Move cursor to left I = MOD(I+ISCAN-2,ISCAN) + 1 ELSE IF ( CH .EQ. 'M' ) THEN C Mark the point and move cursor to right NDFSTATUS(I) = IOR( NDFSTATUS(I),MASK(ICHAN) ) CALL PGSCI(2) CALL PGPOINT( 1, XPLOT(I), YPLOT(I), 9 ) I = MOD(I,ISCAN) + 1 ELSE IF ( CH .EQ. 'I' ) THEN C Identify this scan C CALL LOCATE (0,1) WRITE(LINE,'(2(A,I5))') ' SCAN = ', I, ' STAR = ', STAR(I) CALL WRITE_STRING( LINE ) ELSE IF ( CH .EQ. 'U' ) THEN C Unmark the point and move cursor to right NDFSTATUS(I) = IOR( NDFSTATUS(I),MASK(ICHAN) ) $ - MASK(ICHAN) CALL PGSCI(5) CALL PGPOINT( 1, XPLOT(I), YPLOT(I), 9 ) I = MOD(I,ISCAN) + 1 ELSE IF ( CH .NE. 'Q' ) THEN C This is a bad command, better give a list of options. C CALL LOCATE (0, 1) CALL WRITE_STRING ( ' R Move cursor to right' ) CALL LOCATE (0, 2) CALL WRITE_STRING ( ' L Move cursor to left ' ) CALL LOCATE (0, 3) CALL WRITE_STRING ( ' M Mark this scan ' ) CALL LOCATE (0, 4) CALL WRITE_STRING ( ' I identify this scan ' ) CALL LOCATE (0, 5) CALL WRITE_STRING ( ' U Unmark this scan ' ) CALL LOCATE (0, 6) CALL WRITE_STRING ( ' Q quit and save changes') END IF IF ( CH .NE. 'Q' ) GO TO 520 C C All the points are marked, ask the user for the flux ratio. C CALL LOCATE (0, 1) CALL WRITE_STRING ( ' Multiply all marked scans by ?') READ (*,*) NDFRATIO(ICHAN) C----------------------------------------------------------------------- C Fit a new magnitude and color to this star. ELSE IF ( CH .EQ. 'F' ) THEN SCALE = (XMAX-XMIN)*(XMAX-XMIN) / ((YMAX-YMIN)*(YMAX-YMIN)) DIST = (XMAX-XMIN)*(XMAX-XMIN) + $ SCALE*(YMAX-YMIN)*(YMAX-YMIN) J = 0 DO 540 I = 1, NSTAR DX = XPLOT(I) - RX DY = YPLOT(I) - RY DIST2 = DX*DX + SCALE*DY*DY IF ( DIST2 .LT. DIST ) THEN DIST = DIST2 J = I END IF 540 CONTINUE IF ( J .EQ. 0 ) THEN WRITE(6,*) ' INTERNAL ERROR IN EXPAND ROUTINE ' GO TO 320 END IF ISTAR = SLIST(J) C C Plot the magnitude of this star versus color term C 550 CONTINUE YMIN = 1.E6 YMAX = -1.E6 XMIN = 1.E6 XMAX = -1.E6 DO 570 K = 1, 4 XPLOT(K) = CTERM(K) YPLOT(K) = 0. ERROR(K) = 1.0 IPLOT = 0 DO I = 1, ISCAN IF ( (STAR(I) .EQ. ISTAR ) .AND. $ ( IAND(OKFLUX(I),MASK(K)).EQ.0) ) THEN NPHOT = BDEN(I,K) - D(I,K) IF ( IAND(NDFSTATUS(I),MASK(K)).NE. 0 ) THEN NPHOT = NDFRATIO(K) * NPHOT END IF YPLOT(K) = YPLOT(K) + NPHOT IPLOT = IPLOT + 1 END IF END DO IF ( IPLOT .GT. 0 ) THEN NPHOT = YPLOT(K) / FLOAT(IPLOT) YPLOT(K) = 2.5*LOG10( NPHOT ) - MAG0(K) YMIN = MIN ( YMIN, YPLOT(K) ) YMAX = MAX ( YMAX, YPLOT(K) ) ELSE YPLOT(K) = 2.E6 END IF XMIN = MIN ( XMIN, XPLOT(K) ) XMAX = MAX ( XMAX, XPLOT(K) ) 570 CONTINUE XLINE(1) = XLO XLINE(2) = XHI CALL POLYFIT( XPLOT, YPLOT, ERROR, YFIT, 4, XMIN, XMAX, $ YMIN, YMAX, 1, XLINE, YLINE, 2, NCAL_RMS(ICHAN)) NEWBV = (YLINE(2)-YLINE(1))/(XLINE(2)-XLINE(1)) NEWMAG = - YLINE(1) + XLINE(1)*NEWBV TITLE(1) = 'COLOR TERM ' TITLE(4) = ' ' TITLE(5) = 'GREEN=OLD FIT RED=NEW FIT' WRITE( TITLE(6),1310) NEWMAG, NEWBV, NCAL_RMS(ICHAN) CALL PGSCI ( 5 ) CALL PGSCH ( 1.5 ) CALL PGRNGE ( XMIN, XMAX, XLO, XHI ) CALL PGRNGE ( YMIN, YMAX, YLO, YHI ) CALL PGENV ( XLO, XHI, YHI, YLO, 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 ( 2 ) CALL PGLINE ( 2, XLINE, YLINE ) CALL PGSCI ( 1 ) CALL PGPOINT( 4, CTERM, YPLOT, SYMBOL(1) ) DO 585 K = 1, 4 YLINE(K) = - MAG(J) + XLINE(K)*BV(J) 585 CONTINUE CALL PGSCI ( 3 ) CALL PGLINE ( 4, XLINE, YLINE ) RX = XMIN RY = YMAX CALL EGA_RESTORE_DEFAULT CALL LOCATE(0,0) CALL WRITE_STRING ( 'Shall we use the new values (Y/N)?' ) 590 CONTINUE CALL PGCURSE(RX, RY, CH ) CALL CAPS ( CH ) IF ( CH .EQ. 'Y' ) THEN MAG(J) = NEWMAG BV(J) = NEWBV ELSE IF ( CH .NE. 'N' ) THEN GO TO 590 END IF C----------------------------------------------------------------------- C Run automatic editor C ELSE IF ( CH .EQ. 'A' ) THEN WRITE(6,*) ' WHAT RMS DO YOU EXPECT ? ' READ (5,*) GOODRMS DO 760 J = 1, NSTAR IPLOT = 0 DO 720 I = 1, ISCAN IF ( STAR(I) .NE. SLIST(J) ) GO TO 720 IF ( IAND(OKFLUX(I),MASK(ICHAN)) .NE. 0 ) GO TO 720 IPLOT = IPLOT + 1 YPLOT(IPLOT) = -2.5*LOG10( BDEN(I,ICHAN)-D(I,ICHAN) ) WHATSCAN(IPLOT) = I 720 CONTINUE IF ( IPLOT .EQ. 0 ) THEN WRITE(6,*) ' NO DATA FOR STAR ', J, SLIST(J) GO TO 760 C ELSE C WRITE(6,*) IPLOT, ' SCANS FOR STAR ', J, SLIST(J) END IF 730 CONTINUE RMS = 0. AVG = 0. IMARK = 0 DO 740 I = 1, IPLOT IF ( WHATSCAN(I) .EQ. 0 ) GO TO 740 AVG = AVG + YPLOT(I) RMS = RMS + YPLOT(I)*YPLOT(I) IMARK = IMARK + 1 740 CONTINUE IF ( IMARK .LT. 2 ) THEN WRITE(6,*) ' ALL DATA DELETED FOR STAR ', J, SLIST(J) GO TO 755 END IF AVG = AVG / FLOAT(IMARK) RMS = SQRT ( RMS / FLOAT(IMARK) - AVG*AVG ) C WRITE(6,*) ' RMS = ', RMS, ' NUMBER OF SCANS = ', IMARK IF ( RMS .LT. GOODRMS ) GO TO 755 C C Delete the scan furthest from the mean C C WRITE(6,*) ' DELETING ONE SCAN of ', IMARK IMARK = 0 DO 750 I = 1, IPLOT IF ( WHATSCAN(I) .EQ. 0 ) GO TO 750 IF ( IMARK .EQ. 0 ) THEN IMARK = I ELSE IF ( ABS(YPLOT(I) -AVG) .GT. $ ABS(YPLOT(IMARK)-AVG) ) THEN IMARK = I END IF 750 CONTINUE IF ( IMARK .EQ. 0 ) THEN WRITE(6,*) ' INTERNAL ERROR IN AUTO. STAR ', SLIST(J) GO TO 755 ELSE C WRITE(6,*) ' SCAN ', IMARK, ' DELETED ' OKFLUX(WHATSCAN(IMARK)) = IOR ( $ OKFLUX(WHATSCAN(IMARK)), MASK(ICHAN) ) WHATSCAN(IMARK) = 0 GO TO 730 END IF 755 CONTINUE 760 CONTINUE C----------------------------------------------------------------------- C quit ELSE IF ( CH .EQ. 'Q' ) THEN GO TO 900 END IF CALL PGASK ( .FALSE. ) CALL PGADVANCE GO TO 210 C----------------------------------------------------------------------- 900 CONTINUE CALL PGEND RETURN 1305 FORMAT ( 'CHANNEL', I3, ' = ', A7, 20X ) 1310 FORMAT ( ' MAG =', F7.2, SP, F7.3, SS, ' (B-V) RMS= ', F6.3) END