C Program to set up input deck for PREF
C Modified for VAX 25-FEB-88 by Jim Walker
C Modified more in Feb 1990 at Alfred University
C
      CHARACTER FILE*80,BATFIL*40, CARD*80, PROG*6
      DIMENSION ICON(10), NOYES(2)
      DATA NOYES/'NO ','YES'/
      PARAMETER TITLES='           2THETA  PEA'//
	1 'K     D      H  K  L I(INT) I(PK) I(DS)'
      PARAMETER CELLCO='0CELL CONSTANTS '
C
C I/O unit numbers
C     RDI500 uses unit 1 for observed pattern.
      ITP1 = 2		! output batch file.
      IN30 = 3		! Calculated pattern
      IREAD = 5
      ITYP = 6
C
  108 FORMAT(12A1)
1002  FORMAT(A)
C
      WRITE(ITYP,2)
    2 FORMAT(' * PROGRAM TO SET UP BATCH RUN TO ',
     & 'ANALYZE PREFERRED ORIENTATION * ',/)
      WRITE(ITYP,1001)
1001  FORMAT(' Enter name of Batch command file: ',$)
      READ(IREAD,1002,END=9999) BATFIL
      OPEN(UNIT=ITP1,NAME=BATFIL,STATUS='NEW',
     &    CARRIAGECONTROL='LIST',DEFAULTFILE='.COM')
      IDOT = INDEX(BATFIL,'.')-1
      IF(IDOT.LT.0) IDOT = INDEX(BATFIL,' ')-1
C
      WRITE(ITYP,41) 'Tek'
41    FORMAT(' Tektronix or HP version? <',A3,'> ',$)
      READ(IREAD,108) IANS
      PROG='TKPREF'
      IF(IANS.EQ.'H' .OR. IANS.EQ.'h') PROG='HPPREF'
C
      IF(PROG.EQ.'TKPREF') WRITE(ITP1,42)
42    FORMAT('$ IF F$MODE().NES."BATCH" THEN SET TERM/NOWRAP')
C
      WRITE(ITP1,40) BATFIL(1:IDOT),BATFIL(1:IDOT), PROG
40    FORMAT(
     & '$ IF F$MODE().EQS."BATCH" THEN ASSIGN ',A,'.PLT TT:'
     &/'$ ASSIGN/USER ',A,'.LIS FOR006'
     &/'$ ',A)
C
C
C  DEFAULT SETTINGS
C
50    ICON(1)=0		! 0=calc pattern entered, 1=not
      ICON(2)=0		! 0=PEAK INT., 1=INTEG INT.
      ICON(3)=0		! not used
      ICON(4)=1		! 0=make plots, 1=calculate only, 2=skip
      ICON(5)=0		! 0=last data set, 1=another sample follows this one
      ICON(6)=0		! 1=plot Q-obs vs Angle, 0=don't   \
      ICON(7)=0		! 1=plot Q-calc vs Angle, 0=don't   } pen #
      ICON(8)=1		! 1=plot Delta-Q vs Angle, 0=don't /
      ICON(9)=0		! 1=dump Q-obs, Q-calc & Delta-Q to FOR020.DAT, 0=don't
      ICON(10)=1	! number of plots / page
      MP = 200		! Max # unmatched observed peaks
      SI = 10000.	! Full Scale
      BC = 1.0		! Background counts
      FA = 1.0		! Plot size multiplyer 1.0
      X2 = 180.		! Max angle in table of Q-values
      X3 = 90.		! Max angle in plots
      WAVE=1.5405	! Wavelength of X-rays (should be read from obs pat)
      A = 0.0		! Initialize this one.
C
      CALL OBREAD(IREAD,ITYP,WAVE)
C
      WRITE(ITYP,106)
  106 FORMAT(/' Enter title information identifing the run.'/
     & '  vvvvvvvvvv-- first 10 letters will appear on plots.'/
     & ' :',$)
      READ(IREAD,1002,END=92) CARD
      WRITE(ITP1,1002) CARD
