	SUBROUTINE SCAN(ID,W,CHAR)
C	ROUTINE TO GIVE SCAN FROM CRAWLER'S VIEWPOINT
C	ID IS CRAWLER ID
C	W IS 'WAY' OR DIRECTION OF SCAN
C	N=0 FOR NORMAL SCAN, 1 FOR X-RAY SCAN, 2 FOR FULL-CUBE X-RAY SCAN
C	IOUT IS SCANNER STORAGE ARRAY
C	JOUT CONTAINS SHIFTED IOUT FOR SCREEN IMAGE
C----------------------standard common block----------------------------
C 
	COMMON ICR(8,12),IPARM(10),IS1,IS2,NT,ICU(10,10,10,2),CLEAR(8)
	COMMON MARKER(4,3,3)
	LOGICAL*1 ICU,CLEAR
C 
C-----------------------------------------------------------------------
	LOGICAL*1 IOUT(10,10),JOUT(10,10),W,CHAR
	LUN=ICR(ID,8)
30	IF(W.EQ.'S') N=0
	IF(W.EQ.'X') N=1
	IF(W.EQ.'W') N=2
	M=0
	IF(CHAR.EQ.'E') ME=1
	WRITE(LUN,31)
31	FORMAT(' scan direction (F,L,B,R,U,D): ',$)
	READ(LUN,32) W
32	FORMAT(A1)
	IF(W.EQ.'F'.OR.W.EQ.'L'.OR.W.EQ.'B'.OR.W.EQ.'R'.OR.W.EQ.'U'.OR.
     CW.EQ.'D') GOTO 37
	WRITE(LUN,36)
36	FORMAT(' scan aborted')
	GOTO 700   ! RETURN
37	IS0=0 ! FLAG TO BSCAN: GET IS0,JS0 IFF IS0=0
	X=-1.
	IF(N.EQ.1) GOTO 7
	IF(N.EQ.2) GOTO 17
	IF(ICR(ID,9).LT.1) GOTO 10  ! RETURN, NOT ENOUGH ENERGY
	ICR(ID,9)=ICR(ID,9)-1
	GOTO 6
7	IF(ICR(ID,9).LT.2) GOTO 10  ! NOT ENOUGH ENERGY FOR X-RAY SCAN
	ICR(ID,9)=ICR(ID,9)-2
	GOTO 6
17	IF(ICR(ID,9).LT.4) GOTO 10 ! NOT ENOUGH FOR WHOLE-CUBE SCAN
	ICR(ID,9)=ICR(ID,9)-4
6	I0=ICR(ID,10)
	J0=ICR(ID,11)
	K0=ICR(ID,12)
	NS=0  ! FLAG TO ASCAN, CLEAR SCREEN ON FIRST PASS ONLY
C 
C	TRANSMITTER LOCATIONS:
	DO 4 L=1,3
	I=MARKER(ID,1,L)
	IF(I.LE.0) GOTO 4
	J=MARKER(ID,2,L)
	K=MARKER(ID,3,L)
	IF(ICU(I,J,K,1).NE.' ') GOTO 4
	ICU(I,J,K,1)='@'+L+10! 1-->A, 2-->B, 3-->C
C	+10 IN ABOVE STMT TO PREVENT AMBIGUITIES WITH CRAWLERS ON
C	DOORWAYS WHICH ARE CHARS. ";" THROUGH "B"
4	CONTINUE
C	WRITE(5,900) ((MARKER(1,J,K),J=1,3),K=1,3)
C900	FORMAT(' MARKER'/3(3I4/))
C	READ(5,901) Z
C901	FORMAT(A1)
5	IX=0
	IY=0
	IZ=0
	CALL DIREC(ID,W,IZ,L)   ! IZ IS DUMMY; GET ABS SCAN DIRECTION
	CHAR='@'
