	INTEGER FUNCTION GETDIF 
     +	(	Difile,Icode,Dcode,Pkcode,Alcode,Irange,Fwcode,
     +		Ercode,		!in-situ error report
     +		     nid   ,			!number of chars in id
     +		     Id    ,			!Id of the sample
     +		     noper ,			!number of chars in operator
     +		     Oper  ,			!operator name
     +						!who created the d/i file
     +		     Idate ,			!date of D-I file creation
     +		     Itime ,			!time of D-I file creation
     +		     nhow ,			!number of characters in how
     +		     how  ,			!text indicating
     +						!how this file was created
     +		     Npeaks,			!number of peaks returned
     +		     Nlim  ,			!limit the no of peaks to
     +					!this number; passed into the routine
     +		     pealoc ,			!peak locations (d or 2theta)
     +		     Ints  ,			!intensities 
     +		     Fwhm  ,			!full width at half max(2theta)
     +		     Smes  ,			!actual (or pseudo) starting
     +						!angle of mesurement on d500
     +		     Emes  ,			!actual (or pseudo) ending
     +						!angle of measurement on d500
     +		     countm,			!max intensity in cps
     +		     pmax ,			!location of maximum peak
     +		     temp ,			!temperature value
     +		     field,			!electrical or magnetic
     +		     lambda,			!wavelength of consideration
     +		     Erunit,			!unit for error messages
     +		     opsysm,iunit)		!operating system for
c						!fcs error control
c						and logical unit number for i/o

c
c	a little more about the entering flags
c
c	Icode	= 0	return peaks as	non-normalized cps      as real*4
c		= 1	  "	"	peaks normalized to 100 as real*4
c		= 2	  "     "	peaks normalized to 100 as integer
c
c	Dcode	= 0	return peak locations as d-values	real*4
c		= 1	  "     "      "         2theta		real*4
c		= 2	  "     "      "         jcpds data bae cod integer
c
c	Pkcode	= 0	obtain and treat net intensities of the peaks
c		= 1	  "          "   integrated intensities of the peaks
c
c	Alcode	= 0	do not report alpha-2 and beta lines
c		= 1	report alpha-2 and beta lines
c
c	irange	= 0	report peaks of all ranges
c			ranges can be due to multiple range measurements
c			or multiple temperature measurements
c			or multiple electrical or magnetic field measurements
c		= +n	report information for the specific range n
c
c	Fwcode	= 0	do not report FWHM values
c		= 1	report FWHM values
c	Ercode	= 0	suppress all the error messages inside the
c			the routine (just success or failure returned
c			in getdif)
c		= 1	report errors if they occur on site
c
c	:: note ::	on countm, pmax
c			if irange = + n, the above values are returned
c					for that range
c			otherwise countm and pmax are returned for the
c				entire scanned area
c			countm is returned in the same notation as pkcode
c			pmax is returned as d for dcode = 0 and 2 and 
c					 as twotheta for dcode = 1

c	*********************************************************************
c
c	return values of GETDIF
c
c		getdif	=  0		normal successful return
c			= -1		file name has garbage in it
c			= -2		error in device name translation
c			= -3		error opening file
c			= -4	valid for pkcode = 1
c				integrated intensities not available; only
c				net intensities available
c			= -5	valid for irange > 0
c					normal return but this range number
c					is higher than the existing number
c					of ranges
c			= +1		normal return but there are no peaks
c					in the file (peaks found = 0)
c			= + 2		normal return; there are more
c					peaks available than nlim
c					
c	:: note ::	on error -4 
c			always peak intensities are stored
c			when integrated intensities are available,
c			then the ratios of the integrated intensities to
c			the peak intensities (which are essentially called 
c			integral breadths) are stored.  these integral breaths 
c			enable us to calculate the integrated intensities.
c			integral breadth should not be confused with fwhm
c			even though in some cases there may be a relationship
c			between these two.
c	*********************************************************************

c	Author:	Satyam C. Cherukuri
c		Siemens-Allis, Inc.
c		Cherry Hill, N.J. 08034
c
c
c	created on : 10-jul-84
c	modified on	by			remarks
c
c ________________________________________________________________________
c
	include '[100,1]common.imp'	!implicit none; rsx-compatibility
	character*32	Difile
	character*9	idate
	character*8	itime
	character	id,
     +                  How  ,
     +			Oper  
     	integer*4	opsysm
