[comp.sys.hp] Spectrometer Troubles

duchow@watnxt1.ucr.edu (John Duchowski) (05/08/91)

Hi,

    This is probably a long shot, but I'm desperate, so here it goes.  For
the last week I have been trying to get our HP9000 series 300 to talk to
a Varian DMS 100 Spectrophotometer.  The connection is over HPIB where the
DMS 100 becomes the system controller.  There appear to be several problems
invloved which are:

    1. The DMS does not respond correctly to the commands issued from the
       300.  I have artificially shut down the error response which seems
       to work, but I am not happy about this idea.

    2. As a consequence of (1), I seem to be loosing one data point on
       transfer.  The DMS 100 transfer photometric data for a given wavelength
       interval; if the interval is < 150 nm the points are at every 0.05 nm,
       for larger intervals, the points are at every 0.2 nm.  At the moment
       I am trying to smear that one point over the entire interval which
       is a better solution from sceintific point of view but worse compu-
       tationally as the array indeces "sometimes" are out of sync.

    3. The main problem is that not all data appears to get transferred.  At
       shorter intervals, things seem OK, but at larger ones what appears to
       be a totally arbitrary cut off seems to be taking place.  The reason
       for this is that the DMS is supposed send a signal indicating the end
       of data transfer and is not doing that, so the collection ends once
       the array is filled - ON ERROR goto NO ERROR solution again :-( and
       the size of the array is determined by looking at the starting and
       ending wavelengths.

Finally, I must confess that my knowledge of HP BASIC and IEEE interfacing
at the moment is rudimentary at best.  I was therefore wondering if anyone
out there might be able to spot the problem or come up with a better way of
doing things.  Any hints and/or comments will be greatly appreciated.  Thank
you !

                                        - John

==============================================================================
1     !RE-STORE "DMS100_310"
10    !This is program DMS100_310
20    !It transfers data directly from the Varian DMS100 UV/VIS
30    !absorption spectrophotometer to an HP310 microcmputer
40    !via an HPIB interface
41    !**********************************************************
42    !
43    !                 CAUTION
44    !When using this program make sure the IEEE cable between the
45    !spctrophotometer and the computer is not connected until after
46    !this program is running.
47    !
48    !
50    ABORT 7
51    RESET 7
57    STATUS 7,3;Old_address
58    CONTROL 7,3;5
59    STATUS 7,3;Address
69    OPTION BASE 1
70    DEG
71    DIM M$[88],Tr$[88],Array(4000,2),Dat$(4000)[4],Pp$[4],C(19),A(19)
72    DIM Y(4000),Stat$[88],H1$[80],H2$[80]
76    INTEGER Npts,Stopts,Mcol
77    Mcol=2
78    PASS CONTROL 709       !Control of the bus has been passed to the DMS100
79    BEEP 
80    PRINT "Ready to capture trace buffer from DMS100"
81    PRINT "Connect IEEE cable and then press  [CONT]."
82    PAUSE
83    N$="ECD"         !E=Talker identity, in this case computer at 705
84                     !C=Command follows
85                     !D=tells DMS to report current opperating parameters
86    CALL Cksum(N$,Cs$)
87    M$=N$&Cs$
88    STATUS 7,7;X
89    PRINT "Status 7 before request is";IVAL$(X,2)
90    STATUS 7,6;X
91    PRINT "Status 6 before request is";IVAL$(X,2)
99    REQUEST 7;73     !Set SRQ line high (64) to tell DMS that computer wants
100                    !to talk and say it wants to talk to DMS (address 9).
101   STATUS 7,7;X
102   PRINT "Status 7 after request is ";IVAL$(X,2)
103   STATUS 7,6;X
104   PRINT "Status 6 after request is ";IVAL$(X,2)
105   OUTPUT 7;"ECD"&Cs$ END
108   ON ERROR GOTO 111
109   OUTPUT 7;"1"
110   GOTO 113
111   OFF ERROR 
113   STATUS 7,7;X
114   PRINT "Status 7 after output is ";IVAL$(X,2)
115   STATUS 7,6;X
116   PRINT "Status 6 after output is ";IVAL$(X,2)
119   ENTER 7;Stat$    !Get response from DMS100
120   STATUS 7,7;X
121   PRINT "status 7 after enter is ";IVAL$(X,2)
122   STATUS 7,6;X
123   PRINT "status 6 after enter is ";IVAL$(X,2)
125   DISP Stat$
127   W2=(NUM(Stat$[20,20])+256*NUM(Stat$[21,21]))/20  !Starting Wavelength
128   W1=(NUM(Stat$[22,22])+256*NUM(Stat$[23,23]))/20  !Ending Wavelength
129   Tau=NUM(Stat$[25,26])
130   IF Tau=0 THEN Tau=.3                             !Time Constant
131   IF Tau=2 THEN Tau=5
132   Speed=6/(.00375*(NUM(Stat$[18,18])+NUM(Stat$[19,19])*256))
133                                                    !Scan Speed
134   Slit=NUM(Stat$[26,26])/20                        !Slit width
135   PRINT "Lower wavelength =";W1;"nm and upper wavelength =";W2
136   PRINT "Time constant =";Tau;"     Scan speed =";Speed
137   PRINT "Spectral slit width =";Slit
140   !
141   !Get data from DMS100
142   !
143   N$="ECH"                      !E= computer's address (705)
144                                 !C= Command follows
145                                 !H= Send trace buffer
146   CALL Cksum(N$,Cs$)
147   M$=N$&Cs$
148   REQUEST 7;73
149   OUTPUT 7;M$;END
150   ON ERROR GOTO Skip
151   OUTPUT 7;"1"
152   GOTO 155
154 Skip:  OFF ERROR 
155   J=0
156   ON ERROR GOTO Last_one
157 Dat_in:  ENTER 7;Tr$
158        ! PRINT Tr$
160          An$=Tr$[1,3]
162          IF An$="INH" THEN 
163          BEEP 
164             PRINT An$
165             GOTO Last_one
166             END IF
167          FOR I=1 TO 16
168             J=J+1
169             Dat$(J)=Tr$[4*I,4*I+3]
171          NEXT I
172          GOTO Dat_in
173 Last_one:  OFF ERROR 
174            PRINT J-1;" data transferred"
175          Npts=J-2
176          Stp=(W2-W1)/(Npts-1)
177         !Add1=0
178         !IF Stp<.1 AND Stp<>.05 THEN
179         !Stp=.05
180         !Npts=(W2-W1)/Stp+1
181         !Add1=1
182         !END IF
183         !IF Stp>.1 AND Stp<>.2 THEN
184         !Stp=.2
185         !Npts=(W2-W1)/Stp+1
186         !END IF
187          PRINT Npts
188          PAUSE
190          REDIM Array(Npts,2),Y(Npts)
191          FOR I=1 TO Npts!-Add1
192          Pp$=Dat$(I)
193          CALL Sttofp(Pp$,X,I)
194          Array(I,2)=X
195          Array(I,1)=W2-(I-1)*Stp
197          NEXT I
198          FOR I=1 TO Npts
199          Array(I,2)=-LGT(Array(I,2))
200          NEXT I
202          PRINT "UNPLUG IEEE CABLE THEN PRESS CONTINUE"
203          PAUSE
204          RESET 7
205          INPUT "NAME TO STORE THE DATE",Name$
206          CREATE BDAT Name$,(160+Npts*Mcol*16)/256+1
207          ASSIGN @Out TO Name$
209          H2$=VAL$(W1)&VAL$(W2)&VAL$(Tau)&VAL$(Speed)
210          INPUT "HEADER",H1$
211          OUTPUT @Out;H1$,H2$,Npts,Mcol,Array(*)
212          ASSIGN @Out TO *
213          CALL Plot_it(Array(*))
214   END
215   !***********************************************************
216   !***********************************************************
217   !***********************************************************
218 Cksum:  SUB Cksum(N$,Cs$)  !Compute checksum for data to be sent to DMS100
219         Total=0
220         FOR J=1 TO LEN(N$)
221         Total=Total+NUM(N$[J])
222         NEXT J
230         Totla=Total-INT(Total/256)*256
240         Total=256-Total
250         Cs$=CHR$(Total)
260         SUBEND
270   !************************************************************
280   !************************************************************
290   !************************************************************
300 Sttofp:  SUB Sttofp(Pp$,X,I)   !Coverts floating point numbers to
310                                !to its decimal equivalent.
311          ON ERROR GOTO Fudge
320          Rr=(NUM(Pp$[1,1])/256+NUM(Pp$[2,2]))/256   !this bombs unless
330          Ee=NUM(Pp$[4,4])                           ! Npts = J-2 ?!
340          IF Ee>127 THEN Ee=Ee-256
350          Sn=1
360          IF BIT(NUM(Pp$[3,3]),7) THEN Sn=-1
370          X=Sn*Rr*2^Ee
371          GOTO 380
373 Fudge:         BEEP 
374                PRINT "WHAT IS GOING ON?!"
376                PRINT I,Pp$
377                PAUSE
380          SUBEND
390!
400! Plotting subroutine deleted for brevity