C**************************************************************************
C*
C* WDS.FOR PROGRAM TO DATA ACQUISITION FROM X-RAY FLUORESCENCE 
C* SPECTROSCOPE BY RADIX DATABOX
C*
C* AUTOR: S.I. ZDZIESZYNSKI
C*        FEB-93
C*
C**************************************************************************
        IMPLICIT NONE
	COMMON /RADIXC/ INBUF
        COMMON /RADIX/ ICHAN,IOSB
        CHARACTER DEVICE*7
	CHARACTER*255 INBUF,OUTBUF
	INTEGER*4 SYS$ASSIGN, ISTAT,TIMEOUT,NPTS,TIMWAIT
        INTEGER*4 IERR(5),NPOITS,INT,NUM(10000),ITIME,NTIME,IQ
        REAL*4 RSTART,REND,RSTEP,THETA(10000),RTIME,YOBS,DATM,TIMM
        INTEGER*2 ICHAN,IOSB(4),NCHAR,I,K,J,L,NDIGIT,LREP,RUNSTAT,Q
	CHARACTER*512 BUFFER  ! alows to set max count time 23 sec.
        CHARACTER*6 ANGLE,START,END,STEP
        CHARACTER*4 CTIME
        CHARACTER TIM*8,DAT*9
        CHARACTER FILOUT*14 ,SLID*60,NAME*12
	PARAMETER CR=CHAR(13)
        PARAMETER QE=CHAR(63)
        COMMON /FILE/ FILOUT
        COMMON /USER/ NAME
        COMMON /SAMPLE/ SLID
        COMMON /SETUP/ RSTART,REND,RSTEP,CTIME,NDIGIT
        COMMON /DATA/ NPTS,YOBS(10000)

        DEVICE='LTA338:'

        RUNSTAT=0
C
C  *** Set screen
C
        CALL TITLE
        CALL SIDE2(START,END,STEP,CTIME,NDIGIT)
        CALL GTIME(DAT,TIM,DATM,TIMM)

C
C  ***  Assign a channel to the device.
C       

	IF(ICHAN.EQ.0) THEN
		ISTAT=SYS$ASSIGN(DEVICE,ICHAN,,)
		IF(.NOT.ISTAT) THEN
			IERR(5)=353
		 CALL LIB$SIGNAL(%VAL(ISTAT))
			GOTO 9001
		ENDIF
C		TYPE*,'ICHAN=', ICHAN
	ENDIF