c
	INTEGER IERR
	Integer		Icode,		!default integer types
     +			Dcode,
     +			Pkcode,
     +			Alcode,
     +			Tmcode,
     +			Irange,
     +			Fwcode,
     +			Ercode,
     +			Npeaks,
     +			Nlim,
     +			Erunit,
     +			Iunit,
     +			i,
     +			junk,
     +			loc,
     +			push,
     +			j1,
     +			j2,
     +			ass,
     +			length,
     +			fill,
     +			iprev
	integer dcod			!jcpds data base code conversion
	integer	nid, noper, nhow
	integer*2 nida,nopera,nhowa	!actual values in the file
c
	integer*2			!explicit
     +			idlen,
     +			oplen,
     +			howlen,
     +			ibeg,
     +			nrec,
     +			rnow,
     +			nnow,
     +			next
c
	real*4		Smes ,
     +			Emes ,
     +			countm,
     +			fwhm (1),
     +			pmax,
     +			breadm,
     +			temp,
     +			field,
     +			peakl,
     +			intens,
     +			bread,
     +			normal,
     +			lambda,
     +			twothd		!two-theta to d conversion function
c
	logical		tag,		!default logical types
     +			dread,
     +			transl,
     +			alread,
     +			fwread,
     +			inttru,
     +			unlock
c
c **	the following variables must be treated default integer arrays for the
c	flexibility of the routine we are looking for
	integer		pealoc (1),
     +			Ints  (1)			!intensities 
c

c **	get proper device and extentions
	getdif = -1				!if file has garbage	
	if (tag(difile,'DI:','DIF',.true.,.true.)) then	!write device
c						!and extentions but dont 
c						!override existing ones
		if (ercode .eq. 1) write (erunit,6000) difile	!message
6000	format(x,'GETDIF: d/i file-',A,'error attaching',
     +		' device and extention to it')
		return
	endif
c
c **	get the translation of the device name
	getdif = -2				!if error in translation
	if (transl (difile)) then
		if (ercode .eq. 1) write (erunit,6100) difile	!message
6100	format(x,'GETDIF: d/i file-',A,'physical device',
     +		' translation error')
		return
	endif
c **	open the file
	getdif = -3				!if error in opening
c
100	OPEN (		UNIT	=	IUNIT		,
     +			NAME	=	DIFILE		,
     +			TYPE	=	'OLD'		,
     +					SHARED		,
     +					READONLY	,
     +			FORM	=	'UNFORMATTED'	,
     +		      ACCESS	=	'DIRECT'	,
     +		  RECORDSIZE	=	1		,
     +	   ASSOCIATEVARIABLE	=	ASS		,
     +			 ERR	=	200		)
c
	go to 300					!successful opening
c **	see if we can remedy the error (provided it is just locked but exists)
200	if (unlock(difile,opsysm)) then			!if cannot be unlocked
c							!existence problems.
		if (ercode .eq. 1) write (erunit,6200) difile	!message
6200	format(x,'GETDIF: d/i file-',A,'cannot be opened')
		return
	else
		go to 100				!try again
	endif
C++++
C  TRY TO READ A DIFFRAC-11 FILE JDW FEB-85	
300	CALL DIFF11(IERR, IUNIT, ASS, ERUNIT, ERCODE,
     &		DIFILE, ICODE, DCODE, PKCODE, IRANGE, FWCODE,
     &		ID, NID, IDATE, ITIME, OPER, NOPER, HOW, NHOW, 
     &		SMES, EMES, TEMP, FIELD, LAMBDA,
     &		NLIM, NPEAKS, PEALOC, INTS, COUNTM, PMAX )
	GETDIF = IERR
D	PRINT *,' RETURNED FROM DIFF11: IERR=',IERR
D	PRINT*,'DAYTIME=',IDATE,ITIME
D	PRINT*,'OPER=',OPER
D	PRINT*,'HOW=',HOW
D	PRINT*,'SMES,E, T,F, LA=',SMES,EMES,TEMP,FIELD,LAMBDA
D	PRINT*,'NPEAKS=',NPEAKS
D	PRINT*,'FIRST I=',INTS(1),' D=',PEALOC(1)
D	PRINT*,'MAXIMUM=',COUNTM,PMAX
	IF (IERR.NE.99) GOTO 9000
