	PROGRAM RADIXMES	!jdw03
C++
C	Programmer: MK
C	Date: 26/11/85
C++
C++	Purpose: DATACOLLECTION PROGRAM FOR THE DIFFRAC 500 SOFTWARE SYSTEM
C++              VIA A DACO-MP INTERFACE
C++
C++	the exit statuses have been modified to be compatable with
C++	the res of the diffrac 500 project with a STATUS of 1 to be
C++	successful completion and all of the rest to be in error
C++
C++           Overview of the RESFLG function :
C++
C++                 3            1          0
C++                 |            |          |
C++                 |            |          |
C++                 |            |          |
C++		+-----------------------+   |
C++		| angle synchronization |   |
C++		|                       |   | 
C++		+-----------------------+   |
C++                                         |
C++                 3            1          |
C++                 |            |          |
C++                 |            |          |
C++                 |            |          |
C++		+-----------------------+   |
C++		| reset samplechanger   |   |
C++		| ( SR SAMP0 )          |   | 
C++		+-----------------------+   |
C++                                         |
C++			   *                |
C++			   *                |
C++		  doing the measurement     | 
C++			   *                |
C++			   *                |
C++			   *                |
C++                 3            2          | 
C++                 |            |          |
C++                 |            |          |
C++                 |            |          |
C++		+-----------------------+   |
C++		| reset samplechanger   |   |
C++		| ( SR SAMP0 )          |   |
C++		+-----------------------+   |
C++
C++
C++	References:
C++
C++	 CHKMCA	 CLORAW	 CLOS$	 CLOXRY	 CLWIND	 CORANG	 
C++	 DACTYP	 DATCOD	 DATE	 DCMD	 DELFIL	 DEVATA	 
C++	 DPMLUN	 D500IN	 D501IN	 ERRDPM
C++	 ERRMSG	 EXST	 GETMCR	 INITER	 INWIND	 MCAMES	 
C++	 MCASET	 MEAS	 MESSET	 MMFIND	 NEXSAM	 OPNDEF	 
C++	 OPNSCR	 OPSCR1	 OPSYS	 OPWIND
C++	 RANREA	 RAWCHK	 RAWDER	 RAWHED	 RAWHEW	 RAWINC	 
C++	 RAWOPN	 RAWSPR	 RAWSPW	 RAWTER	 RDFLGS	 RDSTAT	 
C++	 REAKEY	 REAPAR	 SAMP0	 SLEEP
C++	 STACHK	 STFLGS	 STMOPT	 TAG	 TIMCOD	 TIME	 
C++	 TRANSL	 VARRES	 XRDREA	 XRDREH	 XRYCHK	 XRYHED	 XRYOPN
C++
C++	Enviroment:
C++	Computer system: PDP11
C++	Operating system: RSX11M V4.1E
C++	Language: FORTRAN 77 V5.0
C++	Application: DIFFRAC 500
C++     Application (program) : DPMES
C++
C	Modifications
C	Who	date	what
C
C	MK      21/1/87 ADAPTION TO THE F77-DRIVERS FOR THE DACO-MP
C			AND THE INTERRUPT PROCEDURE OF THE JCT.
C			FURTHERMORE INCLUDE: DPMES>TYPE S TO START
C	DJH01	11FEB87	add code for O scan, add vpar D9
C	DJH02	9JUN87	some of the code was not going down far enough
C			on an error condition after the sample is
C			opened.  A file that would error out for
C			being measured would actually be set for not
C			measured upon exit!
C	JDW01	13JUL87	Add quant logic to latest data collector
C	JDW02	17JUL87 Open shutter before starting quant optimization pass
C	DJH03	3SEP87	UPGRADE THE TASK FOR THE  INTERRUPT FEATURE
C	DJH04	30SEP87 SPECIAL UPGRADE FOR VMS EDITION TO TURN OFF SHARED
C			ACCESS
C	DJH05	19OCT87	upgrade for new type s to start
C			Write type s to start out on ispol
C	DJH08	20OCT87	turn off share priv
C	DJH09	21OCT87	upgrade the error handeling procedure and communications
C			file deletion procedure
C
C	DJH10	23OCT87	modify type s to start to use logicals
C	DJH11	6NOV87	change shutter control operation
C	jdw03	11NOV87	Modify DPQNT for RADIXMES at NBS.
C
C===============================================================================
C
C                    GENERAL COMMON-BLOCKS
C
	INCLUDE '[102,2]INP.COM/NOLIST'    ! ADAPTION TO VAX/VMS MK 29/4/87
	INCLUDE '[102,2]TALK.COM/NOLIST'
	INCLUDE '[102,2]IOBLK.COM/NOLIST'  ! carry all LUNs
	INCLUDE '[102,2]ERRBLK.COM/NOLIST' ! carry error parameters
	INCLUDE '[102,2]SYSTEM.COM/NOLIST' ! carry system parameters
C
C                   COMMON-BLOCKS FOR XRAY.XRY & XRYnnL.XRY
C
	INCLUDE '[102,2]XRDDIF.COM/NOLIST' ! softw. related data from XRDnnL.XRD
	INCLUDE '[102,2]XRDHDW.COM/NOLIST' ! hardw. related data from XRDnnL.XRD
	INCLUDE '[102,2]XRYDES.COM/NOLIST' ! specific information from XRAY.XRY
