C***   XMAP


       SUBROUTINE XMAP

C  PRINT A CAVE MAP.

       IMPLICIT INTEGER(A-Z)
      REAL*8 ATAB,DJJ
       COMMON /VOCCOM/ KTAB(600),ATAB(600),TABSIZ
      INTEGER*4 LTEXT,STEXT,LL
       COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
      INTEGER*4 TRAVEL,JJ
       COMMON /TRVCOM/ TRAVEL(1600)
      INTEGER*4 LOCCON,OBJCON
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

       DIMENSION TK(20),BUF(66),TEMP(10)

      POSN=0
      CALL SRCH$$(2,'MAP.ADV',7,1,FTYPE,FCODE)
       DO 107 LOC=1,LOCSIZ
       IF(STEXT(LOC).EQ.0.AND.LTEXT(LOC).EQ.0)GOTO 9
       CALL XSPEAK(LOC)
       K=0
       IF(MOD(LOCCON(LOC)/8,2).EQ.1) K=34+(MOD(LOCCON(LOC)/2,4))
       CALL MSPEAK(K)

       N=KEY(LOC)

3       LL=IABS(TRAVEL(N))/1000
C       WRITE (22,10),LL
      ENCODE(8,10,TEMP)LL
      DO 100 I1=1,4
      POSN=POSN+1
100   BUF(POSN)=TEMP(I1)
4       K=MOD(IABS(TRAVEL(N)),1000)
       IF(K.GT.1)GOTO 6
C       IF(K.EQ.1)WRITE (22,14)
      IF(K.NE.1)GOTO 9
      ENCODE(18,14,TEMP)
      DO 101 I1=1,9
      POSN=POSN+1
101   BUF(POSN)=TEMP(I1)
      GOTO 9

6      DO 7 J=1,TABSIZ
       IF(KTAB(J).EQ.-1)GOTO 8
       IF(K.NE.KTAB(J))GOTO 7
       DJJ=ATAB(J)
C       IF(KK.NE.1)WRITE (22,11),JJ
      ENCODE(8,11,TEMP)DJJ
C       IF(KK.EQ.1)WRITE (22,12),DJJ
      DO 102 I1=1,4
      POSN=POSN+1
102   BUF(POSN)=TEMP(I1)
      GOTO 8
7       CONTINUE

8       N=N+1
C       IF(KK.GT.1)WRITE (22,13)
       IF(TRAVEL(N-1).LT.000000)GOTO 9
       JJ=IABS(TRAVEL(N))/0001000
       IF(JJ.EQ.LL)GOTO 4
C       WRITE (22,15)
      WRITE(5,104)(BUF(I1),I1=1,POSN)
104   FORMAT(66A2)
      POSN=0
       GOTO 3

9     WRITE(5,104)(BUF(I1),I1=1,POSN)
      POSN=0
107   CONTINUE
      CALL CLOS$A(1)
       RETURN

10    FORMAT(2X,I6)
11    FORMAT(2X,A6)
12    FORMAT(1X,'(',A6)
13    FORMAT(1X,')')
14      FORMAT ('      [FORCED LOC]')
15      FORMAT (1H )

       END