D	PRINT*,'READING FROM DIFF500 FILE'
C----
c **	start reading the data from the file
c
c **	identification of the sample
C300	read (iunit ' 1)	ibeg,nrec	!beginning record number
	read (iunit ' 1)	ibeg,nrec	!beginning record number
c						!and number of records
c						!in the header
	ass = ibeg					!header starting point
	read (iunit ' ass)	nida		!length of the sample iden-
c						!tification string in file
	nid = min(nid,nida)			!minimum of these two
	i = 1
	j2 = 0					!reset j2
310	if (j2 .ge. nid ) go to 320
		j1 = (i-1)*4 + 1		!starting character number
		j2 = min (j1+3,nid)
		read (iunit ' ass) id (j1:j2)
		i = i + 1
	go to 310
320	ibeg = ibeg + int(nida/4.) + int((mod(nida,4)+3)/4.) + 1
	ass = ibeg				!beginning of operator name
c **	operator name
	read (iunit ' ass) nopera			!length of op string
	noper = min(noper,nopera)		!minimum of these two
	i = 1
	j2 = 0					!reset j2
400	if (j2 .ge. noper) go to 420
		j1 = (i-1)*4 + 1		!starting character number
		j2 = min (j1+3,noper)
		read (iunit ' ass) oper (j1:j2)
		i = i + 1
	go to 400
420	ibeg = ibeg + int(nopera/4.) + int((mod(nopera,4)+3)/4.) + 1
	ass = ibeg				!beginning of how
c **	how the file is created
	read (iunit ' ass) nhowa			!same scheme as id
	nhow = min(nhowa,nhow)
	i = 1
	j2 = 0					!reset j2
500	if (j2 .ge. nhow ) go to 520
		j1 = (i-1)*4 + 1		!starting character number
		j2 = min (j1+3,nhow)
		read (iunit ' ass) how (j1:j2)
		i = i + 1
	go to 500
520	ibeg = ibeg + int(nhowa/4.) + int((mod(nhowa,4)+3)/4.) + 1
c **	date and time
	ass = ibeg
	read (iunit ' ass)	idate(1:4)	!these record numbers are
	read (iunit ' ass)	idate(5:8)	!always fixed in the data file
	read (iunit ' ass)	idate(9:9)
	read (iunit ' ass)	itime(1:4)
	read (iunit ' ass)	itime(5:8)
c **	get the peak search parameters
	read (iunit ' 2)	ibeg,nrec
	ass = ibeg +1					!skip the first record 
c							!here  this information
c							!is not needed now
	read (iunit ' ass)	Smes		!starting angle of measurement
	read (iunit ' ass)	Emes		!ending angle of measurement
	ass = ass + 3			!skip stsize,ctime,aper size
	if (irange .eq. 0) then
		read (iunit ' ass) countm	!maximum peak intensity
		read (iunit ' ass) breadm	!integral breadth
		read (iunit ' ass) pmax	!peak location in two-theta
	else
	ass = ass + 3
	endif
	ass = ass + 6				!get to ka1 wavelength
	read (iunit ' ass) lambda
c **	get the d-i values
	read (iunit ' 3)	ibeg,nrec	!beginning record and total
c						!number of records for
c						!the d-i data block
	ass = ibeg				!get to the npeaks record
	read (iunit ' ass) rnow			!number of sets
	if (irange .ne. 0 .and. irange .gt. rnow) go to 1100	
c				!range asked for is higher than available
	npeaks = 0				!initialize npeaks
c **	a few internal flags
	dread = .false.				!read d-values ?
	inttru = .false.			!integrated intensities ?
	alread = .false.			!alpha2 and beta report ?
	fwread = .false.			!read fwhm ?
	if (fwcode .eq. 1) fwread = .true.
	if (alcode .eq. 1) alread = .true.	
	if (dcode .eq. 0 .or. dcode .eq. 2 ) dread = .true.
	if (pkcode .eq. 1) inttru = .true.
c
	rnow = 0				!current range
1000	read (iunit ' ass) nnow,next		!d/i pairs of this block
c						!iend is the flag indicating
c						!whether this is the last
c						!block of d/i pairs
c						!if next = 0 this is the
c						!last block
c						!else next = record number
c						!of the next starting block
	rnow = rnow + 1				!current range
	if (irange .gt. 0) then			!specific range is requested
	
		if (irange .eq. rnow) go to 1200	!found specified range
		if (rnow .ne. irange .and. next .eq. 0) go to 1100 !end of data

		ass = next			!otherwise prepare next range
		go to 1000
	endif
	go to 1200				!irange = 0
c
1100	getdif = -5				!invalid range
	if (ercode .eq. 1) write (erunit,6300) difile, irange, rnow
6300	format(x,'GETDIF: d/i file-',A,'specified range',i3,' is',
     +	' higher than the available ranges',i3)
	go to 9000				!terminate
c
1200	iprev = npeaks				!previous total
	npeaks = npeaks + nnow			!number of peaks
c
	if (npeaks .eq. 0 .and. next .eq. 0) then
		getdif = 1			!error code
		if (ercode .eq. 1) write (erunit,6400) difile, rnow
6400	format(x,'GETDIF: d/i file-',A,'no peaks found in range',i3)
		go to 9000
	end if
	if (npeaks .gt. nlim ) then		!exceeds dimension
		npeaks = nlim			!cutoff
		getdif = 2			!no error message associated
c						!with this
	endif
	if (irange .gt. 0) then			!specific range
		read (iunit ' ass) smes		!starting angle of this range
		read (iunit ' ass) emes		!ending angle of this range
		ass = ass + 2			!skip stsize and ctime
		read (iunit ' ass) countm	!maximum cps of this range
		read (iunit ' ass) breadm	!incase we need integrated
		read (iunit ' ass) pmax	!always read this as two-theta
		ass = ass + 1			!skip fwhm max
	else
		ass = ass + 8
	endif
c
	if (breadm .le. 0.0 .and. inttru) then
c						!if integral breadths are
c						!not reported and integrated
c						!are reported; bail out
		getdif = -4		!error code
		if (ercode .eq. 1) write (erunit,6500) difile
6500	format(x,'GETDIF: d/i file-',A,'integrated intensities not',
     +		' available')
		go to 9000
	endif
	if (inttru) countm = countm * breadm	!integrated intensity
	read (iunit ' ass) temp			!temperature
	read (iunit ' ass) field		!field (electric or magnetic ?)
	ass = ass + 1				!skip unused portion
c
	loc = iprev				!counter for the arrays
	do 3000 i  = iprev + 1 , npeaks		!read one by one
c **	d-value
	if (dread) then
		ass = ass + 1			!skip two-theta
		read (iunit ' ass) peakl	!read d-value
c **	two-theta				!skip this value
	else
		read (iunit ' ass) peakl	!read two-theta
		ass = ass + 1			!skip over d-value
	endif
c **	intensity
	if (peakl .lt. 0.0 .and. .not. alread) go to 2900
	loc = loc + 1				!counter for the arrays
	read (iunit ' ass) intens		!read intensity
	if (inttru) then			!if integrated intensity asked
		read (iunit 'ass) bread		!read integral breadth
		intens = intens * bread		!integrated intensity
	else
		ass = ass + 1			!otherwise skip this record
	endif
c **	FWHM
	if (fwread) then
		read (iunit 'ass) fwhm (loc)
	else
		ass = ass + 1
	endif
c **	encode according to the choice
	if (icode .eq. 0) then
		junk = push(ints,intens,loc,4)	!push 4 bytes
	else
		normal = intens * 100.0/ countm	!normalized intensity
		if (icode .eq. 1) junk = push (ints,normal,loc,4)  !4 bytes
		if (icode .eq. 2) ints (loc) = nint (normal)   !default integer
	endif
c
	if (dcode .eq. 2) then
		pealoc(loc) = dcod(peakl)	!as integer
	else
		junk = push (pealoc , peakl , loc , 4) 	!real*4
	endif
	ass = ass + 7				!skip over 7 records 
	go to 3000
2900	ass = ass + 10				!if pair skipped
3000	continue
	npeaks = loc					!re-evaluated number
	if (next .eq. 0 .or. irange .gt. 0) then	!end of fetch
		getdif = 0				!success flag
		if (dcode .ne. 1) pmax = twothd (pmax,lambda)	!d-value
		go to 9000
	endif
	ass = next					!next set
	go to 1000
c
9000	CLOSE ( UNIT = IUNIT )			!wrap up proceedings
	return
	end