C
C                   DPMES SPECIFIC COMMON-BLOCKS
C
	INCLUDE '[102,7]DPMES1.COM/NOLIST' ! carry DACO-MP specific variables
	INCLUDE '[102,7]DPMES2.COM/NOLIST' ! carry some useful parameters
	INCLUDE '[102,7]DPMES3.COM/NOLIST' ! carry the units for the MCA & HTC
	INCLUDE '[102,7]DPMES4.COM/NOLIST' ! carry the parameters for MCA measm.
C
C	            RAW-DATA FILE COMMON-BLOCKS
C
	INCLUDE '[102,2]RAWDES.COM/NOLIST' ! carry info. of the descript. block
	INCLUDE '[102,2]RAWSPC.COM/NOLIST' ! carry pointers and lengths
	INCLUDE '[102,2]RAWLIN.COM/NOLIST' ! carry measurement parameters
	INCLUDE '[102,2]EXPBLK.COM/NOLIST' ! carry experimental parameters
C
C		OTHER COMMONS
C
	COMMON /ERSTAT/IER
	COMMON /MBXCHA/MBXCOM		!DJH03
	INTEGER*2	MBXCOM
C
C
C	special for the type s to start djh08  VMS ONLY
C
	INCLUDE 	'($PRVDEF)/NOLIST'
	INCLUDE 	'($DVIDEF)/NOLIST'				!DJH10
	INTRINSIC	MOD
C
	INTEGER*4	LONG,LIB$GETDVI					!DJH10
	INTEGER*4	VSTATUS,SYS$SETPRV,LIB$SIGNAL,PRIV_MASK(0:1)
	1		,ISUB,IPOSA
	BYTE		SST
	LOGICAL*1	ASTART,AERROR,FIRST		!DJH		!DJH11
C
	INTEGER*2 IER,OUT
C
	REAL*4		RMAX,VORH
	CHARACTER*80 	STR
	CHARACTER*6	TERMINAL
	INTEGER*2	MSCAN,MFLAG,IDUM,IS,TH,OM,ISA,IEMPTY,I1,I,LROT
	LOGICAL 	TAG,TRANSL
	INTEGER*2   	JDIFRA,IFLAG,IREC,MODE,IEXT,IPOS,RESFLG
	INTEGER*2	RESPOI
	INTEGER*2	IOUT,IVAL					!DJH10
	INTEGER*4 	WTIME
	REAL*4 		START,END,RESINC,TISPE,OFFSET,FIXANG,CHI,PHI
	REAL*4 		FIXINT,MAX,SAVMAX
	REAL*8 		TEXT
	CHARACTER*8 	TIM
	CHARACTER*9 	DAT
	INTEGER*2	STATUS
	BYTE		NULL
	CHARACTER*1	ANULL
	DATA		NULL/0/
	EQUIVALENCE	(ANULL,NULL)
C
	DATA MCAU/9/ IHTCU/10/ ISCR1/7/            ! setup the units 
C
	CALL SUSPND	!JDW03
C
	STATUS=2
	FIRST=.TRUE.
C
C	read the MCR command line 
C
	COMAND=' '                         ! init. COMAND buffer
	CALL GETMCR(COMAND,IDS)            ! RSX-system call
C
C	set up the process flags
C
	ISYSC=COMAND(5:5)
	IPROC=COMAND(6:6)
C
	PROG   ='RADIX '   !JDW03                !set the program name 
	IERR(5)= 0                         ! setup error flag
	ISCRAS = 1                         ! setup associatevariable for scratch
                                           ! file
	ISC1AS = 1			   !set up associate variable for 
					   !scratch file for mca measurement
	RESPOI = 0			   !for a measurement with an mca this
					   !pointer gives the previous reso-
					   !lution or increment
	ASTEPS = 0			   !set up counter for record # of raw
C
C=========================================================================
C
C	initialize the software error handler
C
	CALL INITER                        ! F77 ERRSET for this program
	CALL ERRDPM                        ! additional ERRSET 
C
C	handle   FILLOC.FIL and assign LUNs   
C
	CALL DPMLUN                        ! assign the LUNs for DPMES
C
C       the error messages will be put out to the error logger file
C       no user interaction will be required 
C
C	*****				******
C	 ERROR MESSAGE SYSTEM - EXECUTE PHASE
C	*****				******
C
	ERRLOG=' '
C
	ERRLOG='TI:'
	ERRLOG(4:4)=ANULL
C
C
C	check to see if the command line is in the right format if not
C	put out the error message.. the flag of 2 will display the message
C	with out a required carriage return
C
C	the format of the command line is
C
C		PGM #$DDDDFILE
C
C	where DDD is the device name and file is the file name
C
C
	IF(IDS.LE.10)THEN
		IERR(5)=68 !illegal interprocess communication command line
		CALL ERRMSG('PGMNAM',DEFILE,2,COMAND)
		STATUS=2
		GO TO 9000
	ENDIF
C
C
C	in immediate mode the error messages will be put to TI: 
C	and the user will have to enter a carriage return to continue
C
C
C	all other error messages will go to the error logger
C
	IF(IPROC.EQ.'3'.OR.IPROC.EQ.'4'.OR.IPROC.EQ.'0')THEN
