azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
377ab3a63ff3cebb6424b5c28496ce100de44c17
claudetools/Test Datasheets/QB-Source/NLIBATED.BAS
sysadmin 505bc12355 AD2 session 2026-03-27/28/29: Test datasheet pipeline rebuild 
- Built exact-match TXT formatter from QuickBASIC source (SCM5B, 8B, DSCA, DSCT, SCM7B)
- Spec parser for 10 binary DAT files (1470+ models)
- Work order report importer (33K WOs, 63K test lines)
- On-demand PDF generation, styled HTML view
- Archived 500K pre-2026 For_Web files into year subfolders
- Created domain service account (INTRANET\svc_testdatadb)
- Generated 73/73 Quatronix customer datasheets
- Added STAGE + Reports auto-import to sync script

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-29 17:48:37 -07:00

3224 lines
153 KiB
QBasic
Raw Blame History

Attribute VB_Name = "Module1"
'Library of functions used with SCM5B and SCT1P test programs.
'Created from LIB49.BAS
'Author: John Lehman 9/15/95
'KEPCO ABC125 Upgrade code development - Tom Orlando
'Date: 10/25/2007
'
' REVISION RECORD
'
'DATE REV APPR DESCRIPTION
'---- --- ---- -----------
'10/5/95 n/a JL Initial Release.
' ...
' ... See "Revs.txt" file.
' ...
'2015/05/29 B.08 PWR Revised CuRTD polynomial and inverse polynomial to allow 2% bounds (from 1%).
'
'02/08/19 MR Added NI50, 50 Ohm at 75F Nickel RTD
Const LIBVERSION$ = "B.09 2019.02.08 MR" 'Version (Revision Date) and initials of engr.
DECLARE SUB CALDAC (TE$) 'Read main and vernier DAC limits
DECLARE SUB CASEINST () 'Tell user to install a case over the unit
DECLARE SUB CHANGEDN (SN$)
DECLARE SUB CONTINUE () 'Waits for a key press
DECLARE SUB GETSN (SN$)
DECLARE SUB HS1 () 'GPIB communications handshake
DECLARE SUB INIT488 (DVMADDR%) 'Initialize 488 interface
DECLARE SUB INITPS (VINADDR%, OVERI!, OVERV!) 'Initialize Kepco DPS power supply
DECLARE SUB LOADDAC (BINDATA%, DAC%) 'Send data to DAC
DECLARE SUB LOADMUX (CH%, CHON%) 'Set relay multiplexer
DECLARE SUB OHMSET (OHM!) 'Set resistor DAC
DECLARE SUB PAUSE (TIME!) 'Pause for TIME
DECLARE SUB RTDTHCAL () 'Check test head operation
DECLARE SUB SETDAC (VOLTAGE!, CH%, VRANGE!, VSENATTEN!) 'Set DAC voltage
DECLARE SUB SETDAC2 (VOLTAGE!, CH%, VRANGE!, VSENATTEN!) 'Sets DAC, output module test heads
DECLARE SUB SETDACFAST (VOLTAGE!) 'Set main DAC voltage (fast operation)
DECLARE SUB SETTEST (TEST%) 'Set test 0-7 on RTD test head
DECLARE SUB SETTH (DOUT%, BANK%) 'Load test head controlbank data
DECLARE SUB SETTHFAST (DOUT%, BANK%) 'Load test head, don't disable
DECLARE SUB TRIGGER () 'Send trigger to 488 device
DECLARE SUB WRITEDVM (CMD$, value!) 'Send command to 488 DVM
DECLARE SUB WRITEGEN (CMD$, value!) 'Send command to 488 function generator
DECLARE SUB WRITEPS (ADDR%, CMD$)
DECLARE SUB SNPARSE (SN$, WO$, DS$) 'Parses serial number into work order and dash numbers
DECLARE SUB GETDSFNAME (SN$, DSSNAME$, DSFNAME$) 'Gets datasheet search and file names from serial number
DECLARE SUB WORKORDERLINE (FAILSTATE%, SN$)
DECLARE SUB WORKORDERPRINT (SN$)
DECLARE SUB WORKORDERHEADER (SN$)
DECLARE FUNCTION BESTFIT! (SLOPE!, OFFSETS!, TSIM!(), NUMPTS%, ERRO!())
DECLARE FUNCTION FAILCOM! (SETP$) 'Sends a "FAIL" flag to SETPOWER if serial COM FAILURE
DECLARE FUNCTION GETTHID% () '** Get test head id #
DECLARE FUNCTION KEYBDIN$ () '** Get keyboard input
DECLARE FUNCTION MEASRES! (OHM!, RESNUM%, TE$) 'Measure loop current sense resistor
DECLARE FUNCTION POWERIO$ (ADDR%, CMD$) '** Kepco DPS power supply I/O
DECLARE FUNCTION READDVM! (TOL!) '** Get Fluke meter reading
DECLARE FUNCTION READDATA$ (ADDR%)
DECLARE FUNCTION READPS$ (ADDR%, CMD$)
DECLARE FUNCTION READGPIB$ (ADDR%, CMD$)
DECLARE FUNCTION REPEAT$ (N$) '** Ask if you would like to repeat test
DECLARE FUNCTION REPEAT2$ (N$, SN$)
DECLARE FUNCTION RTDOHMS! (TEMP!, SENTYPE$) '** Convert RTD in temp to ohms
DECLARE FUNCTION RTDTEMP! (OHMS!, SENTYPE$) '** Convert RTD ohms to temp
DECLARE FUNCTION SETATTEN% (VOLTAGE!) '** Sets test head R/2R ladder
DECLARE FUNCTION SETPOWER$ (ADDR%, VSUPPLY!, FUNC$) '** Controls Kepco DPS 125
DECLARE FUNCTION SETRANGE$ (value!) 'Library fn only. Set Fluke range.
DECLARE FUNCTION STRINGVAL% (a$) '**
DECLARE FUNCTION TCTEMP! (TCV!, SENTYPE$) '** Convert TC volts to deg. C
DECLARE FUNCTION TCVOLTS! (TEMP!, SENTYPE$) '** Convert TC in temp to V
DECLARE FUNCTION GETWO$ () 'Gets and returns the work order number
DECLARE FUNCTION GETDS$ (ISNEWDS%, SN$) 'Gets and returns the dash number
DECLARE FUNCTION ISPOSNUMBER% (TESTVALUE$) 'Returns "1" for positive number, "0" otherwise
DECLARE FUNCTION ISALLLETTERS% (TESTVALUE$) 'Returns "1" for all letters, "0" otherwise
DECLARE FUNCTION GETWOSFNAME$ (SN$) 'Returns work order status file name from serial number
DECLARE FUNCTION UPSN$ (SN$) '** Increments dash# of serial#
'** Function called from main programs.
' Declare in programs which call this function.
DECLARE FUNCTION FAILS% (STATUS$()) 'Tests for failed tests
DECLARE FUNCTION LIBVERVAL$ () 'Function to return the library source file version
DECLARE SUB FINISHSUB () 'Subroutine to run at "FINISH" label (after F10 keypress).
COMMON SHARED CB0VAL%, CB1VAL%, CB2VAL%, CB3VAL%
COMMON SHARED MAINMAX!, MAINMIN!, VERNMAX!, VERNMIN!
COMMON SHARED BADDRS%, LPTADDR%, MUXADDR%, THADDR%, PSADDR%, VINADDR%
COMMON SHARED PSPORT%, DVMADDR%, GENADDR%
COMMON SHARED DPSPSADDR%, DPSVINADDR%, ABCPSADDR%, ABCVINADDR%
COMMON SHARED PSMODEL$, VINMODEL$
COMMON SHARED TTYPE%, MAXINVAR!
'VINMODEL$ will be used if 2 different KEPCOs are used.
'assign constants to Fluke meter commands
Const OHM4$ = "F4", OHM2$ = "F3"
Const CON% = 1, COFF% = 0
Const CB0% = 0, CB1% = 1, CB2% = 2, CB3% = 3
Const VODC$ = "F1", FREQ$ = "FREQ"
'CONST DVMADDR% = 1 'GPIB address of Fluke 8842A meter
'CONST GENADDR% = 2 'GPIB address of HP33120A function generator
Const MTA% = &H40 'GPIB talk address
Const MLA% = &H20 'GPIB listen address
Const MAIN% = 1
Const VERN% = 0
Const VOLT$ = "STV=", READVOLT$ = "RTV"
Const CURRENT$ = "RTC", ISTAT$ = "RCS"
CONST LOOPON$ = "SOP=ON", LOOPOFF$ = "SOP=OFF", LOCAL$ = "LOC"
KEY(10) ON 'Activates F10 key
On Key(10) GoSub FINISH 'Traps for F10 key Exits if pressed
FINISH:
Call FINISHSUB
End 'End of program
'******** THERMOCOUPLE POLYNOMIAL COEFFICIENTS EMF = F(T) ******************
'Type J TC polynomial -210C to +760C (RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES)
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEJ1: Data -212, 760, 0, 50.381187815, 0.03047583693, -0.00008568106572, 1.3228195295E-07
Data -1.7052958337E-10, 2.0948090697E-13, -1.2538395336E-16, 1.5631725697E-20, 0
'Type J TC polynomial +760C to +1200C
TYPEJ2: Data 760, 1202, 296456.25681, -1497.6127786, 3.1787103924, -0.0031847686701, 1.5720819004E-06
Data -3.0691369056E-10, 0
'Type K TC polynomial -270C to 0C
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEKNEG: Data -272, 0, 0, 39.450128025, 0.023622373598, -0.00032858906784, -4.9904828777E-06
Data -6.7509059173E-08, -5.7410327428E-10, -3.1088872894E-12
Data -1.0451609365E-14, -1.9889266878E-17, -1.6322697486E-20, 0
'Type K TC polynomial 0C to +1372C
TYPEKPOS: Data 0, 1374, -17.600413686, 38.921204975, 0.018558770032, -0.000099457592874
Data 3.1840945719E-07, -5.6072844889E-10, 5.6075059059E-13
Data -3.2020720003E-16, 9.7151147152E-20, -1.2104721275E-23, 0
'Type T TC polynomial -270C to 0C
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPETNEG: Data -272, 0, 0, 38.748106364, 0.044194434347, 0.00011844323105, 0.000020032973554
Data 9.0138019559E-07, 2.2651156593E-08, 3.6071154205E-10, 3.8493939883E-12
Data 2.8213521925E-14, 1.4251594779E-16, 4.8768662286E-19
Data 1.079553927E-21, 1.3945027062E-24, 7.9795153927E-28, 0
'Type T TC polynomial 0C TO +400C
TYPETPOS: Data 0, 402, 0, 38.748106364, 0.03329222788, 0.00020618243404, -2.1882256846E-06
Data 1.0996880928E-08, -3.0815758772E-11, 4.547913529E-14, -2.7512901673E-17, 0
'Type E TC polynomial -270C TO 0C
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEENEG: Data -272, 0, 0, 58.665508708, 0.04541098, -0.0007799805, -0.00002580016
Data -0.0000005945258, -0.000000009321406, -1.028761E-10, -8.037012E-13
Data -4.39795E-15, -1.641478E-17, -3.967362E-20, -5.582733E-23, -3.465784E-26, 0
'Type E TC polynomial 0C to +1000C
TYPEEPOS: Data 0, 1005, 0, 58.66550871, 0.04503228, 0.00002890841, -0.000000330569
Data 0.000000000650244, -1.91975E-13, -1.25366E-15, 2.148922E-18
Data -1.438804E-21, 3.59609E-25, 0
'Type R TC polynomial -50C to +1064.18
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPER1: Data -52, 1064.18, 0, 5.28961729765, 0.01391666, -0.00002388557, 0.0000000356916
Data -4.623477E-11, 5.007774E-14, -3.731059E-17, 1.577165E-20, -2.810386E-24, 0
'Type R TC polynomial +1064.18C TO 1664.5C
TYPER2: Data 1064.18, 1664.5, 2951.57925316, -2.52061251332, 0.01595645, -0.00000764086
Data 0.000000002053053, -2.933597E-13, 0
'Type R TC polynomial +1664.5C TO +1768.1C
TYPER3: Data 1664.5, 1770.1, 152232.118209, -268.819888545, 0.1712803, -0.00003458957
Data -9.34634E-12, 0
'Type S TC polynomial -50C to +1064.18
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPES1: Data -52, 1064.18, 0, 5.40313308631, 0.01259343, -0.0000232478, 0.00000003220288
Data -3.314652E-11, 2.557443E-14, -1.250689E-17, 2.714432E-21, 0
'Type S TC polynomial +1064.18C TO 1664.5C
TYPES2: Data 1064.18, 1664.5, 1329.00444085, 3.34509311344, 0.006548052, -0.000001648563
Data 1.299896E-11, 0
'Type S TC polynomial +1664.5C TO +1768.1C
TYPES3: Data 1664.5, 1770.1, 146628.232636, -258.430516752, 0.1636936, -0.0000330439
Data -9.432237E-12, 0
'Type B TC polynomial 0C TO +630.615C
'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEB1: Data -2, 630.615, 0, -0.2465081, 0.005904042, -0.000001325793, 0.000000001566829
Data -1.694453E-12, 6.299035E-16, 0
'Type B TC polynomial 630.615C TO +1820C
TYPEB2: Data 630.615, 1822, -3893.8168621, 28.57174747, -0.08488511, 0.0001578528, -0.0000001683535
Data 1.110979E-10, -4.451543E-14, 9.897564E-18, -9.379133E-22, 0
'Type C TC polynomial 0C to +2315C (-32F to 4208F)
'**These coeffs are for temp in deg F.
TYPEC: Data -33, 4209, -234.471, 7.190027, 0.003956443, -0.000001842722
Data 3.471851E-10, -2.616792E-14, 0
'Type N TC polynomial -270C to 0C
TYPENNEG: Data -272, 0, 0, 26.159105962, 0.01095748, -0.00009384111, -0.00000004641204
Data -0.000000002630336, -2.265344E-11, -7.60893E-14, -9.341967E-17, 0
'Type N TC polynomial 0C to +1300C
TYPENPOS: Data 0, 1302, 0, 25.929394601, 0.01571014, 0.00004382563, -0.0000002526117
Data 6.431182E-10, -1.006347E-12, 9.974534E-16, -6.086325E-19
Data 2.084923E-22, -3.06822E-26, 0
'******* THERMOCOUPLE INVERSE POLYNOMIAL COEFFICIENTS T = F(EMF) **************
'Type J TC INVERSE polynomial -210C to 0C, -0.05C to +0.03C accurate
'-8095uV to 0uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVJ1: Data -8135, 0, 0, 0.01952827, -0.000001228619, -0.000000001075218, -5.908693E-13
Data -1.725671E-16, -2.813151E-20, -2.396337E-24, -8.382332E-29, 0
'Type J TC INVERSE polynomial 0C to +760C, +/-0.04C accurate
'0uV to +42919uV
INVJ2: Data 0, 42919, 0, 0.01978425, -0.0000002001204, 1.036969E-11, -2.549687E-16
Data 3.585153E-21, -5.344285E-26, 5.09989E-31, 0
'Type J TC INVERSE polynomial +760C to +1200C, -0.04C to +0.03C accurate
'42919uV to +69593uV
INVJ3: Data 42919, 69653, -3113.58187, 0.3005437, -0.000009947732, 1.702766E-10
Data -1.430335E-15, 4.738861E-21, 0
'Type K TC INVERSE polynomial -200C to +0C, -0.02C to +0.04C accurate
'-5891uV to 0uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVK1: Data -5931, 0, 0, 0.02517346, -0.000001166288, -0.000000001083364, -8.977354E-13
Data -3.734238E-16, -8.663264E-20, -1.04506E-23, -5.192058E-28, 0
'Type K TC INVERSE polynomial 0C to +500C, -0.05C to +0.04C accurate
'0uV to 20644uV
INVK2: Data 0, 20644, 0, 0.02508355, 0.00000007860106, -2.503131E-10, 8.31527E-14
Data -1.228034E-17, 9.804036E-22, -4.41303E-26, 1.057734E-30
Data -1.052755E-35, 0
'Type K TC INVERSE polynomial +500C to +1372C, -0.05C to +0.06C accurate
'20644uV to 54866uV
INVK3: Data 20644, 54906, -131.8058, 0.04830222, -0.000001646031, 5.464731E-11, -9.650715E-16
Data 8.802193E-21, -3.11081E-26, 0
'Type T TC INVERSE polynomial -200C to 0C, -0.02C to +0.04C accurate
'-5603uV to 0uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVTNEG: Data -5643, 0, 0, 0.02594919, -0.0000002131697, 7.901869E-10, 4.252778E-13
Data 1.330477E-16, 2.024145E-20, 1.266817E-24, 0
'Type T TC INVERSE polynomial 0C to +400C, +/-0.03C accurate
'0uV to 20872uV
INVTPOS: Data 0, 20912, 0, 0.025928, -0.0000007602961, 4.637791E-11, -2.165394E-15
Data 6.048144E-20, -7.293422E-25, 0
'Type E TC INVERSE polynomial -200C to 0C, -0.01C to 0.03C accurate
'-8825uV to 0uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVENEG: Data -8865, 0, 0, 0.016977288, -0.0000004351497, -1.5859697E-10, -9.2502871E-14
Data -2.6084314E-17, -4.1360199E-21, -3.403403E-25, -1.156489E-29, 0
'Type E TC INVERSE polynomial 0C to +1000C, +/-0.02C accurate
'0uV to 76373uV
INVEPOS: Data 0, 76748, 0, 0.01705704, -0.0000002330176, 6.543559E-12, -7.356275E-17
Data -1.7896E-21, 8.403617E-26, -1.373588E-30, 1.062982E-35
Data -3.244709E-41, 0
'Type R TC INVERSE polynomial -50C to +250C, +/-0.02C accurate
'-226uV to 1923uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVR1: Data -300, 1923, 0, 0.1889138, -0.00009383529, 0.0000001306862, -2.270358E-10
Data 3.514566E-13, -3.89539E-16, 2.823947E-19, -1.260728E-22
Data 3.135361E-26, -3.318777E-30, 0
'Type R TC INVERSE polynomial +250C to +1064C, +/-0.005C accurate
'1923uV to 11361uV
INVR2: Data 1923, 11361, 13.34585, 0.1472645, -0.00001844025, 0.00000000403113, -6.249428E-13
Data 6.468412E-17, -4.45875E-21, 1.99471E-25, -5.313402E-30
Data 6.481976E-35, 0
'Type R TC INVERSE polynomial +1064C to +1664.5C, -0.0005C to +0.001C accurate
'11361uV to 19739uV
INVR3: Data 11361, 19739, -81.99599, 0.1553962, -0.000008342198, 4.279434E-10
Data -1.191578E-14, 1.49229E-19, 0
'Type R TC INVERSE polynomial +1664.5C to +1768.1C, -0.001C to +0.002C accurate
'19739uV to 21103uV
INVR4: Data 19739, 21143, 34061.78, -7.023729, 0.0005582904, -0.00000001952395
Data 2.56074E-13, 0
'Type S TC INVERSE polynomial -50C to +250C, +/-0.02C accurate
'-235uV to +1874uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVS1: Data -275, 1874, 0, 0.1849495, -0.00008005041, 0.0000001022374, -1.522486E-10
Data 1.888213E-13, -1.590859E-16, 8.230279E-20, -2.341819E-23
Data 2.797863E-27, 0
'Type S TC INVERSE polynomial +250C to +1064C, +/-0.01C accurate
'1874uV to 10332uV
INVS2: Data 1874, 10332, 12.91507, 0.1466299, -0.00001534713, 0.000000003145946
Data -4.163258E-13, 3.187964E-17, -1.291638E-21, 2.183475E-26
Data -1.47738E-31, 8.211272E-36, 0
'Type S TC INVERSE polynomial +1064C to +1664.5C, +/-0.0002C accurate
'10332uV to 17536uV
INVS3: Data 10332, 17536, -80.87801, 0.1621573, -0.000008536869, 4.719687E-10
Data -1.441694E-14, 2.081619E-19, 0
'Type S TC INVERSE polynomial +1664.5C to +1768.1C, +/-0.002C accurate
'17536uV to 18693uV
INVS4: Data 17536, 18733, 53338.75, -12.35892, 0.001092658, -0.00000004265694
Data 6.247205E-13, 0
'Type B TC INVERSE polynomial about 0C - KEPT AT ZERO
'-50uV to +2.28uV
INVB0: Data -100, 2.28, 0, 0
'Type B TC INVERSE polynomial +50C to +100C, MATLAB calculated.
'+2.28uV to +33.2uV
INVB1: Data 2.28, 33.2, 41.9664852585855, 4.17611917690301
Data -0.36363063524752, 0.04062282514548, -0.00327375413268
Data 0.00016908870534, -0.00000526545664, 0.00000008960324, -0.00000000063806, 0
'Type B TC INVERSE polynomial +100C to +150C, MATLAB calculated.
'+33.2uV to +92.06uV
INVB2: Data 33.2, 92.06, 50.885274757731, 2.00987431811108
Data -0.02203802052765, 0.00022299977771, -0.00000133317504
Data 0.00000000342225, 0
'Type B TC INVERSE polynomial +150C to +200C, MATLAB calculated.
'+92.06uV to 178.26uV
INVB3: Data 92.06, 178.26, 64.970832553974, 1.2502025062851
Data -0.00469901536023, 0.00001427652212, -0.0000000191953, 0
'Type B TC INVERSE polynomial +200C to +250C, MATLAB calculated.
'+178.26uV to 291.28uV
INVB4: Data 178.26, 291.28, 75.7085787280323, 0.98679299982849
Data -0.00225934986745, 0.00000416854466, -0.00000000339906, 0
'Type B TC INVERSE polynomial +250C to +700C, -0.02C to +0.03C accurate
'291uV to 2431uV
INVB5: Data 291.28, 2431, 98.42332, 0.699715, -0.000847653
Data 0.000001005264, -8.334595E-10, 4.550854E-13, -1.552304E-16
Data 2.988675E-20, -2.474286E-24, 0
'Type B TC INVERSE polynomial +700C to +1820C, -0.01C to +0.02C accurate
'2431uV to 13820uV
INVB6: Data 2431, 13900, 213.1507, 0.285105, -0.00005274289, 0.00000000991608
Data -1.29653E-12, 1.119587E-16, -6.06252E-21, 1.86617E-25
Data -2.487859E-30, 0
'Type C TC INVERSE polynomial +32F to +1000F, max. accuracy +/-0.05F
'0.0 uV to 9395 uV
'POLYNOMIAL RANGE MODIFIED BY -40 MICROVOLTS ON -FS BECAUSE OF TEST EQUIMENT ITERATIONS
INVC1: Data -40, 9395, 32.2462, 0.133353, -0.00000767462, 0.0000000008891
Data -6.2196E-14, 1.91477E-18, 0
'Type C TC INVERSE polynomial +1000F to +3000F, max. accuracy +/-0.0063F
'9395uV to 28955uV
INVC2: Data 9395, 28955, 69.4813, 0.112055, -0.00000216715, 9.92444E-11
Data -1.81613E-15, 1.81995E-20, 0
'Type C TC INVERSE polynomial +3000F to +4208F, max. accuracy +/-0.057F
'28955uV to 37107uV
'POLYNOMIAL RANGE MODIFIED BY +40 MICROVOLTS ON +FS BECAUSE OF TEST EQUIMENT ITERATIONS
INVC3: Data 28955, 37147, -143161, 22.7646, -0.00143581, 0.0000000454959
Data -7.21241E-13, 4.5844E-18, 0
'Type N TC INVERSE polynomial -200C to 0C, -0.02C to +0.03C accurate
'-3990uV to 0uV
'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE TO TEST EQUIMENT ITERATIONS
INVNNEG: Data -4030, 0, 0, 0.03843685, 0.000001101049, 0.000000005222931, 7.206053E-12
Data 5.848859E-15, 2.775492E-18, 7.707517E-22, 1.158267E-25
Data 7.313887E-30, 0
'Type N TC INVERSE polynomial 0C to +1300C, +/-0.06C accurate
'0uV to 47513uV
INVNPOS: Data 0, 47553, 0, 0.03878328, -0.000001161234, 6.952566E-11, -3.009008E-15
Data 8.831158E-20, -1.621384E-24, 1.669336E-29, -7.311754E-35, 0
'**************** RTD POLYNOMIAL COEFFICIENTS R = F(T) ********************
'NIST Pt RTD polynomial tested accurate to +/-0.01% from -200C to +850C
'Type Pt RTD polynomial -200C to 0C. Alpha = 0.00385
TYPEPTNEG: Data -201, 0, 100, 0.39083, -0.00005775, 0.00000004183, -0.0000000004183, 0
'Type Pt RTD polynomial 0C to +850C
TYPEPTPOS: Data 0, 851, 100, 0.39083, -0.00005775, 0
'Type E1 Pt100 (Rosemount) RTD polynomial 0C to +370C; accuracy better than +/-0.01%
TYPEE1PT100: Data -1, 371, 100, 0.39486, -0.0000581579, 0
'Type Pt100 RTD polynomial -200C to 0C. Alpha = 0.00392
TYPEPT392NEG: Data -201, 0, 100, 0.39848, -0.0000587, 0.00000004, -0.0000000004, 0
'Type Pt100 RTD polynomial 0C to +630C Alfa = 0.00392
TYPEPT392POS: Data 0, 631, 100, 0.39848, -0.0000587, 0
'Type Ni RTD polynomial 0C to +150C; accuracy better than +/-0.01%
TYPENI1: Data -1, 150, 120, 0.7086472, 0.0008145844, 0.000003004712, -0.00000001804135
Data 4.379183E-11, 0
'Type Ni RTD polynomial +150C to +300C; accuracy better than +/-0.013%
TYPENI2: Data 150, 301, 95.06276, 1.243133, -0.003164436, 0.00001339464, -0.00000001301027, 0
'Type Cu RTD polynomial; accuracy better than +/-0.01% from 0C to +190C
'Polynomial is for sensors which are 10 ohms @ 25C.
'TYPECU: DATA -1, 191, 9.035, 3.865188E-2, -9.702684E-7, 9.564953E-9, -6.434575E-11
' DATA 2.474374E-13, 0
'Updated PWR 2015-05-29
TYPECU: Data -2, 192, 9.035, 0.03865188, -0.0000009702684, 0.000000009564953, -6.434575E-11
Data 2.474374E-13, 0
'Type LEWIS Ni RTD polynomial -17.77C to +120C; Accuracy better than +/-0.02%
TYPENI90NEG: Data -20, 120, 90.37878, 0.3380199, 0.0004086852, 0.0000009321948, -0.000000005017392, 1.547324E-11, 0
'Type LEWIS Ni RTD polynomial +120C to +260C; Accuracy better than +/-0.015%
TYPENI90POS: Data 120, 266, 82.86723, 0.5150368, -0.001024307, 0.000005189308, -0.000000005295223, 0
'Type 50 Ohm at 75F Ni RTD polynomial -60C to +150C; Polynomials created from Table Vishay TN-506-3
TYPENI50: Data -60, 150, 43.78743239, 0.2538277596, 0.0002663627284, 9.264565362E-08, 7.262789981E-10
Data 5.652904273E-12, -2.20910324E-14, 0
'************** RTD INVERSE POLYNOMIAL COEFFICIENTS T = F(R) ***************
'Type Pt RTD INVERSE polynomial -200C to 0C; +/-0.006% accuracy
'33.01 ohms to 100 ohms
INVPTNEG: Data 17.49, 100, -242.02, 2.2228, 0.0025859, -0.000004826, -0.000000028183, 0.00000000015243, 0
'Type Pt RTD INVERSE polynomial 0C to +850C; +/-0.005% accuracy
'100 ohms to 345.13 ohms
INVPTPOS: Data 100, 390.26, 0, 0
'Type E1 Pt100 (Rosemount) INVERSE polynomial 0C to +370C; +/-0.00047% accuracy
'100 ohms to 238.138 ohms
INVE1PT100: Data 99, 240, -245.031, 2.3766, 0.000643374, 0.000000931902, 0
'Type Pt392 RTD INVERSE polynomial -200C to 0C; +/-0.006% accuracy
'16.996 ohms to 100 ohms
INVPT392NEG: Data 15.996, 100, -238.09, 2.2032, 0.0023, -0.000005, 0
'Type Pt392 RTD INVERSE polynomial 0C to +630C; +/-0.005% accuracy
'100 ohms to 327.744 ohms
INVPT392POS: Data 100, 328.744, -243.932, 2.37547, 0.000522608, 0.00000111348, 0
'Type Ni RTD INVERSE polynomial 0C to +150C; +/-0.006% accuracy
'120 ohms to 248.95 ohms
INVNI1: Data 119, 248.95, -221.08, 2.394604, -0.005785688, 0.00001097436, -0.000000009322357, 0
'Type Ni RTD INVERSE polynomial +150C to +300C; +/-0.006% accuracy
'248.95 ohms to 439.44 ohms
INVNI2: Data 248.95, 440.44, -179.0702, 1.666061, -0.001307243, -0.0000006926585, 0.000000001559142, 0
'Type Cu RTD INVERSE polynomial 0C to +190C; +/-0.003% accuracy
'Polynomial is for sensors which are 10 ohms @ 25C.
'9.035 ohms to 16.386 ohms
'Updated PWR 2015-05-29
'INVCU: DATA 8.9, 16.5, -2.415982E2, 2.882270E1, -4.163392E-1, 2.598613E-2, -5.999452E-4, 0
INVCU: Data 8.8, 16.6, -241.5982, 28.8227, -0.4163392, 0.02598613, -0.0005999452, 0
'Type LEWIS Ni RTD INVERSE polynomial -17.77C to +260C; Accuracy better than +/-0.003%
'84.19 ohms to 214.55 ohms
INVNI90: Data 83.19, 218.55, -474.928, 9.28092, -0.0710136, 0.000383725, -0.00000112616, 0.00000000133984, 0
'Type 50 Ohm at 75F Ni RTD polynomial -60C to +150C; Polynomials created from Table Vishay TN-506-3
'29.5 Ohms to 88.71 Ohms
INVNI50: Data 29.5, 88.71, -220.7334849, 6.760139867, -0.05982731918, 0.0006456926033, -0.000004696053099
Data 1.598365447E-08, -1.211366077E-11, 0
Function BESTFIT!(SLOPE!, OFFSETS!, TSIM!(), NUMPTS%, ERRO!())
'Calculates Max error of data from bestfit line
'
MTERR! = 0
For INC% = 1 To NUMPTS% 'Increments thru test points
BVEC! = TSIM!(INC%) * SLOPE! + OFFSETS! 'Calculates point on best fit line
AVEC! = ERRO!(INC%) 'Gets corresponding data point
TERR! = AVEC! - BVEC! 'Calculates difference
If Abs(TERR!) > Abs(MTERR!) Then 'Checks if bigger than last Max
MTERR! = TERR! 'Assigns max error
End If
Next
BESTFIT! = MTERR! 'Passes Max error back
End Function
Sub CALDAC(TE$)
'Calibrates the DAC to make sure it will swing at least +/- 9.2V
'
Call WRITEDVM(VODC$, 10!) 'Sets up meter to read 10VDC
If TE$ = "TE1035" Or TE$ = "TE1036" Or TE$ = "TE1052" Or TE$ = "TE1088" Or TE$ = "TE1089" Then
CH% = 3 'Attenuator input, SCT, DSC test heads
ElseIf TE$ = "TE1054" Or TE$ = "TE1055" Or TE$ = "TE1186" Then
CH% = 1 'DSCA and 8B voltage & current output module test heads
Else
CH% = 8 'Attenuator input, SCM test heads
End If
Call LOADMUX(CH%, CON%) 'Mux CHn = R/2R ladder input
Call LOADDAC(2048, VERN%) 'Sets vernier DAC at 0V
Do
ITER1% = ITER1% + 1
Call LOADDAC(4095, MAIN%) 'Sets main DAC at -10V
MAINMIN! = READDVM!(0!)
Loop While MAINMIN! > -9.2 And ITER1% < 10
Do
ITER2% = ITER2% + 1
Call LOADDAC(0, MAIN%) 'Sets main DAC at 10V
MAINMAX! = READDVM!(0!)
Loop While MAINMAX! < 9.2 And ITER2% < 10
Call WRITEDVM(VODC$, 0.01) 'Sets meter to read 5mV DC
Call LOADDAC(2048, MAIN%) 'Sets main DAC at 0V
Do
ITER3% = ITER3% + 1
Call LOADDAC(4095, VERN%) 'Sets vernier DAC at -5mV DC
VERNMIN! = READDVM!(0!)
Loop While VERNMIN! > -0.005 And ITER3% < 10
Do
ITER4% = ITER4% + 1
Call LOADDAC(0, VERN%) 'Sets vernier DAC at 5mV DC
VERNMAX! = READDVM!(0!)
Loop While VERNMAX! < 0.005 And ITER4% < 10
Call LOADMUX(CH%, COFF%) 'Turns CHn off
If ITER1% > 9 Or ITER2% > 9 Or ITER3% > 9 Or ITER4% > 9 Then TE$ = "ERROR"
End Sub
Sub CASEINST()
Color 20, 1, 1
CLS
LOCATE 8
Print Tab(15); " -- NOTE -- "
Color 15, 1, 1
Print Tab(15); "**************************************************"
Print ;
Color 14, 1, 1
Print Tab(15); " INSTALL A CASE OVER THE UNIT (NO LABEL REQUIRED) "
Color 15, 1, 1
Print ;
Print Tab(15); "**************************************************"
SOUND 400, 1
CONTINUE
Color 11, 0, 0
CLS
End Sub
Sub CHANGEDN(SN$)
'Sub to update the module serial number with a new dash number
NDS$ = GETDS$(1, SN$) 'Get new dash number from function
Call SNPARSE(SN$, WO$, DS$) 'Get current work order and dash numbers from module serial number
SN$ = WO$ + "-" + NDS$
Print "New serial number is: "; SN$
End Sub
Sub CONTINUE()
X% = POS(0)
Y% = CSRLIN
LOCATE 22, 10: Print "Press any key to continue"
a$ = KEYBDIN$
LOCATE 22, 10: Print " "
LOCATE Y%, X%
End Sub
Function FAILCOM(COMSTATUS$)
If Left$(COMSTATUS$, 4) = "FAIL" Then
LOCATE 15, 10
Print "A Required KEPCO is not connected"
Print Tab(10); "Please confirm connectivity to required power supplies."
Print Tab(10); "Exiting Program......"
End
End If
End Function
'********************************************
Function GETDS$(ISNEWDS%, SN$)
'Function to get and return the dash number
'---------------------------------------------------------------------------------------------
'Valid dash number = 1) One or two characters, both numeric (but not "0")
' 2) Blank (defaults to "1")
'Note: For prototype or debug, one or two alphabetic or alphanumeric characters
' are also accepted for the dash number, but this is not mentioned on the
' screen.
'---------------------------------------------------------------------------------------------
CLS
'COLOR 15, 0, 0 'White on black
CURLOC% = 2
DSFLAG% = 1 'Flag = "1" to stay in loop waiting for valid dash number ("0" to exit loop)
'Loop to get and validate dash number
Do While DSFLAG% = 1
DS$ = "" 'Initialize dash number
'Clear lines on loop-back
LOCATE CURLOC% + 4, 10: Print " "
LOCATE CURLOC% + 5, 10: Print " "
If ISNEWDS% = 1 Then
LOCATE CURLOC% + 4, 10: Print "Old serial number: "; SN$
LOCATE CURLOC% + 5, 10: INPUT "Enter new dash number: "; DS$
Else
LOCATE CURLOC% + 5, 10: INPUT "Starting dash number (Press 'Enter' for 1) "; DS$
End If
DS$ = UCase$(DS$) 'Set to upper case
DSL% = Len(DS$) 'Get length of dash number
'Validate dash number entry
If (DS$ = "") Then 'Blank.
DS$ = "1" 'Default to 1 if blank
DSFLAG% = 0 'Valid dash number, set flag to exit loop
ElseIf (DSL% > 2) Then 'More than two characters
DSFLAG% = 1 'Bad dash number entry, remain in loop
ElseIf (DSL% = 1) Then 'One character
If (ISALLLETTERS%(DS$) = 1) Then 'Alphabetic character
DSFLAG% = 0 'Valid dash number, set flag to exit loop
ElseIf ((Val(DS$) > 0) And (Val(DS$) < 10)) Then 'Positive number from 1 to 9
DSFLAG% = 0 'Valid dash number, set flag to exit loop
Else 'Not alphabetic or number from 1 to 9
DSFLAG% = 1 'Bad dash number entry, remain in loop
End If
ElseIf (DSL% = 2) Then 'Two characters
If (ISPOSNUMBER%(DS$) = 1) Then 'Two-character positive number
VALDS% = Val(DS$) 'Get value of dash number
If ((VALDS% > 0) And (VALDS% < 100)) Then 'Two-character number from 1 to 99
DSFLAG% = 0 'Valid dash number, set flag to exit loop
Else 'Not from 1 to 99
DSFLAG% = 1 'Bad dash number entry, remain in loop
End If
ElseIf (ISALLLETTERS%(DS$) = 1) Then 'Two alphabetic characters
DSFLAG% = 0 'Valid dash number, set flag to exit loop
Else 'Not all alphabetic or number from 1 to 99, check for valid alphanumeric
DSLC$ = Left$(DS$, 1) 'Get left character
DSRC$ = Right$(DS$, 1) 'Get right character
'Check for valid alphanumeric dash number with first character alphabetic
If (ISALLLETTERS%(DSLC$) = 1) Then 'First (left) character is alphabetic
If ((Val(DSRC$) > 0) And (Val(DSRC$) < 10)) Then 'Last (right) character is number from 1 to 9
'Valid alphanumeric (left character alphabetic, right character number)
DSFLAG% = 0 'Valid dash number, set flag to exit loop
Else 'Right character not a valid number
'Left character alphabetic, but right character not valid
'number, so not a valid alphanumeric dash number
DSFLAG% = 1 'Bad dash number entry, remain in loop
End If
'Check for valid alphanumeric dash number with first character alphabetic
ElseIf (ISALLLETTERS%(DSRC$) = 1) Then 'Last (right) character is alphabetic
If ((Val(DSLC$) > 0) And (Val(DSLC$) < 10)) Then 'First (left) character is number from 1 to 9
'Valid alphanumeric (left character number, right character alphabetic)
DSFLAG% = 0 'Valid dash number, set flag to exit loop
Else 'Left character not a valid number
'Right character alphabetic, but left character not valid
'number, so not a valid alphanumeric dash number
DSFLAG% = 1 'Bad dash number entry, remain in loop
End If
Else 'Not a valid alphanumeric
DSFLAG% = 1 'Bad dash number entry, remain in loop
End If
End If
End If
'Post error text and list allowable values if a good entry was not found the first time through
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID DASH NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Entered: "; DS$
LOCATE CURLOC% + 3, 10: Print "Must be number between 1 and 99"
Color 15, 0, 0 'White on black
LOCATE CURLOC% + 6, 10: Print "Values allowed: numbers from 0 to 99 or blank for '1'";
Loop 'Loop when flag = "1"
'Clear warnings and messages
Color 11, 0, 0 'Cyan on black background
CLS
GETDS$ = DS$ 'Set function return
End Function
'********************************************
Sub GETDSFNAME(SN$, DSSNAME$, DSFNAME$)
'Sub to create and return the datasheet search name (DSSNAME$) and datasheet file name
'(DSFNAME) as parameters from the the passed serial number string. The serial number is
'in the form: "work order number" + "-" "dash number" (for example: "12345-1"). The Sub
'parses out the work order number from the serial number, checks its validity, and
'modifies valid six-character work order numbers to create specially coded five-character
'work order numbers as described below. The modified or unmodified work order numbers then
'become part of the datasheet search and file names.
'---------------------------------------------------------------------------------------------
'The datasheet search and file names produced depend on the parsed work order number as shown
'below:
' 1) If the work order number is 5 characters or less, then the datasheet file name is
' "work order #" + "-" + "dash #" + ".TXT" and the search name is "work order #".
' For example, if the serial number is "12345-1":
' Datasheet file name = "12345-1.TXT"
' Datasheet search name = "12345"
' 2) If the work order number is 6 characters with the first two characters from "10"
' to "19" then convert the first two characters to "A" from "10" up to "J" for "19".
' Then the datasheet file name is "modified work order #" + "-" "dash #" + ".TXT"
' and the datasheet search name is "modified work order #".
' For example, if the serial number is "123456-1":
' Datasheet file name = "C3456-1.TXT"
' Datasheet search name = "C3456"
' 3) If the work order number is invalid (blank, more than six characters, six characters
' with the first two characters not a number from "10" to "19" inclusive), then the
' datasheet file name is "BAD" + "-" + "dash #" + ".TXT" and the datasheet search name
' is "BAD".
' For example, if the serial number is "223456-1":
' Datasheet file name = "BAD-1.TXT"
' Datasheet search name = "BAD"
'---------------------------------------------------------------------------------------------
Call SNPARSE(SN$, WO$, DS$) 'Parse work order number and dash number from serial number
LWO% = Len(WO$) 'Get length of work order number
If WO$ = "" Then
'Work order is blank
CLS
CURLOC% = 2
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Work order number is: "; "<blank>"
LOCATE CURLOC% + 3, 10: Print "Valid datasheet file name cannot be created!"
LOCATE CURLOC% + 4, 10: Print "Contact Engineering!"
Color 15, 0, 0 'White on black
DSFNAME$ = "BAD" + "-" + DS$ + ".TXT" 'Create "bad" datasheet file name.
DSSNAME$ = "BAD" 'Create "bad" datasheet search name.
ElseIf LWO% > 6 Then
'Work order more than six characters
CLS
CURLOC% = 2
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Work order number is more than six characters: "; WO$
LOCATE CURLOC% + 3, 10: Print "Valid datasheet file name cannot be created!"
LOCATE CURLOC% + 4, 10: Print "Contact Engineering!"
Color 15, 0, 0 'White on black
DSFNAME$ = "BAD" + "-" + DS$ + ".TXT" 'Create "bad" datasheet file name.
DSSNAME$ = "BAD" 'Create "bad" datasheet search name.
ElseIf LWO% = 6 Then
'Work order is six characters long
VALLEFT2% = Val(Left$(WO$, 2)) 'Get numerical value of left two characters in work order number
If ((VALLEFT2% < 10) Or (VALLEFT2% > 19)) Then
'Value of left two characters are not between 10 to 19 (including the two endpoints)
CLS
CURLOC% = 2
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "1st and 2nd digits or work order # must be '10' to '19': "; WO$
LOCATE CURLOC% + 3, 10: Print "Valid datasheet file name cannot be created!"
LOCATE CURLOC% + 4, 10: Print "Contact Engineering!"
Color 15, 0, 0 'White on black
DSFNAME$ = "BAD" + "-" + DS$ + ".TXT" 'Create "bad" datasheet file name.
DSSNAME$ = "BAD" 'Create "bad" datasheet search name.
Else
'Six character work order number with valid first two characters
Select Case VALLEFT2%
Case 10
WO1$ = "A" 'Single alpha for the two-character value
Case 11
WO1$ = "B" 'Single alpha for the two-character value
Case 12
WO1$ = "C" 'Single alpha for the two-character value
Case 13
WO1$ = "D" 'Single alpha for the two-character value
Case 14
WO1$ = "E" 'Single alpha for the two-character value
Case 15
WO1$ = "F" 'Single alpha for the two-character value
Case 16
WO1$ = "G" 'Single alpha for the two-character value
Case 17
WO1$ = "H" 'Single alpha for the two-character value
Case 18
WO1$ = "I" 'Single alpha for the two-character value
Case Else
'Value of "19" (already checked that value in "10" to "19" range)
WO1$ = "J" 'Single alpha for the two-character value
End Select
WONXT4$ = Right$(WO$, 4) 'Get the last for characters of the work order number
'Create datasheet file name from the new 1st character and then the next 4 characters
'of the six-character work order number, then using the dash number
'Create "good" datasheet file and search names from modified work order#.
DSFNAME$ = WO1$ + WONXT4$ + "-" + DS$ + ".TXT"
DSSNAME$ = WO1$ + WONXT4$
End If
Else 'Work order number is 5 characters of less (but not blank)
'Create "good" datasheet file and search names from unmodified work order#.
DSFNAME$ = WO$ + "-" + DS$ + ".TXT"
DSSNAME$ = WO$
End If
End Sub
'********************************************
Sub GETSN(SN$)
'Sub to get work order number and dash number to generate serial number for module
'Get work order number
WO$ = GETWO$ 'Get work order number from function
'Get dash number
DS$ = GETDS$(0, SN$) 'Get (starting) dash number from function
'Create serial number from work order number and dash number
SN$ = WO$ + "-" + DS$
End Sub
Function GETTHID%()
'Reads and returns the test head identification number
'
'There are only 3 bits for test head identification which is not enough
'to give each type of test head for each product a unique address. Use
'the following addresses to identify test heads within a given product line.
'
'Test Head ID# Use To Test Product
'------------- -------------------
' 0 Voltage, Current, TC, Strain Gage, 2W TX, DC LVDT, Input
' 7B Voltage Output, 7B Current Output
' 1 RTD, Thermistor, Resistance Input
' 2 5B, DSC Current Output
' 3 5B, DSC Voltage Output
' 4 Frequency Input
' 5 VAS
' 6
' 7
'
'
'Test Head Output Data Line Function Description Parallel Port Signal
'-------------------------- -------------------- --------------------
' D00 Switch S1 input - Acknowledge Data\
' reserved for future use
' D01 Fixture identification, LSB Busy\
' D02 Fixture identification Paper Out
' D03 Fixture identification, MSB On Line\
' D04 Hardwired, Logic 1 Error\
'
'
'Status Register, located at parallel port address + 1
' MSB LSB
'DB25 pin # 11 10 12 13 15 X X X
'Data Line D01 D00 D02 D03 D04
'
'NOTES; Bit D01 (pin 11) reads opposite the expected value
' * Only when D02 is pulled low * JL 06/01/01
' Logic levels may be present on pins 10-15 which represent the active state.
' For the first board tested, 3.3Kohm was not enough to pull down the
' logic 1 signal on pin 12 to a logic 0. Use 510 ohms for this line.
BYTE% = THADDR% * 4 + 0 'Select control bank #0, W/R control
OUT (LPTADDR%), BYTE%
OUT (LPTADDR% + 2), &HE 'D/A line low
Call PAUSE(0.0001)
OUT (LPTADDR% + 2), &H4 'W/R EN/ D/A S/ high
OUT (LPTADDR% + 2), &HC 'W/R line low
'Enables test head output data
Call PAUSE(0.05)
I% = INP(LPTADDR% + 1) 'Gets data from the test head.
D01% = Int(I% / 2 ^ 7)
I% = I% - 2 ^ 7 * D01%
D00% = Int(I% / 2 ^ 6)
I% = I% - 2 ^ 6 * D00%
D02% = Int(I% / 2 ^ 5)
I% = I% - 2 ^ 5 * D02%
D03% = Int(I% / 2 ^ 4)
If D01% = 0 Then D01% = 1 Else D01% = 0
GETTHID% = D03% * 4 + D02% * 2 + D01%
OUT (LPTADDR% + 2), &H4 'W/R EN/ D/A S/ high
'Disables test head output data
End Function
'********************************************
Function GETWO$()
'Function to get and return the work order number. A valid work order number has to be entered
'twice. If the first and second valid work order numbers do not match, then they have to be
'entered again. Once the two numbers match, the function returns the work order number. Valid
'values for work order numbers are listed below:
'---------------------------------------------------------------------------------------------
'Valid work order number = 1) 6 characters only if first character is "1"
' and the remaining characters are numbers
' 2) 5 alpha-numeric characters:
' a) If the next four characters are numeric,
' the first character cannot be A through J,
' since that format is reserved for datasheet
' file names with work order numbers of six
' digits.
' b) If any of the next four characters are
' alphabetic, then there is no restriction
' on the first character.
' 3) 1 to 4 alpha-numeric characters
'---------------------------------------------------------------------------------------------
CLS
CURLOC% = 2
WOFLAG1% = 1 'Flag = "1" to stay in inner loop waiting for valid work order number ("0" to exit loop)
WOFLAG2% = 1 'Flag = "1" to stay in outer loop waiting for matching work order numbers ("0" to exit loop)
LOOPNUM% = 1 'Outer loop index (for matching work order numbers)
WO1E$ = "" 'Initialize first work order number entered
WO2E$ = "" 'Initialize second work order number entered
Do While WOFLAG2% = 1 'Loop to match first and second work order numbers entered
Do While WOFLAG1% = 1 'Loop to get and validate work order number
WO$ = "" 'Initialize work order number
'Clear entry line on loop-back
LOCATE CURLOC% + 4, 10: Print " "
If LOOPNUM% = 1 Then
LOCATE CURLOC% + 4, 10: INPUT "Enter Work Order number "; WO$
Else
LOCATE CURLOC% + 4, 10: INPUT "Enter Work Order number again "; WO$
End If
WO$ = UCase$(WO$) 'Set to upper case
WOL% = Len(WO$) 'Get length of work order number
If (WOL% > 6) Then
'Clear any previous warning lines
CLS
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Entered: "; WO$
LOCATE CURLOC% + 3, 10: Print "Must be 6 characters or less"
Color 15, 0, 0 'White on black
ElseIf (WOL% = 6) Then 'Six characters
If (Left$(WO$, 1) <> "1") Then
'Clear any previous warning lines
CLS
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Entered: "; WO$
LOCATE CURLOC% + 3, 10: Print "1st character can only be '1' for 6-digit entry"
Color 15, 0, 0 'White on black
Else 'Six characters, with 6th character = 1
If (ISPOSNUMBER%(WO$) = 1) Then 'Whole entry is a positive number
WOFLAG1% = 0 'Valid work order number, set flag to exit loop
Else
'Clear any previous warning lines
CLS
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Entered: "; WO$
LOCATE CURLOC% + 3, 10: Print "All digits must be numeric for 6-character entry"
Color 15, 0, 0 'White on black
End If
End If
ElseIf (WOL% = 5) Then 'Five characters
WO4CHAR$ = Right$(WO$, 4) 'Get last four characters
If (ISPOSNUMBER%(WO4CHAR$) = 1) Then 'Last four characters are a positive number
'Check that first character is not A through J
WO1STCHAR$ = Mid$(WO$, 1, 1) 'Get 1st character (from left)
Select Case WO1STCHAR$
Case "A" To "J"
'Clear any previous warning lines
CLS
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Entered: "; WO$
LOCATE CURLOC% + 3, 10: Print "With 5-character entry, 1st character cannot be A through J"
Color 15, 0, 0 'White on black
Case Else
WOFLAG1% = 0 'Valid work order number, set flag to exit loop
End Select
Else
'No entry restrictions with a 5-character entry if last four
'characters are not a positive number
WOFLAG1% = 0 'Valid work order number, set flag to exit loop
End If
ElseIf (WO$ = "") Then
'Clear any previous warning lines
CLS
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Entered: <blank>"
LOCATE CURLOC% + 3, 10: Print "Cannot be blank"
Color 15, 0, 0 'White on black
Else 'Less than 5 characters, but not blank
WOFLAG1% = 0 'Valid work order number, set flag to exit loop
End If
If WOFLAG1% = 1 Then
End If
'List allowable values if a good entry was not found the first time through
LOCATE CURLOC% + 5, 10: Print "Values allowed: up to 6 digits matching the WO#, or";
LOCATE CURLOC% + 6, 10: Print " for debug or non-production purposes:";
LOCATE CURLOC% + 7, 10: Print " 4 alpha-numeric characters";
LOCATE CURLOC% + 8, 10: Print " 5 characters not starting with A-J";
Loop 'Loop when flag = "1" (waiting for valid work order number)
WOFLAG1% = 1 'Good work order number entered - reinitialize inner loop flag for 2nd entry
CLS 'Good work order number entered - clear screen
'Store valid work order numbers for comparison
If LOOPNUM% = 1 Then
WO1E$ = WO$ 'Store value of first valid work order number entered
LOOPNUM% = LOOPNUM% + 1 'Increment outer loop index
Else
WO2E$ = WO$ 'Store value of second valid work order number entered
'Compare valid work order numbers
If WO2E$ = WO1E$ Then 'Matching work order numbers
WO$ = WO1E$ 'Set work order number to first valid work order number entered
WOFLAG2% = 0 'Matching work order numbers, set flag to exit loop
Else
'Clear any previous warning lines
CLS
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "WORK ORDER NUMBERS ENTERED DO NOT MATCH!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "First number entered: " + WO1E$
LOCATE CURLOC% + 3, 10: Print "Second number entered: " + WO2E$
Color 15, 0, 0 'White on black
LOOPNUM% = 1 'Matching failed - reinitialize outer loop index
WO1E$ = "" 'Matching failed - reinitialize first work order number entered
WO2E$ = "" 'Matching failed - reinitialize second work order number entered
End If
End If
Loop 'Loop when flag = "1" (waiting for matching work order number)
'Clear warnings
Color 11, 0, 0 'Cyan on black background
CLS
GETWO$ = WO$ 'Set function return
End Function
'********************************************
Function GETWOSFNAME$(SN$)
'Function to create and return the work order status file name from
'the passed serial number string
'---------------------------------------------------------------------------------------------
'Valid work order file name = 1) If work order number is 6 characters or less, then
' "work order #" + ".TXT"
' 2) "BAD" + ".TXT" for error cases (work order number
' more than 6 characters or blank.
'---------------------------------------------------------------------------------------------
Call SNPARSE(SN$, WO$, DS$)
LWO% = Len(WO$) 'Get length of work order number
If WO$ = "" Then
'Work order is blank
CLS
CURLOC% = 2
'Clear any previous warning lines
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Work order number is: "; "<blank>"
LOCATE CURLOC% + 3, 10: Print "Valid work order status file name cannot be created!"
LOCATE CURLOC% + 4, 10: Print "Contact Engineering!"
Color 15, 0, 0 'White on black
GETWOSFNAME$ = "BAD" + ".TXT" 'Create "bad" work order status file name.
ElseIf LWO% > 6 Then
'Work order more than six characters
CLS
CURLOC% = 2
'Clear any previous warning lines
Color 28, 0, 0 'Flashing light red
LOCATE CURLOC% + 1, 10: Print "INVALID WORK ORDER NUMBER!"
Color 12, 0, 0 'Light red
LOCATE CURLOC% + 2, 10: Print "Work order number is more than six characters: "; WO$
LOCATE CURLOC% + 3, 10: Print "Valid work order status file name cannot be created!"
LOCATE CURLOC% + 4, 10: Print "Contact Engineering!"
Color 15, 0, 0 'White on black
GETWOSFNAME$ = "BAD" + ".TXT" 'Create "bad" work order status file name.
Else
'Work order number is 6 characters of less (but not blank)
GETWOSFNAME$ = WO$ + ".TXT" 'Create work order status file name directly from WO#.
End If
End Function
Sub HS1()
'GPIB "handshake: waits for the last instruction to be sent then
' checks bit #4 for "True".
CNT = 0
CNTR = 50000 'Loop exit count. 1000 is too little (causes SUPPLYSEN to display error message below).
BYTE% = 0
WHILE (BYTE% AND 16) = 0
BYTE% = INP(BADDRS% + 0)
If CNT > CNTR Then
'GPIBFLAG! = 1!
CLS
Print
Print Tab(25); "COMMUNICATIONS FAILURE."
Print
Print Tab(5); "Please check connectivity of external test devices and power supplies."
Print Tab(5); "KEPCO DPS-125 Power Supply address should be set to 1."
Print Tab(5); "KEPCO DPS-125 High Voltage Input source address should be set to 2."
Print
Print Tab(5); "The newer KEPCO ABC 125 Power Supply's GPIB address is set to 5"
Print Tab(5); "from the front panel by pressing: Menu, Menu, 05, ENTER, RESET."
Print
Print Tab(5); "The newer KEPCO ABC 125 High-Voltage Supply's GPIB address is set to 6"
Print
Print Tab(10); "Program will return to main menu."
End
'BYTE% = 1
End If
CNT = CNT + 1
Wend
End Sub
Sub INIT488(DVMADDR%)
'Initializes the IEEE488 interface.
'
OUT (BADDRS% + 8), &H0 'Configure PC4311 as controller
OUT (BADDRS% + 3), &H80 'Release ACDS holdoff, set operation
OUT (BADDRS% + 3), &H0 'Software reset, set operation
OUT (BADDRS% + 4), DVMADDR% 'Enable dual primary addressing mode
OUT (BADDRS% + 0), &H0 'Disable all interrupts
OUT (BADDRS% + 3), &H8F 'Request control, clear operation
OUT (BADDRS% + 3), &HF 'Send remote enable, clear operation
OUT (BADDRS% + 3), &H90 'Listen only, set operation
End Sub
Sub INITPS(ADDR%, OVERI!, OVERV!)
'Initializes the Kepco power supply (either model).
'
If PSMODEL$ = "DPS125" Then
'******** Initialize Kepco power supply
'****** Select over-current protection mode
PS$ = POWERIO$(ADDR%, "SMD=OC")
'****** Select Over-Current Limit
STLEN% = Len(Str$(OVERI!))
PS$ = POWERIO$(ADDR%, "SOC=" + Right$(Str$(OVERI!), STLEN% - 1))
'****** Set Over-Voltage Limit
STLEN% = Len(Str$(OVERV!))
PS$ = POWERIO$(ADDR%, "SOV=" + Right$(Str$(OVERV!), STLEN% - 1))
PS$ = POWERIO$(ADDR%, "ZER") 'Clear errors if any
ElseIf PSMODEL$ = "ABC125" Then
'******* Initialize KEPCO ABC Power Supply
Call WRITEPS(ADDR%, "*CLS") 'Clears Status Data
Number$ = READPS(ADDR%, "OUTP?") 'If output is off, turn on
If Number$ = "0" Then
Call WRITEPS(ADDR%, "OUTP ON")
End If
'For the KEPCO ABC125, the numeric parameter sent to the power supply
'with the command VOLT:PROT has to be in exponential notation.
'The code below converts the overvoltage integer (125)
'to an exponential (1.25E+2)
STLEN% = Len(Str$(OVERV!))
NUMSTR$ = Right$(Str$(OVERV!), STLEN% - 1)
If STLEN% > 2 Then
EXPSTR$ = Left$(NUMSTR$, 1) + "." + Right$(NUMSTR$, STLEN% - 2) + "E+" + Right$(Str$(STLEN% - 2), 1)
Call WRITEPS(ADDR%, "VOLT:PROT " + EXPSTR$)
Else
Call WRITEPS(ADDR%, "VOLT:PROT 1.0E+1") 'set to 10V limit
End If
'******* Sets the voltage limit
Call WRITEPS(ADDR%, "VOLT:LIM:HIGH")
Call WRITEPS(ADDR%, "CURR:PROT" + Str$(OVERI! / 1000))
'******* Sets the current limit
Call WRITEPS(ADDR%, "CURR:LIM:HIGH")
Else
Print "Neither KEPCO model could be identified and initialized"
End If
End Sub
'********************************************
Function ISALLLETTERS%(TESTVALUE$)
'Function that checks if the passed string is all letter characters. Returns "1" for a letter
'or "0" anything else.
ISALLLETTERS% = 1 'Initialize to function return for all-letter string
N% = Len(TESTVALUE$) 'Get length of passed string
Do Until N% = 0
TVC$ = Mid$(TESTVALUE$, N%, 1) 'Get nth character of passed string
CHARVALUE% = Asc(TVC$) 'Get decimal ASCII code for nth character
If Not (((CHARVALUE% >= 65) And (CHARVALUE% <= 90)) Or ((CHARVALUE% >= 97) And (CHARVALUE% <= 122))) Then
'If character is not within the range of uppercase letters (65 to 90 for "A" to "Z") or
'within the range of lowercase letters (97 to 122 for "a" to "z")
ISALLLETTERS% = 0 'Character is not a letter
End If
N% = N% - 1
Loop
End Function
'********************************************
Function ISPOSNUMBER%(TESTVALUE$)
'Function that checks if the passed string is a positive number (entirely numerical)
'or is a string (at least one non-numerical character). Returns "1" for a positive
' number or "0" anything else
ISPOSNUMBER% = 1 'Initialize to function return for numerical string
N% = Len(TESTVALUE$) 'Get length of passed string
Do Until N% = 0
TVC$ = Mid$(TESTVALUE$, N%, 1) 'Get nth character of passed string
CHARVALUE% = Asc(TVC$) 'Get decimal ASCII code for nth character
If ((CHARVALUE% < 48) Or (CHARVALUE% > 57)) Then
ISPOSNUMBER% = 0 'Character not ASCII code for 0 through 9
End If
N% = N% - 1
Loop
End Function
Function KEYBDIN$()
Do
X$ = INKEY$
Loop While X$ = ""
KEYBDIN$ = X$
End Function
Function LIBVERVAL$()
'Function to return the library source file version
LIBVERVAL$ = LIBVERSION$
End Function
Sub LOADDAC(BINDATA%, DAC%)
' Module Name - LOADDAC
'
' Inputs - BINDATA Binary value to write to DAC
' DAC Selects main DAC if 1 else selects vernier DAC
' Output - None
' Description - Loads the binary value in BINDATA to the DAC specified
' by the DAC variable.
'
If BINDATA% > 4095 Then
BINDATA% = 4095
ElseIf BINDATA% < 0 Then
BINDATA% = 0
End If
If DAC% = 1 Then
ADDRLO% = 770
ADDRHI% = 771
Else
ADDRLO% = 768
ADDRHI% = 769
End If
DATAHI% = Int(BINDATA% / 16)
DATALO% = (BINDATA% - 16 * DATAHI%) * 16
OUT ADDRLO%, DATALO%
OUT ADDRHI%, DATAHI%
End Sub
Sub LOADMUX(CH%, CHON%)
'Parallel Port Control Register is located at address LPTADDR% + 2
'Bits 0, 1, and 3 toggle the opposite way expected.
' W/R EN/ D/A S/
' X X X X X X X X
'C 1 1 0 0 (0 1 1 1)
'D 1 1 0 1 (0 1 1 0)
'4 0 1 0 0 (1 1 1 1)
If CH% = 0 Then 'Reset all channels (open)
OUT (LPTADDR% + 2), &H4 'W/R line high
OUT (LPTADDR% + 2), &HC 'W/R line low
Else
RELAY% = (MUXADDR% * 16) + ((CH% - 1) * 2) + CHON%
OUT (LPTADDR%), RELAY%
Call PAUSE(0.01) 'Waits for data to stabilize
OUT (LPTADDR% + 2), &HD 'S/ line low
Call PAUSE(0.01) 'Waits for relays to settle
'0.5ms operate + 0.5ms bounce
OUT (LPTADDR% + 2), &HC 'S/ line high
End If
End Sub
Sub OHMSET(OHM!)
'Convert the desired ohms to a 20 bit representation and
'set the resistor DAC
E1! = 16.1
If OHM! >= -1 Then
Bit! = 0: B2! = 1E+30
J1! = 0
For K% = 1 To 20
M% = 1
For J! = J1! To 19
B! = 2 ^ J!
If M% = 1 And OHM! / E1! <= 1 / (1 / B! + 1 / B2!) Then M% = 2
If M% = 2 Then
M% = 0
Bit! = Bit! + B!
B2! = 1 / (1 / B2! + 1 / B!)
J1! = J! + 1
End If
Next J!
Next K%
Else
Bit! = 2 ^ 20 'open all relays
End If
CB3VAL% = &HFF - (Bit! - Int(Bit! / 2 ^ 8) * 2 ^ 8)
'06/15/99 SETTHFAST was previously used here. Paul's station was erroneously
'setting the resistance. Adding a 0.1s pause after the S/ line is set
'cures the problem. Use SETTH instead. Performance is not noticeably slowed.
Call SETTH(CB3VAL%, CB3%)
CB2VAL% = &HFF - (Int(Bit! / 2 ^ 8) - Int(Bit! / 2 ^ 16) * 2 ^ 8)
Call SETTH(CB2VAL%, CB2%)
CB1VAL% = (&HFF - (Int(Bit! / 2 ^ 16) * 16 - Int(Bit! / 2 ^ 20) * 2 ^ 8)) And (CB1VAL% Or &HF0)
Call SETTH(CB1VAL%, CB1%)
' Disables the test head by clearing the address.
OUT (LPTADDR%), 0
OUT (LPTADDR% + 2), &HE 'D/A line low
OUT (LPTADDR% + 2), &HC 'D/A line high
'PRINT OHM!, BIT!
'PRINT CB3VAL%, CB2VAL%, CB1VAL%
'CALL CONTINUE
End Sub
Sub PAUSE(TIME!)
T1 = Timer
Do
T2 = Timer
Loop Until (T2 - T1) > TIME!
End Sub
Function POWERIO$(ADDR%, CMD$)
'This function sends commands and receives output from the
'Kepco DPS 125-0.5M programmable power supply.
'Inputs: power supply address, command
'Outputs: supply response, if any
'Open and initialize the power supply controller communications channel for I/O
PSPORTDATA$ = "COM" + Right$(Str$(PSPORT%), 1) + ":9600,N,8,1,CS0,DS0"
Open PSPORTDATA$ For Random As #1 ',BIN,CD0,CS0,DS0,OP0,RS,TB2048,RB2048
DEVSEL = ADDR% + &HE0
RXOK = ADDR% + &HC0
'DEVSEL must be sent without a <CR>
'prior to each command
'Send DEVSEL byte to DPS
Print #1, Chr$(DEVSEL);
N = 0 'Await input buffer to become non-zero
LOOPCOUNT! = 5000 'print message if not successful
Do
N = N + 1
If N = LOOPCOUNT! Then
POWERIO$ = "FAIL"
End If
Loop While (Loc(1) = 0) And N < LOOPCOUNT!
If N = LOOPCOUNT! Then
Close #1 'close power supply communication channel
End If
'RXOK is returned (without a <CR>) in
If N < 5000 Then 'response to DEVSEL
a$ = Input$(1, #1) 'Input RXOK byte
Print #1, CMD$
'Await input buffer to become non-zero
Do
Loop While (Loc(1) = 0)
a$ = Input$(1, #1) 'Input first (non-ASCII) character of
'string and discard
Input #1, B$ 'Input balance of string
POWERIO$ = B$
Close #1 'close power supply communication channel
'ELSE 'N is not less than LOOPCOUNT (5000)
' 'Insert message here
End If
End Function
Function READDATA$(ADDR%)
BYTE% = (MTA% OR ADDR%)
OUT (BADDRS% + 7), BYTE% 'Send out talk address
Call HS1
OUT (BADDRS% + 3), &H89 'Request control, clear
OUT (BADDRS% + 3), &HB 'Remote enable, clear
ITERATION% = ITERATION% + 1
M1! = M2!
'CALL PAUSE(.1)
DATABYTE$ = ""
Do
Do 'Check for Bit #5 = true
BYTE% = INP(BADDRS% + 0)
LOOP WHILE (BYTE% AND 32) = 0
DATABYTE = INP(BADDRS% + 7)
If DATABYTE <> &HA Then
DATABYTE$ = DATABYTE$ + Chr$(DATABYTE)
End If
Loop While DATABYTE <> &HA
Call PAUSE(0.01) 'Slow down execution on faster computers
OUT (BADDRS% + 3), &HC 'Remote enable, set command
OUT (BADDRS% + 3), &H9 'Clear listen only
OUT (BADDRS% + 7), &H5F 'Un-talk command
Call HS1
'Don't exit loop if over-ranged
READDATA$ = DATABYTE$
End Function
Function READDVM!(TOL!)
' Inputs - None
' Outputs - Returns meter reading
' Description - Triggers the meter to take a reading with current
' function, range, and rate. Then returns the measurement.
' Successive readings must differ by less than TOL! to assure
' that filter response has settled. If TOL! = 0 then only
' one reading is taken.
Call INIT488(DVMADDR%)
M2! = 999.9 'Initialize current measurement
ITERATION% = 0 'Initialize loop number (iteration) to zero
MAXLOOPS% = 20 'Initialize maximum number of loops (iterations) to 20
Do
Call TRIGGER
BYTE% = (MTA% OR DVMADDR%)
OUT (BADDRS% + 7), BYTE% 'Send out talk address
Call HS1
OUT (BADDRS% + 3), &H89 'Request control, clear
OUT (BADDRS% + 3), &HB 'Remote enable, clear
ITERATION% = ITERATION% + 1
M1! = M2!
'CALL PAUSE(.1)
DATABYTE$ = ""
Do
Do 'Check for Bit #5 = true
BYTE% = INP(BADDRS% + 0)
LOOP WHILE (BYTE% AND 32) = 0
DATABYTE = INP(BADDRS% + 7)
If DATABYTE <> &HA Then
DATABYTE$ = DATABYTE$ + Chr$(DATABYTE)
End If
Loop While DATABYTE <> &HA
Call PAUSE(0.01) 'Slow down execution on faster computers
M2! = Val(DATABYTE$)
OUT (BADDRS% + 3), &HC 'Remote enable, set command
OUT (BADDRS% + 3), &H9 'Clear listen only
OUT (BADDRS% + 7), &H5F 'Un-talk command
Call HS1
'Changes made to measurement loop exit criteria to account
'for overrange measurements: 2014/03/04 PWR
If (Abs(M2!) > 10000000#) Then
'An overrange value is measured. The meter is set
'to autorange. The only exit while in overrange
'is when the maximum number of iterations has been
'reached (see the loop-exit criteria at the end of
'the loop).
Call WRITEDVM(VODC$, 2000!) 'Autorange meter
Else
'No overrange. Three valid exits (accomplished by
'letting the iterations reach the maximum allowed
'or setting the iteration to the max. allowed):
'1) The difference between the last two measurements are within the
' measurement tolerance passed to the function.
'2) The passed measurement tolerance is zero, calling for only a single
' measurement.
'3) The measurements have not matched to the tolerance, but the
' maximum number if iterations has been reached (see the
' loop-exit criteria at the end of the loop).
If (Abs(M2! - M1!) <= TOL!) Then
'If the difference between the last two measurements are within the measurement
'tolerance passed to the function, accept the last measurement.
ITERATION% = MAXLOOPS% 'Set the iteration to exit the loop
End If
If (TOL! = 0!) Then
'The passed tolerance is zero, calling for a single measurement. The
'loop exits and the current measurement (M2) is used.
ITERATION% = MAXLOOPS% 'Set the iteration to exit the loop
End If
End If
'If the measurement has not settled in 20 readings due to noise or
'module malfunction, accept 20th reading and continue.
Loop While (ITERATION% < MAXLOOPS%)
'Previous code:
'IF M2! > 1E+07 THEN CALL WRITEDVM(VODC$, 2000!) 'autorange
'IF ABS(M2!) > 1E+07 THEN M2! = 0 '12/19/07 JL
'LOOP WHILE (TOL! <> 0! AND ABS(M2! - M1!) > ABS(TOL!) AND ITERATION% < 20) '12/19/07 JL
READDVM! = M2!
End Function
Function READGPIB$(ADDR%, CMD$)
' Inputs - CMD$ = instruction sent to GPIB device
' - ADDR% = GPIB Address of device
' Outputs - Returns device reading as a string that could be
' converted back to an integer value
'
' Description - Triggers the KEPCO ABC125 Power Supply to apply a constant
' voltage or current and/or retrieve specific status information such as if
' the power supply has reached overcurrent limit.
TOL! = 0.01
Call INIT488(DVMADDR%)
M2! = 999 'Why is this 999 instead of 0?
ITERATION% = 0
Do
'****** WRITEPS starts here
'***** 'CALL WRITEPS(ADDR%, CMD$)
'****
Call INIT488(ADDR%)
DDATA$ = CMD$
BYTE% = ADDR% OR MLA%
OUT (BADDRS% + 7), BYTE% 'Send byte out as data
Call HS1
OUT (BADDRS% + 3), &H8A 'Request control, set operation
Call PAUSE(0.001) 'TSO - required for the KEPCO ABC
OUT (BADDRS% + 3), &HB 'Remote enable, clear
For X1 = 1 To Len(DDATA$)
BYTE% = ASC(MID$(DDATA$, X1, 1))
OUT (BADDRS% + 7), BYTE% 'Successively send each character
'***** HS1 starts here
' CALL HS1 'of DDATA$ to 488 device
CNT = 0
CNTR = 1000
BYTE% = 0
WHILE (BYTE% AND 16) = 0 AND GPIBFLAG! <> 1!
BYTE% = INP(BADDRS% + 0)
If CNT > CNTR Then
GPIBFLAG! = 1!
'PRINT
'PRINT TAB(10); "GPIB COM FAILURE. Please Check GPIB connectivity."
'END
BYTE% = 1!
End If
CNT = CNT + 1
Wend
'***** HS1 ends here
Next X1
If GPIBFLAG! <> 1 Then
OUT (BADDRS% + 7), &HD 'Send CR, tell device to execute command
Call HS1
OUT (BADDRS% + 7), &HA 'Send LF
Call HS1
OUT (BADDRS% + 3), &HC 'Remote enable, set operation
OUT (BADDRS% + 3), &HA 'Clear talk only
OUT (BADDRS% + 7), &H3F 'Un-listen
Call HS1
'****** WRITEPS ends here
BYTE% = (MTA% OR ADDR%)
OUT (BADDRS% + 7), BYTE% 'Send out talk address
Call HS1
OUT (BADDRS% + 3), &H89 'Request control, clear
Call PAUSE(0.001) 'TSO - required for the KEPCO ABC
OUT (BADDRS% + 3), &HB 'Remote enable, clear
ITERATION% = ITERATION% + 1
M1! = M2!
'CALL PAUSE(.1)
DATABYTE$ = ""
Do
Do 'Check for Bit #5 = true
BYTE% = INP(BADDRS% + 0)
LOOP WHILE (BYTE% AND 32) = 0
DATABYTE = INP(BADDRS% + 7)
If DATABYTE <> &HA Then
DATABYTE$ = DATABYTE$ + Chr$(DATABYTE)
End If
Loop While DATABYTE <> &HA
Call PAUSE(0.01) 'Slow down execution on faster computers
'M2! = VAL(DATABYTE$)
OUT (BADDRS% + 3), &HC 'Remote enable, set command
OUT (BADDRS% + 3), &H9 'Clear listen only
OUT (BADDRS% + 7), &H5F 'Un-talk command
Call HS1
End If
'IF M2! > 1E+07 THEN CALL WRITEDVM(VODC$, 2000!) 'autorange
Loop While (TOL! <> 0! And Abs(M2! - M1!) > Abs(TOL!) And ITERATION% < 20 And GPIBFLAG! <> 1)
READGPIB$ = DATABYTE$
End Function
Function READPS$(ADDR%, CMD$)
' Inputs - CMD$ = instruction sent to Power Supply
' - ADDR% = GPIB Address of Power Supply
' Outputs - Returns Power Supply reading as a string that could be
' converted back to an integer value
'
' Description - Triggers the KEPCO ABC125 Power Supply to apply a constant
' voltage or current and/or retrieve specific status information such as if
' the power supply has reached overcurrent limit.
TOL! = 0.01
Call INIT488(DVMADDR%)
M2! = 999 'Why is this 999 instead of 0?
ITERATION% = 0
Do
Call WRITEPS(ADDR%, CMD$)
BYTE% = (MTA% OR ADDR%)
OUT (BADDRS% + 7), BYTE% 'Send out talk address
Call HS1
OUT (BADDRS% + 3), &H89 'Request control, clear
Call PAUSE(0.001) 'TSO - required for the KEPCO ABC
OUT (BADDRS% + 3), &HB 'Remote enable, clear
ITERATION% = ITERATION% + 1
M1! = M2!
'CALL PAUSE(.1)
DATABYTE$ = ""
Do
Do 'Check for Bit #5 = true
BYTE% = INP(BADDRS% + 0)
LOOP WHILE (BYTE% AND 32) = 0
DATABYTE = INP(BADDRS% + 7)
If DATABYTE <> &HA Then
DATABYTE$ = DATABYTE$ + Chr$(DATABYTE)
End If
Loop While DATABYTE <> &HA
Call PAUSE(0.01) 'Slow down execution on faster computers
'M2! = VAL(DATABYTE$)
OUT (BADDRS% + 3), &HC 'Remote enable, set command
OUT (BADDRS% + 3), &H9 'Clear listen only
OUT (BADDRS% + 7), &H5F 'Un-talk command
Call HS1
'IF M2! > 1E+07 THEN CALL WRITEDVM(VODC$, 2000!) 'autorange
Loop While (TOL! <> 0! And Abs(M2! - M1!) > Abs(TOL!) And ITERATION% < 20)
READPS$ = DATABYTE$
' if measurement has not settled in 20 readings due to noise or
' module malfunction, accept 20th reading and continue.
End Function
Function REPEAT$(N$)
'Function to determine whether to test another module. Changed to explicitly require
'that the "Y" or "N" key be pressed (uppercase or lowercase)
'
Color 15, 0, 0 'Bright white on black background
CLS
LOCATE 10, 10: Print "Do you want to test another "; RTrim$(N$); " module?"
LOCATE 11, 10: Print "Either the 'Y' or 'N' must be pressed."
Do 'Loop until the "Y" or "N" key is pressed
a$ = INKEY$
a$ = UCase$(a$) 'Set key value to uppercase
Loop While (a$ <> "N") And (a$ <> "Y")
If (a$ = "Y") Then
LOCATE 14, 10: Print "Insert the next module"
Call CONTINUE
End If
REPEAT$ = a$
Color 11, 0, 0 'Cyan on black background
End Function
Function REPEAT2$(N$, SN$)
'Function to determine whether to test another module. If testing another module
'is desired, a menu of options is presented. The function has been changed to
'explicitly require that the "Y" or "N" key be pressed (uppercase or lowercase)
'
Color 15, 0, 0 'Bright white on black background
CLS
LOCATE 10, 10: Print "Do you want to test another "; RTrim$(N$); " module?"
LOCATE 11, 10: Print "Either the 'Y' or 'N' must be pressed."
Do 'Loop until the "Y" or "N" key is pressed
a$ = INKEY$
a$ = UCase$(a$) 'Set key value to uppercase
Loop While (a$ <> "N") And (a$ <> "Y")
If (a$ = "Y") Then
CLS
Color 14, 0, 0
LOCATE 3, 23: Print N$; " NEXT MODULE TEST OPTIONS"
LOCATE 4, 23: Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
Color 15, 0, 0
LOCATE 6, 10: Print "Please select the desired option for the next module to test:"
Color 11, 0, 0
LOCATE 8, 15: Print "1.) Same work order, next sequential number"
LOCATE 9, 15: Print "2.) Same work order, different sequential number"
LOCATE 10, 15: Print "3.) Different work order, different sequential number"
LOCATE 11, 15: Print "4.) Retest the same unit"
LOCATE 14, 10: Print "The serial number for the module just tested is: "; SN$
Do
I$ = INKEY$
Loop While Val(I$) < 1 Or Val(I$) > 4
SEL2% = Val(I$)
Select Case SEL2% 'Changes S/N information as selected
Case 1
SN$ = UPSN$(SN$) 'Increments the Dash# of the serial #
Case 2
Call CHANGEDN(SN$) 'Changes dash number only
Case 3
Call WORKORDERPRINT(SN$) 'Print the work order status file
Call GETSN(SN$) 'Changes work order and dash number
Call WORKORDERHEADER(SN$) 'Write header to work order status file (with new number)
Case 4
' Do nothing since same unit will be tested
End Select
End If
REPEAT2$ = a$
Color 11, 0, 0 'Cyan on black background
End Function
Function RTDOHMS!(TEMP!, SENTYPE$)
'Function inputs; temperature, RTD type
'Function Output; RTD resistance in ohms
'Polynomial format; OHMS = c0 + c1*T + c2*T^2 + c3*T^3 + ...
'RTD sensor types are: P1 = Pt100, P2 = Pt600, P3 = Pt500, P4 = E1 Pt100 Rosemount
' NI = Ni120
' C1 = Cu10 (10 ohms @ 25C), C2 = Cu10 (10 ohms @ 0C)
' P8 = Pt392 (50 Ohm RTD alfa=0.00392)
' P9 = Pt392 (100 Ohm RTD alfa=0.00392)
' N9 = LEWIS NICKEL RTD
' N2 = 50 Ohm at 75 F NNICKEL RTD
ST$ = UCase$(Left$(SENTYPE$, 2))
If ST$ = "P1" Or ST$ = "P2" Or ST$ = "P3" Or ST$ = "P5" Then 'Select the proper polynomial
If TEMP! < 0 Then '100 ohm Platinum RTD
RESTORE TYPEPTNEG
Else
RESTORE TYPEPTPOS
End If
T2! = TEMP!
ElseIf ST$ = "P4" Then 'E1 Pt100 Rosemount
RESTORE TYPEE1PT100
T2! = TEMP!
ElseIf ST$ = "P8" Or ST$ = "P9" Then 'Pt100 with alfa=0.00392
If TEMP! < 0 Then
RESTORE TYPEPT392NEG
Else
RESTORE TYPEPT392POS
End If
T2! = TEMP!
ElseIf ST$ = "NI" Then '120 ohm Nickel RTD
If TEMP! < 150 Then
RESTORE TYPENI1
Else
RESTORE TYPENI2
End If
T2! = TEMP!
ElseIf ST$ = "N9" Then 'LEWIS Nickel RTD
If TEMP! < 120 Then
RESTORE TYPENI90NEG
Else
RESTORE TYPENI90POS
End If
T2! = TEMP!
ElseIf ST$ = "C1" Then '10 ohm Copper RTD
RESTORE TYPECU '10 ohms @ 25C
T2! = TEMP!
ElseIf ST$ = "C2" Then '10 ohm Copper RTD
RESTORE TYPECU '10 ohms @ 0C
T2! = TEMP! + 25! 'offset before using polynomial
ElseIf ST$ = "N2" Then '50 ohm Nickel RTD
RESTORE TYPENI50 '50 ohms @ 75F
T2! = TEMP!
Else
RTDOHMS! = 99 'invalid sensor type
Exit Function
End If
'Check if TEMP is within polynomial limits
READ MINTEMP!, MAXTEMP!
If T2! < MINTEMP! Or T2! > MAXTEMP! Then
Print "Error! Polynomial limits exceeded. Contact engineering."
Print SENTYPE$, TEMP!, MINTEMP!, MAXTEMP!
RTDOHMS! = 98
Stop
'EXIT FUNCTION
End If
Do
READ COEFF#
R! = R! + COEFF# * T2! ^ EXPNT%
EXPNT% = EXPNT% + 1
Loop While COEFF# <> 0 Or EXPNT% = 1 'look for coeff = 0, end of data
If ST$ = "P2" Then
RTDOHMS! = 6 * R! 'Pt 600 sensor
ElseIf ST$ = "P3" Then
RTDOHMS! = 5 * R! 'Pt 500 sensor
ElseIf ST$ = "P5" Then
RTDOHMS! = 10 * R! 'Pt 1000 sensor
ElseIf ST$ = "P8" Then
RTDOHMS! = 0.5 * R! 'Pt 50 sensor
Else
RTDOHMS! = R!
End If
End Function
Function RTDTEMP!(OHMS!, SENTYPE$)
'Function inputs; measured ohms from simulated RTD, RTD type
'Function Output; RTD temperature in deg. C.
'Polynomial format; T = c0 + c1*OHM + c2*OHM^2 + c3*OHM^3 + ...
'RTD sensor types are: P1 = Pt100, P2 = Pt600, P3 = Pt500, P4 = E1 Pt100 Rosemount
' NI = Ni120
' C1 = Cu10 (10 ohms @ 25C), C2 = Cu10 (10 ohms @ 0C)
' P8 = Pt392 (50 Ohm RTD alfa=0.00392)
' P9 = Pt392 (100 Ohm RTD alfa=0.00392)
' N9 = LEWIS Nickel RTD
' N2 = 50 Ohm at 75F Nickel RTD
ST$ = UCase$(Left$(SENTYPE$, 2))
If ST$ = "P1" Or ST$ = "P2" Or ST$ = "P3" Or ST$ = "P5" Then 'Select the proper polynomial
If ST$ = "P2" Then
OHMS! = OHMS! / 6 'Pt 600 sensor
ElseIf ST$ = "P3" Then
OHMS! = OHMS! / 5 'Pt 500 sensor
ElseIf ST$ = "P5" Then
OHMS! = OHMS! / 10 'Pt 1000 sensor
End If
If OHMS! < 100 Then '100 ohm Platinum RTD
RESTORE INVPTNEG
Else
RESTORE INVPTPOS 'Coefficient set to zero
T! = (-0.0039083 + (0.00001758480889 - 0.0000000231 * OHMS!) ^ 0.5) / (-0.000001155)
End If
ElseIf ST$ = "P4" Then 'E1 Pt100 Rosemount
RESTORE INVE1PT100
ElseIf ST$ = "P8" Or ST$ = "P9" Then 'Pt100 RTD Alfa = 0.00392
If ST$ = "P8" Then
OHMS! = OHMS! * 2
End If
If OHMS! < 100 Then
RESTORE INVPT392NEG
Else
RESTORE INVPT392POS
End If
ElseIf ST$ = "NI" Then '120 ohm Nickel RTD
If OHMS! < 248.95 Then
RESTORE INVNI1
Else
RESTORE INVNI2
End If
ElseIf ST$ = "N9" Then 'LEWIS Nickel RTD
RESTORE INVNI90
ElseIf ST$ = "C1" Or ST$ = "C2" Then '10 ohm Copper RTD
RESTORE INVCU
ElseIf ST$ = "N2" Then '50 Ohm Nickel RTD
RESTORE INVNI50
Else
RTDTEMP! = 99 'invalid sensor type
Exit Function
End If
'Check if OHMS is within polynomial limits
READ MINOHM!, MAXOHM!
If OHMS! < MINOHM! Or OHMS! > MAXOHM! Then
Print "Error! Polynomial limits exceeded. Contact engineering."
Print SENTYPE$, OHMS!, MINOHM!, MAXOHM!
RTDTEMP! = 98
Stop
'EXIT FUNCTION
End If
Do
READ COEFF#
T! = T! + COEFF# * OHMS! ^ EXPNT%
EXPNT% = EXPNT% + 1
Loop While COEFF# <> 0 Or EXPNT% = 1 'look for coeff = 0, end of data
If ST$ = "C2" Then '10 ohm Copper RTD
RTDTEMP! = T! - 25! '10 ohms @ 0C
Else
RTDTEMP! = T!
End If
End Function
Sub RTDTHCAL()
' This subroutine checks the basic operation of the RTD testhead.
'
OHMFAIL% = 0
DFTFAIL% = 0
Dim RES!(5)
Dim RDRIFT(100)
CONTRES! = MEASRES!(1!, 4, CRSTAT$) 'Measure contact resistance
CLS
Color 11, 0 'Text color to bright cyan (blue) on black 'PWR 2014-04-10
Print Tab(10); USING; "SERIES RELAY CONTACT RESISTANCE = #.#### OHMS"; CONTRES!
Print Tab(15); "RELAY CMD R (<28>) MEAS R (<28>) STATUS"
Print Tab(15); "--------------------------------------------------"
'PRINT TAB(15); " ## ####### ########.### &"; E%; OHMS!; TEMP!; OHMSTAT$
For E% = 1 To 20 'Test relays controlling
'resistors up to 500Kohm for emf
OHMS! = 16.1 * 2 ^ (E% - 1)
Call OHMSET(OHMS!)
Call SETTEST(2) 'Open series relay
If OHMS! < 1000 Then
Call WRITEDVM(OHM4$, OHMS! / 1000) 'Sets meter
Call LOADMUX(1, CON%) 'Sets mux channel
Call LOADMUX(8, CON%) 'set sense channel
Else
Call WRITEDVM(OHM2$, OHMS! / 1000) 'Sets meter
Call LOADMUX(1, CON%) 'Sets mux channel
End If
If OHMS! > 1000000! Then
INITTOL! = 0.15 '15% initial tolerance
MEASTOL! = 0.005 '0.5% measurement tolerance
Else
INITTOL! = 0.05 '5% initial tolerance
MEASTOL! = 0.0005 '0.05% measurement tolerance
End If
TEMP! = READDVM!(MEASTOL! * OHMS!) 'Measure resistor value to tolerance
Print Tab(15); USING; " ## ####### ########.### "; E%; OHMS!; TEMP!; 'PWR 2014-04-10
If Abs(TEMP! - OHMS!) > (OHMS! * INITTOL!) Then 'Test for 15% deviation
Color 12, 0 'Text color to bright red on black 'PWR 2014-04-10
OHMSTAT$ = "FAIL"
OHMFAIL% = OHMFAIL% + 1
Else
Color 10, 0 'Text color to light green on black 'PWR 2014-04-10
OHMSTAT$ = "PASS"
End If
' 1 2 3 4 5 6 7
' 56789012345678901234567890123456789012345678901234567890
'PRINT TAB(15); USING " ## ####### ########.### &"; E%; OHMS!; TEMP!; OHMSTAT$
Print Tab(60); OHMSTAT$
Color 11, 0 'Text color to bright cyan (blue) on black 'PWR 2014-04-10
Call LOADMUX(0, CON%) 'Clears mux
If Left$(CRSTAT$, 4) = "FAIL" Then
LPRINT TAB(10); USING "SERIES RELAY CONTACT RESISTANCE FAILURE AT #.#### OHMS"; CONTRES!
LPRINT
LPRINT Chr$(12) 'Page feed
End If
If OHMFAIL% = 1 Then
LPRINT TAB(25); "RELAY TEST RESULTS"
LPRINT
LPRINT TAB(10); USING "SERIES RELAY CONTACT RESISTANCE = #.#### OHMS"; CONTRES!
LPRINT TAB(15); "RELAY CMD R (<28>) MEAS R (<28>) STATUS"
LPRINT TAB(15); "--------------------------------------------------"
OHMFAIL% = OHMFAIL% + 1
End If
If Left$(OHMSTAT$, 4) = "FAIL" Then
LPRINT TAB(15); USING " ## ####### ########.### &"; E%; OHMS!; TEMP!; OHMSTAT$
LPRINT TAB(15); "--------------------------------------------------"
OHMSTAT$ = "PASS"
End If
Next
'4M and 8M resistance don't measure
'consistent due to emf
For E% = 1 To 20
If E% = 1 Or E% = 6 Or E% = 11 Or E% = 16 Then
Call PAUSE(1)
CLS: Print
Print Tab(8); "RELAY CMD R (<28>) DELTA R (%) Elapsed Time (s) STATUS"
Print Tab(8); "-----------------------------------------------------------------"
'PRINT TAB(8); " ## ####### ###.### ###.# &"; E%; RES2!; DRIFTPERC!; ELAP!; DRIFTSTAT$
End If
N% = 1
Do
OHMS! = 16.1 * 2 ^ (E% - 1)
If N% = 1 Then
Call OHMSET(OHMS!)
TIME1! = Timer
Call SETTEST(2) 'Open series relay
If OHMS! < 1000 Then
Call WRITEDVM(OHM4$, OHMS! / 1000) 'Sets meter
Call LOADMUX(1, CON%) 'Sets mux channel
Call LOADMUX(8, CON%) 'set sense channel
Else
Call WRITEDVM(OHM2$, OHMS! / 1000) 'Sets meter
Call LOADMUX(1, CON%) 'Sets mux channel
End If
If OHMS! > 1000000! Then
MEASTOL! = 0.005 '0.5% measurement tolerance
Else
MEASTOL! = 0.0005 '0.05% measurement tolerance
End If
End If
Call PAUSE(0.5)
RES!(N%) = READDVM!(MEASTOL! * OHMS!) 'Measure resistor value to tolerance
ELAP! = Timer - TIME1!
RDRIFT!(N%) = (RES!(N%) - RES!(1)) / RES!(1) * 100
DRIFTPERC! = RDRIFT!(N%) - RDRIFT!(1)
If OHMS! > 1000000! Then
DRIFTSPEC! = 0.5 '%
Else
DRIFTSPEC! = 0.05 '%
End If
Print Tab(8); USING; " ## ####### #####.### ###.# "; E%; RES!(N%); DRIFTPERC!; ELAP!; 'PWR 2014-04-10
If Abs(DRIFTPERC!) > DRIFTSPEC! Then
Color 12, 0 'Text color to bright red on black 'PWR 2014-04-10
DFTFAIL% = DFTFAIL% + 1
DRIFTSTAT$ = "FAIL"
Else
Color 10, 0 'Text color to light green on black 'PWR 2014-04-10
DRIFTSTAT$ = "PASS"
End If
' 1 2 3 4 5 6 7
' 890123456789012345678901234567890123456789012345678901234567890
'PRINT TAB(8); USING " ## ####### #####.### ###.# &"; E%; RES!(N%); DRIFTPERC!; ELAP!; DRIFTSTAT$
Print Tab(68); DRIFTSTAT$ 'PWR 2014-04-10
Color 11, 0 'Text color to bright cyan (blue) on black 'PWR 2014-04-10
N% = N% + 1
If N% = 4 Then Print
If DFTFAIL% = 1 Then
LPRINT
LPRINT
LPRINT TAB(8); "RELAY CMD R (<28>) DELTA R (%) Elapsed Time (s) STATUS"
LPRINT TAB(8); "-----------------------------------------------------------------"
DFTFAIL% = DFTFAIL% + 1
End If
If Left$(DRIFTSTAT$, 4) = "FAIL" Then
LPRINT TAB(8); USING " ## ####### #####.### ###.# &"; E%; RES!(N%); DRIFTPERC!; ELAP!; DRIFTSTAT$
LPRINT TAB(8); "-----------------------------------------------------------------"
DRIFTSTAT$ = "PASS"
End If
Loop While N% < 4
Next
Call PAUSE(3)
If OHMFAIL% > 0 Or DFTFAIL% > 0 Then
CLS
LOCATE 10, 10
Print "THIS TEST HEAD HAS FAILED THE STARTUP TEST."
Print Tab(10); "PLEASE CONTACT ENGINEERING."
LPRINT
LPRINT TAB(10); "THIS TEST HEAD HAS FAILED THE STARTUP TEST."
LPRINT TAB(10); "PLEASE CONTACT ENGINEERING."
LPRINT Chr$(12)
Stop
End If
CB1VAL% = &HFF
Call SETTH(CB1VAL%, CB1%) '1 1 1 1 1 1 1 1
'Disable K11 (-IN floats)
Call PAUSE(0.2)
'CALL CONTINUE
End Sub
Function SETATTEN%(VOLTAGE!)
'Set the test head R/2R ladder
'Find largest attenuation ratio for Vdac < 9.7V
'Leave 0.3V margin for low computer power supplies and 1% attenuator
'accuracy
If Abs(VOLTAGE!) > 4.85 Then
EXPNT% = 0
If VOLTAGE! > MAINMAX! Then
VOLTAGE! = MAINMAX! 'DAC limitation
ElseIf VOLTAGE! < MAINMIN! Then
VOLTAGE! = MAINMIN! 'DAC limitation
End If
Else
EXPNT% = 10 'first attenuator position
Do 'is atten = 1
EXPNT% = EXPNT% - 1 'max. atten = 512 = 2^9
Loop While Abs(VOLTAGE!) >= (9.7 / (2 ^ EXPNT%))
End If
If (EXPNT% - 7) > 0 Then
CHOOSECB% = CB1%
MASK1% = &H3F '0 0 1 1 1 1 1 1
MASK2% = 2 ^ (EXPNT% - 2) 'X X 0 0 0 0 0 0
CBVAL% = (CB1VAL% And MASK1%) Or MASK2%
CB1VAL% = CBVAL%
Else
CHOOSECB% = CB2%
CBVAL% = &HFF - 2 ^ (7 - EXPNT%)
CB2VAL% = CBVAL%
End If
Call SETTH(CBVAL%, CHOOSECB%)
If CHOOSECB% = 1 Then 'Clear attenuator lines on unused controlbank
CHOOSECB% = 2
CBVAL% = (CB2VAL% Or &HFF)
CB2VAL% = CBVAL%
Else
CHOOSECB% = 1
CBVAL% = (CB1VAL% Or &HC0) '1 1 0 0 0 0 0 0
CB1VAL% = CBVAL%
End If
Call SETTH(CBVAL%, CHOOSECB%)
SETATTEN% = 2 ^ EXPNT%
End Function
Sub SETDAC(VOLTAGE!, CH%, VRANGE!, VSENATTEN!)
'Sub to set DAC for module input.
' VOLTAGE!: Voltage to set, and returned measured voltage.
' CH%: Measurement channel.
' VRANGE!: Voltage range. Also used in calculating set/meas. servo loop tolerance.
' When VRANGE! = 0, loop exit on maximum count is ignored.
' VSENATTEN!: Used to set type of DUT input (voltage, current, source of current).
'
'NOTES:
'Main DAC = 12 bits, vernier DAC = 12 bits, vernier overlap is approximately 4 bits,
'total DAC effective resolution is approx. 20 bits (+/-10V / 2^20 = 19uV).
'R/2R ladder attenuation is 512 max. so max. DUT input voltage resolution is 29 bits or 37nV.
'
'For voltages greater than DAC range, use an external high voltage power supply (Kepco DPS 125-0.5M)
'
If Abs(VOLTAGE!) < 0.00001 Then 'DAC limitation
'Short to ground instead of input from DAC.
CB0VAL% = CB0VAL% And &HE3 'short inputs and ground
Call SETTH(CB0VAL%, CB0%) '1 1 1 0 0 0 1 1
Call SETTH((CB1VAL% Or &HC0), CB1%) 'Clear R/2R ladder
Call SETTH((CB2VAL% Or &HFF), CB2%)
CB3VAL% = CB3VAL% Or &HE0 '1 1 1 0 0 0 0 0
Call SETTH(CB3VAL%, CB3%) 'D.U.T. input = R/2R ladder
VERNBIT% = 2048
Call LOADDAC(VERNBIT%, VERN%) 'zero vernier DAC
MAINBIT% = 2048
Call LOADDAC(MAINBIT%, MAIN%) 'zero main DAC
Call LOADMUX(CH%, CON%)
'Control how the DVM range is set. If VRANGE! is zero, use the
'passed voltage (as it was before), otherwise use the passed
'voltage range (PWR: 2014-10-29).
If (VRANGE! <> 0!) Then
Call WRITEDVM(VODC$, VRANGE!) 'Set DVM range from passed VRANGE! value.
Else
Call WRITEDVM(VODC$, VOLTAGE!) 'Set DVM range from passed VOLTAGE! value.
End If
'CALL PAUSE(.01)
Do
VMEAS! = READDVM!(0!) 'Read actual input voltage
Loop While Abs(VMEAS!) > 1
Call LOADMUX(CH%, COFF%)
ElseIf Abs(VOLTAGE!) <= 10! Then 'Check if within DAC range
'Remove high voltage from +/-IN
Call SETTH((CB3VAL% Or &HC0), CB3%) '1 1 0 0 0 0 0 0
'CALL PAUSE(.1) 'Allow time to open inputs before high V is applied
VERNBIT% = 2048
Call LOADDAC(VERNBIT%, VERN%) 'zero vernier DAC
If VSENATTEN! = 0 Then
'Voltage input to D.U.T.
CB0VAL% = (CB0VAL% And &HEB) Or &H8 '1 1 1 0 1 0 1 1 (ground inputs, short series R, remove short on inputs)
'Remove high voltage from +/-IN
CB3VAL% = CB3VAL% Or &HE0 '1 1 1 0 0 0 0 0 (D.U.T. input = R/2R ladder)
ATTEN! = SETATTEN%(VOLTAGE!)
Else
'Current input to D.U.T.
If VSENATTEN! = 1 Then
'2W TX Input
CB0VAL% = CB0VAL% And &HE3 '1 1 1 0 0 0 1 1 (ground inputs, short series R)
Else
'Current Input
CB0VAL% = (CB0VAL% And &HEB) Or &H8 '1 1 1 0 1 0 1 1 (ground inputs, short series R, remove short on inputs)
End If
CB3VAL% = CB3VAL% And &HDF '1 1 0 1 1 1 1 1 (D.U.T. input = current source)
ATTEN! = VSENATTEN!
End If
Call SETTH(CB0VAL%, CB0%)
Call SETTH(CB3VAL%, CB3%)
Call LOADMUX(CH%, CON%)
ACCURAY! = 0.001
'CALL WRITEDVM(VODC$, VOLTAGE!)
'Control how the DVM range is set. If VRANGE! is zero, use the
'passed voltage (as it was before), otherwise use the passed
'voltage range (PWR: 2014-10-29).
If (VRANGE! <> 0!) Then
Call WRITEDVM(VODC$, VRANGE!) 'Set DVM range from passed VRANGE! value.
Else
Call WRITEDVM(VODC$, VOLTAGE!) 'Set DVM range from passed VOLTAGE! value.
End If
If Abs(MAINMAX!) < Abs(MAINMIN!) Then 'Choose smaller of the two values
MAINDENOM! = Abs(MAINMAX!)
Else
MAINDENOM! = Abs(MAINMIN!)
End If
MBITVOLT! = 2048 / MAINDENOM!
VBITVOLT! = 4096 / (VERNMAX! - VERNMIN!)
MAINBIT% = CInt(2048 - (MBITVOLT! * VOLTAGE! * ATTEN!))
If MAINBIT% > 4095 Then
MAINBIT% = 4095
VOLTAGE! = (MAINMIN! + 0.1) / ATTEN!
ElseIf MAINBIT% < 0 Then
MAINBIT% = 0
VOLTAGE! = (MAINMAX! - 0.1) / ATTEN!
End If
ITERATION% = 0
Do
ITERATION% = ITERATION% + 1
Call LOADDAC(MAINBIT%, MAIN%)
ATTENERR! = READDVM!(0!) - VOLTAGE!
If Abs(ATTENERR!) > Abs(VERNMIN! / ATTEN!) Then
'abs(vernmin) generally < vernmax
'Main DAC setting and R/2R ladder setting resulted
'in a voltage which is out of the vernier adjustment
'range.
BITCOMP% = CInt(ATTENERR! * ATTEN! * MBITVOLT!)
MAINBIT% = MAINBIT% + BITCOMP% 'Increasing mainbit decreases DAC voltage
Call LOADDAC(MAINBIT%, MAIN%)
'ATTEN! = (2048 - MAINBIT%) / MBITVOLT! / VOLTAGE!
Else
Exit Do
End If
'LOOP WHILE ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) AND ITERATION% < 20
Loop While ITERATION% < 20
'IF ITERATION% >= 20 THEN
If ITERATION% >= 20 And (VRANGE! <> 0!) Then
Print Spc(50);
Print Tab(10); "SETDAC main loop."
Print Tab(10); "Problem setting main input DAC."
Print Tab(10); "Check for faulty test head connection or"
Print Tab(10); "current-input module not installed in test"
Print Tab(10); "socket. Otherwise, please notify engineering."
Call CONTINUE
Call FINISHSUB
End
End If
ITERATION% = 0
LIMIT = 0
'CALL PAUSE(.01)
VMEAS! = READDVM!(0!)
Do
ITERATION% = ITERATION% + 1
ADJUST! = VMEAS! - VOLTAGE!
'Control how the DAC tolerance is calculated. If VRANGE! is zero, use the
'passed voltage times the desired accuracy (as it was before), otherwise
'use the passed voltage range times the desired accuracy (PWR: 2014-10-29).
If (VRANGE! <> 0!) Then
DACTOL! = Abs(ACCURAY! * VOLTAGE!)
Else
DACTOL! = Abs(ACCURAY! * VRANGE!)
End If
If Abs(ADJUST!) > DACTOL! Then
'IF ABS(ADJUST!) > ABS(ACCURAY! * VOLTAGE!) THEN 'Original statement.
If Abs(VBITVOLT! * ADJUST! * ATTEN!) < 32767 Then
ADJUSTBIT% = CInt(VBITVOLT! * ADJUST! * ATTEN!)
VERNBIT% = VERNBIT% + ADJUSTBIT%
If VERNBIT% > 4095 Then
VERNBIT% = 4095
LIMIT = 1
ElseIf VERNBIT% < 0 Then
VERNBIT% = 0
LIMIT = 1
End If
Else
LIMIT = 1
End If
Call LOADDAC(VERNBIT%, VERN%)
'CALL PAUSE(.01)
VMEAS! = READDVM!(0!)
Else
LIMIT = 1 'abs(adjust!) < ACCURAY!, set flag to exit loop
End If
Loop While ITERATION% < 20 And LIMIT = 0
'IF ITERATION% >= 20 THEN
If ITERATION% >= 20 And (VRANGE! <> 0!) Then
Beep
Print Spc(50);
Print Tab(10); "SETDAC vernier loop."
Print Tab(10); "Unable to find required voltage."
Print Tab(10); "Error = "; ADJUST!
Print Tab(10); "Limit = "; DACTOL!
Print Tab(10); "Please notify engineering."
Call CONTINUE
Call FINISHSUB
End
End If
Call LOADMUX(CH%, COFF%)
Else
'Configure test head for high voltage ( > 10V ) unipolar input
'supplied by a second Kepco DPS 125 power supply
Call SETTH((CB1VAL% Or &HC0), CB1%) 'Clear R/2R ladder
Call SETTH((CB2VAL% Or &HFF), CB2%)
CB0VAL% = CB0VAL% Or &H18 '0 0 0 1 1 0 0 0 (Un-ground inputs, short series R)
If VOLTAGE! >= 0 Then
CB3VAL% = (CB3VAL% Or &H80) And &HBF '1 0 0 0 0 0 0 0, 1 0 1 1 1 1 1 1
Else
CB3VAL% = (CB3VAL% Or &H40) And &H7F '0 1 0 0 0 0 0 0, 0 1 1 1 1 1 1 1
End If
Call SETTH(CB0VAL%, CB0%)
'CALL PAUSE(.1) 'Allow time to open inputs before high V is applied
Call SETTH(CB3VAL%, CB3%)
Do
SL$ = SETPOWER$(VINADDR%, Abs(VOLTAGE!), FUNC$) 'Set Vin
Loop While Abs(Val(SETPOWER$(VINADDR%, 999!, READVOLT$)) - Abs(VOLTAGE!)) > 1
VMEAS! = VOLTAGE!
End If
VOLTAGE! = VMEAS!
End Sub
Sub SETDAC2(VOLTAGE!, CH%, VRANGE!, VSENATTEN!)
'Sub to set DAC for module input. Similar to SETDAC routine but with controlbank values
'for voltage and current output module testheads.
' VOLTAGE!: Voltage to set, and returned measured voltage.
' CH%: Measurement channel.
' VRANGE!: Voltage range. Also used in calculating set/meas. servo loop tolerance.
' When VRANGE! = 0, loop exit on maximum count is ignored.
' VSENATTEN!: Used to set type of DUT input (voltage, current, source of current).
'
'NOTES:
'Main DAC = 12 bits, vernier DAC = 12 bits, vernier overlap is approximately 4 bits,
'total DAC effective resolution is approx. 20 bits (+/-10V / 2^20 = 19uV).
'
'For voltages greater than DAC range, use an external high voltage power supply (Kepco DPS 125-0.5M)
'
'IF ABS(VOLTAGE!) <= 10.1 THEN 'Check if within DAC range
If Abs(VOLTAGE!) <= 10! Then 'Check if within DAC range
VERNBIT% = 2048
Call LOADDAC(VERNBIT%, VERN%) 'zero vernier DAC
If VSENATTEN! = 0 Then
'Voltage input to D.U.T.
If VOLTAGE! > MAINMAX! Then
VOLTAGE! = MAINMAX! 'DAC limitation
ElseIf VOLTAGE! < MAINMIN! Then
VOLTAGE! = MAINMIN! 'DAC limitation
End If
ATTEN! = 1
Else
'Current input to D.U.T.
ATTEN! = VSENATTEN!
End If
CB0VAL% = (CB0VAL% Or &H6) And &HDE 'Sets relays K00, K05, resets K01, K02
'0 0 0 0 0 1 1 0
'1 1 0 1 1 1 1 0
Call SETTH(CB0VAL%, CB0%)
Call LOADMUX(CH%, CON%)
ACCURAY! = 0.001
Call WRITEDVM(VODC$, 2000!) 'VOLTAGE!) 'Without autorange, can overrange when setting 0V.
If Abs(MAINMAX!) < Abs(MAINMIN!) Then 'Choose smaller of the two values
MAINDENOM! = Abs(MAINMAX!)
Else
MAINDENOM! = Abs(MAINMIN!)
End If
MBITVOLT! = 2048 / MAINDENOM!
VBITVOLT! = 4096 / (VERNMAX! - VERNMIN!)
MAINBIT% = CInt(2048 - (MBITVOLT! * VOLTAGE! * ATTEN!))
If MAINBIT% > 4095 Then
MAINBIT% = 4095
VOLTAGE! = (MAINMIN! + 0.1) / ATTEN!
ElseIf MAINBIT% < 0 Then
MAINBIT% = 0
VOLTAGE! = (MAINMAX! - 0.1) / ATTEN!
End If
ITERATION% = 0
Do
ITERATION% = ITERATION% + 1
Call LOADDAC(MAINBIT%, MAIN%)
ATTENERR! = READDVM!(0!) - VOLTAGE!
If Abs(ATTENERR!) > Abs(VERNMIN! / ATTEN!) Then
'abs(vernmin) generally < vernmax
'Main DAC setting and R/2R ladder setting resulted
'in a voltage which is out of the vernier adjustment
'range.
BITCOMP% = CInt(ATTENERR! * ATTEN! * MBITVOLT!)
MAINBIT% = MAINBIT% + BITCOMP% 'Increasing mainbit decreases DAC voltage
Call LOADDAC(MAINBIT%, MAIN%)
'ATTEN! = (2048 - MAINBIT%) / MBITVOLT! / VOLTAGE!
Else
Exit Do
End If
'LOOP WHILE ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) AND ITERATION% < 20
Loop While ITERATION% < 20
'IF ITERATION% >= 20 THEN
If ITERATION% >= 20 And (VRANGE! <> 0!) Then
Beep
Print Spc(50);
Print Tab(10); "SETDAC main loop."
Print Tab(10); "Problem setting main input DAC."
Print Tab(10); "Check for faulty test head connection or"
Print Tab(10); "current-input module not installed in test"
Print Tab(10); "socket. Otherwise, please notify engineering."
Call CONTINUE
Call FINISHSUB
End
End If
ITERATION% = 0
LIMIT = 0
Do
ITERATION% = ITERATION% + 1
'CALL PAUSE(.01)
VMEAS! = READDVM!(0!)
ADJUST! = VMEAS! - VOLTAGE!
'Control how the DAC tolerance is calculated. If VRANGE! is zero, use the
'passed voltage times the desired accuracy (as it was before), otherwise
'use the passed voltage range times the desired accuracy (PWR: 2014-10-29).
If (VRANGE! <> 0!) Then
DACTOL! = Abs(ACCURAY! * VOLTAGE!)
Else
DACTOL! = Abs(ACCURAY! * VRANGE!)
End If
If Abs(ADJUST!) > DACTOL! Then
'IF ABS(ADJUST!) > ABS(ACCURAY! * VOLTAGE!) THEN 'Original statement.
If Abs(VBITVOLT! * ADJUST! * ATTEN!) < 32767 Then
ADJUSTBIT% = CInt(VBITVOLT! * ADJUST! * ATTEN!)
VERNBIT% = VERNBIT% + ADJUSTBIT%
If VERNBIT% > 4095 Then
VERNBIT% = 4095
LIMIT = 1
ElseIf VERNBIT% < 0 Then
VERNBIT% = 0
LIMIT = 1
End If
Else
LIMIT = 1
End If
Call LOADDAC(VERNBIT%, VERN%)
Else
LIMIT = 1 'abs(adjust!) < ACCURAY!
'set flag to exit loop
End If
Loop While ITERATION% < 20 And LIMIT = 0
'IF ITERATION% >= 20 THEN
If ITERATION% >= 20 And (VRANGE! <> 0!) Then
Beep
Print Spc(50);
Print Tab(10); "SETDAC2 vernier loop."
Print Tab(10); "Unable to find required voltage."
Print Tab(10); "Error = "; ADJUST!
Print Tab(10); "Limit = "; DACTOL!
Print Tab(10); "Please notify engineering."
Call CONTINUE
Call FINISHSUB
End
End If
Call LOADMUX(CH%, COFF%)
Else
'Configure test head for high voltage ( > 10V ) unipolar input
'supplied by a second Kepco DPS 125 power supply
CB0VAL% = CB0VAL% Or &H1C '0 0 0 1 1 1 0 0
'Un-ground inputs, remove short on series R
'remove short on inputs
'D.U.T. input should be R/2R ladder
'High voltage power supply is unipolar.
'Set polarity based on required Vin
If VOLTAGE! >= 0 Then
CB3VAL% = (CB3VAL% Or &H80) And &HBF '1 0 0 0 0 0 0 0
'1 0 1 1 1 1 1 1
Else
CB3VAL% = (CB3VAL% Or &H40) And &H7F '0 1 0 0 0 0 0 0
'0 1 1 1 1 1 1 1
End If
Call SETTH(CB0VAL%, CB0%)
'CALL PAUSE(.1) 'Allow time to open inputs
'before high V is applied
Call SETTH(CB3VAL%, CB3%)
Do
SL$ = SETPOWER(VINADDR%, Abs(VOLTAGE!), FUNC$) 'Set Vin
Loop While Abs(Val(SETPOWER(VINADDR%, 999!, READVOLT$)) - Abs(VOLTAGE!)) > 1
VMEAS! = VOLTAGE!
Print "VMEAS!"
End If
VOLTAGE! = VMEAS!
End Sub
Sub SETDACFAST(VOLTAGE!)
'Sets main DAC only, zeroes vernier DAC.
'Does not set attenuator (R/2R ladder). Set prior to calling.
'Does not measure error in set voltage.
'Assumes test head is configured for DAC input to transmitter
'
VERNBIT% = 2048
Call LOADDAC(VERNBIT%, VERN%) 'zero vernier DAC
MBITVOLT! = 4096 / (MAINMAX! - MAINMIN!)
MAINBIT% = CInt(2048 - (MBITVOLT! * VOLTAGE!))
If MAINBIT% > 4095 Then
MAINBIT% = 4095
ElseIf MAINBIT% < 0 Then
MAINBIT% = 0
End If
Call LOADDAC(MAINBIT%, MAIN%)
End Sub
Function SETPOWER$(ADDR%, VSUPPLY!, CMD$)
'****** PSMODEL$ is the selection of either the Older "DPS125" KEPCO Power Supply
'****** or the new KEPCO "ABC125" Power Supply
If PSMODEL$ = "DPS125" Then
IF CMD$ = LOCAL$ THEN
SETP$ = POWERIO$(ADDR%, CMD$)
STATE = FAILCOM(SETP$)
SETPOWER$ = SETP$
ElseIf CMD$ = ISTAT$ Then
SETP$ = Mid$(POWERIO$(ADDR%, CMD$), 5, 3)
STATE = FAILCOM(SETP$)
SETPOWER$ = SETP$
ElseIf CMD$ = READVOLT$ Then
SETP$ = Mid$(POWERIO$(ADDR%, CMD$), 5, 3)
STATE = FAILCOM(SETP$)
SETPOWER$ = SETP$
ElseIf CMD$ = CURRENT$ Then
SETP$ = Mid$(POWERIO$(ADDR%, CMD$), 5, 3)
STATE = FAILCOM(SETP$)
SETPOWER$ = SETP$
Else
If VSUPPLY! = 999! Then
FUNC$ = CMD$
Else
FUNC$ = VOLT$ + Right$(Str$(VSUPPLY!), Len(Str$(VSUPPLY!)) - 1)
End If
SETP$ = POWERIO$(ADDR%, FUNC$)
STATE = FAILCOM(SETP$)
SETPOWER$ = SETP$
'*** Check for OverCurrent
If POWERIO$(ADDR%, ISTAT$) = "RCS=01" Then 'Check for over-current
SOUND 1000, 0.5
LOCATE , 10
Print "Power supply current and/or voltage has exceeded maximum value."
Print Tab(10); "Power supply has been disabled."
Print Tab(10); "Press any key to continue"
a$ = KEYBDIN$
End If
If CMD$ <> LOOPOFF$ Then
LPN$ = POWERIO$(ADDR%, LOOPON$) 'enable power supply output
End If
Call PAUSE(0.2) '200ms over-current protection. delay
End If
'****** Below is the case where the power supply is the new KEPCO ABC 125
ElseIf PSMODEL$ = "ABC125" Then
If CMD$ = ISTAT$ Then
Call WRITEPS(ADDR%, "CURR:PROT:TRIP?")
SETP$ = READPS$(ADDR%, "VOLT?")
If SETP$ = "0" Then
SETPOWER$ = "RCS=01"
Else
SETPOWER$ = ""
End If
ElseIf CMD$ = READVOLT$ Then
SETP$ = READPS$(ADDR%, "VOLT?")
SETPOWER$ = SETP$
ElseIf CMD$ = CURRENT$ Then
SETP$ = READPS$(ADDR%, "READ:CURR?")
ReadCurrent! = Val(SETP$) * 1000
SETP$ = Str$(ReadCurrent!)
SETPOWER$ = SETP$
ElseIf CMD$ = "ID" Then
SETP$ = READPS$(ADDR%, "*IDN?")
SETPOWER$ = SETP$
Else 'VALUE = 999! AND CMD$ <> "INIT"
If CMD$ = "LOC" Then
FUNC$ = "SYST:KLOC OFF"
ElseIf CMD$ = LOOPOFF$ Then
FUNC$ = "OUTP OFF"
ElseIf CMD$ = LOOPON$ Then
FUNC$ = "OUTP ON"
ElseIf CMD$ = "ZER" Then
FUNC$ = "*RST" 'Zeroes out the error queue
Else
If VSUPPLY! = 999! Then
FUNC$ = CMD$
Else
FUNC$ = "VOLT" + Str$(VSUPPLY!) + "; CURR 0.5"
OCF$ = READPS$(ADDR%, "CURR:PROT:TRIP?")
If OCF$ = "1" Then
Call WRITEPS(ADDR%, "CURR:PROT:CLE")
Call WRITEPS(ADDR%, "*CLS")
SOUND 1000, 0.5
LOCATE , 10
Print "Power supply current and/or voltage has exceeded maximum value."
Print Tab(10); "Power supply has been disabled."
Print Tab(10); "Press any key to continue"
a$ = KEYBDIN$
'END
'CHAIN "C:\ATE\MENUX"
End If
End If
End If
Call WRITEPS(ADDR%, FUNC$)
SETP$ = READPS$(ADDR%, "VOLT?")
SETPOWER$ = SETP$
If CMD$ <> LOOPOFF$ Then
Call WRITEPS(ADDR%, "OUTP ON") 'enable power supply output
End If
'CALL PAUSE(.2) '20ms over-current protection delay
End If
Else
Print "KEPCO Power Supply is *** NOT *** connected"
End If
End Function
Function SETRANGE$(value!)
'range does not switch at exactly 2^n volts. value at switch
'occurs depends on previous voltage (higher or lower than new voltage).
'IF ABS(VALUE!) <= .007 THEN
' SETRANGE$ = "R8" '20mV range
'use to maintain better than
'0.015% resolution for
'input voltage spans < 7mV
If Abs(value!) <= 0.195 Then
SETRANGE$ = "R1" '200mV, 200ohm range
ElseIf Abs(value!) < 1.8 Then
SETRANGE$ = "R2" '2V, 2Kohm range
ElseIf Abs(value!) < 18 Then
SETRANGE$ = "R3" '20V, 20Kohm range
'DAC range is +/-10V max.
ElseIf Abs(value!) < 180 Then
SETRANGE$ = "R4" '200V, 200Kohm range
Else
SETRANGE$ = "R0" 'autorange
End If
End Function
Sub SETTEST(TEST%)
'Set test 0-7 on the RTD test head
CB0VAL% = (CB0VAL% Or &H7) And (&HF8 + TEST%) '0 0 0 0 0 1 1 1
'1 1 1 1 1 0 0 0
Call SETTH(CB0VAL%, CB0%) 'Set Test TEST%
End Sub
Sub SETTH(DOUT%, CB%)
'Parallel Port Control Register is located at address LPTADDR% + 2
'Bits 0, 1, and 3 toggle the opposite way expected.
'Hold W/R low to prevent resetting the relay mux.
'NOTE: Sending data out to LPTADDR%+0 resets the relay mux
' W/R EN/ D/A S/
' X X X X X X X X
'C 1 1 0 0 (0 1 1 1)
'D 1 1 0 1 (0 1 1 0)
'E 1 1 1 0 (0 1 0 1)
' Writes the test head address and selects which control bank
' the data will be written to.
BYTE% = THADDR% * 4 + CB%
OUT (LPTADDR%), BYTE%
OUT (LPTADDR% + 2), &HE 'D/A line low
OUT (LPTADDR% + 2), &HC 'D/A line high
Call PAUSE(0.01) 'Reduced to 0.01 from 0.1 (3/19/04)
' Writes the data to the addressed control bank in the test head.
OUT (LPTADDR%), DOUT%
Call PAUSE(0.01) 'Test head would not process command in some stations
'(so far with PCI parallel cards)
OUT (LPTADDR% + 2), &HD 'S/ line low
OUT (LPTADDR% + 2), &HC 'S/ line high
Call PAUSE(0.01) 'Reduced to 0.01 from 0.1 (3/19/04)
' Disables the test head by clearing the address.
OUT (LPTADDR%), 0
OUT (LPTADDR% + 2), &HE 'D/A line low
OUT (LPTADDR% + 2), &HC 'D/A line high
Call PAUSE(0.01) 'Reduced to 0.01 from 0.1 (3/19/04)
' Clear mux in case in case DOUT% 4 MSB's matched mux address.
' DOUT% 4 LSB's would be loaded as mux data.
OUT (LPTADDR% + 2), &H4 'W/R line high
OUT (LPTADDR% + 2), &HC 'W/R line low
End Sub
Sub SETTHFAST(DOUT%, CB%)
' Same operation as SETTH except test head is not disabled
' to avoid pauses. Use with Step Response test only.
' Writes the test head address and selects which control bank
' the data will be written to.
BYTE% = THADDR% * 4 + CB%
OUT (LPTADDR%), BYTE%
OUT (LPTADDR% + 2), &HE 'D/A line high
OUT (LPTADDR% + 2), &HC 'D/A line low
' Writes the data to the addressed control bank in the test head.
OUT (LPTADDR%), DOUT%
OUT (LPTADDR% + 2), &HD 'S/ line low
OUT (LPTADDR% + 2), &HC 'S/ line high
' Clear mux in case in case DOUT% 4 MSB's matched mux address.
' DOUT% 4 LSB's would be loaded as mux data.
OUT (LPTADDR% + 2), &H4 'W/R line high
OUT (LPTADDR% + 2), &HC 'W/R line low
End Sub
'********************************************
Sub SNPARSE(SN$, WO$, DS$)
'Sub to parse the module serial into work order and dash numbers
N% = 0 'Initialize character number (char. in serial number string)
SNL% = Len(SN$) 'Get length of serial number
Do 'Loop until the dash location is found
N% = N% + 1 'Increment character number
SNCHAR$ = Mid$(SN$, N%, 1) 'Get next char. in serial number
Loop While SNCHAR$ <> "-" 'Loop until the dash is found
WO$ = Left$(SN$, N% - 1) 'Parse work order# from serial number
DS$ = Mid$(SN$, N% + 1, SNL% - N%) 'Parse dash# from serial number
End Sub
Function STRINGVAL%(a$)
'Calculate and return the value of the characters in A$
'which follow the hyphen
T% = Len(a$)
Do
L% = L% + 1
Loop Until Mid$(a$, L%, 1) = "-" Or L% = T%
STRINGVAL% = Val(Right$(a$, T% - L%))
End Function
Function TCTEMP!(TCV!, SENTYPE$)
'Function inputs; Measured simulated TC voltage in V, and TC type
'Function Output; TC temperature in deg. C
'Polynomial format; T = c0 + c1*EMF + c2*EMF^2 + c3*EMF^3 + ...
If UCase$(Left$(SENTYPE$, 1)) = "J" Then 'Select the proper polynomial
If TCV! < 0 Then
RESTORE INVJ1
ElseIf TCV! < 0.042919 Then
RESTORE INVJ2
Else
RESTORE INVJ3
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "K" Then
If TCV! < 0 Then
RESTORE INVK1
ElseIf TCV! < 0.020644 Then
RESTORE INVK2
Else
RESTORE INVK3
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "T" Then
If TCV! < 0 Then
RESTORE INVTNEG
Else
RESTORE INVTPOS
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "E" Then
If TCV! < 0 Then
RESTORE INVENEG
Else
RESTORE INVEPOS
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "R" Then
If TCV! < 0.001923 Then
RESTORE INVR1
ElseIf TCV! < 0.011361 Then
RESTORE INVR2
ElseIf TCV! < 0.019739 Then
RESTORE INVR3
Else
RESTORE INVR4
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "S" Then
If TCV! < 0.001874 Then
RESTORE INVS1
ElseIf TCV! < 0.010332 Then
RESTORE INVS2
ElseIf TCV! < 0.017536 Then
RESTORE INVS3
Else
RESTORE INVS4
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "B" Then
If TCV! < 0.00000228 Then
RESTORE INVB0
ElseIf TCV! < 0.0000332 Then
RESTORE INVB1
ElseIf TCV! < 0.00009206 Then
RESTORE INVB2
ElseIf TCV! < 0.00017826 Then
RESTORE INVB3
ElseIf TCV! < 0.00029128 Then
RESTORE INVB4
ElseIf TCV! < 0.002431 Then
RESTORE INVB5
Else
RESTORE INVB6
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "C" Then
If TCV! < 0.009395 Then
RESTORE INVC1
ElseIf TCV! < 0.028955 Then
RESTORE INVC2
Else
RESTORE INVC3
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "N" Then
If TCV! < 0 Then
RESTORE INVNNEG
Else
RESTORE INVNPOS
End If
Else
TCV! = 99 'invalid sensor type
Exit Function
End If
'Check if TCV is within polynomial limits
READ MINTCV!, MAXTCV!
If TCV! * 1000000! < MINTCV! Or TCV! * 1000000! > MAXTCV! Then
Print "Error! Polynomial limits exceeded. Contact engineering."
Print SENTYPE$, TCV!, MINTCV!, MAXTCV!
TCTEMP! = 98 'out of range
Stop
End If
EXPNT% = 0
T! = 0
Do
READ COEFF#
T! = T! + COEFF# * (TCV! * 1000000!) ^ EXPNT%
EXPNT% = EXPNT% + 1
Loop While COEFF# <> 0 Or EXPNT% = 1 'look for coeff = 0, end of data
If UCase$(Left$(SENTYPE$, 1)) = "C" Then
TCTEMP! = (T! - 32!) * 5 / 9 'Convert from deg. F to deg C.
Else
TCTEMP! = T!
End If
End Function
Function TCVOLTS!(TEMP!, SENTYPE$)
'Function inputs; temperature, TC type
'Function Output; TC voltage in V
'Polynomial format; EMF = c0 + c1*T + c2*T^2 + c3*T^3 + ...
If UCase$(Left$(SENTYPE$, 1)) = "J" Then 'Select the proper polynomial
If TEMP! < 760 Then
RESTORE TYPEJ1
Else
RESTORE TYPEJ2
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "K" Then
If TEMP! < 0 Then
RESTORE TYPEKNEG
Else
RESTORE TYPEKPOS
XTRATERM! = 118.5976 * Exp(-0.0001183432 * (TEMP! - 126.9686) ^ 2)
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "T" Then
If TEMP! < 0 Then
RESTORE TYPETNEG
Else
RESTORE TYPETPOS
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "E" Then
If TEMP! < 0 Then
RESTORE TYPEENEG
Else
RESTORE TYPEEPOS
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "R" Then
If TEMP! < 1064.18 Then
RESTORE TYPER1
ElseIf TEMP! < 1664.5 Then
RESTORE TYPER2
Else
RESTORE TYPER3
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "S" Then
If TEMP! < 1064.18 Then
RESTORE TYPES1
ElseIf TEMP! < 1664.5 Then
RESTORE TYPES2
Else
RESTORE TYPES3
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "B" Then
If TEMP! < 630.615 Then
RESTORE TYPEB1
Else
RESTORE TYPEB2
End If
ElseIf UCase$(Left$(SENTYPE$, 1)) = "C" Then
TEMPDEGC! = TEMP!
TEMP! = TEMPDEGC! * 9 / 5 + 32 'Polynomial expects temp. in deg F.
RESTORE TYPEC
ElseIf UCase$(Left$(SENTYPE$, 1)) = "N" Then
If TEMP! < 0 Then
RESTORE TYPENNEG
Else
RESTORE TYPENPOS
End If
Else
TCVOLTS! = 99 'invalid sensor type
Exit Function
End If
'Check if TEMP is within polynomial limits
READ MINTEMP!, MAXTEMP!
If TEMP! < MINTEMP! Or TEMP! > MAXTEMP! Then
Print TEMP!, MINTEMP!, MAXTEMP!
Print "Error! Polynomial limits exceeded. Contact engineering."
Print SENTYPE$, TEMP!, MINTEMP!, MAXTEMP!
TCVOLTS! = 98
Stop
'EXIT FUNCTION
End If
EXPNT% = 0
V! = 0
Do
READ COEFF#
V! = V! + COEFF# * TEMP! ^ EXPNT%
EXPNT% = EXPNT% + 1
Loop While COEFF# <> 0 Or EXPNT% = 1 'look for coeff = 0, end of data
TCVOLTS! = (V! + XTRATERM!) / 1000000! 'Polynomials return EMF in uV
If UCase$(Left$(SENTYPE$, 1)) = "C" Then TEMP! = TEMPDEGC! 'Re-assign original value.
End Function
Sub TRIGGER()
' Module Name - TRIGGER
' Inputs - None
' Outputs - None
' Description - TRIGGER, sends the Fluke meter the command to take a
' measurement.
'
Add = (MLA% Or DVMADDR%)
OUT (BADDRS% + 7), Add 'Sends listen address
Call HS1
OUT (BADDRS% + 3), &H8A 'Sets request high
OUT (BADDRS% + 3), &HB 'Sets remote low
OUT (BADDRS% + 7), Asc("?") 'Outputs trigger command
Call HS1
OUT (BADDRS% + 7), &HD 'Outputs CR to trigger Fluke 8842A
Call HS1
OUT (BADDRS% + 3), &HC 'Sets remote high
OUT (BADDRS% + 3), &H89 'Sets request low
End Sub
Function UPSN$(SN$)
'Function that returns a new module serial number, with the dash number incremented
'by one, from the passed value of the module serial number
Call SNPARSE(SN$, WO$, DS$) 'Get current work order and dash numbers from module serial number
DSNV% = Val(DS$) + 1 'Get value of new dash number
If (Val(DS$) < 99) Then
DS$ = LTrim$(Str$(DSNV%)) 'Make string of new dash number value
UPSN$ = WO$ + "-" + DS$ 'Set function return to next sequential module serial number
Else
'Next sequential number will be too high, get new dash number
Color 28, 0, 0 'Flashing light red
CLS
LOCATE 10, 10: Print "NEXT SEQUENTIAL DASH NUMBER IS INVALID!"
Color 12, 0, 0 'Light red
LOCATE 11, 10: Print "Next dash number would be: "; DSNV%
LOCATE 12, 10: Print "Must be number between 1 and 99"
Color 15, 0, 0 'White on black
LOCATE 14, 10: Print "Press any key to enter a valid dash number."
Color 11, 0, 0 'Reset to cyan on black background
a$ = KEYBDIN$ 'Wait for keyboard entry (anything)
Call CHANGEDN(SN$) 'Changes dash number only
UPSN$ = SN$ 'Set function return to new module serial number
End If
End Function
Sub WRITEDVM(FUNC$, value!)
' Module Name - WRITEDVM
' Inputs - String of commands to be sent to the meter
' Outputs - None
' Description - Writes a previously set up string of commands to
' the fluke 8842A meter, through the IEEE 488 interface
Call INIT488(DVMADDR%)
DDATA$ = FUNC$ + SETRANGE$(value!)
BYTE% = DVMADDR% OR MLA%
OUT (BADDRS% + 7), BYTE% 'Send byte out as data
Call HS1
OUT (BADDRS% + 3), &H8A 'Request control, set operation
OUT (BADDRS% + 3), &HB 'Remote enable, clear
For X1 = 1 To Len(DDATA$)
BYTE% = ASC(MID$(DDATA$, X1, 1))
OUT (BADDRS% + 7), BYTE% 'Successively send each character
Call HS1 'of DDATA$ to 488 device
Next X1
OUT (BADDRS% + 7), &HD 'Send CR, tell device to execute command
Call HS1
OUT (BADDRS% + 7), &HA 'Send LF
Call HS1
OUT (BADDRS% + 3), &HC 'Remote enable, set operation
OUT (BADDRS% + 3), &HA 'Clear talk only
OUT (BADDRS% + 7), &H3F 'Un-listen
Call HS1
End Sub
Sub WRITEGEN(FUNC$, value!)
' Inputs - String of commands to be sent to the HP33120A
' Outputs - None
' Description - Writes a string of commands to the HP33120A
' function generator, through the IEEE 488 interface
' If VALUE! = -99 then the command is a string only
Call INIT488(GENADDR%)
If value! = -99 Then
value$ = "" 'Command contains no numerical value
ElseIf FUNC$ = FREQ$ And value! = 0! Then
'VALUE! = .0001 'Func. gen. min output = 100uHz
value! = 0.001 'Temporarily gets around layout problem,
'modules go +f.s. out momentarily when .0001
'Hz is applied. Recovers in 10-30s. .001Hz
'reduces recovery to 1-3s.
value$ = Str$(value!)
ElseIf (Left$(FUNC$, 3) = "FSK" Or Left$(FUNC$, 7) = "FREQ:ST") And value! <= 0.0001 Then
value! = 0.01 'Func. gen. min FSK value = 10mHz
value$ = Str$(value!) 'Func. gen. min sweep value = 10mHz
Else
value$ = Str$(value!)
End If
DDATA$ = FUNC$ + " " + value$
BYTE% = GENADDR% OR MLA%
OUT (BADDRS% + 7), BYTE% 'Send byte out as data
Call HS1
OUT (BADDRS% + 3), &H8A 'Request control, clear operation
OUT (BADDRS% + 3), &HB 'Remote enable, clear
For X1 = 1 To Len(DDATA$)
BYTE% = ASC(MID$(DDATA$, X1, 1))
OUT (BADDRS% + 7), BYTE% 'Successively send each character
Call HS1 'of DDATA$ to 488 device
Next X1
OUT (BADDRS% + 7), &HD 'Send CR, tell device to execute command
Call HS1
OUT (BADDRS% + 7), &HA 'Send LF
Call HS1
OUT (BADDRS% + 3), &HC 'Remote enable, set operation
OUT (BADDRS% + 3), &HA 'Clear talk only
OUT (BADDRS% + 7), &H3F 'Un-listen
Call HS1
End Sub
Sub WRITEPS(ADDR%, CMD$)
' Module Name - WRITEPS
' Inputs - String of commands to be sent to the GPIB Power Supply
' Outputs - None
' Description - Writes a previously set up string of commands to
' the KEPCO ABC125 power supply, through the IEEE 488 interface
Call INIT488(ADDR%)
DDATA$ = CMD$ 'the new KEPCO ABC125
BYTE% = ADDR% OR MLA%
OUT (BADDRS% + 7), BYTE% 'Send byte out as data
Call HS1
OUT (BADDRS% + 3), &H8A 'Request control, set operation
Call PAUSE(0.001) 'TSO - required for the KEPCO ABC
OUT (BADDRS% + 3), &HB 'Remote enable, clear
For X1 = 1 To Len(DDATA$)
BYTE% = ASC(MID$(DDATA$, X1, 1))
OUT (BADDRS% + 7), BYTE% 'Successively send each character
Call HS1 'of DDATA$ to 488 device
Next X1
OUT (BADDRS% + 7), &HD 'Send CR, tell device to execute command
Call HS1
OUT (BADDRS% + 7), &HA 'Send LF
Call HS1
OUT (BADDRS% + 3), &HC 'Remote enable, set operation
OUT (BADDRS% + 3), &HA 'Clear talk only
OUT (BADDRS% + 7), &H3F 'Un-listen
Call HS1
End Sub
Reference in New Issue View Git Blame Copy Permalink