DECLARE SUB isextramp (rr!, inom!)
DECLARE SUB isextsetpar (imagdacchan%, imagpervdac!, imagtstable%, imaghpchan%, vtransperimag!)
DECLARE SUB iquadramp (rr!, inom!)
DECLARE SUB iquadsetpar (imagdacchan%, imagpervdac!, imagtstable%, imaghpchan%, vtransperimag!)
DECLARE SUB coilexit ()
DECLARE SUB coilfileinit (project$, magtype$, magname$, run$, logfile$, strdatfile$, hardatfile$, strpltfile$, harpltfile$, ok$)
DECLARE SUB coilinit ()
DECLARE SUB coilmeas ()
DECLARE SUB coilsetpar ()
DECLARE SUB vcoilsetpar (logfile$, coilnsampperrev%, coilnrevpermeas%, coilfreqhpchan%, strcoilhpchan%, harcoilhpchan%, strcoilid%, harcoilid%)
DECLARE SUB blsetpar (logfile$, magname$, run$, harcoilid%, harcoilradiusm!, harcoilnturns%, blnmeasave%)
DECLARE SUB dpolmain ()
DECLARE SUB dpolsetpar (logfile$, strdatfile$, strpltfile$, hardatfile$, harpltfile$, magname$, run$, strcoilid%, strdpolcoilconst!, harcoilradiusm!, blnmeasave%, nimagtest%, imagtest!(), imagharflag!(), nhardisplay%, viewdir$)
DECLARE SUB qpolmain ()
DECLARE SUB qpolsetpar (logfile$, strdatfile$, strpltfile$, hardatfile$, harpltfile$, magname$, run$, strcoilid%, strqpolcoilconst!, harcoilradiusm!, blnmeasave%, nimagtest%, imagtest!(), imagharflag!(), nhardisplay%, viewdir$)
DECLARE SUB spolmain ()
DECLARE SUB spolsetpar (logfile$, strdatfile$, strpltfile$, hardatfile$, harpltfile$, magname$, run$, strcoilid%, strspolcoilconst!, harcoilradiusm!, blnmeasave%, nimagtest%, imagtest!(), imagharflag!(), nhardisplay%, viewdirP$)
DECLARE SUB gpibinit (ieeein%, ieeeout%)
DECLARE SUB bit488setpar (gpibinf%, gpiboutf%, bit488addr$)
DECLARE SUB dac488setpar (gpibinf%, gpiboutf%, dac488addr$)
DECLARE SUB dac488hrinit ()
DECLARE SUB dac488hrsetpar (gpibinf%, gpiboutf%, dac488hraddr$)
DECLARE SUB psdac488setpar (gpibinf%, gpiboutf%, psdac488addr$)
DECLARE SUB pshp3457setpar (gpibinf%, gpiboutf%, pshp3457addr$)
DECLARE SUB hp3457init ()
DECLARE SUB hp3457setpar (gpibinf%, gpiboutf%, hp3457addr$)
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 fileisat (logfile$, isat!)
DECLARE SUB fileistand (logfile$, n%, istand!)
DECLARE SUB fileitest (logfile$, n%, imag!())
DECLARE SUB filemkdir (destdir$)
DECLARE SUB fileopenout (destdir$, basename$, ext$, filename$, ok$)
DECLARE SUB fileprnt (file$)
DECLARE SUB fileprot (file$)
DECLARE SUB gettestparam (projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)

'****************************************************************************
'Program COIL
'This program is used to make rotating coil measurements in dipoles,
'quadrupoles, and sextupoles.
'
'Zachary Wolf
'11/20/95
'****************************************************************************

'Common area for run time parameters
COMMON SHARED /gpibio/ gpibinP%, gpiboutP%
COMMON SHARED /filenames/ logfileP$, strdatfileP$, hardatfileP$, strpltfileP$, harpltfileP$
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 COIL"
PRINT "This program performs rotating coil measurements in dipoles,"
PRINT "quadrupoles, and sextupoles."
PRINT "These measurements give magnet strengths and harmonics."

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

'Open all files
CALL coilfileinit(projectP$, magtypeP$, magnameP$, runP$, logfileP$, strdatfileP$, hardatfileP$, strpltfileP$, harpltfileP$, ok$)
IF ok$ <> "y" THEN
 PRINT : PRINT "Problem opening the data files.  Try a different run number.": PRINT
 GOTO testparam:
END IF

'Initialize the GPIB system
CALL gpibinit(gpibinP%, gpiboutP%)

'Distribute parameters to all modules
CALL coilsetpar

'Initialize the software and hardware
CALL coilinit

'Perform the rotating coil measurement
CALL coilmeas

'Prepare to exit the program
CALL coilexit

'Message
PRINT "The measurement is complete."

END

SUB coilexit

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

'Prepare the power system to be turned off
CALL imagexit

'CALL iquadramp(0!, 0!)

CALL isextramp(0!, 0!)

END SUB

SUB coilfileinit (project$, magtype$, magname$, run$, logfile$, strdatfile$, hardatfile$, strpltfile$, harpltfile$, ok$)

'****************************************************************************
'This subroutine initializes all files.
'
'Input:
' project$, project name
' magtype$, magnet type
' magname$, magnet name
' run$, run number
'
'Output:
' logfile$, path and name of the log file
' strdatfile$, path and name of the magnet strength data file
' hardatfile$, path and name of the magnet harmonics data file
' strpltfile$, path and name of the magnet strength plot file
' harpltfile$, path and name of the magnet harmonics plot file
' ok$, ="y" if the file handling went ok, "n" otherwise
'
'Zachary Wolf
'7/26/95
'****************************************************************************

'Initialize
ok$ = "n"

'Create the \magdata subdirectory to store the file
subdir$ = "c:\magdata\" + LEFT$(project$, 8)
CALL filemkdir(subdir$)
subdir$ = "c:\magdata\" + LEFT$(project$, 8) + "\" + LEFT$(magtype$, 8)
CALL filemkdir(subdir$)
subdir$ = "c:\magdata\" + LEFT$(project$, 8) + "\" + LEFT$(magtype$, 8) + "\" + LEFT$(magname$, 8)
CALL filemkdir(subdir$)

'Form the extension for the file
r% = VAL(run$)
IF r% < 10 THEN ext$ = "ru" + run$
IF r% >= 10 THEN ext$ = "r" + run$

'LOGFILE

'Initialize the log file for the run
'Exit with ok$="n" if there is a problem
CALL fileopenout(subdir$, "bllog", ext$, logfile$, okopen$)
IF okopen$ <> "y" THEN GOTO pblmexitbln

'MAGNET STRENGTH DATA FILE

'Initialize the dat file
'Exit with ok$="n" if there is a problem
CALL fileopenout(subdir$, "blstrdat", ext$, strdatfile$, okopen$)
IF okopen$ <> "y" THEN GOTO pblmexitbln

'Make a .bat file to write protect the data
CALL fileprot(strdatfile$)

'Make a .bat file to print the dat file
CALL fileprnt(strdatfile$)

'HARMONICS DATA FILE

'Initialize the dat file
'Exit with ok$="n" if there is a problem
CALL fileopenout(subdir$, "blhardat", ext$, hardatfile$, okopen$)
IF okopen$ <> "y" THEN GOTO pblmexitbln

'Make a .bat file to write protect the data
CALL fileprot(hardatfile$)

'Make a .bat file to print the dat file
CALL fileprnt(hardatfile$)

'MAGNET STRENGTH PLOT FILE

'Initialize the plt file
'Exit with ok$="n" if there is a problem
CALL fileopenout(subdir$, "blstrplt", ext$, strpltfile$, okopen$)
IF okopen$ <> "y" THEN GOTO pblmexitbln

'Make a .bat file to write protect the data
CALL fileprot(strpltfile$)

'HARMONICS PLOT FILE

'Initialize the plt file
'Exit with ok$="n" if there is a problem
CALL fileopenout(subdir$, "blharplt", ext$, harpltfile$, okopen$)
IF okopen$ <> "y" THEN GOTO pblmexitbln

'Make a .bat file to write protect the data
CALL fileprot(harpltfile$)

'If we made it this far, things are ok
ok$ = "y"

pblmexitbln:

END SUB

SUB coilinit

'****************************************************************************
'This subroutine does all the initialization for the program.
'
'Zachary Wolf
'9/20/95, 9/25/97
'****************************************************************************

'Hardware init

'Initialize the HP3457
CALL hp3457init

'Initialize the DAC488HR
CALL dac488hrinit

'Initialize the power sypply system
CALL imaginit

'Software init