C	GET UP-SCAN DIRECTIONS
	IF(W.EQ.'D') CALL DIREC(ID,CHAR,1,IUS)
	IF(W.EQ.'L') CALL DIREC(ID,CHAR,5,IUS)
	IF(W.EQ.'B') CALL DIREC(ID,CHAR,5,IUS)
	IF(W.EQ.'R') CALL DIREC(ID,CHAR,5,IUS)
	IF(W.EQ.'U') CALL DIREC(ID,CHAR,3,IUS)
	IF(W.EQ.'F') CALL DIREC(ID,CHAR,5,IUS)
C 
	X=(IPARM(4)-.01)*.3
	I00=I0
	J00=J0
	K00=K0
	IF(N.NE.2) GOTO 9
C	SET FOR WHOLE-CUBE SCAN
	X=(IPARM(5)-.01)*.3
	IS0=1  ! FLAG TO BSCAN: DON'T SEARCH FOR CRAWLER COORDINATES
	IF(L.EQ.1) I00=1
	IF(L.EQ.2) J00=1
	IF(L.EQ.3) I00=10
	IF(L.EQ.4) J00=10
	IF(L.EQ.5) K00=1
	IF(L.EQ.6) K00=10
C 
C 	CLEAR JOUT ARRAY:
9	DO 19 I=1,10
	DO 19 J=1,10
	JOUT(I,J)=' '
19	CONTINUE
	CHAR=' '
	GOTO (100,200,300,400,500,600) L
	WRITE(LUN,20) L
20	FORMAT(' invalid scan direction',I6)
	GOTO 700
C 
10	WRITE(LUN,11)
11	FORMAT(' .....sputter... ....fizzzle......')
	GOTO 700
C 
C 
100	DO 101 I=I00,10
C	CLEAR IOUT:
	DO 102 J=1,10
	DO 102 K=1,10
	IOUT(J,K)='.'
102	CONTINUE
	DO 103 J=1,10
	DO 103 K=1,10
	W=ICU(I,J,K,1)
	IF(W.GT.'8'.AND.W.LT.'N') W=W-10
	IF(W.NE.' ') IOUT(J,K)=W
	IF(W.EQ.' '.AND.ME.EQ.1) IOUT(J,K)=ICU(I,J,K,2)+"140
