DECLARE SUB dwcalcbl (dx!, vt!, svt!, bl!, sbl!)
DECLARE SUB vtwgetvtav (x0!, dx!, vt!, svt!)
DECLARE SUB gp3getb (b!)
DECLARE SUB gp3setpar (gpibinf%, gpiboutf%, gp3addr$)
DECLARE SUB imaggeti (imag!)
DECLARE SUB imagramp (inom!)
DECLARE SUB vtwmoveabs (x!)
DECLARE SUB vtwplotv (x0!, dx!)
DECLARE SUB vtwinit ()
DECLARE SUB wireparam ()
DECLARE SUB wireexit ()
DECLARE SUB wireinit ()
DECLARE SUB wiremeas ()
DECLARE SUB gpibinit (gpibin%, gpibout%)
DECLARE SUB hp3458init ()
DECLARE SUB hp3458setpar (gpibinP%, gpiboutP%, hp3458addrP$)
DECLARE SUB mc4init ()
DECLARE SUB mc4setpar (gpibinP%, gpiboutP%, mc4addrP$)
DECLARE SUB mc4zero ()
DECLARE SUB hp3457setpar (gpibin%, gpibout%, hp3457addr$)
DECLARE SUB bit488setpar (gpibin%, gpibout%, bit488addr$)
DECLARE SUB dac488setpar (gpibin%, gpibout%, dac488addr$)
DECLARE SUB dac488hrsetpar (gpibin%, gpibout%, dac488hraddr$)
DECLARE SUB psdac488setpar (gpibin%, gpibout%, psdac488addr$)
DECLARE SUB pshp3457setpar (gpibin%, gpibout%, pshp3457addr$)
DECLARE SUB dwblvsi ()
DECLARE SUB dwblvsx ()
DECLARE SUB dwsetpar (logfile$, datfile$, pltfile$, magname$, run$, dxcm!, nx0%, x0!(), nturns%, nimagtest%, imagtest!(), imagnmeasave%)
DECLARE SUB qwglvsi ()
DECLARE SUB qwsetpar (logfile$, datfile$, pltfile$, magname$, run$, dxcm!, nx0%, x0!(), nturns%, nimagtest%, imagtest!())
DECLARE SUB swsetpar (logfile$, datfile$, pltfile$, magname$, run$, dxcm!, nx0%, x0!(), nturns%, nimagtest%, imagtest!())
DECLARE SUB swslvsi ()
DECLARE SUB vtwsetpar (logfile$, x1$, x2$, acctime!, velcms!, tsamplebefs!, tsampleafts!, nsample%, nmeasave%)
DECLARE SUB imagexit ()
DECLARE SUB imaginit ()
DECLARE SUB imagsaturate (isat!)
DECLARE SUB imagsetpar (logfile$, imagconfig$, imagramprate!, imagnmeasave%, imaglimit!)
DECLARE SUB imagstandardize (nstand%, istand!)
DECLARE SUB ibopsetpar (imaghpchan%, vtransperimag!, imagtstable%)
DECLARE SUB idacsetpar (imagdacchan%, imagpervdac!, imagtstable%, imaghpchan%, vtransperimag!)
DECLARE SUB idachrsetpar (imagdacchan%, imagpervdac!, imagtstable%, imaghpchan%, vtransperimag!)
DECLARE SUB ips123setpar (logfile$, imagconfig$, imagtstable%)
DECLARE SUB imansetpar (imaghpchan%, vtransperimag!)
DECLARE SUB fileheader (logfile$, project$, magtype$, magname$, barcode$, teststand$, coilname$, operator$, run$, comment$)
DECLARE SUB fileinitwire (project$, magtype$, magname$, run$, logfile$, datfile$, pltfile$, ok$)
DECLARE SUB fileisat (logfile$, isat!)
DECLARE SUB fileistand (logfile$, n%, istand!)
DECLARE SUB fileitest (logfile$, n%, imag!())
DECLARE SUB gettestparam (projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)

