DECLARE SUB logit (a$) DECLARE SUB GOTOWAVE (lambda!) DECLARE SUB getslav (boost!, lowdn!, hidn!, moustest) DECLARE SUB timelp (ms!) DECLARE SUB clrky () DECLARE SUB setup (tstvers!, Versdte$, opnme$, root$, path$) DECLARE SUB openshut (moustest) DECLARE SUB closeshut (moustest) DECLARE SUB pathstuff (root$, mask$, drv$, lot$) 'DECLARE SUB ndstuff (L2!, u2!, N2!, NDL!, NDU!, NDN!) DECLARE SUB twait (mins!, secs!) DECLARE SUB ptrbeep (beepnum!) DECLARE SUB ampcalc (ednflg!, edn!, take!, current!, dn!) DECLARE SUB keyp (a$) DECLARE SUB lprtfil (n$, Tcmnt$, u$, d!, l!, u!, n!, wmax!, dmax!) DECLARE SUB axes (left!, right!, bot!, top!) DECLARE SUB ioread (W1!) COMMON SHARED /ioport/ P1CW, P1C, P1B, P1A, P2CW, P2C, P2B, P2A, HIMASK, LOMASK Versdte$ = "Aug. 24, 1999" ' change this to indicate on boot print tstvers = 67 ' change this too for major rewrites moustest = 0 ' =0 for uniblitz and 1 for mouse connected ' diagnostic 280 SCREEN 9, 0, 0: WIDTH 80: CLS : disp = 9 ' 640x350 16 color is plenty 290 KEY OFF 300 ' 310 ' 746 Detector Spectral Response Measurement Program 320 ' 330 ' - INITIALIZATION - 1100 ' ==================================================================== 1110 P1CW = 528: P1C = 529: P1B = 530: P1A = 531 1120 P2CW = 532: P2C = 533: P2B = 534: P2A = 535 1130 OUT P1CW, 147: OUT P2CW, 147 1140 HIMASK = 240: LOMASK = 15 1160 OPTION BASE 1 1170 DIM R(501), K(501), Tstdet(501), Wavel(501), n(501), ND(501) 1180 tstarea = 1 ' initial default of test detector area 1190 STDarea = 1 ' initial default of standard detector area 1210 lin$ = "--------------------------------------------------------------------------" 1220 Runum = 0: fsetup = 0: Fchgareans = 0: Fabort = 0: Fdetscan = 0: F6 = 0 1225 qe% = 0: ND% = 0 1230 F = 1: A1 = 1 ' change range 1240 Tcmnt$ = "" root$ = "d:\qetest\" path$ = root$ lotpath = 0 ' no lot or path specified 1250 U3$ = "Irradiance [watts/cm^2]" uq$ = "Quantum Efficiency" 1260 ' 1270 CALL setup(tstvers, Versdte$, opnme$, root$, path$) a$ = DATE$ + " " + TIME$ + " 740dma program vers " + STR$(tstvers) + "-" + Versdte$ + " Operator is " + opnme$ CALL logit(a$) 1280 GOSUB 9650 ' Timeloop Measurement 1290 ' - START - 1300 ' 1310 ' - OLD / NEW CAL FACTOR OPTION - 1320 ' FOR I = 1 TO 500: Tstdet(I) = 0: NEXT I ' zero old data 1330 K1$ = "Old": K2$ = "": K3$ = "": K4$ = "": K5$ = " New": K6$ = "": K7$ = "": K8$ = "": K9$ = "": K10$ = " X" 1340 IF Runum = 0 THEN PRINT : PRINT lin$: PRINT 1350 PRINT "This program can either use calibration factors stored on a mass storage medium or generate new factors.": PRINT 1360 PRINT "F1 : generate new calibration factors (Irradiance)" 1370 PRINT "F5: calibration factors already stored on a mass storage medium" 1380 Q$ = "Select option." 1390 GOSUB getfkey ' SUBROUTINE (7): Assign key labels 1400 CLS 1410 ON a GOTO 1550, 1410, 1410, 1410, 1450, 1410, 1410, 1410, 1410, bail 1420 ' 1430 ' - LOAD DATA FILES - 1440 ' 1450 ' - 'old' calibration factors - 1460 ' 1470 GenNewcal = 0: Fdetscan = 1: Fchgareans = 0: F6 = 0: A1 = 1 'A1 change range 1480 PRINT "The calibration factor data file must contain the system's monochromatic" 1490 PRINT "irradiance output in units of [watts/cm^2].": PRINT CHDIR "\qetest" 1500 PRINT lin$: FILES root$ + "*.*": PRINT lin$ 1510 PRINT "Enter name of data file where calibration factors are stored." SOUND 500, 1: CALL clrky: INPUT Nstdcal$ 1520 IF Nstdcal$ = "" THEN 1500 1530 GOTO 1630 1540 ' 1550 ' - 'new' calibration factors - 1560 ' 1570 GenNewcal = 1: Fdetscan = 0: Fchgareans = 0: A1 = 1 ' Change range 1580 PRINT : PRINT "The standard detector data file must contain the values for the detector's" 1590 PRINT "spectral response in units of amps/W ." 1600 PRINT : PRINT lin$: CLOSE #1 1610 PRINT "Enter name of data file where standard detector values are stored." PRINT "(file must reside in D:\QETEST\ directory)" PRINT "(However, Do NOT include drive and path specifier! )" PRINT "(optional detectors are D846J10.DAT and HEADDET.DAT)" PRINT PRINT " (Press ENTER for default < D861J10.DAT >" SOUND 500, 1: CALL clrky: INPUT Nstdcal$ 1620 IF Nstdcal$ = "" THEN Nstdcal$ = "d861j10.dat" 1630 ON ERROR GOTO 7380 ' SUBROUTINE (2): Nstdcal$ on MSU CALL logit(TIME$ + " Reading in " + root$ + Nstdcal$) 1640 OPEN root$ + Nstdcal$ FOR INPUT AS #1 1650 ON ERROR GOTO 0 1660 IF GenNewcal = 0 THEN INPUT #1, K$, U3$, D2, l, u, n ELSE INPUT #1, s$, u1$, Dte, l, u, n 1670 IF n > 0 THEN 1730 1680 CLS 1690 PRINT "Data must be stored at equally spaced wavelength intervals." 1700 PRINT : PRINT "The data in '"; Nstdcal$; "' is stored at unequally spaced wavelength intervals." 1710 CLOSE #1 1720 GOTO 1600 1730 m = (u - l) / n + 1' # of data pts. in data file 1740 IF m > 501 THEN 1750 ELSE 1800 1750 CLS 1760 PRINT "The # of data points in this data file ("; m; ") is > the allowed" 1770 PRINT "maximum of 501!": PRINT 1780 PRINT "Please select another data file which contains <= 501 points." 1790 GOTO 1600 1800 FOR I = 1 TO m 1810 IF GenNewcal = 0 THEN INPUT #1, K(I) ELSE INPUT #1, R(I)' cal or std values 1820 NEXT I 1830 CLOSE #1 'lprint lin$ 'lprint Nstdcal$ 'lprint lin$ 1840 IF Fdetscan = 1 THEN L2 = l: u2 = u: N2 = n: M2 = m' 'old' cal factors 1845 IF Fdetscan = 1 THEN GOSUB 14000 ' ND file/1.0's 1846 IF ND% = 1 THEN GOSUB 16000 ' ND common 1847 IF ND% = 2 THEN 1845 ' ND file had no common waves, try again 1850 ' 1860 ' - MEASUREMENT PARAMETERS - 1870 ' 1880 ' - ENTER RANGE - 1890 ' 1900 IF A1 = 10 THEN GOTO 2492 ' same range 1905 IF ND% = 1 THEN SAVE.L = L2: SAVE.U = u2: SAVE.N = N2 ' save old values 1907 IF ND% = 1 THEN L2 = COMMON.L: u2 = COMMON.U: N2 = COMMON.N 1910 CLS 1920 ' 1930 IF Fdetscan = 1 THEN 2000' test scan 1940 PRINT "Data File Name: "; Nstdcal$ 1950 PRINT "Data File Comments: "; s$ 1960 PRINT "Data File Units: "; u1$ 1970 PRINT "Data File Date:"; Dte: PRINT 1980 ' 1990 PRINT "Data File Range:"; l; "-"; u; "nm @"; n; "nm": GOTO 2070 2000 IF GenNewcal = 1 THEN 2060' new calibration factors 2010 PRINT "Data File Name: "; Nstdcal$ 2020 PRINT "Data File Comments: "; K$ 2030 PRINT "Data File Units: "; U3$ 2040 PRINT "Data File Date:"; D2: PRINT 2050 ' 2060 PRINT "Calibration Range:"; L2; "-"; u2; "nm @"; N2; "nm" 2070 PRINT 2080 ON ERROR GOTO 1930 2090 IF Fdetscan = 1 THEN GOTO 2120 2100 PRINT "Lower and upper limits must be wavelengths within the mechanical range and whose values are stored in '"; Nstdcal$; "'.": PRINT 2105 PRINT : PRINT "( Example:"; l; ", "; u; ")" ' +N -N took out 11-15-91 2110 GOTO 2160 2120 PRINT "Lower and upper limits must be wavelengths whose values are stored in the calibration data file." 2130 PRINT : PRINT "( Example:"; L2; ", "; u2; ")" ' +N2 -N2 etc 2160 PRINT lin$ 2170 IF Fdetscan = 1 THEN 2200 ' test scan 2180 PRINT "Enter lower & upper limits of cal." SOUND 500, 1: CALL clrky: INPUT L2, u2 2190 GOTO 2210 2200 PRINT "Enter lower & upper limits of test." SOUND 500, 1: CALL clrky: INPUT L1, u1 2210 ON ERROR GOTO 0 2220 IF Fdetscan = 0 THEN L1 = L2: u1 = u2 2230 GOSUB 7560 ' SUBROUTINE (3): Check L1 & U1, or L2 & U2 2240 ' 2250 ' - ENTER JOG INTERVAL - 2260 ' 2270 CLS 2280 IF Fdetscan = 0 THEN PRINT "Measurement Range:"; L2; "-"; u2 ELSE PRINT "Measurement Range:"; L1; "-"; u1 2290 PRINT 2300 ON ERROR GOTO 2310 2310 IF Fdetscan = 0 THEN PRINT "The wavelength jog interval can be any multiple of"; n; "." ELSE PRINT "The wavelength jog interval can be any multiple of"; N2; "" END IF 2320 PRINT : PRINT lin$ 2330 PRINT "Enter wavelength jog interval." SOUND 500, 1: CALL clrky IF Fdetscan = 0 THEN INPUT N2 ELSE INPUT n1 2340 ON ERROR GOTO 0 2350 IF Fdetscan = 1 THEN 2370 2360 IF N2 <= 0 THEN 2380 ELSE 2410' calibration scan 2370 IF n1 <= 0 THEN 2380 ELSE 2430' test scan 2380 CLS 2390 PRINT "The wavelength interval can not be <= 0 !": PRINT 2400 GOTO 2300 2410 TVAR = CSNG(N2 / n): IF TVAR = CINT(N2 / n) THEN 2450 ELSE CLS 2420 PRINT N2; "is not a multiple of"; n; "!": PRINT : GOTO 2300 2430 TVAR = CSNG(n1 / N2): IF TVAR = CINT(n1 / N2) THEN 2490 ELSE CLS 2440 PRINT n1; "is not a multiple of"; N2; "!": PRINT : GOTO 2300 2450 J3 = (L2 - l) / n + 1 ' std. file starting wavelength 2460 J4 = (N2 - n) / n + 1 ' std. file jog increment 2470 M2 = (u2 - L2) / N2 + 1 ' # of scan pts. 2480 J1 = 1: J2 = 1: GOTO 2536 ' [was GOTO 2540] 2490 IF ND% = 1 THEN L2 = SAVE.L: u2 = SAVE.U: N2 = SAVE.N ' restore old vals 2492 IF ND% = 1 THEN NDJ1 = (L1 - NDL) / NDN + 1 2493 IF ND% = 1 THEN NDJ2 = (n1 - NDN) / NDN + 1 2495 J1 = (L1 - L2) / N2 + 1 ' cal. file starting wavelength 2500 J2 = (n1 - N2) / N2 + 1 ' cal. file jog increment 2510 NumSpectVal = (u1 - L1) / n1 + 1 ' # of scan pts. 2520 F6 = 1 2530 ' 2532 ' - [NEW] INPUT SOURCE - 2534 ' 2536 GOSUB 10000 2538 ' 2540 ' - [CHANGED] DATE - 2550 ' 2560 IF fsetup = 1 THEN 2820 2570 ' 2580 D1 = VAL(MID$(DATE$, 9, 2)) * 10000 2590 D1 = D1 + (VAL(MID$(DATE$, 1, 2)) * 100) 2600 D1 = D1 + VAL(MID$(DATE$, 4, 2)) 2610 ' 2620 ' 2630 ' 2640 ' - 740 SET UP - 2650 ' 2660 CLS 2670 PRINT "SYSTEM SET UP CHECK LIST:": PRINT 2680 PRINT "1) Preset 740-1C Controller/735-735D Monochromator to 400.0nm." 2690 PRINT "2) Connect detector signal cable to 730A linear signal input." 2700 PRINT : PRINT : PRINT "730A SET UP:": PRINT 2710 PRINT "3) units: 'AMPERES'" 2720 PRINT "4) auto range: 'AUTO'" 2730 PRINT "5) response time: 'FAST'" 2740 PRINT "6) pulse integrator: 'OFF'" 2750 PRINT : PRINT lin$ 2760 PRINT "Press space bar when SET UP is completed.": SOUND 500, 1 2770 CALL clrky 2780 a$ = INKEY$: IF a$ = " " THEN 2790 ELSE 2780 2790 fsetup = 1' date entered & set up displayed 2800 ' 2810 ' 2820 ' - NOISE LEVEL - 2830 ' 2840 IF Fchgareans = 1 THEN 3280 ' same noise level & Comments 2850 K1$ = " 0.5% ": K2$ = "": K3$ = " 1% ": K4$ = "": K5$ = " 2% ": K6$ = "": K7$ = " 5% ": K8$ = "": K9$ = "": K10$ = "" 2860 CLS 2870 PRINT "Signal Noise Level Option:": PRINT 2880 PRINT "F1 = very quiet...[0.5%]" 2890 PRINT "F3 = quiet........[1%]" 2900 PRINT "F5 = noisy........[2%]" 2910 PRINT "F7 = very noisy...[5%]" 2920 Q$ = "Select option." 2930 GOSUB getfkey ' SUBROUTINE (7): Assign key labels 2940 IF a = 1 THEN P = .005 2950 IF a = 3 THEN P = .01 2960 IF a = 5 THEN P = .02 2970 IF a = 7 THEN P = .05 2980 ' 2990 ' - SOURCE DESIGNATION - '3000 ' '3010 'cLS '3020 'PRINT "Signal Noise Level:"; 100 * P; "%?": PRINT 3030 'PRINT "The run Comments can be a descriptive name for the spectral data which can" '3040 'PRINT "have a maximum length of 254 characters." '3050 'PRINT : PRINT "No commas (,) are allowed - use semi-colons (;) instead!" '3060 'PRINT : PRINT "Example: P2 123; 150W Lamp @ 6.0A; 20nm Slits; Exit Beam 1.5cm^2." 3070 'ON ERROR GOTO 8370 ' SUBROUTINE (5): Check X$ '3080 'PRINT LIN$ '3090 'IF Fdetscan = 1 THEN GOTO 3110 '3100 'PRINT "Enter calibration scan Comments." 'SOUND 500, 1: CALL clrky: INPUT K$: GOTO 3120 '3110 'PRINT "Enter test detector Comments. (Fabort)";Fabort ' SOUND 500, 1: CALL clrky: INPUT Tcmnt$ 3120 CLS 3130 PRINT "The default area factor shown in ( ) can be selected by simply" 3140 PRINT "pressing . It is initially set to 1 cm^2." 3141 ON ERROR GOTO 8461 ' SUBROUTINE (55): Check X$ 3150 PRINT : PRINT lin$ 3160 IF Fdetscan = 1 THEN GOTO 3219 3170 PRINT " Enter standard detector area in units of cm^2 (default ="; STDarea; "cm^2)" 3180 SOUND 500, 1: CALL clrky: INPUT DETAREA$ 3190 IF DETAREA$ <> "" THEN STDarea = VAL(DETAREA$) ' change if entry 3200 IF STDarea = 0 THEN PRINT "AREA CANNOT = 0": GOTO 3150 3210 GOTO 3260 3219 OPEN root$ + "sizes.txt" FOR INPUT AS #1 INPUT #1, siznum FOR I = 1 TO siznum INPUT #1, size$ ', smask$ PRINT size$ '; " - ", smask$ NEXT I CLOSE #1 3220 PRINT PRINT PRINT " Enter test detector area in units of cm^2 (default ="; tstarea; "cm^2)" 3230 SOUND 500, 1: CALL clrky: INPUT DETAREA$ 3240 IF DETAREA$ <> "" THEN tstarea = VAL(DETAREA$) ' change if entry 3250 IF tstarea = 0 THEN PRINT "AREA CANNOT = 0!": GOTO 3150 lotpath = 0 ' so that a new lotpath will be created 3260 ON ERROR GOTO 0 3270 ' 3280 ' - MEASUREMENT ROUTINE - CLS IF Fdetscan = 1 AND lotpath = 0 THEN GOSUB lotpath ON ERROR GOTO 8370 ' SUBROUTINE (5): Check X$ PRINT "Signal Noise Level:"; 100 * P; "%": PRINT IF Fdetscan = 1 THEN GOTO td CLS PRINT "The cal run Comments should describe stuff about the cart or test environment." PRINT "Such as, 'STIS cart cal with 5 mm slits input; middle; and output. cart is near" PRINT "Evaporator. Lynette is matrix testing.' " PRINT : PRINT "No commas (,) are allowed - use semi-colons (;) instead!" PRINT lin$ PRINT "Enter calibration scan Comments." SOUND 500, 1: CALL clrky: INPUT K$: GOTO ctm td: CLS PRINT "Enter the Part ID number <"; partid$; ">"; : INPUT npartid$ IF npartid$ <> "" THEN partid$ = npartid$ CLS : PRINT "Enter the part illuminated side <"; side$; ">"; : INPUT nside$ IF nside$ <> "" THEN side$ = nside$ CLS PRINT "The run Comments must include info about the part. Additional info such" PRINT "'special AR' or 'non ar' or anything else that is special about the test" PRINT : PRINT "Example: M747A 1376AN-04-E3 frontside grade 4 in special package(epoxy) no window." PRINT : PRINT "No commas (,) are allowed - use semi-colons (;) instead!" PRINT "old comments :" PRINT Tcmnt$ PRINT lin$ PRINT "Enter new test detector Comments. " SOUND 500, 1: CALL clrky: INPUT nTcmnt$ IF nTcmnt$ <> "." THEN IF nTcmnt$ = "" THEN GOTO td Tcmnt$ = nTcmnt$ END IF CLS : PRINT : PRINT "You are about to measure: " PRINT partid$, side$ PRINT Tcmnt$: PRINT : PRINT PRINT "Press 'n' or 'N' to re-enter this data" CALL keyp(a$): IF a$ = "n" OR a$ = "N" THEN GOTO td ctm: 3290 ' 3300 IF Fdetscan = 0 THEN L1 = L2: u1 = u2: n1 = N2: NumSpectVal = M2 3310 CLS 3320 PRINT "To abort run at any time press key 'F10'." 3330 ' 3340 PRINT 3350 PRINT "zero detector" '"Shutter source & adjust zero." CALL closeshut(moustest) 3450 ' - BEGINNING WAVELENGTH - 3460 ' 3470 OUT P1C, 112: OUT P1C, 240 ' fast/neutral 3480 CALL ioread(W1) 'GOSUB 9260 ' SUBROUTINE (9): Read wavelength 3490 IF W1 < L1 - 11 THEN 3550 ELSE 3500 ' do fwd and wt ELSE backup 3500 OUT P1C, 192: OUT P1C, 224: OUT P1C, 240 ' reverse/start/neutral 3510 FOR I = 1 TO 10 * ms: NEXT I' delay loop 3520 WHILE W1 > L1 - 11 3530 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength 3540 WEND 3550 OUT P1C, 128: OUT P1C, 224: OUT P1C, 240 ' forward/start/neutral 3560 FOR I = 1 TO 10 * ms: NEXT I' delay loop 3570 WHILE W1 < L1 - 10.4 ' at 10.4 do slow 3580 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength 3590 WEND 3600 OUT P1C, 208: OUT P1C, 240 ' slow/neutral 3610 WHILE W1 < L1 - 10 ' stop at l1-10 3620 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength 3630 WEND 3640 OUT P1C, 160: OUT P1C, 240 ' stop/neutral PRINT : PRINT lin$ PRINT "press space bar when zero" '"To start run remove shutter & press space bar.": SOUND 500, 1 CALL clrky chkky: a$ = INKEY$ IF a$ = " " THEN CALL openshut(moustest) GOTO takescan ELSE GOTO chkky END IF takescan: KEY 1, "": KEY 2, "": KEY 3, "": KEY 4, "": KEY 5, "": KEY 6, "": KEY 7, "": KEY 8, "": KEY 9, "" ON KEY(10) GOSUB 6170 ' abort KEY(10) ON: KEY 10, "Abort": KEY ON CLS 3440 ' 3650 FOR J0 = 1 TO 10 * ms: NEXT J0' delay loop 3660 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength 3670 IF W1 > L1 - 9.799999 OR W1 < L1 - 10.2 THEN GOTO 3470 ' beginning wl. 3680 h = 5 3690 ' 3700 ' - PRINT HEADING - 3710 ' 3720 ON ERROR GOTO 9370 ' SUBROUTINE (10): Error-check printer GOSUB smaldata ' GOSUB nlq ' Near letter quality 3730 IF Fdetscan = 0 THEN 3740 ELSE 3980 3740 'lprint : 'lprint ' : 'lprint : 'lprint 3750 'lprint lin$ 3760 'lprint "STANDARD DETECTOR DATA FILE" 3770 'lprint : 'lprint "Name: "; Nstdcal$ 3780 'lprint "Comments: "; s$ 3790 'lprint "Units: "; u1$ 3800 'lprint "Date:"; Dte 3810 'lprint "L ="; l 3820 'lprint "U ="; u 3830 'lprint "N ="; n 3840 'lprint lin$ 3850 'lprint "System Calibration Description: "; K$: 'lprint 3860 'lprint "Signal Noise Level:"; P * 100; "%" 3870 'lprint "Standard Detector Area:"; STDarea; "cm^2" 3880 D2 = D1: 'lprint "Date of Run:"; D2; " Time of test - "; TIME$ 'lprint 3890 'lprint "Measurement Range:"; L2; "-"; u2; "nm @"; N2; "nm": 'lprint 3900 Runum = Runum + 1 3910 'lprint "Run#"; Runum: 'lprint 3920 'lprint " SYSTEM'S FLUX INCIDENT STANDARD" 3930 'lprint " MONOCHROMATIC ON STANDARD 730A DETECTOR" 3940 'lprint " WAVE. IRRADIANCE OUTPUT DETECTOR SIGNAL VALUES" 3950 'lprint " [nm] [watts/cm^2] [watts] [amps] [amps/W]" 3960 ON ERROR GOTO 0 3970 GOTO 4270 3980 'lprint lin$ 3990 IF GenNewcal = 1 THEN 4090 4000 'lprint "SYSTEM MONOCHROMATIC IRRADIANCE OUTPUT DATA FILE ( read in )" 4010 'lprint : 'lprint "Name: "; Nstdcal$ 4020 'lprint "Comments: "; K$ 4030 'lprint "Units: "; U3$ 4040 'lprint "Date:"; D2 4050 'lprint "L ="; L2 4060 'lprint "U ="; u2 4070 'lprint "N ="; N2 4080 'lprint lin$ 4081 IF ND% = 0 THEN 4095 4082 'lprint "NEUTRAL DENSITY FILTER CALIBRATION DATA FILE" 4083 'lprint : 'lprint "Name: "; NDF$ 4084 'lprint "Comments: "; NDS$ 4085 'lprint "Units: "; NDU$ 4086 'lprint "Date:"; NDD 4087 'lprint "L ="; NDL 4088 'lprint "U ="; NDU 4089 'lprint "N ="; NDN 4090 'lprint : 'lprint : 'lprint : 'lprint 'CHR$(12); ' FORMFEED 'lprint CHR$(27) + "@" ' MASTER RESET 'lprint lin$ 4095 'lprint "Test Run Comments: "; Tcmnt$: 'lprint 4100 'lprint "Signal Noise Level:"; P * 100; "%" 4110 'lprint "Test Detector Area:"; tstarea; "cm^2" 4120 'lprint "Date of Run:"; D1; " Time of test - "; TIME$ 4130 'lprint "Measurement Range:"; L1; "-"; u1; "nm @"; n1; "nm" 4140 Runum = Runum + 1 4150 u2$ = "Detector power response [amps/W]" 4160 U22$ = "Detector irradiance response [amps/(W/cm^2)]" GOSUB smaldata 'GOSUB compdata ' superscript, 17 lpi 4170 'lprint "Run#"; Runum 4180 'lprint " TEST DETECTOR SCAN" 4187 'lprint CHR$(27); CHR$(88); CHR$(0); CHR$(130) ' right margin 130 4189 WIDTH "LPT1:", 132 ' set device width 4190 'lprint " SYSTEM'S " 4200 'lprint " POWER IRRADIANCE QUANTUM 730A MONOCHROMATIC "; 4205 'IF ND% = 1 THEN 'lprint " ND FILTER" ELSE 'lprint 4210 'lprint " WAVE RESPONSE RESPONSE EFFICIENCY SIGNAL IRRADIANCE OUTPUT"; 4215 'IF ND% = 1 THEN 'lprint " TRANSMITTANCE" ELSE 'lprint 4220 'lprint " [nm] [amps/W] [amps/(W/cm^2)] [ % ] [amps] [watts/cm^2] "; 4225 'IF ND% = 1 THEN 'lprint " [ % ]"; 4230 ON ERROR GOTO 0 4240 ' 4250 ' - SCAN - 4260 ' 4270 maxrd = 0: QEval = 0: oldw = L1: olds = 0: oldqe = 0 FOR j = 1 TO NumSpectVal 4280 Wavel(j) = L1 + (j - 1) * n1 4290 w = L1 + (j - 1) * n1: W3 = w - 1: W4 = w - 1.1 4300 IF n1 <= 1 AND j > 1 THEN OUT P1C, 208 ELSE OUT P1C, 112: OUT P1C, 240 ' slow/fast/neutral 4310 OUT P1C, 128: OUT P1C, 224: OUT P1C, 240 ' forward/start/neutral 4320 FOR I = 1 TO 10 * ms: NEXT I' delay loop 4330 WHILE W1 < W3 4340 CALL ioread(W1)' GOSUB 9260 ' SUBROUTINE (9): Read wavelength 4350 WEND 4360 CALL ioread(W1)' GOSUB 9260 ' SUBROUTINE (9): Read wavelength 4370 IF W1 < W4 THEN 4330 4380 OUT P1C, 208: OUT P1C, 240 ' slow/neutral 4390 WHILE W1 < w 4400 CALL ioread(W1)' GOSUB 9260 ' SUBROUTINE (9): read wavelength 4410 WEND 4420 OUT P1C, 160: OUT P1C, 240 ' stop/neutral 4430 IF SRCE% = 1 THEN GOSUB 9100 ' throw away one 730A signal reading 4435 CALL ioread(W1)' GOSUB 9260 ' read wavelength 4440 VIEW (0, 1)-(320, 330) ' text area CLS : LOCATE 1, 1 4450 PRINT USING " #####.# nm "; w 4460 PRINT 4470 GOSUB 9100: S1 = s' signal 1 4475 IF SRCE% <> 1 THEN GOTO 4600 ' [new] need only 1 sample from alt srce 4480 PRINT USING "S1 : ##.###^^^^"; S1 4490 GOSUB 9100: S2 = s' signal 2 4500 PRINT USING "S2 : ##.###^^^^"; S2 4510 GOSUB 9100: S3 = s' signal 3 4520 PRINT USING "S3 : ##.###^^^^"; S3 4530 IF Fdetscan = 1 THEN 4550 4540 IF S1 = 0 OR S3 = 0 THEN 4460 ELSE 4570 4550 IF S1 = 0 AND S3 = 0 THEN 4580 4560 IF S3 = 0 THEN 4460 4570 IF ABS((S1 - S3) / S3) > P THEN 4460 4580 s = (S1 + S3) / 2 4590 PRINT : PRINT USING "Average = ##.###^^^^"; s 4600 IF Fdetscan = 1 THEN 4610 ELSE 4630 ' entry from aly source 4610 IF s = 0 THEN Tstdet(j) = 0: GOTO 4690 4620 GOTO 4650 4630 K(j) = s / R((j - 1) * J4 + J3) / STDarea ' irradiance output [watts/cm^2] 4640 GOTO 4690 4650 IF ND((j - 1) * NDJ2 + NDJ1) = 0 THEN ND((j - 1) * NDJ2 + NDJ1) = 1E-15 4655 Tstdet(j) = (s / (ND((j - 1) * NDJ2 + NDJ1) / 100)) / K((j - 1) * J2 + J1) / tstarea ' test det. response [A/W] or [V/W] 4660 ' 4670 ' - PRINT DATA ROUTINE - 4680 ' 4690 ON ERROR GOTO 9370 ' SUBROUTINE (10): Error-check printer 4700 IF h - 5 = 0 THEN 4770 4710 IF Fdetscan = 1 THEN 4740 4720 'lprint USING "#####.# ##.###^^^^ ##.###^^^^ ##.###^^^^ ##.###^^^^"; w; K(j); K(j) * STDarea; s; R((j - 1) * J4 + J3) 4730 GOTO 4750 4740 'lprint USING "#####.# ##.###^^^^ ##.###^^^^ ###.### ##.###^^^^ ##.###^^^^"; w; Tstdet(j); Tstdet(j) * tstarea; Tstdet(j) * (1.2395 / (w / 1000)) * 100; s; K((j - 1) * J2 + J1); 4745 IF ND% = 1 THEN a = 0'lprint USING " ###.###"; ND((j - 1) * NDJ2 + NDJ1); IF camsig <> 0 THEN a = 0'lprint USING " ##### ####"; camsig; itake ELSE 'lprint 4750 h = h + 1 4760 GOTO 4830 4770 'lprint 4780 IF Fdetscan = 1 THEN 4810 4790 'lprint USING "#####.# ##.###^^^^ ##.###^^^^ ##.###^^^^ ##.###^^^^"; w; K(j); K(j) * STDarea; s; R((j - 1) * J4 + J3) 4800 GOTO 4820 4810 'lprint USING "#####.# ##.###^^^^ ##.###^^^^ ###.### ##.###^^^^ ##.###^^^^"; w; Tstdet(j); Tstdet(j) * tstarea; Tstdet(j) * (1.2395 / (w / 1000)) * 100; s; K((j - 1) * J2 + J1); 4815 IF ND% = 1 THEN a = 0'lprint USING " ###.###"; ND((j - 1) * NDJ2 + NDJ1); IF camsig <> 0 THEN a = 0'lprint USING " ##### ####"; camsig; itake ELSE 'lprint 4820 h = 1 4830 ' '740dma real time data plot VIEW (330, 1)-(638, 99), , 1 ' top right waveint = N2 LOCATE 9, 50 ' under top display IF Fdetscan = 1 THEN ' amps per watt signl = Tstdet(j) WINDOW (200, 0)-(1100, .6) PRINT USING "&.###"; "Amps/Watt = "; signl LOCATE 10, 50: PRINT "area-"; area; " cm^2" ELSE IF L1 < 300 THEN rtpmax = 3E-08 ELSE rtpmax = .0000003 signl = K(j) ' irradiance WINDOW (200, 0)-(1100, rtpmax) PRINT "Watts/cm^2 = "; signl LOCATE 10, 50: PRINT "area-"; area; " cm^2" END IF w = w + waveint - N2 ' increment wavelength pointer LINE (oldw, olds)-(w, signl), 2 olds = signl rtqeplt: QEval = (Tstdet(j) * (1.2395 / (w / 1000)) * 100) VIEW (330, 200)-(638, 300), , 1 ' bottom right WINDOW (200, 0)-(1100, 100) LINE (oldw, oldqe)-(w, QEval), 2 oldqe = QEval: oldw = w LOCATE 23, 50: PRINT USING "&##.##"; "QE = "; QEval NEXT j ' dstore = 0 ' flag data just taken as not stored CLOSE ' comm ports 4835 'lprint CHR$(18); CHR$(27) + "T"; CHR$(27) + "0"' 10 CPI (normal), cancel superscript,1/8 inch lf 4837 WIDTH "LPT1:", 80 ' set device width 4840 'lprint lin$ 4850 'lprint : 'lprint ' end scan 4860 ON ERROR GOTO 0 4865 IF SRCE% > 3 THEN CLOSE #1: COMOPEN% = 0 4870 Fabort = 0 ' scan complete ''lprint CHR$(7); CHR$(7); CHR$(7); ' beep the operator CALL ptrbeep(3) ' 3 beeps from printer 4880 ' 4890 ' - SELECT OPTION - 4900 ' mainmenu: 4910 VIEW: CLS 4920 IF Fabort = 0 AND Fdetscan = 0 THEN 4930 ELSE 4950 ' completed cal run 4930 K1$ = "Test D": K2$ = " Cal": K3$ = "": K4$ = "StoreC": K5$ = "Plot C": K6$ = "OldNew": K7$ = "": K8$ = "": K9$ = "": K10$ = " End " 4940 GOTO 5060 4950 IF Fabort = 1 AND Fdetscan = 0 THEN 4960 ELSE 4970 ' aborted cal run 4960 K1$ = "": K2$ = " Cal": K3$ = "": K4$ = "": K5$ = "": K6$ = "OldNew": K7$ = "": K8$ = "": K9$ = "": K10$ = " End ": GOTO 5060 4970 IF GenNewcal = 1 THEN 5020 ' completed test run using new calibration data 4980 IF Fabort = 0 AND Fdetscan = 1 THEN 4990 ELSE 5000 ' completed test det. run using 'old' 4990 K1$ = "Test D": K2$ = "": K3$ = "QEmenu": K4$ = "StoreP": K5$ = "Plot P": K6$ = "OldNew": K7$ = "StoreI": K8$ = "Plot I": K9$ = "Plot C": K10$ = " End ": GOTO 5060 5000 ' F3=1 AND Fdetscan=1 , aborted test det. run using 'old' 5010 K1$ = "Test D": K2$ = "": K3$ = "": K4$ = "": K5$ = "": K6$ = "OldNew": K7$ = "": K8$ = "": K9$ = "Plot C": K10$ = " End ": GOTO 5060 5020 IF Fabort = 0 AND Fdetscan = 1 THEN 5030 ELSE 5040 ' completed test det. run using 'new' 5030 K1$ = "Test D": K2$ = " Cal": K3$ = "QEmenu": K4$ = "StoreP": K5$ = "Plot P": K6$ = "OldNew": K7$ = "StoreI": K8$ = "Plot I": K9$ = "": K10$ = " End ": GOTO 5060 5040 IF Fabort = 1 AND Fdetscan = 1 THEN 5050 ELSE 5060' aborted test det. run using 'new' 5050 K1$ = "Test D": K2$ = " Cal": K3$ = "": K4$ = "": K5$ = "": K6$ = "OldNew": K7$ = "": K8$ = "": K9$ = "": K10$ = " End " 5060 IF Fabort = 1 AND Fdetscan = 0 THEN 5080 ELSE 5070 5070 PRINT "F1 : measure test detector (Part) response" 5080 IF GenNewcal = 0 THEN 5100 5090 PRINT "F2 : run calibration scan" 5100 IF Fabort = 1 THEN 5170' aborted scan 5110 IF Fdetscan = 1 THEN 5115 ELSE 5140 ' test scan 5115 PRINT "F3 : test detector Quantum efficiency submenu" 5120 PRINT "F4 : store test detector power response data" 5130 PRINT "F5 : plot test detector normalized power reponse data": GOTO 5170 5140 IF GenNewcal = 1 AND Fdetscan = 0 THEN 5150 ELSE 5170 5150 PRINT "F4 : store calibration irradiance factors" 5160 PRINT "F5 : plot normalized calibration irradiance factors ('new')" 5170 PRINT "F6 : return to 'OLD' or 'NEW' calibration factors option" 5180 IF Fdetscan = 0 THEN GOTO 5210 5190 PRINT "F7 : store test detector irradiance response data" 5200 PRINT "F8 : plot test detector normalized irradiance response data" 5210 IF GenNewcal = 0 THEN PRINT "F9 : plot normalized calibration irradiance factors ('old')" 5220 PRINT "F10: end" 5230 Q$ = "Select option." 5240 GOSUB getfkey ' SUBROUTINE (7): Assign key labels returns a 5245 IF a = 3 THEN qe% = 1: GOTO 12000 ' added for Tektronix 5250 ON a GOTO 5270, 5290, 5250, 5320, 5340, 5310, 5330, 5350, 6350, bail 5260 ' 5270 IF dstore = 0 THEN ' fkey entry pt PRINT "Data is not stored! do you wish to store data now? (y/n) " 5271 kyp$ = INKEY$: IF kyp$ = "" THEN GOTO 5271 IF kyp$ = "y" OR kyp$ = "Y" THEN GOTO mainmenu END IF Fdetscan = 1 ' flag: test detector scan 5280 GOTO 5300 5290 IF dstore = 0 THEN ' fkey entry pt PRINT "Data is not stored! do you wish to store data now? (y/n) " 5292 kyp$ = INKEY$: IF kyp$ = "" THEN GOTO 5292 IF kyp$ = "y" OR kyp$ = "Y" THEN GOTO mainmenu END IF Fdetscan = 0 ' flag: cal detector scan 5300 GOTO 5370 5310 CLS : Fdetscan = 0: GOTO 1310 ' old/new calibration file ' fkey entry pt 5320 Fstrplt = 0: area$ = STR$(tstarea): GOTO 5710 ' store test det power data ' fkey entry pt 5330 Fstrplt = 1: area$ = STR$(STDarea): GOTO 5710 ' store test det irrad data ' fkey entry pt 5340 Fstrplt = 0: GOTO 6350 ' plot test det power data ' fkey entry pt 5350 Fstrplt = 1: GOTO 6350 ' plot det irrad data ' fkey entry pt 5360 ' 5370 ' - \ OPTIONS - 5380 ' 5390 ' -change range - 5400 CLS IF dstore = 0 THEN PRINT "Data is not stored! do you wish to store data now? (y/n) " 5401 kyp$ = INKEY$: IF kyp$ = "" THEN GOTO 5401 IF kyp$ = "y" OR kyp$ = "Y" THEN GOTO 5320 END IF 5410 K1$ = "Same": K2$ = "": K3$ = "": K4$ = "": K5$ = "": K6$ = "": K7$ = "": K8$ = "": K9$ = "": K10$ = "Change" 5420 IF Fdetscan = 1 THEN 5440 ' flag: test scan 5430 PRINT "Current Calibration Range:"; L2; "to"; u2; "nm @"; N2; "nm. interval.": PRINT : GOTO 5450 5440 PRINT "Current Test Range:"; L1; "to"; u1; "nm @"; n1; "nm.": PRINT 5450 PRINT "F1 : same range and interval" 5460 PRINT "F10: change range and interval" 5470 Q$ = "Select option." 5480 GOSUB getfkey ' SUBROUTINE (7): Assign key labels 5490 ON a GOTO 5510, 5490, 5490, 5490, 5490, 5490, 5490, 5490, 5490, 5512 5500 ' 5510 A1 = 10: GOTO 5520 5512 A1 = 1: GOTO 5520 5520 IF Fdetscan = 1 AND Tcmnt$ = "" THEN Fchgareans = 0: GOTO 1845 5530 ' 5540 ' - change noise level, Comments & or area 5550 ' 5560 CLS 5570 K1$ = "Same": K2$ = "": K3$ = "": K4$ = "": K5$ = "": K6$ = "": K7$ = "": K8$ = "": K9$ = "": K10$ = "Change" 5580 IF Fdetscan = 1 THEN 5600 5590 PRINT "Cal Run Comments: "; K$: GOTO 5610 PRINT "STD detector area: "; STDarea; " cm^2" 5600 PRINT "Test Detector Comments: "; Tcmnt$ PRINT "Test detector area: "; tstarea; " cm^2" 5610 PRINT "Signal Noise Level:"; P * 100; "%" PRINT "data file path "; path$ 5620 PRINT : PRINT "F1 : Same noise level or area or LOT number" 5630 PRINT "F10 : Change noise level, area, or LOT number" 5640 Q$ = "Select option." 5650 GOSUB getfkey ' SUBROUTINE (7): Assign key labels 5660 ON a GOTO 5690, 5660, 5660, 5660, 5660, 5660, 5660, 5660, 5660, 5680 5670 ' 5680 Fchgareans = 0: GOTO 1845 ' change ' change F2 TO 5690 Fchgareans = 1: GOTO 1845 ' same 5700 ' 5710 ' - DATA STORAGE ROUTINE - 5720 ' 5730 CLS 5740 PRINT "The data file name can be 1-8 characters in length. Valid characters include:" 5750 PRINT "A-Z 0-9 ( ) { } @ # $ % ^ & ! - _ ` ' / ~" 5760 PRINT : PRINT "Any other characters are invalid. The program will automatically add the appropriate extension to designate a data file." IF LEN(partid$) = 12 THEN nme$ = MID$(partid$, 1, 4) + MID$(partid$, 8, 2) + MID$(partid$, 11, 2) ' nme$ = nme$ + ".x" + MID$(partid$, 5, 2) '4192BAN01-04 --> 41920104.xxx '123456789012345678 ' whew, What a bitch! who thought up this screwy name anyway ? ELSE nme$ = MID$(partid$, 2, 3) + MID$(partid$, 7, 2) + MID$(partid$, 10, 2) ' PRINT partid$, nme$ '1376an12-05 '123456789012345678 END IF PRINT "Press 'Enter' to use the suggested file name is --> ", nme$; 5770 PRINT lin$ 5780 PRINT "Enter name of data file where values are to be stored. <"; nme$; "> "; CALL clrky: INPUT F$ 5790 IF F$ = "" THEN F$ = nme$ ' use default created name 5800 F$ = LEFT$(F$, 8): FPER = INSTR(1, F$, ".") 5810 IF FPER <> 0 THEN F$ = LEFT$(F$, FPER - 1) 5820 ext$ = ".VDR" ' visible detector responsivity IF Fdetscan = 0 THEN ext$ = ".VCL" 'visible Calibration IF Fstrplt = 1 THEN ext$ = LEFT$(ext$, 3) + "I" ' irradiance data store IF L1 < 340 THEN ext$ = ".U" + RIGHT$(ext$, 2) ' uv detctr responsivity IF qe% = 1 THEN ext$ = LEFT$(ext$, 3) + "Q"' for quantum efficiency data F$ = F$ + ext$: IF F$ = ext$ THEN 5770 ' this algorithm is funna 5830 ON ERROR GOTO 8000 ' SUBROUTINE (4): Error-create F$ 5840 IF Fdetscan = 0 THEN path$ = root$ ' cal file CALL logit(TIME$ + " Storing " + path$ + "\" + F$) OPEN path$ + "\" + F$ FOR OUTPUT AS #1 ' file data OPEN "d:\qetest\netfile\" + F$ FOR OUTPUT AS #2 ' file to be moved area$ = " area = " + area$ + " cm^2" 5850 IF Fdetscan = 0 THEN GOTO 5930 ' CAL file store 5860 IF Fstrplt = 1 THEN GOTO 5900 ' DUT data file store 5865 IF qe% = 1 THEN WRITE #1, Tcmnt$ + area$, uq$, D1, L1, u1, n1 ' : GOTO 5885 WRITE #2, Tcmnt$ + area$, uq$, D1, L1, u1, n1: GOTO 5885 END IF 5870 WRITE #1, Tcmnt$ + area$, u2$, D1, L1, u1, n1 ' Test file store, power WRITE #2, Tcmnt$ + area$, u2$, D1, L1, u1, n1 ' Test file store, power 5880 FOR I = 1 TO NumSpectVal WRITE #1, Tstdet(I) WRITE #2, Tstdet(I) NEXT I 5882 GOTO 5980 5885 ' Quantum efficiency data store FOR I = 1 TO NumSpectVal WRITE #1, Tstdet(I) * (1.2395 / (Wavel(I) / 1000)) * 100 WRITE #2, Tstdet(I) * (1.2395 / (Wavel(I) / 1000)) * 100 ' file to be moved NEXT I ' [NEW] - QE - 5890 GOTO 5980 5900 WRITE #1, Tcmnt$ + area$, U22$, D1, L1, u1, n1 ' Test file store, irradiance WRITE #2, Tcmnt$ + area$, U22$, D1, L1, u1, n1 ' Test file store, irradiance 5910 FOR I = 1 TO NumSpectVal WRITE #1, Tstdet(I) * tstarea WRITE #2, Tstdet(I) * tstarea ' file to be moved NEXT I 5920 GOTO 5980 5930 ' Cal File store 5940 WRITE #1, K$, U3$, D2, L2, u2, N2 5950 FOR I = 1 TO NumSpectVal 5960 WRITE #1, K(I) 5970 NEXT I GOTO endfl 5980 WRITE #1, partid$, mask$, side$ WRITE #2, partid$, mask$, side$ endfl: CLOSE #1: CLOSE #2 dstore = 1 ' flag data is stored mdn 5990 ON ERROR GOTO 0 6000 ON ERROR GOTO 9370 ' SUBROUTINE (10): Error-check printer 6010 'lprint lin$ 6020 'IF Fdetscan = 0 THEN 'lprint "Writing SYSTEM MONOCHROMATIC IRRADIANCE OUTPUT DATA FILE" 6025 'IF Fdetscan = 1 AND qe% = 0 THEN 'lprint "Writing DETECTOR SPECTRAL RESPONSE output DATA FILE" 6027 'IF Fdetscan = 1 AND qe% = 1 THEN 'lprint "Writing QUANTUM EFFICIENCY output DATA FILE" 6030 'lprint "FILEName: "; F$; " to path "; path$ 6040 IF Fdetscan = 0 THEN 'lprint "Comments: "; K$ ELSE 'lprint "Comments: "; Tcmnt$; " "; partid$; " "; mask$; " "; side$ END IF 6050 IF Fdetscan = 0 THEN 6060 ELSE 6070 6060 'lprint "Units: "; U3$: GOTO 6080 6070 'lprint "Units: "; 6072 'IF qe% = 1 THEN 'lprint "Quantum Efficiency": GOTO 6080 6074 'IF Fstrplt = 0 THEN 'lprint u2$ ELSE 'lprint U22$ 6080 'IF Fdetscan = 0 THEN 'lprint "Date:"; D2; " Time of test - "; TIME$ 'ELSE 'lprint "Date:"; D1; " Time of test - "; TIME$ 'END IF 6090 'IF Fdetscan = 0 THEN 'lprint "L ="; L2 ELSE 'lprint "L ="; L1 6100 'IF Fdetscan = 0 THEN 'lprint "U ="; u2 ELSE 'lprint "U ="; u1 6110 'IF Fdetscan = 0 THEN 'lprint "N ="; N2 ELSE 'lprint "N ="; n1 6120 'lprint lin$ 6130 'lprint ': 'lprint : 'lprint : 'lprint 6140 ON ERROR GOTO 0 6150 IF qe% = 1 THEN GOTO 12000 ELSE GOTO 4890 ' select option 6160 ' 6170 ' - ABORT ROUTINE - 6180 ' 6190 OUT P1C, 160: OUT P1C, 240 ' stop/neutral 6200 ON ERROR GOTO 9370 ' SUBROUTINE (10): Error-check printer 6210 'lprint : 'lprint " ------------------- ABORT --------------------": 'lprint lin$: 'lprint 6220 'lprint ': 'lprint : 'lprint 6230 ON ERROR GOTO 0 6235 IF SRCE% > 3 THEN CLOSE #1: COMOPEN% = 0 CLOSE #2 END IF 6240 Fabort = 1: GOTO 4890 6250 ' 6260 ' - END OF PROGRAM - ' fkey entry pt bail: 6270 ' IF dstore = 0 THEN PRINT "Data is not stored! do you wish to store data now? (y/n) "; 6275 kyp$ = INKEY$: IF kyp$ = "" THEN GOTO 6275 'wait for keyp IF kyp$ = "y" OR kyp$ = "Y" THEN GOTO 5320 END IF CALL logit("EXIT program @ " + DATE$ + " " + TIME$) CLS : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT PRINT "Monochrometer is returning to POWER UP wavelength" PRINT : PRINT " Please wait to turn system power off " CALL GOTOWAVE(400) PRINT : PRINT " THANK YOU " 6280 PRINT "End of program!": SOUND 500, 5 ' signals end of program ' 'lprint CHR$(12) ' form feed 6290 END 6300 ' 6310 ' - SUBROUTINE - 6320 ' 6330 ' -------------------------------- 1 ------------------------------------- 6340 ' 6350 ' SUBROUTINE (1): Graphics display ' fkey entry pt 6360 ' 6370 IF a <> 9 THEN 6410 ' calibration file plot ' 6380 L3 = L1: U3 = u1: N3 = n1: M3 = NumSpectVal: L1 = L2: u1 = u2: n1 = N2: NumSpectVal = M2 6390 FOR I = 1 TO NumSpectVal: Wavel(I) = L1 + (I - 1) * n1: NEXT I ' fill wavelength array 6400 ' 6410 ' - data sorting routine - 6420 ' 6425 IF qe% = 1 THEN GOTO 13000 ' alternate "data sorting routine" 6430 IF Fdetscan = 0 OR a = 9 THEN dmax = K(1) ELSE dmax = Tstdet(1) ' maximum 6440 FOR I = 1 TO NumSpectVal ' find maximum 6450 IF Fdetscan = 0 OR a = 9 THEN 6460 ELSE 6480 'true-cal 6460 IF K(I) < dmax THEN 6500 6470 dmax = K(I): GOTO 6500 ' calibration data max 6480 IF Tstdet(I) < dmax THEN 6500 6490 dmax = Tstdet(I) ' test detector data max 6500 NEXT I 6510 ' 6520 ' - normalization loop - 6530 ' 6540 FOR I = 1 TO NumSpectVal 6550 IF Fdetscan = 0 OR a = 9 THEN 6560 ELSE 6600 6560 IF K(I) = dmax THEN w = Wavel(I) 6570 n(I) = K(I) / dmax 'Normalize std det cal values for display 6580 GOTO 6610 6600 IF qe% = 1 THEN ' convert data to QE data n(I) = (Tstdet(I) * (1.2395 / (Wavel(I) / 1000)) * 100) '/ dmax ELSE n(I) = Tstdet(I) / dmax IF Tstdet(I) = dmax THEN w = Wavel(I) END IF 6610 NEXT I 6620 IF Fdetscan = 1 AND Fstrplt = 1 AND a <> 9 THEN dmax = dmax * tstarea' peak for irradiance CALL keyp(kyp$) END IF 6630 ' 6640 ' draw grid 6650 ' 6660 CLS : KEY OFF ' plot data to screen SCREEN 2, 0, 0 '6670 ' '6680 ' X-axis lines (horizontal) '6690 ' 6700 FOR Y = 3 TO 163 STEP 16 6710 LINE (30, Y)-(610, Y) 6720 NEXT Y '6730 ' '6740 ' Y labels '6750 ' 6760 ROW = 21 6770 FOR YLABEL = 0 TO 1.1 STEP .1 6780 LOCATE ROW, 1 6790 PRINT USING "#.#"; YLABEL 6800 ROW = ROW - 2 6810 NEXT YLABEL '6820 ' '6830 ' Y-axis lines (vertical) & X labels '6840 ' 6850 F = 1 6860 IF (u1 - L1) / (n1 * F) <= 10 THEN 6880 6870 F = F + 1: GOTO 6860 6880 FOR X = 0 TO (u1 - L1) / (n1 * F) 6890 WAVELABEL = L1 + n1 * F * X 6900 WAVEGRIDPOS = (WAVELABEL - L1) * (610 - 30) / (u1 - L1) + 30 6910 LINE (WAVEGRIDPOS, 163)-(WAVEGRIDPOS, 3) 6920 WAVELABELPOS = (WAVELABEL - L1) * .125 * (610 - 30) / (u1 - L1) + .125 * 30 6930 IF WAVELABEL < 1000 THEN LOCATE 22, WAVELABELPOS: PRINT USING "###"; WAVELABEL: GOTO 6960 6940 IF WAVELABEL >= 1000 AND WAVELABEL < 10000 THEN LOCATE 22, WAVELABELPOS - 1: PRINT USING "####"; WAVELABEL: GOTO 6960 6950 IF WAVELABEL >= 10000 THEN LOCATE 22, WAVELABELPOS - 2: PRINT USING "#####"; WAVELABEL 6960 NEXT X '6970 ' '6980 ' plot data '6990 ' 7000 PSET (30, (1 - n(1)) * (163 - 3) / (1 - 0) + 3) 7010 FOR I = 1 TO NumSpectVal 7020 LINE -((Wavel(I) - L1) * (610 - 30) / (u1 - L1) + 30, (1 - n(I)) * (163 - 3) / (1 - 0) + 3) 7030 NEXT I 7040 LOCATE 23, 20: PRINT USING "Peak Value = ##.###^^^^ @ #####.#nm"; dmax; w 7050 ' CALL keyp(kyp$) IF kyp$ = "p" OR kyp$ = "P" THEN GOTO 7060 ELSE SCREEN 9, 0, 0 ' back to good graphics IF qe% = 1 THEN GOTO 12000 ' qemenu GOTO 4890 'mainmenu END IF 7060 ' dump graphics display to printer 7070 ' 7080 ON ERROR GOTO 9370 ' SUBROUTINE (10): Error-check printer 'lprint CHR$(12) ' ff 7090 DEF SEG = &H40 7100 HIGHMEM = (((256 * PEEK(20) + PEEK(19)) / 64) - 1) * 4096 + 3988 7110 DEF SEG = HIGHMEM 7120 SBRPTSC = 0 7130 POKE 0, 205: POKE 1, 5: POKE 2, 203 7140 DEF SEG = HIGHMEM: CALL ABSOLUTE(SBRPTSC) ' some kind of DOS dump screen ? SCREEN 9, 0, 0 '7150 ' '7160 ' print data file heading '7170 ' 7180 ''lprint CHR$(27) + "@"; CHR$(27) + "x1" 'reset and set printer GOSUB smaldata 7190 'IF Fdetscan = 0 OR a = 9 THEN 'lprint "SYSTEM MONOCHROMATIC IRRADIANCE DATA FILE PLOT" 7195 'IF Fdetscan = 1 AND qe% = 0 THEN 'lprint "DETECTOR SPECTRAL RESPONSE DATA FILE PLOT" 7197 'IF Fdetscan = 1 AND qe% = 1 THEN 'lprint "QUANTUM EFFICIENCY DATA FILE PLOT" 7200 'lprint 7210 'IF a = 9 THEN 'lprint "Data File Name: "; Nstdcal$ 7220 'IF Fdetscan = 0 OR a = 9 THEN 'lprint "Data File Comments: "; K$ ELSE 'lprint "Data File Comments: "; Tcmnt$ 7230 'lprint "Data File Units: "; 7240 'IF Fdetscan = 0 OR a = 9 THEN GOTO 7250 ELSE GOTO 7260 7250 'lprint U3$: GOTO 7270 7260 ' IF qe% = 1 THEN 'lprint "Quantum Efficiency": GOTO 7270 7265 ' IF F9 = 0 THEN 'lprint u2$ ELSE 'lprint U22$ 7270 'IF Fdetscan = 0 OR a = 9 THEN 'lprint "Data File Date:"; D2 ELSE 'lprint "Date File Date:"; D1 7280 'lprint : 'lprint USING "Wavelength Range: #####.# - #####.#nm @ ###.#nm"; L1; u1; n1 7290 'lprint : 'lprint USING "Peak Value = ##.###^^^^ @ #####.#nm"; dmax; w 7300 'lprint lin$: 'lprint lin$: 'lprint : 'lprint 7310 ON ERROR GOTO 0 7320 IF a <> 9 THEN 7350 7330 L1 = L3: u1 = U3: n1 = N3: NumSpectVal = M3 7340 FOR I = 1 TO NumSpectVal: Wavel(I) = L1 + (I - 1) * n1: NEXT I 7350 'SCREEN 0 7355 IF qe% = 1 THEN GOTO 12000 ELSE GOTO 4890 ' return to 'OPTION' menu 7360 ' -------------------------------- 2 ------------------------------------- 7370 ' 7380 ' SUBROUTINE (2): Nstdcal$on MSU 7390 ' 7400 IF ERR = 53 THEN 7410 PRINT "Data file '"; Nstdcal$; "' is not stored on this mass storage device!" CLS : RESUME 1500 ELSE GOTO 7430 END IF 7430 IF ERR = 71 THEN CLS ELSE 7510 7440 PRINT "The disc drive door is open or a disc is not in the drive." 7450 PRINT "Place the correct disc in the default drive." 7460 PRINT : PRINT lin$ 7470 PRINT "Insert disc. Press space bar when fixed.": SOUND 500, 1 7480 CALL clrky 7490 a$ = INKEY$: IF a$ = " " THEN 7500 ELSE 7490 7500 CLS : RESUME 1630 ' return 7510 GOSUB 8490 ' SUBROUTINE (6): Unidentified error 7520 CLS : RESUME 1600 ' return 7530 ' 7540 ' -------------------------------- 3 ------------------------------------- 7550 ' 7560 ' SUBROUTINE (3): Check L1 & U1, or L2 & U2 7570 ' 7580 CLS 7590 IF Fdetscan = 1 THEN 7790' test scan 7600 ' 7610 ' - check L2 & U2 7620 IF L2 < u2 THEN 7660' calibration scan 7630 PRINT L2; "is not <"; u2; "!": PRINT 7640 PRINT "The lower wavelength limit must be < the upper wavelength limit!" 7650 PRINT : GOTO 1930 7660 IF L2 >= l THEN 7690 7670 PRINT L2; "is not >="; l; "!": PRINT 7680 GOTO 1930 7690 TVAR = CSNG(L2 - l) / n: IF TVAR = CINT((L2 - l) / n) THEN 7720 7700 PRINT L2; "is not a wavelength whose value is stored in '"; Nstdcal$; "'!" 7710 PRINT : GOTO 1930 7720 IF u2 <= u THEN 7750 7730 PRINT u2; "is not <="; u; "!": PRINT 7740 GOTO 1930 7750 TVAR = CSNG((u2 - l) / n): IF TVAR = CINT((u2 - l) / n) THEN 7960 7760 PRINT u2; "is not a wavelength whose value is stored in '"; Nstdcal$; "'!" 7770 PRINT : GOTO 1930 7780 ' 7790 ' - check L1 & U1 7800 IF L1 < u1 THEN 7840' test scan 7810 PRINT L1; "is not <"; u1; "!": PRINT 7820 PRINT "The lower wavelength limit must be < the upper wavelength limit!" 7830 PRINT : GOTO 1930 7840 IF L1 >= L2 THEN 7870 7850 PRINT L1; "is not >="; L2; "!": PRINT 7860 GOTO 1930 7870 TVAR = CSNG((L1 - L2) / N2): IF TVAR = CINT((L1 - L2) / N2) THEN 7900 7880 PRINT L1; "is not a wavelength whose value is contained in the calibration data file.": PRINT : GOTO 1930 7890 PRINT : GOTO 1990 7900 IF u1 <= u2 THEN 7930 7910 PRINT u1; "is not <="; u2; "!": PRINT 7920 GOTO 1930 7930 TVAR = CSNG((u1 - L2) / N2): IF TVAR = CINT((u1 - L2) / N2) THEN 7960 7940 PRINT u1; "is not a wavelength whose value is contained in the calibration data file." 7950 PRINT : GOTO 1930 7960 RETURN 7970 ' 7980 ' -------------------------------- 4 ------------------------------------- 7990 ' 8000 ' SUBROUTINE (4): Error-create F$ 8010 ' 8020 IF ERR = 70 THEN CLS ELSE 8090 8030 PRINT "Mass storage medium is write-protected!": PRINT 8040 PRINT lin$ 8050 PRINT "Press space bar when fixed.": SOUND 500, 1 8060 CALL clrky 8070 a$ = INKEY$: IF a$ = " " THEN 8080 ELSE 8070 8080 RESUME 5830 ' return to open F$ 8090 IF ERR = 61 THEN CLS ELSE 8170 8100 PRINT "All diskette storage space is in use!": PRINT 8110 PRINT "If there are any files on the diskette that you not longer need, erase them or use a new diskette. Then retry the operation." 8120 PRINT : PRINT lin$ 8130 PRINT "Press space bar when fixed.": SOUND 500, 1 8140 CALL clrky 8150 a$ = INKEY$: IF a$ = " " THEN 8160 ELSE 8150 8160 RESUME 5710 ' return to DATA STORAGE ROUTINE 8170 IF ERR = 67 THEN CLS ELSE 8240 8180 PRINT "The file directory on the mass storage medium is full or the file specification is invalid!" 8190 PRINT : PRINT lin$ 8200 PRINT "If the file specification is okay, use a new formatted disc & retry operation. Press space bar when ready.": SOUND 500, 1 8210 CALL clrky 8220 a$ = INKEY$: IF a$ = " " THEN 8230 ELSE 8220 8230 RESUME 5710 ' return to DATA STORAGE ROUTINE 8240 IF ERR = 71 THEN CLS ELSE 8320 8250 PRINT "The disc door is open or a disc is not in the drive.": PRINT 8260 PRINT "Place the correct disc in the default drive." 8270 PRINT : PRINT lin$ 8280 PRINT "Press space bar when ready.": SOUND 500, 1 8290 CALL clrky 8300 a$ = INKEY$: IF a$ = " " THEN 8310 ELSE 8300 8310 RESUME 5830 ' return to open F$ 8320 GOSUB 8490 ' SUBROUTINE (6): Unidentified error 8330 RESUME 5710 ' return to DATA STORAGE ROUTINE 8340 ' 8350 ' -------------------------------- 5 ------------------------------------- 8360 ' 8370 ' SUBROUTINE (5): Error-check X$ 8380 ' 8390 IF errn = 15 THEN 8400 ELSE 8440 8400 PRINT 8410 PRINT "The length of this input is > 254 characters!" 8420 PRINT 8430 RESUME 3070 ' return to enter Comments 8440 GOSUB 8490 ' SUBROUTINE (6): Unidentified error 8450 RESUME 3030 ' return to enter Comments 8460 ' 8461 ' SUBROUTINE (55): Error-check X$ ' IF errn = 55 THEN CLOSE : RESUME END IF IF errn = 15 THEN 8401 ELSE 8441 8401 PRINT PRINT "The length of this input is > 254 characters!" PRINT RESUME 3141 ' return to enter det area 8441 GOSUB 8490 ' SUBROUTINE (6): Unidentified error RESUME 3130 ' return to enter Comments 8470 ' -------------------------------- 6 ------------------------------------- 8480 ' 8490 ' SUBROUTINE (6): Unidentified error 8500 ' 8510 CLS IF ERR = 55 THEN CLOSE : PRINT "error 55 trapped ": RESUME IF ERR = 24 THEN PRINT "ERROR # 24 - Device Timeout" PRINT "Please plug serial cable into the Uniblitz " PRINT "or Check Printer " GOTO 8540 END IF 8520 PRINT "Error #"; ERR; "on line"; ERL; "!": PRINT 8530 PRINT "Please refer to your IBM PC BASIC manual." 8540 PRINT : PRINT lin$ 8550 PRINT "Press space bar when ready.": SOUND 500, 1 8560 CALL clrky 8570 a$ = INKEY$: IF a$ = " " THEN 8580 ELSE 8570 8580 CLS 8590 RETURN 8600 ' 8610 ' -------------------------------- 7 ------------------------------------- 8620 ' getfkey: 8630 ' SUBROUTINE (7): Assign key labels 8640 ' 8650 a = 0 8660 PRINT : PRINT "Use 'soft key' answer." 8670 PRINT lin$ 8680 PRINT Q$ 8690 ' 8700 KEY 1, K1$: KEY 2, K2$: KEY 3, K3$: KEY 4, K4$: KEY 5, K5$ 8710 KEY 6, K6$: KEY 7, K7$: KEY 8, K8$: KEY 9, K9$: KEY 10, K10$ 8720 SOUND 500, 1 8730 IF K1$ = "" THEN ON KEY(1) GOSUB 9050 ELSE ON KEY(1) GOSUB 8880 8740 IF K2$ = "" THEN ON KEY(2) GOSUB 9050 ELSE ON KEY(2) GOSUB 8890 8750 IF K3$ = "" THEN ON KEY(3) GOSUB 9050 ELSE ON KEY(3) GOSUB 8900 8760 IF K4$ = "" THEN ON KEY(4) GOSUB 9050 ELSE ON KEY(4) GOSUB 8910 8770 IF K5$ = "" THEN ON KEY(5) GOSUB 9050 ELSE ON KEY(5) GOSUB 8920 8780 IF K6$ = "" THEN ON KEY(6) GOSUB 9050 ELSE ON KEY(6) GOSUB 8930 8790 IF K7$ = "" THEN ON KEY(7) GOSUB 9050 ELSE ON KEY(7) GOSUB 8940 8800 IF K8$ = "" THEN ON KEY(8) GOSUB 9050 ELSE ON KEY(8) GOSUB 8950 8810 IF K9$ = "" THEN ON KEY(9) GOSUB 9050 ELSE ON KEY(9) GOSUB 8960 8820 IF K10$ = "" THEN ON KEY(10) GOSUB 9050 ELSE ON KEY(10) GOSUB 8970 8830 KEY(1) ON: KEY(2) ON: KEY(3) ON: KEY(4) ON: KEY(5) ON 8840 KEY(6) ON: KEY(7) ON: KEY(8) ON: KEY(9) ON: KEY(10) ON 8850 KEY ON 8860 ' 8870 IF a = 0 THEN 8870 ELSE KEY OFF: RETURN 8880 a = 1: GOTO 8980 8890 a = 2: GOTO 8980 8900 a = 3: GOTO 8980 8910 a = 4: GOTO 8980 8920 a = 5: GOTO 8980 8930 a = 6: GOTO 8980 8940 a = 7: GOTO 8980 8950 a = 8: GOTO 8980 8960 a = 9: GOTO 8980 8970 a = 10: GOTO 8980 8980 KEY(1) OFF: KEY(2) OFF: KEY(3) OFF: KEY(4) OFF: KEY(5) OFF 8990 KEY(6) OFF: KEY(7) OFF: KEY(8) OFF: KEY(9) OFF: KEY(10) OFF 9000 KEY 1, "": KEY 2, "": KEY 3, "": KEY 4, "": KEY 5, "" 9010 KEY 6, "": KEY 7, "": KEY 8, "": KEY 9, "": KEY 10, "" 9020 K1$ = "": K2$ = "": K3$ = "": K4$ = "": K5$ = "" 9030 K6$ = "": K7$ = "": K8$ = "": K9$ = "": K10$ = "" 9040 RETURN 9050 IF INKEY$ = "T" THEN 9060 ELSE SOUND 500, 1: RETURN 9060 BEEP: FOR J0 = 1 TO 10000 * ms: NEXT J0: BEEP: RETURN ' 10 sec test 9070 ' 9080 ' -------------------------------- 8 ------------------------------------- 9090 ' 9100 ' SUBROUTINE (8): Read 736 signal 9110 ' 9115 IF SRCE% <> 1 THEN GOSUB 11000: RETURN ' skip this sub if alt input (QE STATION) 9120 FOR I = 1 TO 450 * ms: NEXT I 9130 PORT2A = INP(P2A): PORT2B = INP(P2B): PORT2C = INP(P2C) 9140 DATAREADY = ((PORT2C AND 8) / 8) 9150 IF DATAREADY = 1 THEN 9130 9160 PORT2AHIGH = (PORT2A AND HIMASK) / 16: PORT2ALO = (PORT2A AND LOMASK) 9170 PORT2BHIGH = (PORT2B AND HIMASK) / 16: PORT2BLO = (PORT2B AND LOMASK) 9180 PORT2C1 = PORT2C AND 1 9190 EXPONENT = ((PORT2C AND 4) / 4) 9200 POWER = -(EXPONENT * 10 + PORT2ALO) 9210 MANTISSA = PORT2C1 * 1 + PORT2BHIGH * .1 + PORT2BLO * .01 + PORT2AHIGH * .001 9220 s = MANTISSA * (10 ^ POWER): RETURN 9230 ' '9240 ' -------------------------------- 9 ------------------------------------- '9250 ' '9260 ' SUBROUTINE (9): Read 740-1C wavelength '9270 ' '9280 PORT1A = INP(P1A): PORT1B = INP(P1B): PORT1C = INP(P1C) '9290 PORT1AHIGH = (PORT1A AND HIMASK) / 16: PORT1ALO = PORT1A AND LOMASK '9300 PORT1BHIGH = (PORT1B AND HIMASK) / 16: PORT1BLO = PORT1B AND LOMASK '9310 PORT1C3 = PORT1C AND 3 '9320 W1 = (PORT1C3 * 1000 + PORT1BHIGH * 100 + PORT1BLO * 10 + PORT1AHIGH * 1 + PORT1ALO * .1) '9330 RETURN 9340 ' 9350 '-------------------------------- 10 ------------------------------------- 9360 ' 9370 ' SUBROUTINE (10): Error-check printer 9380 ' 9390 IF ERR = 24 THEN CLS ELSE 9470 9400 PRINT "Device timeout!": PRINT 9410 PRINT "The printer is not online, or the cable connector is loose or faulty.": PRINT 9420 PRINT lin$ 9430 PRINT "Press space bar when fixed.": SOUND 500, 1 9440 CALL clrky 9450 a$ = INKEY$: IF a$ = " " THEN 9460 ELSE 9450 9460 RESUME 9470 IF ERR = 25 THEN CLS ELSE 9550 9480 PRINT "Device fault!": PRINT 9490 PRINT "Printer is off or not online.": PRINT 9500 PRINT lin$ 9510 PRINT "Press space bar when printer is ready.": SOUND 500, 1 9520 CALL clrky 9530 a$ = INKEY$: IF a$ = " " THEN 9540 ELSE 9530 9540 RESUME 9550 IF ERR = 27 THEN CLS ELSE 9610 9560 PRINT "The printer is OUT of paper, or not switched on." 9570 PRINT : PRINT lin$ 9580 PRINT "Press space bar when fixed.": SOUND 500, 1 9590 CALL clrky 9600 a$ = INKEY$: IF a$ = " " THEN 9610 ELSE 9600 9610 GOSUB 8490 ' SUBROUTINE (6): Unidentified error 9620 RESUME 9630 END 9640 ' 9650 ' --------------TIMELOOP MEASUREMENT SUBROUTINE----------------------- CALL timelp(ms) RETURN 9998 '============================ NEW CODE ============================== 9999 ' 10000 ' - INPUT SOURCE - This routine allows the user to select the source 10010 ' of data input (formally only from 730A). Data is 10020 ' read from 730A, Keyboard, COM1, or COM2. 10030 ' 10035 IF Fdetscan = 0 THEN SRCE% = 1: RETURN ' 730A input only for cal scan 10040 K1$ = " 730A ": K2$ = "": K3$ = " KYBD ": K4$ = "": K5$ = " COM1 ": K6$ = "": K7$ = " COM2 ": K8$ = "": K9$ = "": K10$ = "" 10050 CLS ednflg = 0 ' signal that EDN is not known 10060 PRINT "Input Source Option": PRINT 10070 PRINT "F1 = Read from 730A" 10080 PRINT "F3 = Manually enter data from Keyboard" 10090 PRINT "F5 = Read from RS232 COM1" 10100 PRINT "F7 = Read from RS232 COM2 AUTOQE (Heurikon is slave)" 10110 Q$ = "Select source of program input." 10120 GOSUB getfkey ' SUB (7): Assign key labels 10130 SRCE% = a ' same val as Function key # 10140 RETURN 10150 ' 11000 ' - ALT input source - This routine is executed when the user has 11010 ' indicated that signal input shall come from 11020 ' keyboard, COM1, or COM2, vice 730A 11030 ' 11040 IF SRCE% > 3 THEN GOTO 11500 ' ---- must be RS232 11050 ' IF ednflg = 0 THEN CALL ampcalc(ednflg, edn, take, current, dn) 11060 INPUT "Enter signal value in dn (0 allows 'take' change) ", s IF s = 0 THEN CALL ampcalc(ednflg, edn, itake, current, dn) GOTO 11060 END IF camsig = s s = (s * edn / (itake * .05)) / 6.25E+18 ' convert to amps 11070 RETURN ' code from QESLAV -----------------------------------------6-2-92 mdn 11500 IF COMOPEN% = 1 THEN GOTO 11550 ' 11505 IF SRCE% > 5 THEN GOTO 11530 ' ---- must be COM2 11510 OPEN "COM1:4800,N,8" FOR RANDOM AS #1 11520 GOTO 11540 11530 CLS : PRINT "Make sure the Heurikon computer" PRINT "is plugged into PORT2" PRINT "and the Uniblitz shutter" PRINT "is plugged into PORT1." PRINT "ALSO, Use the 730-1 or " PRINT "730-2 ND filter for visible" OPEN "COM2:4800,N,8" FOR RANDOM AS #1 ' Heurikon IF moustest = 0 THEN OPEN "com1:300,n,8,1" FOR OUTPUT AS #2 ' Uniblitz shutter PRINT #2, CHR$(67); ' reset uniblitz END IF 11540 COMOPEN% = 1: PRINT "opening comm port "; SRCE% 11550 ' new heurikon master / slave interface ' the program AUTOQE must be invoked on the Heurikon computer ' of course the entire camera must be set up for the appropriate ' part ( ccdformat, etc.) ' ASSUME Heurikon is port 2 and Uniblitz shutter is port 1 IF ednflg = 0 THEN CALL getslav(boost, lowdn, hidn, moustest) PRINT "Getting edn... " PRINT #1, "E"; ' send flag for EDN value GOSUB getport 'CALL getport(portval) edn = portval PRINT "Got edn - "; edn PRINT "Getting edn... " PRINT #1, "E"; ' send flag for EDN value GOSUB getport 'CALL getport(portval) edn = portval PRINT "Got edn - "; edn IF edn = 0 THEN PRINT " Abort run ----------- EDN must be run on Heurikon first " END IF 'lprint " edn = "; edn Tcmnt$ = Tcmnt$ + " EDN=" + STR$(edn) ednflg = 1 itake = 7 ' starting take END IF getdn: ' main data getter FOR I = 1 TO 20 ' start with fresh data screen LOCATE I, 1: PRINT " " NEXT I LOCATE 1, 1: PRINT "Closing shutter, "; IF moustest = 0 THEN ' so's I can debug in QB with a mouse PRINT #2, CHR$(65); ' close uniblitz ELSE PRINT "CLOSE SHUTTER NOW !!!!!!": 'lprint CHR$(7); : CALL twait(0, 3) END IF 'lprint CHR$(7); ' bell PRINT "Commanding "; itake; " take" PRINT #1, USING "!"; "Z"; : GOSUB waitbuf ' send to heurikon PRINT #1, USING "!"; CHR$(itake); ' for a QE TEST ROUTINE GOSUB getport ' get confirmation ' takes darkframe PRINT "Received a "; portval; STR$(portval) 'lprint CHR$(7); ' bell PRINT "Opening shutter, "; IF moustest = 0 THEN ' so's I can debug in QB with a mouse PRINT #2, CHR$(64) ' Open Uniblitz ELSE PRINT "OPEN SHUTTER NOW !!!!!": 'lprint CHR$(7); : CALL twait(0, 3) END IF PRINT #1, USING "!"; "g"; ' indicate that we're ready to read PRINT "sent g(o)"; IF moustest = 0 THEN ' so's I can debug in QB with a mouse CALL twait(0, 10) ' wait 10 seconds then close shutter PRINT #2, CHR$(65) ' close Uniblitz END IF GOSUB getport ' returns portval in this case MEAN DN 11555 'WHILE EOF(1): WEND ' opportunity for ABORT key to work 11560 'INPUT #1, S ' read a signal value from RS232 camsig = portval PRINT " - DN = "; camsig IF camsig = 0 THEN camsig = 1 IF camsig < lowdn THEN IF itake > 120 THEN ' can't use > 127 over serial port GOTO calcamps ' don't worry about it ELSE IF boost = 1 THEN PRINT 2000 / camsig, INT(2000 / camsig) itaken = itake * INT(2000 / camsig) ' ELSE IF boost = 2 THEN itaken = itake * 2 ELSE itaken = itake + 2 ' boost =3 slow boat to china END IF END IF IF itaken > 120 THEN itaken = 121 END IF END IF itake = itaken ' use this next time around PRINT camsig; " too small,use "; itake GOTO getdn END IF IF camsig > hidn THEN IF boost = 1 THEN itaken = INT(itake / (INT(camsig / 2000))) ELSE IF boost = 2 THEN itaken = INT(itake / 2) ELSE itaken = itaken - 2 END IF END IF IF itaken < 4 THEN IF itake = 4 THEN GOTO calcamps ELSE itaken = 4 END IF itake = itaken PRINT camsig; " too big, use "; itake GOTO getdn END IF calcamps: 'S = (camsig * EDN / (itake * .01)) / 6.25E+18 ' for flat LEDs s = (camsig * edn / (itake * .05)) / 6.25E+18 ' for shutter PRINT "Signal gotten (DN,Amps) "; camsig, s 11570 RETURN compdata: ' for compressed print 8lpi (maryann) 'lprint CHR$(27); "x0"; CHR$(15); CHR$(27); "S0" ' cancel NLQ, 17 cpi compressed? , superscript 'lprint CHR$(27) + "1" ' 7/72 inch line space RETURN smaldata: ' for compressed print 8lpi (maryann) 'lprint CHR$(27); "@"; CHR$(15); CHR$(27); "S0" ' cancel NLQ, 17 cpi compressed? , superscript 'lprint CHR$(27) + "3" '+ CHR$(12)' 12/72 inch line space + FF RETURN nlq: 'lprint CHR$(18); CHR$(27) + "2"; ' cancel compressed, do 6lpi 'lprint CHR$(27) + "x1"; ' do NLQ, do 7/72 line space WIDTH "LPT1:", 80 ' set device width RETURN prtnorm: 'lprint CHR$(18); CHR$(27) + "x0"; ' cancel compressed, do draft mode 'lprint CHR$(27) + "2"; ' 6 lpi RETURN 11600 ' get port routine getport: 'everythin in getport came from here ON ERROR GOTO comerr REM----------------------DUMB TERMINAL REM DUMB TERMINAL dataflg = 0 ' initialize data entry routine anum$ = "" FALSE = 0: TRUE = NOT FALSE XOFF$ = CHR$(19): XON$ = CHR$(17) LOCATE , , 1 PAUSE = FALSE insloop: b$ = INKEY$: IF b$ <> "" THEN PRINT #1, b$; IF EOF(1) THEN GOTO insloop ' don't loop if data in buffer IF LOC(1) > 128 THEN PAUSE = TRUE: PRINT #1, XOFF$; a$ = INPUT$(LOC(1), #1) ' get some characters dataflg = 1 ' got data anum$ = anum$ + a$ ' concatenate characters 'PRINT "---------------------------anum$-"; anum$; "-" FOR I = 1 TO 1000: ii = ii + 1: NEXT I ' wait loop for last characters IF PAUSE THEN PAUSE = FALSE: PRINT #1, XON$; IF LOC(1) > 0 THEN GOTO insloop ' loop if any more characters portval = VAL(anum$) ' return niumeric value 'PRINT "leaving getport ----------------------"; portval, anum$; "-" RETURN comerr: PRINT "ERROR NO."; ERR: RESUME RETURN waitbuf: FOR I = 1 TO 100: ii = ii + 1: NEXT I RETURN clrport: RETURN '----------------------------------------------- Sub routine lotpath ' creates and set path depending on mask and lot lotpath: ON ERROR GOTO direrr CLS PRINT " existing file directories :" OPEN root$ + "maskdir.txt" FOR INPUT AS #1 INPUT #1, dirnum FOR I = 1 TO dirnum INPUT #1, mask$ mask$ = UCASE$(mask$) PRINT mask$; " " NEXT I CLOSE #1 CALL pathstuff(root$, mask$, drv$, lot$) IF lot$ = "" THEN path$ = drv$ 'PRINT " No make dir. now changing path", path$ ' CALL keyp(a$) CHDIR path$ 'PRINT " changed directory path"; path$ ' CALL keyp(a$) ELSE path$ = drv$ + "\" + lot$ 'PRINT " making directory ", path$ ' CALL keyp(a$) MKDIR path$ 'PRINT " made directory now changing path"; path$ ' CALL keyp(a$) CHDIR path$ PRINT " changed directory path"; path$ ' CALL keyp(a$) END IF lotpath = 1 ' signal that lotpath is ok CALL logit(TIME$ + " >Changing directories " + path$) RETURN 'GOTO 1300 direrr: PRINT root$; "-"; mask$; "-"; lot$; " - "; path$ IF ERR = 75 THEN PRINT " # 75 directory already exists. Please wait ..." GOTO reserr ' directory already there END IF IF ERR = 76 THEN ' make directory PRINT " Error #76 need to make new directory " PRINT root$; "-"; mask$; "-"; lot$, " = "; path$; " making "; drv$ MKDIR drv$ OPEN root$ + "maskdir.txt" FOR APPEND AS #1 WRITE #1, mask$ CLOSE #1 GOTO reserr END IF PRINT "error number = "; ERR PRINT " Attention!!! write down the error number and then call" PRINT " Mark Nelson @7320" CALL keyp(a$) END reserr: CALL twait(0, 6) RESUME NEXT 11999 ' 12000 ' - QE submenu - This routine provides a menu for selecting qemenu: 12010 ' Quantum efficiency options. 12020 ' 12030 ' 12040 K1$ = "StoreQ": K2$ = "": K3$ = "Plot Q": K4$ = "": K5$ = "": K6$ = "": K7$ = "": K8$ = "": K9$ = "": K10$ = "return" 12050 CLS 12060 ' 12070 PRINT "F1 = store test detector Quantum efficiency data" 12080 PRINT "F3 = plot test detector Quantum efficiency data" 12090 PRINT "F10= return to previous menu" 12100 ' 12110 Q$ = "Select option." 12120 GOSUB getfkey ' SUB (7): Assign key labels 12130 ' 12140 IF a = 1 THEN GOTO 5320 12150 IF a = 3 THEN GOTO 5340 12160 IF a = 10 THEN qe% = 0: GOTO 4890 12190 PRINT " this is a bogus statement: RETURN" 12999 ' 13000 ' - QE FIND PEAK (an alternate "data sorting routine") - 13010 ' 13020 dmax = (Tstdet(1) * (1.2395 / (Wavel(1) / 1000)) * 100) 13025 w = Wavel(1) ' Set MAX to first wavelength 13030 FOR I = 1 TO NumSpectVal 13040 IF (Tstdet(I) * (1.2395 / (Wavel(I) / 1000)) * 100) > dmax THEN 13041 w = Wavel(I) ' Set MAX wavelength 13042 dmax = (Tstdet(I) * (1.2395 / (Wavel(I) / 1000)) * 100) 13043 END IF 13050 NEXT I 13060 GOTO 6520 13999 ' 14000 ' - ND Filter file - This routine prompts the user to see if a ND 14010 ' filter is to be used for the measurement, if so 14020 ' then the file is loaded, if not the 1st array 14030 ' element gets a 100.0 to have no effect on calcs 14040 ' 14050 K1$ = " No ": K2$ = "": K3$ = "": K4$ = "": K5$ = "": K6$ = "": K7$ = "": K8$ = "": K9$ = "": K10$ = " Yes " 14060 CLS 14070 PRINT "Are you using a ND filter for this measurement?": PRINT 14080 PRINT "F1 = No, not using ND filter." 14090 PRINT "F10 = Yes, using ND filter." 14100 Q$ = "Select option." 14110 GOSUB getfkey ' SUB (7): Assign key labels 14120 IF a = 1 THEN GOTO 14400 ' no ND filter 14130 PRINT : PRINT lin$: CLOSE #1 14140 PRINT "Enter name of ND filter file " PRINT "File must reside in D:\QETEST. Do NOT type in path specifier!" PRINT "Present options are 730-1.DAT , 730-2.DAT , 730-3.DAT" PRINT "Default currently is <"; NDF$; ">"; CALL clrky: INPUT NDFn$ ' get new ND file 14150 IF NDFn$ = "" AND NDF$ = "" THEN GOTO 14130 IF NDFn$ = "" THEN GOTO 14160 ' no change to nd filter file ELSE NDF$ = NDFn$ END IF 14160 ON ERROR GOTO 15000 ' NDF$ not on MSU CALL logit(TIME$ + " Reading ND file " + NDF$) 14170 OPEN root$ + NDF$ FOR INPUT AS #1 14180 ON ERROR GOTO 0 14190 INPUT #1, NDS$, NDU$, NDD, NDL, NDU, NDN 14200 IF NDN > 0 THEN 14260 14210 CLS 14220 PRINT "Data must be stored at equally spaced wavelength intervals." 14230 PRINT : PRINT "The data in '"; NDF$; "' is stored at unequally spaced wavelength intervals." 14240 CLOSE #1 14250 GOTO 14130 14260 NDM = (NDU - NDL) / NDN + 1' # of data pts. in data file 14270 IF NDM > 501 THEN 14280 ELSE 14330 14280 CLS 14290 PRINT "The # of data points in this data file ("; m; ") is > the allowed" 14300 PRINT "maximum of 501!": PRINT 14310 PRINT "Please select another data file which contains <= 501 points." 14320 GOTO 14130 14330 FOR I = 1 TO NDM 14340 INPUT #1, ND(I) ' read ND file values 14350 NEXT I 14360 CLOSE #1 14370 ND% = 1: GOTO 14500 ' set ND% flag / done 14400 ND(1) = 100! ' No ND Filter, set to 100.0 14410 NDJ1 = 1 ' would be set on line #'s 2492 / 3 14420 NDJ2 = 0 14430 ND% = 0 ' clear ND% flag / done 14500 RETURN 14999 ' 15000 ' - NDF$ NOT on MSU - 15010 ' 15020 IF ERR = 53 THEN CLS ELSE 15050 15030 PRINT "Data file '"; NDF$; "' is not stored on this mass storage device!" 15040 RESUME 14130 ' return 15050 IF ERR = 71 THEN CLS ELSE 15130 15060 PRINT "The disc drive door is open or a disc is not in the drive." 15070 PRINT "Place the correct disc in the default drive." 15080 PRINT : PRINT lin$ 15090 PRINT "Insert disc. Press space bar when fixed.": SOUND 500, 1 15100 CALL clrky 15110 a$ = INKEY$: IF a$ = " " THEN 15120 ELSE 15110 15120 CLS : RESUME 14160 ' return 15130 IF ERR = 75 THEN PRINT "directory already there ": RESUME NEXT END IF GOSUB 8490 ' SUBROUTINE (6): Unidentified error 15140 CLS : RESUME 14130 ' return 15999 ' 16000 ' - ND common - This routine finds the U, L, N of the common 16010 ' datapoints between the calibration file and 16020 ' the ND filter file. 16030 ' 16032 L2 = L2 * 10: u2 = u2 * 10: N2 = N2 * 10 ' promote 10ths to whole 16035 NDL = NDL * 10: NDU = NDU * 10: NDN = NDN * 10 ' numbers to avoid cum- 16036 ' ulative floating point 16037 ' errors 16038 IF NDU < u2 THEN LOWEST.U = NDU ELSE LOWEST.U = u2 16040 MATCH% = 0: CAL.C = L2: ND.C = NDL 16050 WHILE MATCH% < 1 ' find 1st common point 16070 IF CAL.C < ND.C THEN CAL.C = CAL.C + N2 16080 IF CAL.C > ND.C THEN ND.C = ND.C + NDN 16085 IF CAL.C = ND.C THEN MATCH% = 1: COMMON.L = ND.C: GOTO 16090 16090 WEND 16092 IF ND% = 2 THEN 16210 ' NO COMMON LAMBDA 16095 CAL.C = CAL.C + N2: ND.C = ND.C + NDN 16097 IF CAL.C > LOWEST.U OR ND.C > LOWEST.U THEN MATCH% = 10: ND% = 2 16100 WHILE MATCH% < 2 16110 IF CAL.C < ND.C THEN CAL.C = CAL.C + N2 16120 IF CAL.C > ND.C THEN ND.C = ND.C + NDN 16130 IF CAL.C = ND.C THEN MATCH% = 2: COMMON.N = ND.C - COMMON.L 16135 IF CAL.C > LOWEST.U OR ND.C > LOWEST.U THEN MATCH% = 10: ND% = 2 16140 WEND 16150 IF ND% = 2 THEN 16210 16160 COMMON.U = ND.C 16170 WHILE ((COMMON.U + COMMON.N) <= LOWEST.U) 16180 COMMON.U = COMMON.U + COMMON.N 16190 WEND ' find last common point 16195 COMMON.L = COMMON.L / 10: COMMON.U = COMMON.U / 10: COMMON.N = COMMON.N / 10 16200 GOTO 16250 16210 PRINT : PRINT " ERROR: Files must have two or more common wavelengths." 16220 PRINT : PRINT " Press space bar when ready.": SOUND 500, 1 16230 CALL clrky 16240 a$ = INKEY$: IF a$ <> " " THEN 16240 16250 L2 = L2 / 10: u2 = u2 / 10: N2 = N2 / 10 ' restore to old magnitude 16260 NDL = NDL / 10: NDU = NDU / 10: NDN = NDN / 10 16280 RETURN 'SUB (L2, u2, N2, NDL, NDU, NDN) 'END SUB SUB ampcalc (ednflg, edn, take, current, dn) ' current=e/dn*dn/t=electrons per second CLS edn = 100 IF ednflg = 1 THEN GOTO skipedn INPUT "Input EDN - ", edn ednflg = 1 ' edn has been entered skipedn: CLS 'lprint " current= (dn * EDN / (take * .05 )) / 6.2E+18 **** new EDN = "; edn INPUT "Input TAKE - ", take ' INPUT "enter DN - ", dn ' current = (dn * EDN / (take * .05)) / 6.25E+18 ' PRINT current; " Amps" ' GOTO 40 END SUB SUB axes (left, right, bot, top) axclr = 8 minaxis = (top - bot) / 30 miniaxis = minaxis / 3 guard = (right - left) / 500 ' guard against printing close to frame ' LOCATE 28, 20: PRINT guard; left + guard; right - guard ytick = (bot - top) / 10 ' LOCATE 10, 10: PRINT " -xy>"; ytick; top; bot; left; right FOR I = 200 TO 1100 STEP 100 IF I > left + guard AND I < right - guard THEN ' print LINE (I, bot)-(I, top), axclr ' LOCATE 4, 5: PRINT i END IF ' LOCATE 5, 5: PRINT i; ' CALL keyp(key$) LINE (I, bot)-(I, bot + minaxis), axclr LINE (I + 50, bot)-(I + 50, bot + minaxis), axclr LINE (I + 10, bot)-(I + 10, bot + miniaxis), axclr LINE (I + 20, bot)-(I + 20, bot + miniaxis), axclr LINE (I + 30, bot)-(I + 30, bot + miniaxis), axclr LINE (I + 40, bot)-(I + 40, bot + miniaxis), axclr LINE (I + 60, bot)-(I + 60, bot + miniaxis), axclr LINE (I + 70, bot)-(I + 70, bot + miniaxis), axclr LINE (I + 80, bot)-(I + 80, bot + miniaxis), axclr LINE (I + 90, bot)-(I + 90, bot + miniaxis), axclr NEXT I FOR I = 1 TO 9 LINE (left, top + I * ytick)-(right, top + I * ytick), axclr NEXT I END SUB SUB closeshut (moustest) IF moustest = 0 THEN ' so's I can debug in QB with a mouse OPEN "com1:300,n,8,1" FOR OUTPUT AS #2 PRINT #2, CHR$(67); ' reset PRINT #2, CHR$(65); ' close CLOSE #2 ELSE PRINT "CLOSE SHUTTER NOW ! " END IF END SUB SUB clrky DEF SEG = 0: POKE 1050, PEEK(1052) END SUB SUB getslav (boost, lowdn, hidn, moustst) redoget: INPUT "Mouse ???? ( 0 for uniblitz, 1 for mouse )", moustst INPUT "Which boost algorithm?(1 or 2) <1>", booost$ IF booost$ <> "" THEN boost = VAL(booost$) ELSE boost = 1 INPUT "What is low DN threshold ?(where TAKE stops increasing<1000>)", lowdnn$ IF lowdnn$ <> "" THEN lowdn = VAL(lowdnn$) ELSE lowdn = 1000 INPUT "What is high DN threshold ?(where TAKE starts decreasing<8000>)", hidnn$ IF hidnn$ <> "" THEN hidn = VAL(hidnn$) ELSE hidn = 8000 PRINT "Entry values are "; boost; lowdn; hidn; "; Are These OK (y/n)?" inkget: a$ = INKEY$: IF a$ = "y" OR a$ = "Y" THEN GOTO outgets IF a$ = "" THEN GOTO inkget ELSE GOTO redoget outgets: END SUB SUB GOTOWAVE (lambda) ' - BEGINNING WAVELENGTH - ' L1 = 400 OUT P1C, 112: OUT P1C, 240 ' fast/neutral CALL ioread(W1) 'GOSUB 9260 ' SUBROUTINE (9): Read wavelength IF W1 < L1 - 11 THEN GOTO forw ELSE GOTO revrs revrs: OUT P1C, 192: OUT P1C, 224: OUT P1C, 240 ' reverse/start/neutral FOR I = 1 TO 10 * ms: NEXT I' delay loop WHILE W1 > L1 - 11 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength WEND forw: OUT P1C, 128: OUT P1C, 224: OUT P1C, 240 ' forward/start/neutral FOR I = 1 TO 10 * ms: NEXT I' delay loop WHILE W1 < L1 - 1.4 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength WEND OUT P1C, 208: OUT P1C, 240 ' slow/neutral WHILE W1 < L1 CALL ioread(W1) ' GOSUB 9260 ' SUBROUTINE (9): Read wavelength WEND OUT P1C, 160: OUT P1C, 240 ' stop/neutral END SUB ' SUB ioread (W1) STATIC 'OMMON SHARED /ioport/ P1CW, P1C, P1B, P1A, P2CW, P2C, P2B, P2A, HIMASK, LOMASK 92601 ' SUBROUTINE (9): Read 740-1C wavelength 92701 ' 92801 PORT1A = INP(P1A): PORT1B = INP(P1B): PORT1C = INP(P1C) 92901 PORT1AHIGH = (PORT1A AND HIMASK) / 16: PORT1ALO = PORT1A AND LOMASK 93001 PORT1BHIGH = (PORT1B AND HIMASK) / 16: PORT1BLO = PORT1B AND LOMASK 93101 PORT1C3 = PORT1C AND 3 93201 W1 = (PORT1C3 * 1000 + PORT1BHIGH * 100 + PORT1BLO * 10 + PORT1AHIGH * 1 + PORT1ALO * .1) 93301 ' RETURN END SUB SUB keyp (a$) keylp: a$ = INKEY$: IF a$ = "" THEN GOTO keylp END SUB SUB logit (a$) OPEN "d:\qetest\log\qelog.dat" FOR APPEND AS #1 PRINT #1, a$ CLOSE #1 END SUB SUB lprtfil (n$, t$, u$, Dte, l, u, n, wmax, dmax) 'lprint "Startplot - file read vvvvvvvvvvvvvvvvvv "; DATE$ 'lprint "Data File Name: "; Nstdcal$ 'lprint "Data File Comments: "; t$ 'lprint "Data File Units: "; u$ 'lprint "Data File Date:"; Dte: 'lprint "L ="; l: 'lprint "U ="; u: 'lprint "N ="; n 'lprint USING "Maximum at ####.# of ##.###^^^^"; wmax; dmax END SUB SUB openshut (moustest) IF moustest = 0 THEN ' so's I can debug in QB with a mouse OPEN "com1:300,n,8,1" FOR OUTPUT AS #2 PRINT #2, CHR$(67); ' reset PRINT #2, CHR$(64); ' open CLOSE #2 ELSE PRINT "OPEN SHUTTER NOW ! ": CALL twait(0, 3) END IF END SUB SUB pathstuff (root$, mask$, drv$, lot$) PRINT " - - - - - - - - - - - " PRINT "Please enter mask set from the entries listed above ( no spaces )" ' PRINT "Valid directories are listed above)" ' PRINT "no entry uses > "; root$; " directory as root path" PRINT : INPUT "Enter mask set of device to be measured - ", mask$ IF mask$ = "" THEN drv$ = root$ ELSE drv$ = root$ + mask$ END IF 'CLS PRINT PRINT " - - - - - - - - - - - " ' PRINT "(Lot number controls subdirectory where data is to be stored)" ' PRINT : PRINT "no entry uses "; drv$; " directory as path" INPUT "Enter 4 digit lot number of device to be measured - ", lot$ END SUB SUB ptrbeep (beepnum) FOR I = 1 TO beepnum 'lprint CHR$(7); : 'lprint " "; : 'lprint CHR$(13); 'bell,spaces,cr NEXT I END SUB SUB setup (tstvers, Versdte$, opnme$, root$, path$) PRINT " 740 Detector Spectral Response Measurement Program" PRINT " Version "; tstvers PRINT : PRINT PRINT " Special version for Tektronix CCD test" PRINT : PRINT PRINT " Latest modification on "; Versdte$ PRINT " (No printer version)" PRINT : PRINT PRINT " by Mark D. Nelson " PRINT " "', root$, path$ CALL twait(0, 3) CLS : PRINT "Please enter your name :"; : INPUT opnme$ CLS : PRINT : PRINT : PRINT : PRINT PRINT " Set printer paper to the top of the page" PRINT " (Perforation aligned with top of ribbon)" PRINT PRINT " and press SPACE BAR to continue " CALL keyp(kyp$) ''lprint ">>>>>>> Entering 740DMA QE station program at "; TIME$; " on "; DATE$ ''lprint " 740DMA version "; tstvers; " compiled "; Versdte$; " OPERATOR is "; opnme$ CLS : PRINT : PRINT : PRINT : PRINT PRINT " Set Uniblitz switch to N.C and then press RESET" PRINT " of Uniblitz shutter controller " PRINT PRINT " and then SPACE BAR to continue " CALL keyp(kyp$) END SUB SUB timelp (ms) 9660 PRINT : PRINT "Calibrating measurement delay loops against system time, please wait ...." 9670 PRINT : PRINT "-------------------------------------------------------------------------------": PRINT 9680 IPEAK = 1000 ' sets the upper count limit for the slowest machine 9690 DEF SEG = &H40 9700 LB1 = PEEK(&H6C): LB2 = PEEK(&H6C): IF LB2 = LB1 THEN GOTO 9700 9710 ' above is to find the beginning of the period 9720 LB1 = PEEK(&H6C): NB1 = PEEK(&H6D) ' start count 9730 FOR I = 1 TO IPEAK: NEXT I ' timing loop 9740 LB2 = PEEK(&H6C): NB2 = PEEK(&H6D) ' finish count 9750 C1 = NB1 * 256 + LB1: C2 = NB2 * 256 + LB2 ' computes times 9760 IF C2 < C1 THEN GOTO 9700 ' in case of 256 turn-over 9770 IF C2 - C1 >= 20 THEN GOTO 9820 ' 20 counts gives an accuracy of 5% 9780 IF C2 - C1 = 0 THEN IPEAK = IPEAK * 2: GOTO 9700 9790 ' above -- if the count is 0 then count doubles and tries again 9800 IPEAK = IPEAK * 21 / (C2 - C1) ' ratio to try again, should take 1 try 9810 GOTO 9700 9820 t = (C2 - C1) / 18.2' 18.2 COUNTS/SEC 9830 ms = IPEAK / t * .001' loop/msec TIMING VARIABLE 9840 CLS ': RETURN END SUB SUB twait (mins, secs) ' this routine waits a number of minutes and seconds t$ = TIME$ sec$ = RIGHT$(t$, 2): min$ = MID$(t$, 3, 2) LOCATE 1, 70: PRINT min$; sec$ seccnt = 0 IF mins = 0 THEN seclp: IF seccnt = secs THEN GOTO subout tstlp: IF RIGHT$(TIME$, 2) <> sec$ THEN seccnt = seccnt + 1 sec$ = RIGHT$(TIME$, 2) GOTO seclp END IF GOTO tstlp ELSE PRINT "minutes not implemented" END IF subout: END SUB