DECLARE SUB ls450getb (b!)
DECLARE SUB ls450setrange (r%)
DECLARE SUB mtoolgetbcoil (btrans!, th!)
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/ 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
logfileP$ = "logfile.dat"
filenum% = FREEFILE
OPEN logfileP$ FOR OUTPUT AS filenum%
CLOSE filenum%

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

'Distribute required parameters
CALL mapparam

'Initialize all systems
CALL mapinit
'INPUT "Press Enter to continue. "; a$

'Perform tests here
'CALL ls450setrange(1)
'CALL ls450getb(b!)
'PRINT
'PRINT "B = "; b!; " T"

PRINT
PRINT "Making a measurement with the PAR 5209 lock-in..."
CALL mtoolgetbcoil(btrans!, th!)

'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