'Write general headers to the log and dat files
CALL fileheader(logfileP$, projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)
CALL fileheader(strdatfileP$, projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)
CALL fileheader(hardatfileP$, 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(strdatfileP$, imagsaturateP!)
 CALL fileisat(hardatfileP$, imagsaturateP!)
END IF

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

'Write headers describing the test currents
CALL fileitest(logfileP$, nimagtestP%, imagtestP!())
CALL fileitest(strdatfileP$, nimagtestP%, imagtestP!())
CALL fileitest(hardatfileP$, nimagtestP%, imagtestP!())

END SUB

SUB coilmeas

'****************************************************************************
'This subroutine supervises the rotating coil measurements.
'
'Zachary Wolf
'9/21/95
'****************************************************************************

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

'Standardize the sextupole coil

'Let the operator know what is happening
PRINT
PRINT "Standardizing the sextupole coil..."

'Ramp to the desired current
CALL isextramp(0!, 268!)

'Ramp to 17 A
CALL isextramp(0!, 17!)

'Ramp to the desired current
CALL isextramp(0!, 268!)

'Ramp to 17 A
CALL isextramp(0!, 17!)

'Ramp to the desired current
CALL isextramp(0!, 268!)

'Ramp to 17 A
CALL isextramp(0!, 17!)

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

'Standardize the quad coil

'Let the operator know what is happening
'PRINT
'PRINT "Standardizing the quadrupole coil..."

'Ramp to the desired current
'CALL iquadramp(0!, 500!)

'Ramp to 25 A
'CALL iquadramp(0!, 25!)

'Ramp to the desired current
'CALL iquadramp(0!, 500!)

'Ramp to 25 A
'CALL iquadramp(0!, 25!)

'Ramp to the desired current
'CALL iquadramp(0!, 500!)

'Ramp to 25 A
'CALL iquadramp(0!, 25!)

'Perform the measurements
IF measurementP$ = "BLVSI" THEN
 CALL dpolmain
ELSEIF measurementP$ = "GLVSI" THEN
 CALL qpolmain
ELSEIF measurementP$ = "SLVSI" THEN
 CALL spolmain
ELSE
 PRINT
 PRINT "Unknown measurement requested."
END IF

END SUB

SUB coilsetpar

'****************************************************************************
'This subroutine sets all parameters for the program.
'Most parameters come from param.inc.
'
'Zachary Wolf
'9/20/95, 9/24/97
'****************************************************************************

'Hardware parameters

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

'Set the parameters for the DAC488 (used for PS and the Reset signal)
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$)

'Software parameters

'Set parameters for the main magnet measurements modules
CALL dpolsetpar(logfileP$, strdatfileP$, strpltfileP$, hardatfileP$, harpltfileP$, magnameP$, runP$, strcoilidP%, strdpolcoilconstP!, harcoilradiusmP!, blnmeasaveP%, nimagtestP%, imagtestP!(), imagharflagP!(), nhardisplayP%, viewdirP$)
CALL qpolsetpar(logfileP$, strdatfileP$, strpltfileP$, hardatfileP$, harpltfileP$, magnameP$, runP$, strcoilidP%, strqpolcoilconstP!, harcoilradiusmP!, blnmeasaveP%, nimagtestP%, imagtestP!(), imagharflagP!(), nhardisplayP%, viewdirP$)
CALL spolsetpar(logfileP$, strdatfileP$, strpltfileP$, hardatfileP$, harpltfileP$, magnameP$, runP$, strcoilidP%, strspolcoilconstP!, harcoilradiusmP!, blnmeasaveP%, nimagtestP%, imagtestP!(), imagharflagP!(), nhardisplayP%, viewdirP$)

'Set parameters for the harmonics measurements, common to all magnet types
CALL blsetpar(logfileP$, magnameP$, runP$, harcoilidP%, harcoilradiusmP!, harcoilnturnsP%, blnmeasaveP%)

'Set parameters for the coil voltage measurements
CALL vcoilsetpar(logfileP$, coilnsampperrevP%, coilnrevpermeasP%, coilfreqhpchanP%, strcoilhpchanP%, harcoilhpchanP%, strcoilidP%, harcoilidP%)

'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 DAC488 IQUAD power supply control
CALL iquadsetpar(imagdacchanP%, imagpervdacP!, imagtstableP%, imaghpchanP%, vtransperimagP!)

'Set the parameters for DAC488 SEXT power supply control
CALL isextsetpar(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