C
C  OPEN THE CALCULATED PATTERN FILE AND LOOK FOR CELL CONSTANTS
C  AND THE BEGINNING OF THE PEAK LIST.
C
C  Pref blows up without a calculated pattern.
CC	WRITE(ITYP,141) NOYES( 2-ICON(1) )
CC141	FORMAT(' Will a calculated pattern be entered? <',A3,'> ',$)
CC	READ(IREAD,108) IANS
CC	IF(IANS.EQ.'Y' .OR. IANS.EQ.'y') ICON(1)=0
CC	IF(IANS.EQ.'N' .OR. IANS.EQ.'n') ICON(1)=1
CC	IF(ICON(1).EQ.1) GOTO input cell params
C
81      WRITE(ITYP,1005)
1005  FORMAT(' Enter name of the file containing',
     & ' the calcualated peaks: ',$)
      READ(IREAD,1002) FILE
CC      WRITE(ITYP,230)
CC1010   FORMAT(/' Calculated pattern listing file ',
CC     &  'or Spray dried DI  file? <C or S> ',$)
CC      READ(IREAD,108) IANS
CC      IF(IANS.EQ.'S' .OR. IANS.EQ.'s') THEN
CC	 CALL OBREAD(ITYP,WAVEL,FILE)
CC	 CALL CAWRIT(ITP1)
CC      ENDIF
      OPEN(UNIT=IN30,NAME=FILE,STATUS='OLD',READONLY,ERR=88)
      GOTO 83
88    WRITE(ITYP,89)
89    FORMAT(/' ERROR OPENING FILE, TRY AGAIN')
      GOTO 81
C  Now look for good data.
83    READ(IN30,1002) CARD
C  Read Cell constants if present.
      IF(CARD.EQ.CELLCO) READ(IN30,84,ERR=83) A,B,C,ALPHA,BETA,GAMMA
84    FORMAT(/,3(/,4X,F8.4),3(/,8X,F6.2))
      IF(CARD.NE.TITLES) GOTO 83
C
      IF(A.EQ.0.0) THEN
         WRITE(ITYP,130)
130   FORMAT(/' Cell parameters - enter A,B,C,ALPHA,BETA,GAMMA'/,' :',$)
         READ(IREAD,60) A,B,C,ALPHA,BETA,GAMMA
60       FORMAT(8G10.0)
      ENDIF
      WRITE(ITP1,135) A,B,C,ALPHA,BETA,GAMMA
135   FORMAT(6F10.4)
C
      WRITE(ITYP,170) MP
170   FORMAT(' Maximum number of unmatched peaks allowed? <',I5,'> ',$)
      READ(IREAD,171) IANS
      IF(IANS.NE.0) MP = IANS
171   FORMAT(I)
C
      WRITE(ITYP,178) WAVE
178   FORMAT(' Wavelength of radiation used? <',F7.4'> ',$)
      READ(IREAD,173) ANS
      IF(ANS.NE.0.0) WAVE = ANS
173   FORMAT(G10.0)
C
      WRITE(ITYP,172) SI
172   FORMAT(' Full scale for output? <',F7.0,' cps> ',$)
      READ(IREAD,173) ANS
      IF(ANS.NE.0.0) SI = ANS
C
      WRITE(ITYP,174) BC
174   FORMAT(' Average background value? <',F5.0,'> ',$)
      READ(IREAD,173) ANS
      IF(ANS.NE.0.0) BC = ANS

      WRITE(ITYP,142) NOYES(1+ICON(2))
142   FORMAT(' Use integrated intensity? <',A3,'> ',$)
      READ(IREAD,108) IANS
      IF(IANS.EQ.'Y' .OR. IANS.EQ.'y') ICON(2)=1
      IF(IANS.EQ.'N' .OR. IANS.EQ.'n') ICON(2)=0
