C	PROGRAM NBS
C
C	SET UP THE DECK NECESSARY TO RUN AN NBS*LATTICE SEARCH
C
	DIMENSION CELL(6)
	CHARACTER*1 BR(7),B,BRAV,RH,INORG,ORG,ANS
	CHARACTER*2 LM,OI
	DATA LO/5/,LI/5/,IUNIT1/1/,LM/'LM'/
	DATA BR/'P','A','B','C','F','I','R'/
C
	OPEN (UNIT=IUNIT1,FILE='SEARCH.LAT',STATUS='NEW',
     $  ACCESS='SEQUENTIAL', FORM='FORMATTED',CARRIAGECONTROL='LIST')
C
	WRITE (LO,9)
9	FORMAT (//,20X,'NBS*SETUP -- VERSION 1'/
     1             20X,'WHICH GIVES THE SHORT OUTPUT BY DEFAULT'/
     1             20X,'MODES BY JOHNSON'/
     1             20X,'ALL FILES CREATED FROM THIS CODE WILL BE NAMED'/
     1             30X,'SEARCH.LAT     ----   SO BE CAREFUL'/
     1             20X,'VAX VERSION AUG 11, 1988'//)
	WRITE (LO,10) 
10	FORMAT (' THIS PROGRAM IS PRESENTLY DESIGNED TO SET UP A DECK'/
     $ ' OF CARDS FOR SUBMISSION TO PROGRAM "SEARCH" TO CARRY OUT A'/
     $ ' SEARCH/MATCH OF A SINGLE UNIT CELL (INCLUDING POSSIBLE'/
     $ ' SUPER- OR SUB-CELLS).'/)
11	WRITE (LO,12)
12	FORMAT (' ENTER ALL UNIT-CELL PARAMETERS (A,B,C,ALPHA,BETA,GAMMA):')
	READ (LO,14,ERR=11,END=9999) CELL
14	FORMAT (6F10.0)
15	WRITE (LO,16)
16	FORMAT ('$ENTER BRAVAIS LATTICE TYPE (P,A,B,C,F,I,OR R) (D:P):')
	READ (LI,18) B
        KEY=STR$UPCASE(B,B)
18	FORMAT (A)
	IF(B.EQ.' ') B='P'
	DO 20 J=1,7
	IF (B.EQ.BR(J)) GO TO 23
20	CONTINUE
	WRITE (LO,22)  B
22	FORMAT (/' UNKNOWN BRAVAIS LATTICE: ',A)
	GO TO 15
23	BRAV=B
	RH=' '
	IF(J.NE.7) GO TO 24
	RH='R'
	IF(CELL(6).GT.119.8.AND.CELL(6).LT.120.2) RH='H'
24	NRED=0
	WRITE(LO,25)
25	FORMAT(/' SUPERCELLS MAY BE SEARCHED WITH VOLUMES UP TO 9 TIMES'/
     $  ' THE INPUT CELL VOLUME.: SUBCELLS WITH VOLUMES DOWN TO 1/9.'/)
	MSUPER=0
	MSUB=0
	NPRINT=0
	WRITE (LO,26)
26	FORMAT ('$DO YOU WANT TO CONDUCT A SEARCH FOR SUPERCELLS (D:N) :')
	READ (LI,18) ANS
        KEY=STR$UPCASE(ANS,ANS)
	IF(ANS.EQ.'Y') MSUPER=1
C
C
	WRITE (LO,27)
27	FORMAT('$DO YOU WANT TO CONDUCT A SUBCELL SEARCH (D:N) :')
	READ (LI,18) ANS
        KEY=STR$UPCASE(ANS,ANS)
	IF(ANS.EQ.'Y') MSUB=1
	NRED = MSUPER+2*MSUB
	IF(NRED.EQ.0) GO TO 30
275	WRITE (LO,28) 
28	FORMAT ('$ENTER THE VOLUME MULTIPLIER AND/OR DIVISOR (2 - 9): ')
	READ (LI,29,ERR=275) MSUPER
29	FORMAT (I)
	IF (MSUPER.GT.9) MSUPER=9
	IF (MSUPER.LT.2) MSUPER=2
	MSUB=2
	WRITE (LO,291)
291	FORMAT ('$PRINT OUT REDUCTION AND DERIVATIVE LATTICE',
	1 ' CALCULATIONS (D:N) ? ')
	READ (LI,18) ANS
	IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') NPRINT=1
C
C	INFO FOR LM PARAMETER LINE
C
30	WRITE (LO,32)
32	FORMAT(/'$ENTER TOLERANCE FOR MATCH OF CELL EDGES (D:=0.10 A): ')
	READ (LI,14,ERR=30) EDGET
	IF (EDGET.LE.0.01) EDGET=0.10
325	WRITE (LO,33)
33	FORMAT('$ENTER TOLERANCE FOR MATCH OF CELL ANGLES (D:60.0): ')
	READ (LI,14,ERR=325) ANGLET
	IF (ANGLET.LE.0.01) ANGLET=60.0
335	WRITE (LO,34)
34	FORMAT('$ENTER PERCENT VOLUME TOLERANCE (D:5.0%): ')
	READ (LI,14,ERR=335) VOLT
	IF (VOLT.LE.5.0) VOLT=5.0
3636    WRITE (LO,36)
36	FORMAT(/'$DO YOU WANT TO SEARCH THE INORGANIC DATA BASE (D:Y): ')
	READ (LI,18) INORG
        KEY=STR$UPCASE(INORG,INORG)
	WRITE (LO,38)
38	FORMAT('$DO YOU WANT TO SEARCH THE ORGANIC DATA BASE (D:Y): ')
	READ (LI,18) ORG
        KEY=STR$UPCASE(ORG,ORG)
	IF(INORG.EQ.' ') INORG='Y'
	IF(ORG.EQ.' ') ORG='Y'
        IF(INORG.EQ.'N'.AND.ORG.EQ.'N') THEN
                                        WRITE(6,4455)
4455    FORMAT(' YOU MUST SEARCH ONE OF THE DATA BASES')
                                        GO TO 3636
        ENDIF
	IF(INORG.EQ.'Y'.AND.ORG.EQ.'Y') OI='OI'
	IF(INORG.EQ.'Y'.AND.ORG.NE.'Y') OI='I '
	IF(INORG.NE.'Y'.AND.ORG.EQ.'Y') OI='O '
C
C	WRITE INPUT DECK TO LATTICE
C
	WRITE (IUNIT1,90) LM,IUNIT1
90	FORMAT (A,7X,I1)
	WRITE (IUNIT1,92) EDGET,ANGLET,VOLT,OI,NPRINT
92	FORMAT (3F10.2,3X,A,4X,I1)
	WRITE (IUNIT1,94) NRED,MSUB,MSUPER,BRAV,RH,CELL
94	FORMAT (I1,2X,2I1,3X,2A,3F10.3,3F10.2)
	CLOSE (UNIT=IUNUT1)
	STOP '                     END OF NBS*SETUP'
9999    CLOSE (UNIT=IUNIT1,STATUS='DELETE')
	END
