DECLARE SUB par5209err (ynerr$)
DECLARE SUB gpibclrdev (addr$)
DECLARE SUB par5209datready ()
DECLARE SUB par5209ready ()
DECLARE SUB gpibin (addr$, msg$)
DECLARE SUB gpibout (addr$, cmd$)
DECLARE SUB gpibspoll (addr$, msg$)
DECLARE SUB gpibterm (termin$, termout$)

'****************************************************************************
'Module PAR5209
'This module contains I/O subroutines for the Princeton Applied Research
'Model 5209 lock-in amplifier.
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Common area for shared parameters
COMMON SHARED /par5209/ gpibinP%, gpiboutP%, par5209addrP$

'Semi-permanent parameters
CONST par5209terminP$ = "CR LF EOI"
CONST par5209termoutP$ = "CR LF"

SUB par5209automeas

'****************************************************************************
'This subroutine has the PAR 5209 lock-in amplifier perform an auto-measure
'command.
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Set the input sensitivity to the highest range (3 V)
CALL par5209ready
CALL gpibout(par5209addrP$, "SEN 15")

'Auto-measure
remeasure:
CALL par5209ready
CALL gpibout(par5209addrP$, "ASM")

'Wait until the auto-measure is complete
CALL par5209ready

'Check for errors
CALL par5209err(ynerr$)

'If there is an error, try again
IF ynerr$ = "y" THEN
 PRINT
 PRINT "PAR 5209, problem detected, remeasuring..."
 GOTO remeasure
END IF

END SUB

SUB par5209datready

'****************************************************************************
'This subroutine is used to verify that the 5209 is done processing and
'has data ready to return.  It checks the serial poll bits and
'waits until the 5209 is ready to send its output.
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Check the status until the 5209 is ready to send data
WHILE 1

 'Perform a serial poll on the 5209
 CALL gpibspoll(par5209addrP$, spoll$)

 'Message for debugging
 'PRINT "DEBUG, Datready, Spoll = "; spoll$

 'Convert spoll$ to an integer
 spoll% = VAL(spoll$)

 'Print a message if an error is detected
 IF (spoll% AND 1) = 1 THEN
  'OK, command done
 ELSEIF (spoll% AND 2) = 2 THEN
  PRINT "PAR 5209 DATREADY, invalid command received"
 ELSEIF (spoll% AND 4) = 4 THEN
  PRINT "PAR 5209 DATREADY, parameter error"
 ELSEIF (spoll% AND 8) = 8 THEN
  PRINT "PAR 5209 DATREADY, reference channel UNLOCKED"
 ELSEIF (spoll% AND 16) = 16 THEN
  PRINT "PAR 5209 DATREADY, overload"
 ELSEIF (spoll% AND 32) = 32 THEN
  'OK, external trigger
 ELSEIF (spoll% AND 64) = 64 THEN
  'OK, SRQ
 ELSEIF (spoll% AND 128) = 128 THEN
  'OK, output ready
 END IF

 'See if the data is ready
 'Bit 7 true (128) means data ready
 IF (spoll% AND 128) = 128 THEN
  EXIT SUB
 ELSE
  SLEEP 1
 END IF

'End while loop
WEND

END SUB

SUB par5209err (ynerr$)

'****************************************************************************
'This subroutine is used to check for an error condition (overflow, command
'error, etc.).
'
'Output:
' ynerr$, "y" if there is an error, "n" if there is no error
'
'Zachary Wolf
'3/26/96
'****************************************************************************

'Default
ynerr$ = "n"

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'First check the bits returned by a serial poll

'Perform a serial poll on the 5209
CALL gpibspoll(par5209addrP$, spoll$)

'Message for debugging
'PRINT "DEBUG, ERR, Spoll = "; spoll$

'Convert spoll$ to and integer and check its value
spoll% = VAL(spoll$)

IF (spoll% AND 1) = 1 THEN
 'OK, command done
ELSEIF (spoll% AND 2) = 2 THEN
 PRINT "PAR 5209 ERROR, invalid command received"
 ynerr$ = "y"
ELSEIF (spoll% AND 4) = 4 THEN
 PRINT "PAR 5209 ERROR, parameter error"
 ynerr$ = "y"
ELSEIF (spoll% AND 8) = 8 THEN
 PRINT "PAR 5209 ERROR, reference channel UNLOCKED"
 ynerr$ = "y"
ELSEIF (spoll% AND 16) = 16 THEN
 PRINT "PAR 5209 ERROR, overload"
 ynerr$ = "y"
ELSEIF (spoll% AND 32) = 32 THEN
 'OK, external trigger
ELSEIF (spoll% AND 64) = 64 THEN
 'OK, SRQ
ELSEIF (spoll% AND 128) = 128 THEN
 'OK, output ready
END IF

'Note that a previous serial poll could have cleared error bits, check status

'Read the status from the 5209
CALL par5209ready
CALL gpibout(par5209addrP$, "N")
CALL par5209datready
CALL gpibin(par5209addrP$, status$)

'Message for debugging
'PRINT "DEBUG, ERR, Status = "; status$