C
C  Note: ICON(4) will be set to 0 later if plots are selected.
      IF(ICON(4).EQ.0) ICON(4)=1
      WRITE(ITYP,144) NOYES(3-ICON(4))
144   FORMAT(' Calculate Q factors? <',A3,'> ',$)
      READ(IREAD,108) IANS
      IF(IANS.EQ.'P' .OR. IANS.EQ.'p') ICON(4)=0	! P is for debugging.
      IF(IANS.EQ.'Y' .OR. IANS.EQ.'y') ICON(4)=1
      IF(IANS.EQ.'N' .OR. IANS.EQ.'n') ICON(4)=2
C
      IF(ICON(4).NE.2) THEN
C  There is no code to implement this in PREF!
CC	 WRITE(ITYP,176) X2 
CC176	 FORMAT(' Maximum angle for listing of Q factors? <',F8.4,'> ',$)
CC	 READ(IREAD,173) ANS
CC	 IF(ANS.NE.0.0) X2 = ANS
C
	 WRITE(ITYP,149) NOYES(1+ICON(9))
149	 FORMAT(' Write Q values to FOR020.DAT in addition',
     &     ' to the listing file? <',A3,'> ',$)
	 READ(IREAD,108) IANS
	 IF(IANS.EQ.'Y' .OR. IANS.EQ.'y') ICON(9)=1
	 IF(IANS.EQ.'N' .OR. IANS.EQ.'n') ICON(9)=0
C
	 WRITE(ITYP,148) NOYES(1+ICON(8))
148	 FORMAT(' Pref always plots the axes and labels using pen 1',/,
     &     ' You can specify a pen number instead of saying yes',/,
     &     ' for these next 3 questions.',//,
     &     ' Plot Delta Q vs Angle? <',A3,'> ',$)
	 READ(IREAD,108) IANS
	 CALL DOPLOT(IANS,ICON(8))
C
	 WRITE(ITYP,146) NOYES(1+ICON(6))
146	 FORMAT(' Plot Q observed vs Angle? <',A3,'> ',$)
	 READ(IREAD,108) IANS
	 CALL DOPLOT(IANS,ICON(6))
C
	 WRITE(ITYP,147) NOYES(1+ICON(7))
147	 FORMAT(' Plot Q calculated vs Angle? <',A3,'> ',$)
	 READ(IREAD,108) IANS
	 CALL DOPLOT(IANS,ICON(7))
C
	 IF(ICON(6)+ICON(7)+ICON(8).NE.0) ICON(4)=0
      ENDIF
C
C  PLOTTER SPECIFICATIONS
C
      IF(ICON(4).EQ.0) THEN
	 WRITE(ITYP,200) ICON(10)
200	 FORMAT(' Number of plots per page <',I2,'> ',$)
	 READ(IREAD,171) IANS
	 IF(IANS.NE.0) ICON(10) = IANS

	 WRITE(ITYP,175) FA
175	 FORMAT(' Plot size multiplication factor <',F7.4,'> ',$)
	 READ(IREAD,173) ANS
	 IF(ANS.NE.0.0 .AND. ANS.LE.10.0) FA = ANS
C
	 WRITE(ITYP,177) X3
177	 FORMAT(' Maximum angle used in plots? <',F8.4,'> ',$)
	 READ(IREAD,173) ANS
	 IF(ANS.NE.0.0) X3 = ANS
      ENDIF
C
      WRITE(ITYP,145) NOYES(1+ICON(5))
145   FORMAT(' Is there another sample following this one? <',A3,'> ',$)
      READ(IREAD,108) IANS
      IF(IANS.EQ.'Y' .OR. IANS.EQ.'y') ICON(5)=1
      IF(IANS.EQ.'N' .OR. IANS.EQ.'n') ICON(5)=0
C
      WRITE(ITP1,195) ICON,MP,SI,BC,FA,X2,X3,WAVE
195   FORMAT(10I1,/,I5,6F10.4)
C
      IF(ICON(2).EQ.0) THEN
         CALL OBWRIT(ITP1)
      ELSE
         CALL OBWRIN(ITP1)
      ENDIF
      WRITE(ITP1,220)
