DECLARE SUB sr850setpar (sr850addr$)
DECLARE SUB gp3getb (b!)
DECLARE SUB teletracgetx (x!)
DECLARE SUB teletracinit ()
DECLARE SUB teletracsetpar (gpibinf%, gpiboutf%, teletracaddr$)
DECLARE SUB teletraczerox ()
DECLARE SUB cm2100getd (d!)
DECLARE SUB mtoolmovez (z!)
DECLARE SUB mtoolgetbcoil (btrans!, th!)
DECLARE SUB mapexit ()
DECLARE SUB mapinit ()
DECLARE SUB mapmeas ()
DECLARE SUB mapparam ()
DECLARE SUB xyhbvsxy ()
DECLARE SUB xyhsetpar (datfile$, pltfile$, nypos%, ypos!(), nxpos%, xpos!())
DECLARE SUB zhbvsz ()
DECLARE SUB zhbvszuser ()
DECLARE SUB zhsetpar (logfile$, datfile$, pltfile$, nzpos%, zpos!())
DECLARE SUB znmrhbvsz ()
DECLARE SUB znmrhsetpar (logfile$, datfile$, pltfile$, nzpos%, zpos!())
DECLARE SUB zcoilbvsz ()
DECLARE SUB zcoilsetpar (datfile$, pltfile$, nzpos%, zpos!())
DECLARE SUB mtoolinit ()
DECLARE SUB mtoolsetpar (logfile$, measdevice$, hallrange%, coilconstant!, movedevice$, acctime!, velcms!, tmovesettle%, xaxis$, yaxis$, zaxis$, posreaddevice$)
DECLARE SUB gpibinit (ieeein%, ieeeout%)
DECLARE SUB ls450setpar (gpibinf%, gpiboutf%, ls450addr$)
DECLARE SUB gp3setpar (gpibinf%, gpiboutf%, gp3addr$)
DECLARE SUB b9900setpar (gpibinf%, gpiboutf%, b9900addr$)
DECLARE SUB pt2025setpar (gpibinf%, gpiboutf%, pt2025addr$)
DECLARE SUB par5209setpar (gpibinf%, gpiboutf%, par5209addr$)
DECLARE SUB mc4setpar (gpibinf%, gpiboutf%, mc4addr$)
DECLARE SUB cm2100setpar (gpibinf%, gpiboutf%, cm2100addr$)
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!())

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

'Get parameters from the parameter file
REM $INCLUDE: 'param.inc'

'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

'Perform the measurements
'CALL mapmeas

'Perform tests here
'readb:
'CALL mtoolmovez(0!)
'PRINT
'INPUT "Press ENTER to read the Group 3 Hall probe. ", a$
'CALL gp3getb(b!)
'PRINT "B = "; b!; " T"
'CALL mtoolmovez(1!)
'GOTO readb

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

getz:
PRINT
INPUT "What position do you want to move to? ", z$
z! = VAL(z$)
CALL mtoolmovez(z!)
CALL teletracgetx(x!)
PRINT "Z = "; x!; " cm"
GOTO getz

CALL cm2100getd(d!)
CALL mtoolmovez(-d!)

'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$ = "ZMAPHUSER" THEN
 CALL zhbvszuser
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.inc.
'
'Zachary Wolf
'2/19/96
'****************************************************************************

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

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

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

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

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

'Set parameters for the SR850
CALL sr850setpar(sr850addrP$)

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

'Set parameters for the CM2100
CALL cm2100setpar(gpibinP%, gpiboutP%, cm2100addrP$)

'Set parameters for the Teletrac interferometer
CALL teletracsetpar(gpibinP%, gpiboutP%, teletracaddrP$)

'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 for the XY mapping routines
DIM yposP!(1 TO nyposP%)
FOR i% = 1 TO nyposP%
 yposP!(i%) = yminP! + (i% - 1!) * dyP!
NEXT i%
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
IF nzregionsP% = 1 THEN
 nzposP% = nzpos1P%
 DIM zposP!(1 TO nzpos1P%)
 FOR i% = 1 TO nzpos1P%
  zposP!(i%) = zminP! + (i% - 1!) * dz1P!
 NEXT i%
ELSEIF nzregionsP% = 2 THEN
 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
 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 mtoolsetpar(logfileP$, measdeviceP$, hallrangeP%, coilconstantP!, movedeviceP$, acctimeP!, velcmsP!, tmovesettleP%, xaxisP$, yaxisP$, zaxisP$, posreaddeviceP$)

'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