C
C	 the error messages will be put out to the error logger file
C	 no user interaction will be required 
C		
	    IF(OPSYSM.EQ.'RSX ')THEN
		ERRLOG=COMAND(7:10)
		ERRLOG(5:18)=':DIF500ERR.FIL'
		ERRLOG(19:19)=ANULL
	    ELSE
		ERRLOG='SY:DIF500ERR.FIL'
		ERRLOG(17:17)=ANULL
	    ENDIF
C
C	if iproc is "0" the error messges will be placed to ti: which was
C	assigned by default above if no an error has occured
C
	ELSE IF(IPROC.NE.'0')THEN
		IERR(5)=68 !illegal interprocess communication command line
		CALL ERRMSG('PGMNAM',DEFILE,2,COMAND)
		STATUS=2
		GO TO 9000
	ENDIF
C
C	The input phase type of message system will also be used for
C	the programs that will not be run in job or model mode
C
C
	STATUS=2 ! default status to failure (of a general type)
C
C
C	There should be a variable the is CHARACTER*32 long in the 
C	main program to be used to make up the file name.
C
C
	DEFILE=' '	!initialize the file name scratch buffer
C
C
C	In the rsx environment, the device and uic will be transmitted via 
C	the comand line in positions 7 to 10
C
C	the name of the communication file has been sent via the command 
C	line starting at position 7 it can be terminate with either a 
C	null of a space
C
	IF(OPSYSM.EQ.'RSX ')THEN
		COMDEV=COMAND(7:10)
		DEFILE=COMAND(11:IDS)
	ELSE
		DEFILE=COMAND(11:IDS)
	ENDIF
C
C		END COMMUNICATIONS FORMAT
C	*************************************************
C
C
	CALL OPSYS(IUNIT)                  ! read FILLOC.FIL
	IF(IERR(5).NE.0) THEN              ! error reading info from FILLOC.FIL
		CALL ERRMSG('OPSYS ',DEFILE,1,COMAND)
		GOTO 9001
	ENDIF
C
C	DJH08  28SEP87 vms changes turn off share priv  VMS ONLY
C
	ISUB=PRV$V_SHARE/32
	IPOSA=MOD(PRV$V_SHARE,32)
	PRIV_MASK(ISUB)=IBSET(PRIV_MASK(ISUB),IPOSA)
	SST=0
	VSTATUS=SYS$SETPRV(%VAL(SST),PRIV_MASK,,)
	IF(.NOT.VSTATUS)THEN
		IERR(5)=551 !no enough priv
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)	
		STATUS=2
		GO TO 9000
	ENDIF
C
C
	IF(TAG(DEFILE,'UF:','DEF',.FALSE.,.FALSE.)) THEN ! get the filename
		CALL ERRMSG('TAG   ',DEFILE,1,COMAND)
		STATUS=3
		GO TO 9001
	ENDIF
	IF(TRANSL(DEFILE)) THEN
		CALL ERRMSG('TRANSL',DEFILE,1,COMAND)
		STATUS=3
		GO TO 9001
	ENDIF
C
C	open the DEF-file
C
	CALL OPNDEF(DEFILE,ISCR2)   ! open the file
	IF(IERR(5).NE.0) THEN
		CALL ERRMSG('OPNDEF',DEFILE,1,COMAND)
		IERR(5)=69
		CALL ERRMSG('DPMES ',DEFILE,1,COMAND)
		STATUS=3
		GO TO 9001
	ENDIF
C
C	now read in the vpars
C
	CALL REAPAR(ISCR2,LENFPA,LENVPA,VPAR)
	IF(IERR(5).NE.0)THEN
		CALL ERRMSG('REAPAR',DEFILE,1,COMAND)
		STATUS=3
		CLOSE(UNIT=ISCR2,DISPOSE='DELETE')			!DJH09
		GO TO 9001						!DJH09
	ENDIF
	RAWFIL=' '
	STR=' '
	CALL REAKEY(VPAR,'F1=',STR,ILEN)
	IF(ILEN.EQ.-1)THEN
		IERR(5)=190  !keyword not found
		CALL ERRMSG('DPMES ',DEFILE,1,COMAND)
		STATUS=3
		CLOSE(UNIT=ISCR2,DISPOSE='DELETE')			!DJH09
		GO TO 9001						!DJH09
	ENDIF
	RAWFIL=STR(1:ILEN)
C
C	determine the sample position
C
	IPOS=0
	STR=' '
	CALL REAKEY(VPAR,'P1=',STR,ILEN)
	IF(ILEN.EQ.-1.OR.ILEN.EQ.0)THEN				!DJH01
		IPOS=0
	ELSE IF(ILEN.GT.2)THEN					!DJH01
		IERR(5)=352
		CALL ERRMSG(STR(1:6),DEFILE,1,COMAND)
		STATUS=3
		CLOSE(UNIT=ISCR2,DISPOSE='DELETE')			!DJH09
		GO TO 9001						!DJH09
	ELSE
		READ(STR(1:ILEN),'(BN I2)',ERR=8751)IPOS	!DJH01
		IF(IPOS.LE.0)IPOS=0
	ENDIF
C
C	determine the reset flag
C
	STR=' '
	CALL REAKEY(VPAR,'RF=',STR,ILEN)
	IF(ILEN.EQ.-1)THEN
		RESFLG=3
	ELSE
		READ(STR(1:ILEN),'(BN I2)',ERR=8751)RESFLG		!DJH01
		IF(RESFLG.LT.0.OR.RESFLG.GT.4)THEN
			RESFLG=3
		ENDIF
	ENDIF