C
C  *** SET A DATABOX (because of small buffer size of DATABOX all
c                     characters will be sent separately in to DATABOX
C
110     CALL NULL('?',1,ISTAT)
        CALL WAIT(15)   ! wait untill DATABOX will be ready to read next
                        ! character.

C  *** Check where we are
C
        IF(ISTAT.EQ.5) GO TO 300
       
        IF(ISTAT.EQ.7) GO TO 301        

        IF(ISTAT.EQ.8) GO TO 302
        GO TO 301

300       TYPE*,' *** WE ARE IN CALIBRATION COMAND MODE ***'

        CALL NULL('A',1,ISTAT) !set current angle
C         CALL WAIT(5)
        IF(ISTAT.EQ.6) CALL NULL('60.0000'//CR,8,ISTAT)
        TYPE*,' **** SETTING INITIAL VALUES FOR DATABOX ****'
C        CALL WAIT(5)
        CALL NULL('E'//CR,2,ISTAT)
        GO TO 110
301     TYPE*,'*** WE ARE IN MONITOR COMMAND MODE ***'
        CALL NULL('E'//CR,2,ISTAT)
        CALL WAIT(7)
        GO TO 110
302     TYPE*,'*** WE ARE IN EDITOR COMMAND MODE ***'


        IF(RUNSTAT.GT.0)THEN   ! for finished or abborted runs set 
                               ! DATABOX for initial parameters
        TYPE*,'SETTING INITIAL POSITION'
        IF(RUNSTAT.EQ.1) CALL NULL('PU'//CR,3,ISTAT) !undefine previous 
                                                     !sentence
        
        IF(RUNSTAT.EQ.2)CALL NULL('U'//CR,2,ISTAT) !undefine aborted
                                                   !sentence
        CALL NULL('E'//CR,2,ISTAT)
        CALL NULL('C'//CR,2,ISTAT)
        CALL NULL('G',1,ISTAT)
        CALL NULL('60.00'//CR,6,ISTAT) ! move goniometer to 60.00 deg.
        GO TO 9003
        ENDIF
C
C  *** SET PARAMETERS FOR RUN
C
        CALL NULL('I',1,ISTAT)
   
        CALL NULL(START//CR,7,ISTAT)  ! starting ange
        CALL WAIT(2)
    
        CALL NULL('F',1,ISTAT)
        CALL NULL(END//CR,7,ISTAT)    ! ending angle
        CALL WAIT(2)
        CALL NULL('S',1,ISTAT)
C        IF(ISTAT.EQ.1)
        CALL NULL(STEP//CR,7,ISTAT)   ! 2-theta step
        CALL WAIT(2)
        CALL NULL('C',1,ISTAT)        
C        IF(ISTAT.EQ.1) 
        CALL NULL(CTIME//CR,NDIGIT+1,ISTAT)    !count time

        DECODE(6,311,START)RSTART    !decode characters to real values
        DECODE(6,311,END)REND
        DECODE(6,311,STEP)RSTEP
        DECODE(NDIGIT,318,CTIME)ITIME
311     FORMAT(F6.3)
318     FORMAT(I)

        CALL WAIT(5)
C
C  ***  start DATABOX
C
319        CALL NULL('E'//CR,2,ISTAT)
        CALL NULL('?',1,ISTAT)
        CALL WAIT(7)
        IF(ISTAT.EQ.8) GO TO 319
        
        IF(ISTAT.EQ.7) THEN
322        CALL NULL('S'//CR,2,ISTAT)
        TYPE*,'**** SENDING STARTING COMMAND ****'
        IF(ISTAT.NE.1) GO TO 322
        ENDIF

        NPOITS=INT((REND-RSTART)/RSTEP+0.5)+1
        NPTS=NPOITS

        TYPE*,'NUMBER OF MEASUREMENT POINTS:',NPTS
C        TYPE*,'TIME=',ITIME
        TIMEOUT=INT(ITIME)+3
C        TYPE*,'TIMEOUT=',TIMEOUT,'NDIGIT=',NDIGIT


        NTIME=(ITIME-1)*22        

316	CALL READ( BUFFER,NCHAR, ISTAT,TIMEOUT)
        TYPE*,'**** MOVING GONIOMETER TO ',START,'deg. ****'
C        TYPE*,'ISTAT=',ISTAT,'[',BUFFER,']'
        IF(NCHAR.EQ.0 .AND. ISTAT.EQ.-1) GO TO 316 

C       THROW AWAY A HEADER

317	CALL READ( BUFFER,NCHAR, ISTAT,TIMEOUT)

        TYPE*,'NCHAR=',NCHAR
        DO J=1,NCHAR
C        TYPE*,'BUFFER(J:J)=',BUFFER(J:J)
        
        IF(BUFFER(J:J).EQ.CHAR(42)) THEN
        I=1
        GO TO 312
        ENDIF
        IF(J.EQ.NCHAR) GO TO 317
        ENDDO

        I=1


312     IF(NPOITS.NE.0) THEN    
        J=INDEX(BUFFER(1:NCHAR),'.')
        L=INDEX(BUFFER(1:NCHAR),'*')
        K=INDEX(BUFFER(1:NCHAR),'|')
C        TYPE*,'INDEX ".":',J
C        TYPE*,'INDEX "|":',K
C        TYPE*,'INDEX "*":',L

C        TYPE*,'BUFFER:[',BUFFER(1:NCHAR),']'
C        TYPE*,'BUFFER:[',BUFFER(J-27-NTIME:J),']'
        
        READ(BUFFER(J-9:J-3),'(I5)') NUM(I)
        READ(BUFFER(J-3:J+4),'(G8.0)') THETA(I)
 
        IF(K.EQ.0 .OR. L-28-NTIME.EQ.0) THEN 
        READ(BUFFER(L-7:L-2),'(G6.0)') YOBS(I)
C        TYPE*,'MARKER "*" =(0) STATUS=',L-28-NTIME        
        GO TO 332
        ENDIF
        IF(K.NE.0 .OR. L-28-NTIME.NE.0) THEN
330     READ(BUFFER(K-7:K-2),'(G6.0)') YOBS(I)
C        TYPE*,'MARKER "*" <OR>(0) STATUS=',L-28-NTIME
        ENDIF
332     TYPE 320,NUM(I),THETA(I),YOBS(I)
320     FORMAT(' STEP#:',I4,2X,'2THETA:',F8.3,2X,'INTENSITY:'F10.2)



        NPOITS=NPOITS-1
        I=I+1
C            
C        TYPE*,'*** READ NCHAR=',NCHAR,'ISTAT=',ISTAT
C        TYPE*,'*** READ BUFFER:[',BUFFER,']'
	CALL READ( BUFFER,NCHAR, ISTAT,TIMEOUT)
C        TYPE 1003,I-1,YOBS(I-1)
C1003    FORMAT( ' MEASURED YOBS(',I4,')=',F10.1)


        GO TO  312
        ENDIF
        RUNSTAT=1     !run finished O.K.
        TYPE*,'           ******* RUN COMPLITED O.K. *******'
C        YOBS(0)=0.0
C        DO I=1,NPTS
C        YOBS(I)=YOBS(I-1)+1.0
C        TYPE 1002,I,YOBS(I)
C1002    FORMAT(' CALCULATED YOBS(',I4,')=',F10.1)
C        ENDDO
       CALL WRW5000(DATM,TIMM)
        CALL WAIT(10)
        GO TO 9002
9001    RUNSTAT=2     !run abborted
        TYPE*,'                         ******* ABORT ******* '
9002    GO TO 110
9003    STOP
	END

	SUBROUTINE NULL( OUTBUF, NCHAR, ISTAT)
C *** Program to setup the DATABOX
	IMPLICIT NONE
C  Interface specific common blocks.
	INCLUDE 'INTERFACE.COM'
	CHARACTER*(*) OUTBUF
	COMMON /RADIXC/ INBUF
	CHARACTER*255 INBUF
        INTEGER*2 NCHAR
	PARAMETER TIMEOUT=3	! 3 use at least 2 seconds
	INTEGER*4 SYS$QIOW, ISTAT, I,L,J, MASK(2)
	DATA MASK /0,7/   !/0,129/	! Terminator mask.
C
C  Get a parameter definitions for system codes.
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
C

C        TYPE*,' **** SUBROUTINE NULL ****'
C  Send the characters one at a time.
1      DO 30, I=1,NCHAR
	IF(OUTBUF(I:I).EQ.' ') GOTO 30
C
C  Send the character and wait for a Null.
	ISTAT = SYS$QIOW( , %VAL(ICHAN),
	1	%VAL( IO$_READPROMPT+IO$M_NOECHO+IO$M_TIMED+IO$M_PURGE ),
	2	IOSB, , ,
	3	%REF(INBUF), %VAL(255), %VAL(TIMEOUT), MASK, 
	4	%REF(OUTBUF(I:I)), %VAL(NCHAR) )
        
C        TYPE*,'NULL NCHAR:',NCHAR,'IOSB(2)=',IOSB(2)       
C        TYPE*,'NULL OUTBUF:[',OUTBUF,']'
C        TYPE*,'NULL INBUF:[',INBUF,']'

        DO L=1,255
        IF(INBUF(L:L+4).EQ.'CALIB') ISTAT=5
        IF(INBUF(L:L+5).EQ.'*Angle')ISTAT=6 
        IF(INBUF(L+7:L+NCHAR).EQ.'40.000')ISTAT=4
        IF(INBUF(L:L+4).EQ.'MONIT') ISTAT=7
        IF(INBUF(L:L+5).EQ.'EDITOR')ISTAT=8
        IF(INBUF(L:L+4).EQ.'*Init') ISTAT=9
        IF(INBUF(L:L+5).EQ.'*Final')ISTAT=10
        IF(INBUF(L:L+4).EQ.'*Step') ISTAT=11
        IF(INBUF(L:L+5).EQ.'*Count')ISTAT=12
        ENDDO
        GO TO 100
30    CONTINUE
100   TYPE*,' ****  STATUS =',ISTAT,'    ****'
      RETURN
      END

	SUBROUTINE READ( BUFFER, NCHAR, ISTAT, TIMEOUT)
C  Programmer: Jim Walker, Aug 1987.
C  This is for a VAX listening to a RADIX DATABOX.
C  Reads characters the terminal on ICHAN into INBUF
C  and waits up to TIMEOUT seconds for a terminator.
C  NCHAR returns number of characters.
C  ISTAT returns QIO error code or -2 if line ended with return.
C  ISTAT = -1 for timeout error or -3 for data overrun
C  ISTAT = 1 if terminator was Null (interface ready for input).
C  Terminators for read will be Null and Return (^@ and ^M)
C
	IMPLICIT NONE
	CHARACTER*(*) BUFFER
	INTEGER*4 SYS$QIOW, ISTAT, MASK(2), TIMEOUT
        INTEGER*4 NUM  !,IOSB(4)
        INTEGER*2 NCHAR   ,I,J,L
	DATA MASK/0,8193/	! Terminator mask.
	INCLUDE 'INTERFACE.COM'
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'

C        TYPE*,'TIMEOUT=',TIMEOUT
C
C  Read the data and wait for a Null or Return.
	ISTAT = SYS$QIOW( , %VAL(ICHAN),
	1	%VAL( IO$_READVBLK+IO$M_NOECHO+IO$M_TIMED ),
	2	IOSB, , ,
	3	%REF(BUFFER), %VAL(LEN(BUFFER)), %VAL(TIMEOUT),MASK, 
	4	,  )
C
C  If there was a "directive error" then signal it and bail out.
	IF(.NOT.ISTAT) THEN
		IF(DEBUG) CALL LIB$SIGNAL(%VAL(ISTAT))
		GOTO 99
	ENDIF
C
C  Now we only worry about I/O errors.
	IF(ISTAT) ISTAT=IOSB(1)
C
C  If there was an input error other than timeout then bail out.
	IF(IOSB(1).EQ.SS$_TIMEOUT) THEN
		ISTAT = -1
	ELSEIF(IOSB(1).EQ.SS$_DATAOVERUN) THEN
		ISTAT = -3
	ELSEIF(.NOT.IOSB(1)) THEN
		IF(DEBUG) CALL LIB$SIGNAL(%VAL(IOSB(1)))
		GOTO 99
C
C  If Return character was recieved than exit with ISTAT=-2.
	ELSEIF(IOSB(3).EQ.13) THEN
	   ISTAT = -2
	ENDIF
C
C  In debug mode print data recieved from interface.
	IF(DEBUG) THEN
	   IF(IOSB(1).EQ.SS$_TIMEOUT) TYPE*,' Timeout'
	   TYPE *,'"',(BUFFER(J:J),J=1,IOSB(2)),'"'
14	   FORMAT(' ',72A1,'-')
	ENDIF
C
C All done here, go back to main program.
C
99    NCHAR=IOSB(2)
C      TYPE*,' SUB. READ IOSB(2)=',IOSB(2),'NCHAR=',NCHAR

      IF(DEBUG) TYPE*,' READ ISTAT=',ISTAT,' NCHAR=',NCHAR
      RETURN
      END
      SUBROUTINE WAIT(WAITIME)
C  *** Program to slow dawn execution when DATABOX is not ready to
c      read new command
      INTEGER WAITIME,DELTA
      TYPE 1,WAITIME
1     FORMAT(////,'     **** DATABOX IS WORKING, WAIT',I3,' sec. ' 
     &' ****')
      TS=SECNDS(0.0)
2     DELTA=SECNDS(TS)
      IF(DELTA.LT.WAITIME) GO TO 2
      RETURN
      END
