C---------------------------------------------------------------------------
C	PDF1 ENCODE -- PART 3a   for the PDF-2 on DISK/CDROM 
C
C	Program for reading the PDF-1 JCPDS-ICDD DI data file
C	to create the d-space index bitmap files.
C
C	            =================================
C
C	   Written by: Brian H. Toby	Oct-1990
C
C-------------------------------------------------------------------------
C logical name	  file	use           *** INPUT ***
C---------------------------------------------------------------------------
C PS_JCPDS	  DI.LIBRARY	output database file containing the D/I info
C 				for each card 1st record (updated)
C 		  JCPDS.INDEX	index file, one record per JCPDS card
C
C---------------------------------------------------------------------------
C logical name	  file	use          *** OUTPUT ***
C---------------------------------------------------------------------------
C PS_BITMAP	DSP%%.BITMAP	D-space bitmap indices (see below)
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	IMPLICIT INTEGER (A-Z)
	EXTERNAL USEROPEN

	CHARACTER*8 CHTIME,filename*80

	include '[-.shared]jcpds.parms/list'
	INTEGER*4 ncrd

C-------------------------------------------------------------------------
C   BITMAP ARRAY
	INTEGER*4 DSPMAP(Max_regions,max_Lwords)

	DIMENSION dsp(212)
	INTEGER*2 INT(212),maxi

	INTEGER      LPDF

	INTEGER*4    JCARD,NAMREC,FULREC,DIREC
C
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
C Open the input file(s)
C---------------------------------------------------------------------------
C read the sizes from the file and write the actual value for N_REGIONS
	LPDF = 23
	OPEN (UNIT=LPDF,FILE='PS_JCPDS:DI.library',STATUS='OLD',
     1		FORM='UNFORMATTED',RECL=32,ACCESS='DIRECT')
	READ (LPDF,rec=1) n_cards,n_lwords,ncrd,N_sub,N_REGIONS,
     1                   N_ELEMC
C make sure that the maximum number of intervals does not exceed 
C the program dimensions
	IF (N_REGIONS .GT. max_regions) THEN
	  N_REGIONS = max_regions
	  WRITE (LPDF,rec=1) n_cards,n_lwords,ncrd,N_sub,N_REGIONS,
     1                      N_ELEMC
	ENDIF
	CLOSE(unit=LPDF)
	OPEN (UNIT=LPDF,FILE='PS_JCPDS:DI.library',STATUS='OLD',
     1		FORM='UNFORMATTED',RECL=32,ACCESS='DIRECT',readonly)
	LUNM = 24
	OPEN (UNIT=lunm,FILE='PS_JCPDS:jcpds.INDEX',STATUS='OLD',
     1		FORM='UNFORMATTED',ACCESS='DIRECT',readonly,
     2		recl=4,recordtype='fixed')

C---------------------------------------------------------------------------
C get the type of bitmap to write
100	read(*,'(I3)',end=9000) itype

C   ITYPE 	file(s)		use
C ------------	-------		---
C     70	DSP70.BITMAP	cards with I>=70% in region of record
C     30	DSP30.BITMAP	cards with I>=30% in region of record
C      0	DSP00.BITMAP	cards with a peak (any I) in region of record
C     -1	DSP3S.BITMAP	cards with 1 of 3 strongest lines ...

C initialize the bitmap
	DO J=1,n_Lwords
	  DO I=1,n_regions
	    DSPMAP(I,J) = 0
	  ENDDO
	ENDDO

C =========================================================================
C
C  Begin production of search files.
C
	DO 1 IPAT=1,n_cards
C... Read an entry from the DI file 
	  READ (LUNM,rec=IPAT) JCARD,NAMREC,FULREC,DIREC
	  CALL READDI(DIREC,dsp,INT,NDSINT,LPDF,0.0,212)
	  IF (NDSINT .le. 0) goto 1
C--------------------------------------------------------------------------
C	SET UP DSPACE BITMAP
	  IW=(IPAT-1)/32 + 1
	  IBT=MOD(IPAT-1,32)
	  if (itype .lt. 0) then 
C Catalog the three strongest peaks (may be more than 3 in case of tie)
	    N3S=0
	    DO WHILE (N3S .LT. 3)
C ... go through the list and find the maximum intensity
	      MAXI = -1
	      DO I=1,NDSINT
	        MAXI = MAX(MAXI,INT(I))
	      ENDDO
C ... there are no more valid peaks
	      IF (MAXI .le. 0) goto 1
C ... index all peaks with maximum intensity
	      DO I=1,NDSINT
	        IF (MAXI .eq. INT(I)) THEN
C ... set the intensity negative, so that the peak is not reused
		  INT(I) = -1
	          FLAG = DTOIND(dsp(I),J,n_regions)
	          IF (FLAG) THEN
	            N3S = N3S+1
	            DSPMAP(J,IW)=IBSET(DSPMAP(J,IW),IBT)
		  ENDIF
	        ENDIF
	      ENDDO
	    ENDDO
	  ELSE
	    DO I=1,NDSINT
	      IF (int(I).GE.itype) then 
	        FLAG = DTOIND(dsp(I),J,n_regions)
	        IF (FLAG) DSPMAP(J,IW)=IBSET(DSPMAP(J,IW),IBT)
	      ENDIF
	    ENDDO
	  ENDIF
C
1	CONTINUE
C--------------------------------------------------------------------------
C	WRITE OUT BITMAP FILE

	if (itype .lt. 0) then 
	  filename = 'PS_bitmap:DSP3S.BITMAP'
	ELSE
	  write(filename,'(A,i2.2,A)') 'PS_bitmap:DSP',itype,'.BITMAP'
	ENDIF
C compute file size in blocks (512 bytes/block), NREC * Nbytes, add 1  round
C use INITIALSIZE to specify the file size, but give back any extra space
C with USEROPEN
	isize = n_regions * n_cards / (8.*512.) + 1.5
	OPEN (UNIT=8,FILE=filename,STATUS='NEW',
	1 FORM='UNFORMATTED',RECL=n_Lwords,RECORDTYPE='FIXED',
	2 initialsize=isize,extendsize=isize/10,USEROPEN=USEROPEN)

	inquire(unit=8,name=filename)
	write(*,'(2A)') ' Writing file: ',filename

	DO 202 I=1,n_regions
	  WRITE (8) (DSPmap(I,J),J=1,n_Lwords)
202	CONTINUE
	CLOSE (UNIT=8)
C processing for this bitmap is complete, go on to next
	goto 100
C =========================================================================
9000	CONTINUE

	CLOSE (UNIT=lunm)
	CLOSE (UNIT=LPDF)

	STOP 'Normal End of Program'
	END