220   FORMAT(' ')
C
C   Now read the calculated peaks.
C
      J=0
      I=1
82    READ(IN30,1002,END=91) CARD
      IF(CARD.EQ.' ' .OR. CARD(1:1).EQ.'1') GOTO 82
      IF(CARD(1:1).EQ.'0') GOTO 91
      IF(CARD(2:9).NE.' ') GOTO 91	! Added Feb90
      IF(ICON(2).EQ.0) THEN
      READ(CARD,235,ERR=82) THETA,DC,IH,IK,IL,INTY
235   FORMAT(F17.2,7X,F7.3,T34,3I3,6X,I6)
      ELSE
      READ(CARD,234,ERR=82) THETA,DC,IH,IK,IL,INTY
234   FORMAT(F17.2,7X,F7.3,T34,3I3,I6)
      ENDIF
      IF(IH.EQ.0 .AND. IK.EQ.0 .AND. IL.EQ.0) THEN
	 IF(J.EQ.0) WRITE(IO6,238)
238	 FORMAT(/' Please enter HKL''s for these calculated peaks.')
	 J=1
         WRITE(ITYP,236) I,THETA
236      FORMAT(' PEAK #',I4,' AT',F8.4,' H,K,L? ',$)
         READ(IREAD,237) IH,IK,IL
237      FORMAT(3I)
      ENDIF
      WRITE(ITP1,235) THETA,DC,IH,IK,IL,INTY
      I=I+1
      GOTO 82
91    CLOSE(UNIT=IN30)
C
C  DONE WITH THIS SAMPLE
C
      WRITE(ITP1,220)
      IF(ICON(5).EQ.0) GOTO 92
      WRITE(ITYP,245)
