DECLARE SUB par5209setpar (gpibinf%, gpiboutf%, par5209addr$)
DECLARE SUB b9900setpar (gpibinf%, gpiboutf%, b9900addr$)
DECLARE SUB getintparam (parname$, intvalue%)
DECLARE SUB getfltparam (parname$, fltvalue!)
DECLARE SUB gpibinit (gpibinf%, gpiboutf%)
DECLARE SUB ls450setpar (gpibinf%, gpiboutf%, ls450addr$)
DECLARE SUB gp3setpar (gpibinP%, gpiboutP%, gp3addrP$)
DECLARE SUB pt2025setpar (gpibinP%, gpiboutP%, pt2025addrP$)
DECLARE SUB mc4setpar (gpibinP%, gpiboutP%, mc4addrP$)
DECLARE SUB hp3457setpar (gpibinf%, gpiboutf%, hp3457addr$)
DECLARE SUB bit488setpar (gpibinf%, gpiboutf%, bit488addr$)
DECLARE SUB dac488setpar (gpibinf%, gpiboutf%, dac488addr$)
DECLARE SUB dac488hrsetpar (gpibinf%, gpiboutf%, dac488hraddr$)
DECLARE SUB psdac488setpar (gpibinf%, gpiboutf%, psdac488addr$)
DECLARE SUB pshp3457setpar (gpibinf%, gpiboutf%, pshp3457addr$)
DECLARE SUB imagexit ()
DECLARE SUB imaginit ()
DECLARE SUB imagramp (inom!)
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 fileinitmap (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 getparamfile ()
DECLARE SUB getstrparam (parname$, parval$)
DECLARE SUB gettestparam (projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$)
DECLARE SUB mtoolinit ()
DECLARE SUB mtoolsetpar (logfile$, measdevice$, hallrange%, coilconstant!, movedevice$, acctime!, velcms!, tmovesettle%, xaxis$, yaxis$, zaxis$)
DECLARE SUB xyhbvsxy ()
DECLARE SUB xyhsetpar (datfile$, pltfile$, nypos%, ypos!(), nxpos%, xpos!())
DECLARE SUB zcoilbvsz ()
DECLARE SUB zcoilsetpar (datfile$, pltfile$, nzpos%, zpos!())
DECLARE SUB zhbvsz ()
DECLARE SUB zhsetpar (logfile$, datfile$, pltfile$, nzpos%, zpos!())
DECLARE SUB znmrhbvsz ()
DECLARE SUB znmrhsetpar (logfile$, datfile$, pltfile$, nzpos%, zpos!())
DECLARE SUB mapexit ()
DECLARE SUB mapinit ()
DECLARE SUB mapmeas ()
DECLARE SUB mapparam ()

'****************************************************************************
'Program MAP
'This program is used to make field maps of magnets.
'
'Zachary Wolf
'12/12/95
'****************************************************************************

'Common area for parameters shared in the main module
COMMON SHARED /gpibio/ gpibinP%, gpiboutP%
COMMON SHARED /filenames/ logfileP$, datfileP$, pltfileP$
COMMON SHARED /testinfo/ projectP$, magtypeP$, magnameP$, barcodeP$, teststandP$, coilnameP$, operatorP$, runP$, commentP$
COMMON SHARED /current/ imagconfigP$, imagsaturateP!, nstandcycleP%, imagstandP!, nimagtestP%, imagtestP!()
COMMON SHARED /meas/ measurementP$

'Prepare the screen
CLS

'Print a message about the program
PRINT
PRINT "Program MAP"
PRINT "This program makes field maps of magnets."

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

'Open all files, get file names
CALL fileinitmap(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

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

'Distribute required parameters
CALL mapparam

'Initialize all systems
CALL mapinit

'Perform the measurements
CALL mapmeas

'Prepare to exit the program
CALL mapexit

'Message
PRINT "The measurement is complete."

END

SUB mapexit

'****************************************************************************
'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 mapinit

'****************************************************************************
'This subroutine does the initialization for the program.
'
'Zachary Wolf
'12/14/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 measurement system
CALL mtoolinit

'Initialize the power sypply system
CALL imaginit

END SUB

SUB mapmeas

'****************************************************************************
'This subroutine supervises the field map 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

'Loop over test currents
FOR i% = 1 TO nimagtestP%

'Ramp to the desired test current
CALL imagramp(imagtestP!(i%))

'Perform the measurements
IF measurementP$ = "XYMAPH" THEN
 CALL xyhbvsxy
ELSEIF measurementP$ = "ZMAPH" THEN
 CALL zhbvsz
ELSEIF measurementP$ = "ZMAPNMRH" THEN
 CALL znmrhbvsz
ELSEIF measurementP$ = "ZMAPCOIL" THEN
 CALL zcoilbvsz
ELSE
 PRINT
 PRINT "MAP: Unknown measurement requested"
 STOP
END IF

'End loop over test currents
NEXT i%

END SUB

SUB mapparam

'****************************************************************************
'This subroutine does the parameter distribution for the program.
'Most parameters come from param.dat.
'
'Zachary Wolf
'2/19/96
'****************************************************************************

'Get the parameter values from param.dat
CALL getparamfile

'Set parameters for the LS450
CALL getstrparam("ls450addrP$", ls450addrP$)
CALL ls450setpar(gpibinP%, gpiboutP%, ls450addrP$)

'Set parameters for the GP3
CALL getstrparam("gp3addrP$", gp3addrP$)
CALL gp3setpar(gpibinP%, gpiboutP%, gp3addrP$)

'Set parameters for the B9900
CALL getstrparam("b9900addrP$", b9900addrP$)
CALL b9900setpar(gpibinP%, gpiboutP%, b9900addrP$)

'Set parameters for the PT2025
CALL getstrparam("pt2025addrP$", pt2025addrP$)
CALL pt2025setpar(gpibinP%, gpiboutP%, pt2025addrP$)

'Set parameters for the PAR5209
CALL getstrparam("par5209addrP$", par5209addrP$)
CALL par5209setpar(gpibinP%, gpiboutP%, par5209addrP$)

'Set parameters for the SR850
'call getstrparam("sr850addrP$", sr850addrP$)
'CALL sr850setpar(gpibinP%, gpiboutP%, sr850addrP$)

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

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

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

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

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

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

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

'Set the parameters for the XY mapping routines
CALL getintparam("nyposP%", nyposP%)
CALL getfltparam("yminP!", yminP!)
CALL getfltparam("dyP!", dyP!)
DIM yposP!(1 TO nyposP%)
FOR i% = 1 TO nyposP%
 yposP!(i%) = yminP! + (i% - 1!) * dyP!
NEXT i%
CALL getintparam("nxposP%", nxposP%)
CALL getfltparam("xminP!", xminP!)
CALL getfltparam("dxP!", dxP!)
DIM xposP!(1 TO nxposP%)
FOR i% = 1 TO nxposP%
 xposP!(i%) = xminP! + (i% - 1!) * dxP!
NEXT i%
CALL xyhsetpar(datfileP$, pltfileP$, nyposP%, yposP!(), nxposP%, xposP!())

'Determine the Z positions in inches for Hall probe, NMR/Hall probe, and coil maps
CALL getintparam("nzregionsP%", nzregionsP%)
CALL getfltparam("zminP!", zminP!)
IF nzregionsP% = 1 THEN
 CALL getintparam("nzpos1P%", nzpos1P%)
 CALL getfltparam("dz1P!", dz1P!)
 nzposP% = nzpos1P%
 DIM zposP!(1 TO nzpos1P%)
 FOR i% = 1 TO nzpos1P%
  zposP!(i%) = zminP! + (i% - 1!) * dz1P!
 NEXT i%
ELSEIF nzregionsP% = 2 THEN
 CALL getintparam("nzpos1P%", nzpos1P%)
 CALL getfltparam("dz1P!", dz1P!)
 CALL getintparam("nzpos2P%", nzpos2P%)
 CALL getfltparam("dz2P!", dz2P!)
 nzposP% = nzpos1P% + nzpos2P%
 DIM zposP!(1 TO nzpos1P% + nzpos2P%)
 FOR i% = 1 TO nzpos1P%
  zposP!(i%) = zminP! + (i% - 1!) * dz1P!
 NEXT i%
 FOR i% = 1 TO nzpos2P%
  zposP!(nzpos1P% + i%) = zposP!(nzpos1P%) + i% * dz2P!
 NEXT i%
ELSEIF nzregionsP% = 3 THEN
 CALL getintparam("nzpos1P%", nzpos1P%)
 CALL getfltparam("dz1P!", dz1P!)
 CALL getintparam("nzpos2P%", nzpos2P%)
 CALL getfltparam("dz2P!", dz2P!)
 CALL getintparam("nzpos3P%", nzpos3P%)
 CALL getfltparam("dz3P!", dz3P!)
 nzposP% = nzpos1P% + nzpos2P% + nzpos3P%
 DIM zposP!(1 TO nzpos1P% + nzpos2P% + nzpos3P%)
 FOR i% = 1 TO nzpos1P%
  zposP!(i%) = zminP! + (i% - 1!) * dz1P!
 NEXT i%
 FOR i% = 1 TO nzpos2P%
  zposP!(nzpos1P% + i%) = zposP!(nzpos1P%) + i% * dz2P!
 NEXT i%
 FOR i% = 1 TO nzpos3P%
  zposP!(nzpos1P% + nzpos2P% + i%) = zposP!(nzpos1P% + nzpos2P%) + i% * dz3P!
 NEXT i%
END IF

'Convert the Z position from inches to cm
FOR i% = 1 TO nzposP%
 zposP!(i%) = zposP!(i%) * 2.54
NEXT i%

'Set the parameters for the Z Hall probe mapping routines
CALL zhsetpar(logfileP$, datfileP$, pltfileP$, nzposP%, zposP!())

'Set the parameters for the Z NMR/Hall probe mapping routines
CALL znmrhsetpar(logfileP$, datfileP$, pltfileP$, nzposP%, zposP!())

'Set the parameters for the Z coil mapping routines
CALL zcoilsetpar(datfileP$, pltfileP$, nzposP%, zposP!())

'Set the parameters for the mapping tools
CALL getstrparam("measdeviceP$", measdeviceP$)
CALL getintparam("hallrangeP%", hallrangeP%)
CALL getfltparam("coilconstantP!", coilconstantP!)
CALL getstrparam("movedeviceP$", movedeviceP$)
CALL getfltparam("acctimeP!", acctimeP!)
CALL getfltparam("velcmsP!", velcmsP!)
CALL getintparam("tmovesettleP%", tmovesettleP%)
CALL getstrparam("xaxisP$", xaxisP$)
CALL getstrparam("yaxisP$", yaxisP$)
CALL getstrparam("zaxisP$", zaxisP$)
CALL mtoolsetpar(logfileP$, measdeviceP$, hallrangeP%, coilconstantP!, movedeviceP$, acctimeP!, velcmsP!, tmovesettleP%, xaxisP$, yaxisP$, zaxisP$)

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

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

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

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

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

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

'Get parameters used in the main module
CALL getfltparam("imagsaturateP!", imagsaturateP!)
CALL getintparam("nstandcycleP%", nstandcycleP%)
CALL getfltparam("imagstandP!", imagstandP!)
CALL getintparam("nimagtestP%", nimagtestP%)
DIM imagtestP!(1 TO nimagtestP%)
FOR i% = 1 TO nimagtestP%
 CALL getfltparam("imagtestP!(" + LTRIM$(STR$(i%)) + ")", imagtestP!(i%))
NEXT i%
CALL getstrparam("measurementP$", measurementP$)

END SUB