'Convert status$ to and integer and check its value
status% = VAL(status$)
IF (status% AND 1) = 1 THEN
 'OK, not used
ELSEIF (status% AND 2) = 2 THEN
 'OK, 10^8 A/V
ELSEIF (status% AND 4) = 4 THEN
 'OK, 10^6 A/V
ELSEIF (status% AND 8) = 8 THEN
 'OK, not used
ELSEIF (status% AND 16) = 16 THEN
 PRINT "PAR 5209 ERROR, X out overload"
 ynerr$ = "y"
ELSEIF (status% AND 32) = 32 THEN
 PRINT "PAR 5209 ERROR, PSD overload"
 ynerr$ = "y"
ELSEIF (status% AND 64) = 64 THEN
 PRINT "PAR 5209 ERROR, Preamp overload"
 ynerr$ = "y"
ELSEIF (status% AND 128) = 128 THEN
 PRINT "PAR 5209 ERROR, REF unlocked"
 ynerr$ = "y"
END IF

END SUB

SUB par5209getfreq (freq!)

'****************************************************************************
'This subroutine has the PAR 5209 lock-in amplifier return the reference
'frequency.
'
'Output:
' freq!, reference frequency in Hz
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Ask for the reference frequency
CALL par5209ready
CALL gpibout(par5209addrP$, "FRQ")

'Get the reference frequency
CALL par5209datready
CALL gpibin(par5209addrP$, freq$)
freq! = VAL(freq$)

'Convert from millihertz to hertz
freq! = freq! / 1000!

'Message for debugging
'PRINT "DEBUG, Frequency = "; freq!; " Hz"

END SUB

SUB par5209getrphase (phase!)

'****************************************************************************
'This subroutine has the PAR 5209 lock-in amplifier return the reference
'phase angle.
'
'Zachary Wolf
'3/13/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Read the reference phase
CALL par5209ready
CALL gpibout(par5209addrP$, "P")
CALL par5209datready
CALL gpibin(par5209addrP$, msg$)

'Message for debugging
'PRINT "DEBUG, Phase info = "; msg$

'Extract the two parameters from the message
'Assumes the parameter separator is a comma
lhs$ = ""
rhs$ = ""
FOR i% = 1 TO LEN(msg$)
 IF MID$(msg$, i%, 1) <> "," THEN
  lhs$ = lhs$ + MID$(msg$, i%, 1)
 ELSE
  rhs$ = MID$(msg$, i% + 1)
  EXIT FOR
 END IF
NEXT i%

'Message for debugging
'PRINT "DEBUG, lhs = "; lhs$
'PRINT "DEBUG, rhs = "; rhs$

'Extract the quadrant
quad% = VAL(lhs$)

'Extract the quadrant phase in degrees (0 to +-100 deg)
qphase! = VAL(rhs$)
qphase! = qphase! / 1000!

'Calculate the reference phase
phase! = quad% * 90! + qphase!

'Message for debugging
'PRINT "DEBUG, Phase = "; phase!; " deg"

END SUB

SUB par5209getvrms (vrms!)

'****************************************************************************
'This subroutine has the PAR 5209 lock-in amplifier return the rms magnitude
'of the input signal.
'
'Output:
' vrms!, the input signal magnitude in volts rms
'
'Zachary Wolf
'3/14/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Ask for the signal magnitude as a fraction of full scale
CALL par5209ready
CALL gpibout(par5209addrP$, "OUT")

'Get the signal magnitude as a fraction of full scale
CALL par5209datready
CALL gpibin(par5209addrP$, fracfs$)

'Extract the fraction of full scale
fracfs! = VAL(fracfs$)
fracfs! = fracfs! / 10000!

'Ask for the input sensitivity
CALL par5209ready
CALL gpibout(par5209addrP$, "SEN")

'Get the input sensitivity
CALL par5209datready
CALL gpibin(par5209addrP$, sensitivity$)

'Determine the input signal strength
IF sensitivity$ = "0" THEN
 vrms! = fracfs! * .0000001
ELSEIF sensitivity$ = "1" THEN
 vrms! = fracfs! * .0000003
ELSEIF sensitivity$ = "2" THEN
 vrms! = fracfs! * .000001
ELSEIF sensitivity$ = "3" THEN
 vrms! = fracfs! * .000003
ELSEIF sensitivity$ = "4" THEN
 vrms! = fracfs! * .00001
ELSEIF sensitivity$ = "5" THEN
 vrms! = fracfs! * .00003
ELSEIF sensitivity$ = "6" THEN
 vrms! = fracfs! * .0001
ELSEIF sensitivity$ = "7" THEN
 vrms! = fracfs! * .0003
ELSEIF sensitivity$ = "8" THEN
 vrms! = fracfs! * .001
ELSEIF sensitivity$ = "9" THEN
 vrms! = fracfs! * .003
ELSEIF sensitivity$ = "10" THEN
 vrms! = fracfs! * .01
ELSEIF sensitivity$ = "11" THEN
 vrms! = fracfs! * .03