C
C	determine the fixed intensity
C                                         ! read fixintensity for online-plot
C                                         ! FIXINT = e.g. 5000. (fix int.)
C                                         ! FIXINT = 0.         (auto scaling)
C                                         ! FIXINT = -1.        (no onlineplot)
C
	STR=' '
	CALL REAKEY(VPAR,'HL=',STR,ILEN)
	IF(ILEN.EQ.-1)THEN
		FIXINT=0
	ELSE
		READ(STR(1:8),'(BN F8.1)',ERR=8751)FIXINT
	ENDIF
C
C
C	check to see which terminal is to be used for i/o
C
	STR=' '
	CALL REAKEY(VPAR,'TZ=',STR,ILEN)
C
C
	IF(ILEN.LE.0)THEN						!DJH10
		STR=' '							!DJH10
		LONG=DVI$_DEVNAM					!DJH10
		VSTATUS=LIB$GETDVI(%REF(LONG),				!DJH10
	1		,						!DJH10
	1		%DESCR('SYS$INPUT'),				!DJH10
	1		,						!DJH10
	1		%DESCR(STR),					!DJH10
	1		IOUT)						!DJH10
		IF(.NOT.VSTATUS)THEN					!DJH10
			IERR(5)=579 ! can not get terminal from system	!DJH10
			CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)		!DJH10
			GO TO 99999					!DJH10
		ENDIF							!DJH10
		IVAL=INDEX(STR(1:80),'_')				!DJH10
		IVAL=IVAL+1						!DJH10
		IOUT=INDEX(STR(1:80),':')				!DJH10
		IF(IOUT.EQ.0)THEN					!DJH10
			IERR(5)=579 ! can not get terminal from system	!DJH10
			CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)		!DJH10
			GO TO 99999					!DJH10
		ENDIF							!DJH10
		IF(STR(IVAL:IVAL+1).EQ.'NL')THEN			!DJH10
			IERR(5)=579 ! can not get terminal from system	!DJH10
			CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)		!DJH10
			GO TO 99999					!DJH10
		ENDIF							!DJH10
		IF(IVAL.GT.0)THEN					!DJH10
			TERMINAL=STR(IVAL:IOUT)				!DJH10
		ELSE							!DJH10
			IERR(5)=579 ! can not get terminal from system	!DJH10
			CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)		!DJH10
			GO TO 99999					!DJH10
		ENDIF							!DJH10
	ENDIF
C
C	the number entered is octal
C
	CALL ASSIGN(ISPOL,STR(1:6),6)	!VMS				!DJH10
	TERMINAL=STR(1:6)						!DJH10
C
C	close the communications file
CC    jdw03  Comment out this line here and move it to below "CALL RADIXCTR"
CC	CLOSE(UNIT=ISCR2,DISPOSE='DELETE')			!DJH09 jdw03
C
	CALL RAWCHK                       ! check the RAW-file name
	IF(IERR(5).NE.0)THEN
		CALL ERRMSG('RAWCHK',RAWFIL,1,COMAND)
		STATUS=3						!DJH09
		GO TO 9002	
	ENDIF
C
C	open the RAW-data file
C
	CALL RAWOPN('U')                   ! open it non-shared
	IF(IERR(5).NE.0) THEN              ! error
		CALL ERRMSG('OPNRAW',RAWFIL,1,COMAND)
		STATUS=3						!DJH09
		GOTO 9001
	ENDIF
	IUNIT=IRAW                         ! necessary for RAWHED !!!
	CALL RAWHED                        ! read header info
	IF(IERR(5).NE.0) THEN              ! error
		CALL ERRMSG('RAWHED',RAWFIL,1,COMAND)
		STATUS=3						!DJH09
		GOTO 9000						!DJH02
	ENDIF
C
C	file already measured ? allow the use of the overwrite flag
C
	IF(MESFLG.EQ.0) THEN               ! sample not measured
		GOTO 10	           
	ELSE IF(IOVER.EQ.1.AND.MESFLG.NE.2)THEN		!djh01
		GO TO 10
	ELSE                               ! sample measured
		IERR(5)=52			
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		STATUS=3						!DJH09
		GOTO 9000						!djh02
	ENDIF 
C
C	check the position number
C
C	 MARK THE SAMPLE AS MEASUREMENT IN PROGRESS
C
10	MESFLG=2                    ! sample complete measured
	CALL RAWHEW                 ! use subroutine to write out
	IF(IERR(5).NE.0)THEN
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GO TO 99999
	ENDIF
C
	IF(IPOS.GT.40.OR.IPOS.LT.0) THEN
		IERR(5)=91		
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999		
	ENDIF
	IF(IPOS.EQ.0) GOTO 30              ! normal holder
	DO 20 I1=1,2
		IF(IPOS.EQ.BLKPOS(I1)) THEN ! check blocked positions of sample-
                                           ! changer
			IERR(5)=91		
		        CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
			GOTO 99999		
		ENDIF