'****************************************************************************
'Program WIRE
'This program is used to make stretched wire measurements in dipoles,
'quadrupoles, and sextupoles.
'
'Zachary Wolf
'3/8/95
'****************************************************************************

'Common area for run time parameters
COMMON SHARED /gpibio/ gpibinP%, gpiboutP%
COMMON SHARED /filenames/ logfileP$, datfileP$, pltfileP$
COMMON SHARED /testinfo/ projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$

'Include the constants used in the program
'Execute assignment statements
REM $INCLUDE: 'param.inc'

'Prepare the screen
CLS

'Print a message about the program
PRINT
PRINT "Program TEST"
'PRINT "This program performs wire scan measurements in dipoles,"
'PRINT "quadrupoles, and sextupoles."

'Get test parameters from the operator
'testparam:
'CALL gettestparam(projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)

'Open all files
'CALL fileinitwire(projectP$, magtypeP$, magnameP$, runP$, logfileP$, datfileP$, pltfileP$, ok$)
'IF ok$ <> "y" THEN
' PRINT : PRINT "Problem opening the data files.  Try a different run number.": PRINT
' GOTO testparam:
'END IF
filenum% = FREEFILE
logfileP$ = "logfile.dat"
OPEN logfileP$ FOR OUTPUT AS #filenum%
CLOSE filenum%

'Establish communication with the GPIB
CALL gpibinit(gpibinP%, gpiboutP%)

'Distribute parameters
CALL wireparam

'Initialize devices, files, and systems
'CALL wireinit

'Initialize the power sypply system
'CALL imaginit

'Polarity reversal stuff
CALL imagstandardize(6, 120!)
STOP

'Initialize the stretched wire system
CALL vtwinit

'Message
PRINT
PRINT "Sampling the wire voltage..."

'Perform the stretched wire measurement


CALL mc4zero
'x0! = 0!
'CALL vtwgetvtav(x0!, dxcmP!, vt!, svt!)
'CALL dwcalcbl(dxcmP!, vt!, svt!, bl!, sbl!)
'PRINT vt!
'PRINT svt!
'PRINT bl!
'PRINT sbl!

'CALL imagramp(100)
CALL vtwplotv(2, dxcmP!)
CALL vtwmoveabs(0!)
'CALL imagramp(0)


'Perform the stretched wire measurement
'CALL wiremeas

'Prepare to exit the program
'CALL wireexit

'Message
PRINT "The measurement is complete."

END

SUB wireexit

'****************************************************************************
'This subroutine prepares for the program to exit.
'
'Zachary Wolf
'9/21/95
'****************************************************************************

'Prepare the power system to be turned off
CALL imagexit

END SUB

SUB wireinit

'****************************************************************************
'This subroutine supervises the initialization for the program.
'
'Zachary Wolf
'12/15/95
'****************************************************************************

'Write general headers to the log and dat files
CALL fileheader(logfileP$, projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)
CALL fileheader(datfileP$, projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)

'Write headers describing the initial iron saturation
IF imagsaturateP! > 0 THEN
 CALL fileisat(logfileP$, imagsaturateP!)
 CALL fileisat(datfileP$, imagsaturateP!)
END IF

'Write headers describing the standardization
IF nstandcycleP% > 0 THEN
 CALL fileistand(logfileP$, nstandcycleP%, imagstandP!)
 CALL fileistand(datfileP$, nstandcycleP%, imagstandP!)
END IF

'Write headers describing the test currents
IF imagconfigP$ <> "NONE" THEN
 CALL fileitest(logfileP$, nimagtestP%, imagtestP!())
 CALL fileitest(datfileP$, nimagtestP%, imagtestP!())
END IF

'Initialize the stretched wire system
CALL vtwinit

'Starting Position
PRINT
PRINT "Starting Position"
PRINT "Please move the wire as close to the center of the magnet as possible."
PRINT "The exact location is not critical."
PRINT "This position will be the (0,0) position."
INPUT "Press ENTER when ready. ", a$
CALL mc4zero

'Initialize the power sypply system
CALL imaginit

END SUB

SUB wiremeas