ELSEIF sensitivity$ = "12" THEN
 vrms! = fracfs! * .1
ELSEIF sensitivity$ = "13" THEN
 vrms! = fracfs! * .3
ELSEIF sensitivity$ = "14" THEN
 vrms! = fracfs! * 1!
ELSEIF sensitivity$ = "15" THEN
 vrms! = fracfs! * 3!
ELSE
 PRINT "PAR 5209: unknown sensitivity recieved"
END IF

'Message for debugging
'PRINT "DEBUG, Vrms = "; vrms!; " V"

END SUB

SUB par5209init

'****************************************************************************
'This subroutine initializes the PAR 5209 lock-in amplifier.
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Message
PRINT
PRINT "Resetting the PAR 5209 lock-in amplifier..."

'Clear the lock-in
CALL gpibclrdev(par5209addrP$)

'Allow the front panel keys to stay in use
CALL par5209ready
CALL gpibout(par5209addrP$, "REMOTE 0")

'Turn off the gain vernier
CALL par5209ready
CALL gpibout(par5209addrP$, "G 0,0")

'Set the input sensitivity to the highest range (3 V)
CALL par5209ready
CALL gpibout(par5209addrP$, "SEN 15")

'Use an external reference
CALL par5209ready
CALL gpibout(par5209addrP$, "IE 0")

'Use F mode (fundamental) not 2F (second harmonic)
CALL par5209ready
CALL gpibout(par5209addrP$, "F2F 0")

'Set the displays to reference phase and signal strength
CALL par5209ready
CALL gpibout(par5209addrP$, "D1 0")
CALL par5209ready
CALL gpibout(par5209addrP$, "D2 1")

'Set the dynamic reserve to normal
CALL par5209ready
CALL gpibout(par5209addrP$, "DR 1")

'Set the delimiter between two numbers to comma (ASCII 44)
CALL par5209ready
CALL gpibout(par5209addrP$, "DD 44")

'Display the PAR 5209 ID
CALL par5209ready
CALL gpibout(par5209addrP$, "ID")
CALL par5209datready
CALL gpibin(par5209addrP$, msg$)
PRINT msg$

'Display the firmware version number
CALL par5209ready
CALL gpibout(par5209addrP$, "VER")
CALL par5209datready
CALL gpibin(par5209addrP$, msg$)
PRINT msg$

END SUB

SUB par5209ready

'****************************************************************************
'This subroutine is used to verify that the 5209 is done processing a command
'and is ready for the next command.  It checks the serial poll bits and
'waits until the 5209 is ready for the next command.
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(par5209terminP$, par5209termoutP$)

'Check the status until the 5209 is ready for a command
WHILE 1

 'Perform a serial poll on the 5209
 CALL gpibspoll(par5209addrP$, spoll$)

 'Message for debugging
 'PRINT "DEBUG, Ready, Spoll = "; spoll$

 'Convert spoll$ to an integer
 spoll% = VAL(spoll$)

 'Print a message if an error is detected
 IF (spoll% AND 1) = 1 THEN
  'OK, command done
 ELSEIF (spoll% AND 2) = 2 THEN
  PRINT "PAR 5209 READY, invalid command received"
 ELSEIF (spoll% AND 4) = 4 THEN
  PRINT "PAR 5209 READY, parameter error"
 ELSEIF (spoll% AND 8) = 8 THEN
  PRINT "PAR 5209 READY, reference channel UNLOCKED"
 ELSEIF (spoll% AND 16) = 16 THEN
  PRINT "PAR 5209 READY, overload"
 ELSEIF (spoll% AND 32) = 32 THEN
  'OK, external trigger
 ELSEIF (spoll% AND 64) = 64 THEN
  'OK, SRQ
 ELSEIF (spoll% AND 128) = 128 THEN
  'OK, output ready
 END IF

 'See if we are ready for a new command
 'Bit 0 true (1) means ready, command done
 IF (spoll% AND 1) = 1 THEN
  EXIT SUB
 ELSE
  SLEEP 1
 END IF

'End while loop
WEND

END SUB

SUB par5209setpar (gpibinf%, gpiboutf%, par5209addr$)

'****************************************************************************
'This subroutine sets parameter values for the PAR 5209 lock-in amplifier.
'
'Input:
' gpibinf%, GPIB input file number
' gpiboutf%, GPIB output file number
' par5209addr$, the PAR5209 GPIB address in a string
'
'Zachary Wolf
'3/12/96
'****************************************************************************

'Make sure all GPIB parameters have reasonable values
IF gpibinf% < 0 OR gpibinf% > 100 THEN
 PRINT "PAR5209: GPIB problem"
 EXIT SUB
END IF

IF gpiboutf% < 0 OR gpiboutf% > 100 THEN
 PRINT "PAR5209: GPIB problem"
 EXIT SUB
END IF

IF par5209addr$ = "" THEN
 PRINT "PAR5209: GPIB problem"
 EXIT SUB
END IF

'Place the parameters in the local common block for future use
gpibinP% = gpibinf%
gpiboutP% = gpiboutf%
par5209addrP$ = par5209addr$

END SUB