20	CONTINUE
C
C	no error on RAW-data file ; start reading
C
30	CALL RAWSPR                        ! read in pointers & lengths load
C                                          ! COMMON /RAWSPC/
	IF(IERR(5).NE.0) THEN              ! error
		CALL ERRMSG('RAWSPR',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
	CALL XRDREA(1)                     ! load COMMON-BLOCK /XRDDIF/
                                           ! now I've the diffractometer #
                                           ! & the version (DIFNUM & DIFVER)
C*****************************************************
C	DACATT=2  !force the right value for mca
C*****************************************************
	IF(IERR(5).NE.0) THEN              ! error reading the info 
		CALL ERRMSG('XRDREA',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
C
C       now I need the corresponding terminal#
C
	CALL XRYOPN('S')                   ! open XRAY.XRY shared readonly
	IF(IERR(5).NE.0) THEN              ! error opening XRAY.XRY
		CALL ERRMSG('OPNXRY',XRYFIL,1,COMAND)
		GOTO 99999
	ENDIF
	CALL XRYHED                        ! read records 1..3 of XRAY.XRY
	IF(IERR(5).NE.0) THEN              ! error during read
		CALL ERRMSG('XRYHED',XRYFIL,1,COMAND)
		CALL CLOXRY
		GOTO 99999
	ENDIF
	IFLAG=1                            ! check only the D500 #
	CALL XRYCHK(IFLAG,IREC,DIFNUM,DIFVER)  ! do this check
C
C       now I have the corresponding terminal# DIFTE1
C
	CALL CLOXRY                        ! close XRAY.XRY
	IF(IFLAG.NE.3) THEN                ! something was wrong
		IERR(5)=48		
		CALL ERRMSG('DPMES ',XRYFIL,1,COMAND)
		GO TO 99999		
	ENDIF
	CALL RADIXCTR(COMAND)		!jdw03
	CLOSE(UNIT=ISCR2,DISPOSE='DELETE')  !jdw03
C
C	*********************************************************
C	  DJH03 VMS CHANGES 3SEP87
C
	CALL ABOCOM(DIFTE1)
	IF(IERR(5).NE.0)THEN
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GO TO 99999
	ENDIF
C
C	**********************************************************
C
C	read the rest of the RAW-data file
C
	CALL RAWDER(1)                     ! read in file description block
	IF(IERR(5).NE.0) THEN              ! error reading error
		CALL ERRMSG('RAWDER',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
	CALL XRDREH(1)                     ! load COMMON-BLOCK /XRDHDW/ 
	IF(IERR(5).NE.0) THEN              ! error reading the info 
		CALL ERRMSG('XRDREH',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C
C       the sample chemistry block and the quantitative analysis block   C
C       is not read in                                                   C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C
C
C	attach the devices DACO , MCA & HTC   
C
	CALL DEVATA                        ! attach the devices
	IF(IERR(5).NE.0)THEN
		GO TO 99999	
	ENDIF
	CALL RESUME		!jdw03
C
C	get STATUS & do the CHECK of the DACO-MP
C
	CALL STACHK                        ! check status & do the check
	IF(IERR(5).NE.0)THEN
		GO TO 99999	
	ENDIF
C
C
C	DJH added 9oct87
C
C	for a measurement with a sample changer we have to make sure that
C	all of the conditions are right for the job mode.
C
C	the following conditions can cause a problem
C	 1. if the system shuts down 
C		if the status from rdstat comes back with an error condition
C		the daco must go through an init and samp0 before
C		type S to start is displayed
C	 2. if the sample position is 0 and rf is ne to 1 or 3
C		this condition will happen in the interrupt features in job
C		mode.  call samp 0 before type s to start. (normally
C		type s to start would not be called)
C
	ASTART=.FALSE. !T type s to start                   F dont
	AERROR=.FALSE. !T do full init then type s          F dont
	IF(SAMHOL.GT.1)THEN
C
C	ISA is the sample position number -1 if not in sync 0 if reset
C	IEMPTY =0 for a good position 1 if empty -1 if unknown
C
		CALL RDSTAT(IS,TH,OM,ISA,IEMPTY,IDS)
		IF(IS.LE.0)THEN   !ERROR  ! give init a shot
			AERROR=.TRUE.
		ELSE IF(TH.LT.0.0)THEN  !no init at all
			AERROR=.TRUE.
		ELSE IF(IEMPTY.EQ.-1.OR.ISA.EQ.-1)THEN !if init w/o sc ini
			CALL SAMP0  !sample changer not init.
			ASTART=.TRUE.
		ELSE IF((RESFLG.EQ.1.OR.RESFLG.EQ.3).AND.ISA.NE.0)THEN
			CALL SAMP0  !prob an interrupt job (shouldnt happen)
		ELSE IF(RESFLG.ne.1.AND.RESFLG.ne.3.AND.ISA.EQ.0)THEN
			ASTART=.TRUE. ! probably interrupted job with restart
		ENDIF
	ENDIF
C
C	Ask DPMES>TYPE 'S' TO START          ! MK 28/1/87
C	djh FOR NOW DO NOT TYPE S TO START IN IMMEDIATE MODE  16FEB87
C
	IF(IPROC.NE.'0')THEN   !job mode
	   IF(SAMHOL.LE.1.OR.RESFLG.EQ.1.OR.RESFLG.EQ.3.OR.ASTART)THEN
C			! ask the question in each case
		CALL DPMSTA(TERMINAL,DIFNUM,DIFVER)			!DJH10
		IF(IERR(5).EQ.-5) GOTO 99999 ! CTRL Z entered
		IF(IERR(5).GT.0)THEN					!DJH07
			CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
		ASTART=.FALSE.
		AERROR=.FALSE.
	  ENDIF
	ENDIF
C
	CALL DCMD('DS',IDS,2)
C	check the D500
C
	CALL DACTYP                        ! check the D500
	IF(IERR(5).NE.0)THEN
		GO TO 99999	
	ENDIF
                                           ! all errors are handled in this call
C
C	initialize DACO <Y/N> ?
C
C	DJH 9OCT87 add aerror
C	
	IF(RESFLG.EQ.1.OR.RESFLG.EQ.3.OR.AERROR) THEN
		CALL INWIND                !initialize the tube shutter control
		  IF(IERR(5).NE.0)THEN
			CALL ERRMSG('INWIND',RAWFIL,1,COMAND)
			GO TO 99999
		  ENDIF
C
C	what is it ?  D500,THE/THE,D500/TX ?
C
	    IF(GONCOD.EQ.0.OR.GONCOD.EQ.2.OR.GONCOD.EQ.5) THEN
C
C	handle initialzation of a 'normal' D500
C
		CALL D500IN                ! initialize the D500
		IF(IERR(5).NE.0)THEN
			GO TO 99999	
		ENDIF
		GOTO 40
	    ELSE
C
C	handle initialization of a D501 
C
		CALL D501IN                ! input and go to desired THE & 2THE 
C                                          ! values when using a D501
		IF(IERR(5).EQ.-5) GOTO 99999 ! CTRL Z entered
		IF(IERR(5).NE.0)THEN
			GO TO 99999	
		ENDIF
	    ENDIF
C
40	    IF(SAMHOL.GT.1) THEN               ! no sample changer in use
C
C	reset sample changer if any
C
	       CALL SAMP0                         ! reset sample changer
	       IF(IERR(5).NE.0)THEN
		STATUS=3						!DJH09
	       ENDIF
	    ENDIF
	ENDIF
C
C	djh 9oct87
C	this is the second location for type s to start will be called
C	if there was an error on the status
C	
C
	IF(AERROR)THEN
C			! ask the question in each case
		CALL DPMSTA(TERMINAL,DIFNUM,DIFVER)			!DJH10
		IF(IERR(5).EQ.-5) GOTO 99999 ! CTRL Z entered
		IF(IERR(5).GT.0)THEN					!DJH07
			CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
		AERROR=.FALSE.
	ENDIF
C
C
	CALL CLOSE(ISPOL)		!detach terminal
C	start measuremnt
C
C
	IF(ITYP.EQ.3) THEN                 ! the following check only for 
                                           ! DACO V2
C
C	make sure that option setting is correct for D500,D501 OR D500 T/T
C
	CALL STMOPT                        ! set the option
	IF(IERR(5).NE.0)THEN
		GO TO 99999	
	ENDIF
	ENDIF
C
C	prepare the RAW-data file
C
C	setmes should be creating this block
C	first check to see if the block is there.
C	if not create the block
C
	IF(ISRBLK(6).EQ.0)CALL RAWINC           ! setup ISRBLK(6) & ISRLEN(6)
	IF(IERR(5).NE.0) THEN          
		GOTO 99999
	ENDIF				
C
C	prepare measurement with MCA
C
	IF(MCATYP.NE.0)THEN
		CALL CHKMCA		!check type of mca
		IF(IERR(5).GT.0)THEN
			CALL ERRMSG('CHKMCA',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
		CALL OPSCR1	!open scratch file MCA.SCR
				!for internal use
		IF(IERR(5).GT.0)THEN
			CALL ERRMSG('OPSCR1',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
	ENDIF
C
	CALL OPNSCR                        ! open scratch file for DPMES
	IF(IERR(5).NE.0)THEN
		GO TO 99999		
	ENDIF
C
	INTMAX=0.                          ! setup sample spec.max.int.
	MAX=0.                             ! setup serie spec.max.int
C
C	Loop until all the series have been measured
C                  ===============
C
	DO 10000 IMESS=1,NREP           ! NREP = # of series
	SAVMAX=0.			!setup saved max intensity
	IF(MCATYP.NE.0)THEN		!reset some parameters for a 
		CALL VARRES		!measurement with mca
		RESPOI = 0.
		ISC1AS = 1
		CALL MCASET		!setup mca (au cl a1)
		IF(IERR(5).NE.0)THEN
			CALL ERRMSG('MCASET',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
	ENDIF
C
C	sample - rotation <Y/N> ?
C
	LROT=.FALSE.                       ! no sample-rotation
	IF(ROTAT.EQ.'R') LROT=.TRUE.       ! yes we do a sample-rotation
C
C	step-scan or scan ?
C
C	DJH01 add check for oscillation scan it is the same as cont..
C
	MSCAN=0                            ! step-scan
	IF(SCAN.EQ.'C'.OR.SCAN.EQ.'O') MSCAN=1            ! scan
	IF(SCAN.EQ.'U') THEN               ! no scan & no step-scan; what is it?
		IERR(5)=93	
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999	
	ENDIF
C
C	check the measurement procedure
C
	IF(MESPRO.EQ.0) THEN
		IERR(5)=95	
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999	
	ENDIF
	IF(MESPRO.EQ.6) THEN						!JDW01
		IERR(5)=95		
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999	
	ENDIF
	
C
C	read & set the flag
C
	CALL RDFLGS(MFLAG,IDUM,IDS)	   ! read main flagword
	IF(IDS.LT.0) THEN
		IERR(5)=111		
		IERR(4)=IDS		
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999		
	ENDIF
	MFLAG=MFLAG.AND."173777
	MFLAG=MFLAG.OR.(2048*MSCAN)	   ! set/clear bit 11
C
	CALL STFLGS(MFLAG,IDUM,IDS)        ! set or clear flagword 2048
	IF(IDS.LT.0) THEN
		IERR(5)=112		
		IERR(4)=IDS		
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
C
C	set the correction angles or not
C
	IF(MCATYP.NE.0)THEN
		CALL CORANG(VORH)                  ! setting this angles
		IF(IERR(5).NE.0)THEN
			CALL ERRMSG('CHKMCA',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
	ENDIF
C
	IF(SAMHOL.LE.1) GOTO 100           ! no sample changer
C
C	change sample if any
C
	CALL NEXSAM(IPOS,LROT)             ! change sample
	IF(IERR(5).NE.0)THEN
		CALL ERRMSG('NEXSAM',RAWFIL,1,COMAND)
		GO TO 99999
	ENDIF
C
C	read the status
C
100	CALL RDSTAT(IS,TH,OM,ISA,IEMPTY,IDS)
	IF(IDS.LT.0) THEN
		IERR(5)=113		
		IERR(4)=IDS		
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999		
	ENDIF
	IF(IEMPTY.LE.0.OR.SAMHOL.LE.1) THEN 
		GOTO 160                    ! this sample position is not empty
                                            ! or no sample changer 
	ELSE
		IERR(5)=110		
		CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
		GOTO 99999 	! input new RAW-data filename
	ENDIF
C
C	get the date & time and the experimental block for the measurement
C
160	EXPSER=IMESS                       ! load COMMON /EXPBLK/ with serie#
	CALL RAWTER(1)                     ! read experimental block
	IF(IERR(5).NE.0) THEN              ! error reading the info
		CALL ERRMSG('RAWTER',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
	WTIME=JINT(BLKTIM)
	CALL SLEEP(WTIME)                   ! wait the desired delay time
	IF(IERR(5).NE.0)THEN
			CALL ERRMSG('SLEEP ',RAWFIL,1,COMAND)
			GO TO 99999
	ENDIF
                                            ! before starting the measurement
                                            ! of each series
	CALL DATE(DAT)                      ! get the system date
	CALL TIME(TIM)                      ! get the system time
C
	CALL DATCOD(RUNDAT,DAT)             ! convert the date to a real value
	IF(IERR(5).EQ.-10.OR.IERR(5).EQ.18) THEN ! error
		IERR(5)=105		
		CALL ERRMSG('DATCOD',RAWFIL,1,COMAND)
		GOTO 99999		
	ENDIF
C
	CALL TIMCOD(RUNTIM,TIM)             ! convert the time to a real value
	IF(IERR(5).LT.0) THEN               ! error
		IERR(5)=135		
		CALL ERRMSG('TIMCOD',RAWFIL,1,COMAND)
		GOTO 99999		
	ENDIF
	WRITE(IRAW'ISRBLK(3)+3) RUNDAT      ! write the date into the RAW-file
	WRITE(IRAW'ISRBLK(3)+4) RUNTIM      ! write the time into the RAW-file
C
C
C   ========================================================	!jdw01
C+++	Check type of collection and call AUTO for quant.	!jdw01
C  First time through (i.e., first series) do optimization pass.!jdw01
C								!jdw01
	IF(MESPRO.EQ.8 .AND. IMESS.EQ.1) THEN			!jdw01
		CALL PASS0(FIRST)		!DJH11		!jdw01
		IF(IERR(5).NE.0) THEN				!jdw01
			IEXT=IERR(5)				!jdw01
			GOTO 99999				!jdw01
		ENDIF						!jdw01
C  Proceed with the normal data collection with mespro=1	!jdw01
C  I hope mespro never gets written back to the file.	 	!jdw01
		MESPRO=1					!jdw01
	ENDIF							!jdw01
C---		End of quant section				!jdw01
C								!jdw01
C
C	loop until all the measuring ranges have been measured
C	           ========================
C
	DO 255 RANNUM=1,NRANG
	CALL RANREA(1)                      ! read line measurement block
	IF(IERR(5).NE.0) THEN
		CALL ERRMSG('RANREA',RAWFIL,1,COMAND)
		GOTO 99999    
	ENDIF
C
C	setup the variables for the SR MEAS
C
	CALL MESSET(START,END,RESINC,TISPE,MODE
     #,OFFSET,FIXANG,CHI,PHI)               ! here we do the setup
C
	WTIME=JINT(LININF(13))
	CALL SLEEP(WTIME)                   ! wait the desired delay time
	IF(IERR(5).NE.0)THEN
		CALL ERRMSG('SLEEP',RAWFIL,1,COMAND)
		GO TO 99999
	ENDIF
                                            ! before starting the measurement
                                            ! of each range
C***************************** MK 30/4/87*******************************
C	IF(DETCOD.GE.2.AND.MCATYP.EQ.0)THEN
C		 CALL OPWIND         ! open tube shutter
C		IF(IERR(5).NE.0)THEN
C			CALL ERRMSG('OPWIND',RAWFIL,1,COMAND)
C			GO TO 99999
C		ENDIF
C	ENDIF
C***********************************************************************
C
	IF(MCATYP.EQ.0)THEN
		CALL MEAS(START,END,RESINC,TISPE,MODE
	1		,OFFSET,FIXANG,CHI,PHI,FIRST)    ! do the measurement
C
C******************* Control of the interrupt procedure **************
C		!DJH03 ADD -350 CODE FOR IMMEDIATE MODE
C           ! INTERRUPT from JCT for 
C		priority sample
		IF(IERR(5).EQ.-360.OR.IERR(5).EQ.-350) THEN
			GOTO 99999              
		ENDIF
C**********************************************************************
		IF(IERR(5).NE.0)THEN
			CALL ERRMSG('MEAS  ',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
		MAX=AMAX1(MAX,RMAX8/TISPE) 	! serie spec.max.int.
	ELSE
		CALL MCAMES(START,END,RESINC,TISPE,MODE
	1		,OFFSET,FIXANG,VORH,RANNUM
	1		,RMAX,RESPOI,SAVMAX,FIRST)
		IF(IERR(5).NE.0)THEN
			CALL ERRMSG('MCAMES',RAWFIL,1,COMAND)
			GO TO 99999
		ENDIF
		MAX=AMAX1(MAX,RMAX)
	ENDIF
C
255	CONTINUE
	INTMAX=AMAX1(INTMAX,MAX)            ! sample spec.max.int.
10000   CONTINUE
	WRITE(IRAW'ISRBLK(3)+6) INTMAX      ! write max.int. of each serie into
                                            ! the RAW-file
C
C	djh dont bother to reset for psd or th/th
C
	IF(MCATYP.EQ.0.AND.GONCOD.NE.2)CALL GOSTAR(30.,0.,0.)!jdw02 move back to 30 degrees
	CALL MMFIND(NRANG,NREP)             ! search max.& min. int.
	IF(IERR(5).NE.0)THEN
			CALL ERRMSG('MMFIND',RAWFIL,1,COMAND)
			GO TO 99999
	ENDIF
	IUNIT=IRAW                          ! setup the unit
	CALL RAWSPW                         ! write out the specification block
                                            ! to the RAW- file
	IF(IERR(5).NE.0) THEN
		CALL ERRMSG('RAWSPW',RAWFIL,1,COMAND)
		GOTO 99999
	ENDIF
C
C
C	*****  normal exit  *****
C
C
	 MESFLG=1                    ! sample complete measured
	 IUNIT=IRAW		
	 IOVER=0			
	 CALL RAWHEW !use subroutine to write out
	 IF(IERR(5).NE.0)THEN
	  CALL ERRMSG('DPMES ',RAWFIL,1,COMAND)
	  GO TO 99999
	 ENDIF
	 STATUS=1
	 GOTO 9000
C
C	*******************************************************************
C
C	error report
C
5080	FORMAT(' ERROR IN PROGRAM DPMES AT ',A8,' - STATUS =  ',I4)
C
C
C	******************************************************************
C	This section is for the handling of the errors
C	******************************************************************
C
99999	CONTINUE
C
C
	MESFLG = 0 !! Sample not measured
	IUNIT  = IRAW
	IOVER  = 0
	CALL RAWHEW
C
C	djh03 add -350 for a status on interrupt
C
	IF(IERR(5).EQ.-360) THEN                      ! INTERRUPT
		STATUS = 11                           ! special status
		CLOSE(UNIT=ISCR2)                     ! close scratch file
		IF(SAMHOL.GT.1) CALL SAMP0            ! reset sample changer
		CALL CLWIND
		GOTO 300
	ELSE IF(IERR(5).EQ.-350) THEN                      ! INTERRUPT
		STATUS = 3                            ! special status
		CLOSE(UNIT=ISCR2)                     ! close scratch file
		IF(SAMHOL.GT.1) CALL SAMP0            ! reset sample changer
		CALL CLWIND
		GOTO 300
	ELSE
		STATUS = 3
	ENDIF
C
C	****  this section is the same for all exits  ***
C
9000	IF(SAMHOL.LE.1) GOTO 300   ! no sample changer
	IF(RESFLG.EQ.3.OR.RESFLG.EQ.2) THEN
		CALL SAMP0 ! reset sample changer
	ENDIF

300	CALL CLORAW('N')           ! close the 'normal' RAW-data file
	CALL DCMD('HT',IDS,2)      ! HT-command to DACO  MK 21/1/87
	IF(RESFLG.EQ.3.OR.RESFLG.EQ.2) THEN
	   CALL DCMD('DSMEASUREMENT COMPLETE,0',IDS,24)
	ENDIF
C
C	***** DELETE COMMUNICATIONS FILE  *******
C
9002	CALL CLOSE(ISCR2)					!DJH01
	IF(MCATYP.NE.0)THEN
		CALL CLOSE(ISCR1) !kill scratch file mca use
	ENDIF
	CALL CLWIND							!DJH11
C
C	***** exit with status **********
C
9001	CALL RESUME		!jdw03
	CALL EXST(STATUS)
C
C
C	MISC ERRORS
C
8751	IERR(5)=352
	CALL ERRMSG(STR(1:6),DEFILE,1,COMAND)
	STATUS=3
	GO TO 9002
	END