'****************************************************************************
'This subroutine supervises the stretched wire measurements.
'
'Zachary Wolf
'9/21/95
'****************************************************************************

'Saturate the magnet steel
IF imagsaturateP! > 0 THEN
 CALL imagsaturate(imagsaturateP!)
END IF

'Standardize the magnet
IF nstandcycleP% > 0 THEN
 CALL imagstandardize(nstandcycleP%, imagstandP!)
END IF

'Perform the measurements
IF measurementP$ = "BLVSX" THEN
 CALL dwblvsx
ELSEIF measurementP$ = "BLVSI" THEN
 CALL dwblvsi
ELSEIF measurementP$ = "GLVSI" THEN
 CALL qwglvsi
ELSEIF measurementP$ = "SLVSI" THEN
 CALL swslvsi
ELSE
 PRINT "WIRE: Unknown measurement requested, exiting"
END IF

END SUB

SUB wireparam

'****************************************************************************
'This subroutine distributes parameters for the program.
'Most parameters come from param.inc.
'
'Zachary Wolf
'9/20/95
'****************************************************************************
'Set parameters for the GP3
CALL gp3setpar(gpibinP%, gpiboutP%, gp3addrP$)

'Set parameters for the HP3458
CALL hp3458setpar(gpibinP%, gpiboutP%, hp3458addrP$)

'Set parameters for the MC4
CALL mc4setpar(gpibinP%, gpiboutP%, mc4addrP$)

'Set the parameters for the HP3457
CALL hp3457setpar(gpibinP%, gpiboutP%, hp3457addrP$)

'Set the parameters for the DAC488
CALL dac488setpar(gpibinP%, gpiboutP%, dac488addrP$)

'Set the parameters for the DAC488HR
CALL dac488hrsetpar(gpibinP%, gpiboutP%, dac488hraddrP$)

'Set the parameters for the Kepco supply
CALL bit488setpar(gpibinP%, gpiboutP%, bit488addrP$)

'Set the parameters for the PS123 DAC488
CALL psdac488setpar(gpibinP%, gpiboutP%, psdac488addrP$)

'Set the parameters for the PS123 HP3457
CALL pshp3457setpar(gpibinP%, gpiboutP%, pshp3457addrP$)

'Set the parameters in the dipole, quad, and sextupole wire measurement routines
CALL dwsetpar(logfileP$, datfileP$, pltfileP$, magnameP$, runP$, dxcmP!, nx0P%, x0P!(), nturnsP%, nimagtestP%, imagtestP!(), imagnmeasave%)
CALL qwsetpar(logfileP$, datfileP$, pltfileP$, magnameP$, runP$, dxcmP!, nx0P%, x0P!(), nturnsP%, nimagtestP%, imagtestP!())
CALL swsetpar(logfileP$, datfileP$, pltfileP$, magnameP$, runP$, dxcmP!, nx0P%, x0P!(), nturnsP%, nimagtestP%, imagtestP!())

'Set the parameters for the VT routines
CALL vtwsetpar(logfileP$, x1P$, x2P$, acctimeP!, velcmsP!, tsamplebefsP!, tsampleaftsP!, nsampleP%, nmeasaveP%)

'Set the parameters for the magnet current control
CALL imagsetpar(logfileP$, imagconfigP$, imagramprateP!, imagnmeasaveP%, imaglimitP!)

'Set the parameters for the Kepco power supply control
CALL ibopsetpar(imaghpchanP%, vtransperimagP!, imagtstableP%)

'Set the parameters for DAC488 power supply control
CALL idacsetpar(imagdacchanP%, imagpervdacP!, imagtstableP%, imaghpchanP%, vtransperimagP!)

'Set the parameters for DAC488HR power supply control
CALL idachrsetpar(imagdacchanP%, imagpervdacP!, imagtstableP%, imaghpchanP%, vtransperimagP!)

'Set the parameters for the PS123 power system
CALL ips123setpar(logfileP$, imagconfigP$, imagtstableP%)

'Set the parameters for manual power system operation
CALL imansetpar(imaghpchanP%, vtransperimagP!)

END SUB