245   FORMAT(//' Enter data for your next sample.',/)
      GOTO 50
C
C  DONE WITH ALL SAMPLES
C
92    WRITE(ITP1,300)
300   FORMAT('$EOD')
      WRITE(ITYP,120) BATFIL(1:IDOT), BATFIL(1:IDOT)
  120 FORMAT(///,
     & ' Your job should  be run in batch.',/,
     & ' Your results will go into a file called ',A,'.LIS',/,
     & ' and a Tektronix plot will go into ',A,'.PLT',/,
     & ' Do you want to start the job now? ',
     & '<Yes or No or Interactive> ',$)
      READ(IREAD,108,END=9999) IANS
      IF(IANS.EQ.'I' .OR. IANS.EQ.'i') 
     &  CALL LIB$DO_COMMAND('@'//BATFIL)
      IF(IANS.NE.'N' .AND. IANS.NE.'n') 
     &  CALL LIB$DO_COMMAND('SUBMIT/NOPRINT/NOTIFY '//BATFIL)
      WRITE(ITYP,1099) BATFIL(1:IDOT)
1099	FORMAT(' To start your job from the $ prompt, type',/,
     &  ' SUBMIT/NOPRINT/NOTIFY ',A,/)
9999  CALL EXIT
      END
C
      SUBROUTINE DOPLOT(IANS,ICON)
      IF(IANS.EQ.'Y' .OR. IANS.EQ.'y') ICON=1
      IF(IANS.EQ.'N' .OR. IANS.EQ.'n') ICON=0
      IF(IANS.GE.'0' .AND. IANS.LE.'9') DECODE(1,4,IANS) ICON
4     FORMAT(I1)
      RETURN
      END
C   TEST PROGRAM TO VERIFY BELOW SUBROUTINES (FORT/D_LINES)
D	INCLUDE 'FILECONV.CBS'
D	CALL OBREAD(5,6,WAVEL)
D	WRITE(IO6,4) (SLID(I),I=1,16),NAME,DATM,NPKS
D4	FORMAT(' SAMPLE ID=',16A4,/,'COLLECTED BY ',3A4,' ON ',F7.0,
D    &	   '   NUMBER OF PEAKS=',I5)
D	TYPE*,'WAVE=',(WAVE(I,6),I=1,5)
D	WRITE(IO10,24) (C2TH(I),CDSP(I),PHKL(1,I),
D     &	   PHKL(2,I),PHKL(3,I),PHGH(I),I=1,NPKS)
D24	FORMAT(2F10.4,3I3,F10.4)
D	CALL OBWRIT(IO6)
D	END

	SUBROUTINE OBREAD(IO5,IO6,WAVEL)
	INCLUDE 'FILECONV.CBS'
1	WRITE(IO6,6)
6	FORMAT(' Enter the filename with the observed peaks? ',$)
	READ(IO5,5,END=9800) FILINP
5	FORMAT(A)
	IERR=0
	CALL RDI500
	IF(IERR.EQ.1) THEN
	   WRITE(IO6,81) IERR,IREC
81	   FORMAT(/' ERROR READING FILE.  IERR=',I5,' IREC=',I5)
	   GOTO 9800
	ELSEIF(IERR.EQ.2) THEN
	   WRITE(IO6,82)
82	   FORMAT(/' ERROR OPENING FILE, TRY ANOTHER NAME')
	   GOTO 1
	ENDIF
	WAVEL=WAVE(1,6)
	WRITE(IO6,14) (SLID(I),I=1,16),NAME,DATM,NPKS,WAVEL
14	FORMAT(' Sample ID=',16A4,/,
     &   ' Collected by ',3A4,' on ',F7.0,'   Number of peaks=',I5,
     &   ' Wavelength=',F6.4)
	RETURN
9800	STOP ' RUN CANCELED '
	END
	SUBROUTINE OBWRIT(IO10)
	INCLUDE 'FILECONV.CBS'
	DO 7,I=1,NPKS
	IF(C2TH(I).NE.0.0) WRITE(IO10,24) C2TH(I),PHGH(I)
7	CONTINUE
24	FORMAT(2F10.4)
	RETURN
	END
	SUBROUTINE OBWRIN(IO10)
	INCLUDE 'FILECONV.CBS'
	DO 7,I=1,NPKS
	IF(C2TH(I).NE.0.0) WRITE(IO10,24) C2TH(I),AREA(I,1)
7	CONTINUE
24	FORMAT(2F10.4)
	RETURN
	END
     	SUBROUTINE RDI500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A DIFFRAC-500 DIFILE
C	AND STORES IN THE CORRESPONDING COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 DUMY, NDIS, NDIR, ISDI(20), NUMP(20)
     	REAL*4 LAMDA1,LAMDA2,LAMDA3,LAMDA4
     	CLOSE( UNIT=IINP )
     	OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888,
     	1 ACCESS='DIRECT', RECL=1, READONLY,
	2 DEFAULTFILE='DI:.DIF')	!JDW FOR NBS
C
C  READ THE FILE HEADER BLOCK...
C
     	READ(IINP,REC= 1,ERR=777) DUMY,ITYP
     	IF( ITYP.NE.2 ) GOTO 777
     	READ(IINP,REC= 2,ERR=777) NHDB
     	READ(IINP,REC= 3,ERR=777) ISBF
     	READ(IINP,REC= 4,ERR=777) LENG
     	IF( LENG.LT.3 ) GOTO 777
C
C  READ THE SPECIFICATION BLOCK REFERENCES...
C
     	IREC = ISBF
     	DO I=1, LENG/3
     	   READ(IINP,REC= IREC  ,ERR=777) IRPR(I,1)
     	   READ(IINP,REC= IREC+1,ERR=777) IRPR(I,2)
     	   READ(IINP,REC= IREC+2,ERR=777) IRLR(I)
     	   IREC = IREC + 3
     	ENDDO
C
C  READ THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1) + 5
    	IELE = 6
     	DO I=1, 5		!READ THE WAVE SOURCES
     	   READ(IINP,REC=IREC,ERR=777) WAVE(I,6)
     	   IREC = IREC + 1
     	ENDDO
     	IF( WAVE(1,6).LE.0.0 ) GOTO 777
     	DO I=1, 5
     	   IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I
        ENDDO
C
C  READ THE FILE DESCRIPTION BLOCK...
C
     	IREC = IRPR(3,1)
     	READ(IINP,REC= IREC  ,ERR=777) NAME(1)
     	READ(IINP,REC= IREC+1,ERR=777) NAME(2)
     	READ(IINP,REC= IREC+2,ERR=777) NAME(3)
     	READ(IINP,REC= IREC+3,ERR=777) DATM
     	READ(IINP,REC= IREC+4,ERR=777) TIMM
     	READ(IINP,REC= IREC+5,ERR=777) FTYP,MTYP
     	READ(IINP,REC= IREC+8,ERR=777) NREP,MPRO
     	IF( NREP.LT.1 ) GOTO 777
     	READ(IINP,REC= IREC+9,ERR=777) NRNG,SCAN
     	IF( NRNG.LT.1 .OR. SCAN.NE.'S' ) GOTO 777
     	READ(IINP,REC= IREC+14,ERR=777) STYP
     	IREC = IREC + 15
     	DO I=1, 15
     	   READ(IINP,REC= IREC,ERR=777) SLID(I)
     	   IREC = IREC + 1
    	ENDDO
C
C  READ THE LINE MEASUREMENT BLOCK (FIRST RANGE ONLY)...
C
     	IREC = IRPR(4,1)
     	DO I=1, 14
     	   READ(IINP,REC= IREC,ERR=777) BANG(I)
     	   IREC = IREC + 1
     	ENDDO
CC     	IF( BANG(3).LE.0.0 .OR. BANG(10).LE.0.0 ) GOTO 777
C
C  READ THE DIFILE DATA BLOCK...
C
     	IREC = IRPR(6,1) 
     	READ(IINP,REC= IREC,ERR=777) NDIS,NDIR
     	IF( NDIS.LT.1 .OR. NDIR.LT.1 ) GOTO 777
     	DO I=1, NDIR*NDIS
     	   IREC = IREC + 1
     	   READ(IINP,REC= IREC,ERR=777) ISDI(I),NUMP(I)
    	ENDDO

     	IF( NDIS.GT.1 ) THEN
     	    DUMY = LDIGIT( NDIS )
1002	    WRITE(6,1000) NDIS
     	    READ(5,1001,ERR=1002,END=1002) DUMY
     	    IF( DUMY.LT.1 .OR. DUMY.GT.NDIS ) DUMY = 1
     	    NDIS = DUMY
     	ENDIF
1000	FORMAT(/
     	1' Input file contains ',I<DUMY>,' series of measurements'/
     	1' but only one measurement can be converted at a time.'/
     	1'$Which measurement to use? <1> ')
1001	FORMAT(I)

     	IRNG = 1
     	IF( NDIR.GT.1 ) THEN
     	    DUMY = LDIGIT( NDIR )
1003	    WRITE(6,1005) NDIR
     	    READ(5,1001,ERR=1003,END=1003) IRNG
     	    IF( IRNG.LT.1 .OR. IRNG.GT.NDIR ) IRNG = 1
     	ENDIF
1005	FORMAT(/
     	1' Input file contains ',I<DUMY>,' ranges of data'/
     	1' but only one range can be converted at a time.'/
     	1'$Which range to use? <1> ')

     	IRNG = IRNG+(NDIS-1)*NDIR
C       This line was improperly setting the base index into the data file.
         !IREC = ISDI(IRNG) 		!JUMP TO THE RANG
        NPKS = NUMP(IRNG)
    	IREC = IREC+1
     	IF( NPKS.GT.MNK ) NPKS = MNK
     	LAMDA1 = 0.5*WAVE(1,IELE)
     	LAMDA2 = 0.5*WAVE(2,IELE)
     	LAMDA3 = 0.5*WAVE(3,IELE)
     	LAMDA4 = 0.5*WAVE(4,IELE)
     	IK = 1
     	DO I=1, NPKS
     	   READ(IINP,REC= IREC  , ERR=777) F2TH(IK)
     	   READ(IINP,REC= IREC+1, ERR=777) C2TH(IK)
     	   READ(IINP,REC= IREC+2, ERR=777) PEAK(IK)
     		IF( PEAK(IK).EQ.' ' ) PEAK(IK) = 'KA1'
     	   READ(IINP,REC= IREC+4, ERR=777) PHGH(IK)
     	   READ(IINP,REC= IREC+6, ERR=777) AREA(IK,1)
     	   READ(IINP,REC= IREC+7, ERR=777) AREA(IK,2)
     		IF( AREA(IK,2).LT.1.0 ) AREA(IK,2) = 0.0
     		IF( AREA(IK,2).GE.1.0 ) IRES = 1
     	   READ(IINP,REC= IREC+8, ERR=777) FWHM(IK)
     	   READ(IINP,REC= IREC+9, ERR=777) NDIS,NDIR
     		IF( IABS(NDIS).GT.99 ) NDIS = 0
     	 	IF( IABS(NDIR).GT.99 ) NDIR = 0
     	   	PHKL(1,I) = NDIS
     	   	PHKL(2,I) = NDIR
     	   READ(IINP,REC= IREC+10,ERR=777) NDIS
     		IF( IABS(NDIS).GT.99 ) NDIS = 0
     		PHKL(3,I) = NDIS
     	   READ(IINP,REC= IREC+11,ERR=777) RELA(IK)
     	   	IREC = IREC + 12
     	   IF(PEAK(IK).EQ.' KA1') FDSP(IK) = LAMDA1/SIN(DTOR*F2TH(IK))
     	   IF(PEAK(IK).EQ.' KA2') FDSP(IK) = LAMDA2/SIN(DTOR*F2TH(IK))
     	   IF(PEAK(IK).EQ.' KA ' ) FDSP(IK) = LAMDA3/SIN(DTOR*F2TH(IK))
           IF(PEAK(IK).EQ.' KB1') FDSP(IK) = LAMDA4/SIN(DTOR*F2TH(IK))
C  IF THE CORRECTED 2THETA IS ABSENT THEN USE THE OBSERVED 2THETA  FEB 1990
	   IF(C2TH(IK).LT.0.0) THEN
	    CDSP(IK) = FDSP(IK)
	   ELSE
               
     	     IF(PEAK(IK).EQ.' KA1') CDSP(IK) = LAMDA1/SIN(DTOR*C2TH(IK))
     	     IF(PEAK(IK).EQ.' KA2') CDSP(IK) = LAMDA2/SIN(DTOR*C2TH(IK))
     	     IF(PEAK(IK).EQ.' KA ' ) CDSP(IK) = LAMDA3/SIN(DTOR*C2TH(IK))
     	     IF(PEAK(IK).EQ.' KB1') CDSP(IK) = LAMDA4/SIN(DTOR*C2TH(IK))
	   ENDIF
     	   IF(FDSP(IK).GT.0.5*LAMDA4) IK = IK + 1
        ENDDO
     	NPKS = IK
     	GOTO 999

777	IERR = 1
     	GOTO 999
888	IERR = 2
999	RETURN
     	END
    	FUNCTION LDIGIT( IT )
C
C  THIS FUNCTION RETURNS WITH THE NUMBER OF DIGITS OF "IT"
C
    	ITT = IABS(IT)
    	IF( ITT.EQ.0 ) THEN
    	    LDIGIT = 1
    	ELSE
    	    LDIGIT = INT( LOG10(FLOAT(ITT)) ) + 1
    	    IF( IT.LT.0 ) LDIGIT = LDIGIT + 1
    	ENDIF
    	RETURN
    	END
