10000 REM **************** testfw2 routine 08/04/96 *******************
10010 REM          MKII/MKIII/MKIV Polarimetric Measurements
10020 REM
10030 REM              (SCI-TEC Instruments, April 1996)
10040 REM
10050 REM *************************************************************
10060 REM
10070 REM  This routine tests and records the neutral densities at
10080 REM  the various filterwheel positions to the file FW2TEST.###.
10090 REM
10200 REM  Side Effects:
10210 REM
10220 REM  Global Variables Referenced:
10230 REM    SP  TD
10240 REM    CZ$ M5$ NO$ O1$ WL$ WU$
10250 REM    HF%
10260 REM
10270 REM  Exits: 13020
10280 REM
10290 REM  Uses: 6610, 6635, 6650, 6690, 6900, 7000, 8300, 9450,
10300 REM        9650, 9700, 9840, 9860, 9900
10310 REM
10500 REM *************************************************************
10510 REM  History: dd/mm/yy
10520 REM  08/04/96 - Output file is now appended
10530 REM  13/02/95 - Original release
10540 REM *************************************************************
11000 '
11001 ' *** Setup ***
11002 '
11010 DATA testfw2
11020 IF M9$<>"2" THEN GOSUB 9820   'Standard Lamp
11030 GOSUB 6610:GOSUB 6630     'Filter#1 to 1
11040 M5$="0":GOSUB 6650        'Filter#2 to 0
11050 GOSUB 6700:TD=1500:GOSUB 7000 'Iris open
11060 LOCATE ,SP:PRINT "4 - Rotate director prism to lamps":GOSUB 9860
11070 GOSUB 9650:T0=TA/3600:GOSUB 8600  'ENTER when ready
11080 PRINT CL$:LOCATE ,SP:PRINT"Waiting until ";H$;" for lamp warmup":GOSUB 6900
11090 IF LO%=1 THEN 13000       'End if Lamp is Off
11100 GOSUB 6800:IF HF%=1 THEN 13000    'End if Aborted
11110 GOSUB 2450            'Get Temperature
12000 '
12001 ' *** Take Set of Observations ***
12002 '
12010 CLS:PRINT CL$:GOSUB 9670
12020 CLOSE 8:OPEN DD$+"FW2TEST."+NO$ FOR APPEND AS 8
12030 PRINT#8,"  Filterwheel #2 Test - Brewer #";NO$;" - ";DC$;" (";JD$;")"
12040 PRINT#8,:PRINT#8,"FW Pos  Dark                        Neutral Densities"
12050 PRINT#8,:PRINT#8,"                Slit 1     Slit 2     Slit 3     Slit 4     Slit 5    Average"
12060 PRINT#8,:LOCATE 10,1:PRINT "Position  Average Neutral Density":PRINT
12070 DS%=0
12100 GOSUB 20000
12110   IF DS%=0 THEN FOR I=2 TO 6:MS(I)=F(I):NEXT  'store FW 1-0 baseline
12120   FOR I=2 TO 6:F(I)=MS(I)-F(I):NEXT       'apply FW 1-0 baseline to data
12130   I=(320-VAL(M4$))/64:GOSUB 21000
12140 DS%=DS%+1:IF HF%<>1 AND DS%<=4 THEN 12100
12150 IF HF%=1 THEN 13000
12160 GOSUB 9785:DS%=4                  'switch FW#1 to 3
12170 FOR I=2 TO 6:MZ(I)=MS(I)-F(I):NEXT        'store FW 1-4 baseline
12200 GOSUB 20000
12210   FOR I=2 TO 6:S(I)=F(I):F(I)=F(I)-MZ(I):NEXT 'apply FW 1-4 baseline to data, store FW 3-4 baseline
12220   I=(320-VAL(M4$))/64:GOSUB 21000
12230 IF HF%=1 THEN 13000
12240 DS%=5
12300 GOSUB 20000
12310   FOR I=2 TO 6:F(I)=MS(I)+S(I)-F(I)-MZ(I):NEXT    'apply FW 1-0, FW 1-4, FW 3-4 baseline to data
12320   I=(320-VAL(M4$))/64:GOSUB 21000
12330   FOR I=2 TO 6:F(I)=S(I)-MZ(I):NEXT       'apply 3-4 baseline to 1-4 data
12340   I=1:DS%=4:GOSUB 21000
12350 IF HF%=1 THEN 13000
12360 GOSUB 9784                    'switch FW#1 to 4
12400 GOSUB 20000
12410   FOR I=2 TO 6:F(I)=S(I)-F(I):NEXT        'apply FW 3-4 baseline to data
12430   I=(320-VAL(M4$))/64:GOSUB 21000
13000 '
13001 ' *** Clean Up and Exit ***
13002 '
13010 PRINT#8,:CLOSE 8:GOSUB 9840
13020 RETURN
20000 '
20001 ' *** Filterwheel #2 Observation ***
20002 '
20010 O1$="M,5,"+MID$(STR$(DS%*64),2):GOSUB 9450    'set FW#2
20020 CZ$="10":WL$="1":WU$="6":GOSUB 9700:GOSUB 9900    'get data
20030 IF HF%=1 THEN PRINT CL$:PRINT "TESTFW#2 measurement terminated":RETURN
20040 GOSUB 8300                    'correct data for dark/dead/temperature
20050 RETURN
21000 '
21001 ' *** Print Out Data ***
21002 '
21010 J=(F(2)+F(3)+F(4)+F(5)+F(6))/5
21020 LOCATE ,1:PRINT USING       " # - #        ######.###";I;DS%;J
21030 PRINT#8,USING " # - #  ###  ######.### ######.### ######.### ######.### ######.### ######.###";I;DS%;F(1);F(2);F(3);F(4);F(5);F(6);J
21040 RETURN
65529 REM proper last line