10000 REM ****************** hp routine 10/09/05 *********************
10010 REM            MKIII Alignment of Two Spectrometers
10020 REM        
10030 REM            (SCI-TEC Instruments, October 1998)
10040 REM
10050 REM  See also:
10060 REM ************************************************************
10070 REM
10080 REM  This routine aligns the two spectrometers in a MKIII
10090 REM  Brewer.
10120 REM
10130 REM  Side Effects:
10140 REM
10150 REM  Global Variables Referenced:
10160 REM    MY% NMZ% TE% PC M5$ M8$ M9$ MC$ O1$ TYP$
10200 REM
10210 REM  Exits: 11010, 14010
10220 REM
10230 REM  Uses:  2450, 3100, 3225, 6610, 6630, 6700, 7000, 9190,
10240 REM         9450, 9480, 9500, 9670, 9805, 9815, 9820, 9840
10260 REM
10270 REM ************************************************************
10280 REM  History: dd/mm/yy
10289 REM  10/09/05 - back and forth movement eliminated
10290 REM  23/10/98 - Q9%/N9$ support added; New electronics support
10300 REM  14/07/95 - Corrected MIOAVG file output
10310 REM  12/01/95 - Update to line fitting algorithm
10320 REM  05/10/94 - Alignment sequence is HP-FR-HP-abort
10330 REM  07/07/94 - Merged all FR and MR routines into one version
10340 REM  15/11/93 - Original 3.73 version
10350 REM ************************************************************
10500 DATA hp
11000 '
11001 ' *** Initialization ***
11002 '
11010 HP%=-1:IF TYP$<>"mkiii" THEN RETURN
12000 '
12001 ' *** Setup for HP Alignment ***
12002 '
12010 ON ERROR GOTO 3100
12020 X(1)=1:Y(1)=1:ERASE X,Y:DIM X(100),Y(100)
13000 '
13001 ' *** Perform HP Alignment ***
13002 '
13010 IF M9$<>"2" THEN GOSUB 9820
13020 PRINT#4,:PRINT#4,"**** 2nd Spectrometer Alignment - HP Test ****"
13030 CX$="4":TR$="s"+"a":REM cycle count and track mode
13040 GOSUB 2450:GOSUB 3225
13050 GOSUB 6610:GOSUB 6630:M5$=MID$(STR$(POFW2),2):GOSUB 6650
13060 TD=1500:GOSUB 7000:GOSUB 6700:GOSUB 9860
13070 LOCATE ,SP:PRINT "4 - Director prism to lamps"
13075 M8$="-"+MC$:GOSUB 9805
13076 M8$=STR$(-OF%):GOSUB 9805
13080 HP%=HP%+1:IF HP%<>5 THEN 13100
13090 GOSUB 9480: B$="Spectrometer alignment trouble, ":IF NEED.FR = 2 THEN B$=B$+"aborting": HF%=1: else B$=B$+"calling FR":
13095 NEED.FR = 1:PRINT#4,B$:GOSUB 3050:GOTO 13190
13100 DW=10:SQ=5:DQ$=STR$(SQ+1):GOSUB 9670
13110 GOSUB 31000:GOSUB 32000
13120 O1$="M,"+N9$+","+STR$(INT(VAL(MAX$)+.5)):GOSUB 9450
13140 IF HF%=1 THEN PRINT "Aborted": PRINT#4, "Aborted":GOTO 13190
13150 IF C1/C9<.97 OR ABS(VAL(MAX$)-80)>10 THEN 13080
13190 M8$=STR$(OF%):GOSUB 9805:M8$=MC$:GOSUB 9805:GOSUB 9500
14000 '
14001 ' *** Clean Up and Exit ***
14002 '
14010 ERASE A,D,TTT,W,X,Y,ZI#:GOSUB 9840:RETURN
31000 '
31001 ' *** Scan W1 to W2 Step DW on Slit SQ ***
31002 '
31010 M8$="-80":GOSUB 9815:W1=0:W2=160:MAX=0:MAX$=""
31011 A1$(IO)=LF$+"hpscan"+CR$+TIME$+CR$
31012 N=0:FOR WV=W1 TO W2 STEP DW
31020 SN$=STR$(WV):N=N+1
31030 O1$="M,"+N9$+","+SN$+";R,"+DQ$+","+DQ$+","+CX$+";O":GOSUB 9450
31040 PRINT SN$,VA:IF VA>MAX THEN MAX=VA:MAX$=SN$
31050 X(N)=VAL(SN$):Y(N)=VA
31052 A1$(IO)=A1$(IO)+CR$+STR$(X(N))+CR$+STR$(Y(N))
31060 NEXT
31062 IO=IO+1:GOSUB 3200:RETURN
32000 IF MAX$="0" OR MAX$="160" THEN 32420
32010 P=4:A(1,1)=1:TTT(1)=1:D(1)=1:W(1)=1:ZI#(1,1)=1:ERASE A,TTT,D,W,ZI#
32020 DIM A(P,P),TTT(P),D(P),W(P),ZI#(P,P)
32030 FOR I=1 TO P
32040 FOR I1=1 TO N:TTT(I)=TTT(I)+X(I1)^I:NEXT
32050 TTT(I)=TTT(I)/N
32060 NEXT
32070 Y1=0
32080 FOR I1=1 TO N:Y1=Y1+Y(I1):NEXT:Y1=Y1/N
32090 FOR J=1 TO P:S1=0
32100 FOR I=1 TO N:S1=S1+(Y(I)-Y1)*(X(I)^J-TTT(J)):NEXT
32110 D(J)=S1:S1=0
32120 FOR K=J TO P:S1=0
32130 FOR I=1 TO N:S1=S1+(X(I)^J-TTT(J))*(X(I)^K-TTT(K)):NEXT
32140 A(J,K)=S1:A(K,J)=S1
32150 NEXT
32160 NEXT
32170 NT=N:N=P
32180 FOR R=1 TO N:FOR C=1 TO N:ZI#(R,C)=A(R,C):NEXT C,R
32190 FOR R=1 TO N:X#=ZI#(R,1)
32200 FOR C=1 TO N
32210 IF C<N THEN ZI#(R,C) = ZI#(R,C+1)/X# ELSE ZI#(R,C)=1/X#
32220 NEXT
32230 FOR R2=1 TO N
32240 IF R2=R THEN 32300 ELSE X#=ZI#(R2,1)
32260   FOR C=1 TO N: Y#=ZI#(R,C)*X#
32270   IF C<N THEN ZI#(R2,C)=ZI#(R2,C+1)-Y# ELSE ZI#(R2,C)=-Y#
32280   NEXT
32300 NEXT
32310 NEXT
32320 N=NT
32330 FOR I=1 TO P:TTT=0:FOR J=1 TO P:TTT=TTT+ZI#(I,J)*D(J):NEXT:W(I)=TTT:NEXT
32340 M1!=0:FOR I=1 TO P:M1!=M1!+W(I)*TTT(I):NEXT
32350 W(0)=Y1-M1!
32360 C9=0:FOR I=1 TO N:C9=C9+(Y(I)-Y1)^2:NEXT
32370 C1=0:FOR I=1 TO P:C1=C1+W(I)*D(I):NEXT
32380 MAX=0:FOR I=X(1) TO X(N) STEP .1:YMAX=W(0)
32390 FOR J=1 TO P:YMAX=YMAX+W(J)*I^J:NEXT
32400 IF MAX<YMAX THEN MAX=YMAX:XMAX=I
32410 NEXT:MAX$=STR$(INT(XMAX*100+.5)/100)
32420 PRINT #4,"Maximum intensity found at step: ";MAX$;MAX;"R^2: ";C1/C9
32430 PRINT "Maximum intensity found at step: ";MAX$;MAX;"R^2: ";C1/C9
32440 A1$(IO)=LF$+"hp"+CR$+TIME$+CR$+STR$(C1/C9)+CR$+STR$(MAX)+CR$+MAX$+CR$+STR$(TE%)
32450 IO=IO+1:GOSUB 3200
32460 RETURN
65529 REM proper last line