C	ABOVE: 0-->`, 1-->a, 2-->b, 3-->c, etc. (ENERGY SCAN)
103	CONTINUE
	CALL BSCAN(IOUT,L,IUS,IS0,JS0,ID)
	CALL ASCAN(ID,IOUT,JOUT,I-I0,N,IS0,JS0,NS)
	IF(I.LT.10) CALL DELAY(X,LUN,CHAR)
	IF(CHAR.GT.' ') GOTO 650
101	CONTINUE
	GOTO 650
200	DO 201 J=J00,10
C	CLEAR IOUT:
	DO 202 I=1,10
	DO 202 K=1,10
	IOUT(I,K)='.'
202	CONTINUE
	DO 203 I=1,10
	DO 203 K=1,10
	W=ICU(I,J,K,1)
	IF(W.GT.'8'.AND.W.LT.'N') W=W-10
	IF(W.NE.' ') IOUT(I,K)=W
	IF(W.EQ.' '.AND.ME.EQ.1) IOUT(I,K)=ICU(I,J,K,2)+"140
203	CONTINUE
	CALL BSCAN(IOUT,L,IUS,IS0,JS0,ID)
	CALL ASCAN(ID,IOUT,JOUT,J-J0,N,IS0,JS0,NS)
	IF(J.LT.10) CALL DELAY(X,LUN,CHAR)
	IF(CHAR.GT.' ') GOTO 650
201	CONTINUE
	GOTO 650
300	DO 301 I1=11-I00,10
C	CLEAR IOUT:
	I=11-I1
	DO 302 J=1,10
	DO 302 K=1,10
	IOUT(J,K)='.'
302	CONTINUE
	DO 303 J=1,10
	DO 303 K=1,10
	W=ICU(I,J,K,1)
	IF(W.GT.'8'.AND.W.LT.'N') W=W-10
	IF(W.NE.' ') IOUT(J,K)=W
	IF(W.EQ.' '.AND.ME.EQ.1) IOUT(J,K)=ICU(I,J,K,2)+"140
	IF(W.GT.'8'.AND.W.LT.'C') W=W-10
303	CONTINUE
	CALL BSCAN(IOUT,L,IUS,IS0,JS0,ID)
	CALL ASCAN(ID,IOUT,JOUT,I0-I,N,IS0,JS0,NS)
	IF(I.GT.1) CALL DELAY(X,LUN,CHAR)
	IF(CHAR.GT.' ') GOTO 650
301	CONTINUE
	GOTO 650
400	DO 401 J1=11-J00,10
	J=11-J1
C	CLEAR IOUT:
	DO 402 I=1,10
	DO 402 K=1,10
	IOUT(I,K)='.'
402	CONTINUE
	DO 403 I=1,10
	DO 403 K=1,10
	W=ICU(I,J,K,1)
	IF(W.GT.'8'.AND.W.LT.'N') W=W-10
	IF(W.NE.' ') IOUT(I,K)=W
	IF(W.EQ.' '.AND.ME.EQ.1) IOUT(I,K)=ICU(I,J,K,2)+"140
403	CONTINUE
	CALL BSCAN(IOUT,L,IUS,IS0,JS0,ID)
	CALL ASCAN(ID,IOUT,JOUT,J0-J,N,IS0,JS0,NS)
	IF(J.GT.1) CALL DELAY(X,LUN,CHAR)
	IF(CHAR.GT.' ') GOTO 650
401	CONTINUE
	GOTO 650
500	DO 501 K=K00,10
C	CLEAR IOUT:
	DO 502 I=1,10
	DO 502 J=1,10
	IOUT(I,J)='.'
502	CONTINUE
	DO 503 I=1,10
	DO 503 J=1,10
	W=ICU(I,J,K,1)
	IF(W.GT.'8'.AND.W.LT.'N') W=W-10
	IF(W.NE.' ') IOUT(I,J)=W
	IF(W.EQ.' '.AND.ME.EQ.1) IOUT(I,J)=ICU(I,J,K,2)+"140
503	CONTINUE
	CALL BSCAN(IOUT,L,IUS,IS0,JS0,ID)
	CALL ASCAN(ID,IOUT,JOUT,K-K0,N,IS0,JS0,NS)
	IF(K.LT.10) CALL DELAY(X,LUN,CHAR)
	IF(CHAR.GT.' ') GOTO 650
501	CONTINUE
	GOTO 650
600	DO 601 K1=11-K00,10
	K=11-K1
C	CLEAR IOUT:
	DO 602 I=1,10
	DO 602 J=1,10
	IOUT(I,J)='.'
602	CONTINUE
	DO 603 I=1,10
	DO 603 J=1,10
	W=ICU(I,J,K,1)
	IF(W.GT.'8'.AND.W.LT.'N') W=W-10
	IF(W.NE.' ') IOUT(I,J)=W
	IF(W.EQ.' '.AND.ME.EQ.1) IOUT(I,J)=ICU(I,J,K,2)+"140
603	CONTINUE
	CALL BSCAN(IOUT,L,IUS,IS0,JS0,ID)
	CALL ASCAN(ID,IOUT,JOUT,K0-K,N,IS0,JS0,NS)
	IF(K.GT.1) CALL DELAY(X,LUN,CHAR)
	IF(CHAR.GT.' ') GOTO 650
601	CONTINUE
C	RESTORE ICU -- REMOVE TRANSMITTER MARKERS:
650	DO 651 L=1,3
	I=MARKER(ID,1,L)
	J=MARKER(ID,2,L)
	K=MARKER(ID,3,L)
	W=ICU(I,J,K,1)-10
	IF(W.EQ.'A'.OR.W.EQ.'B'.OR.W.EQ.'C') ICU(I,J,K,1)=' '
651	CONTINUE
700	RETURN
	END
