       PROGRAM WRITEGOLEM
*
       INCLUDE '(DBLPRC)'
       INCLUDE '(DIMPAR)'
       INCLUDE '(IOUNIT)'
*      COLUMNS: FROM LEFT TO RIGHT
*      ROWS: FROM BACK TO FRONT
*      SLICES: FROM TOP TO BOTTOM
       PARAMETER ( DX = 0.1741 )
       PARAMETER ( DY = 0.1741 )
       PARAMETER ( DZ = 0.1   )
       PARAMETER ( NX = 280 )
       PARAMETER ( NY = 130 )
       PARAMETER ( NZ = 1761 )
       DIMENSION GOLEM(NX,NY,NZ)
       INTEGER*2 GOLEM
       CHARACTER TITLE*80
       DIMENSION IREG(1000), KREG(1000)
       INTEGER*2 IREG, KREG
*
       CALL CMSPPR
       DO IC = 1, 1000
          KREG(IC) = 0
       END DO
       OPEN(UNIT=30,FILE='CRAM_v3_314_new.txt',STATUS='OLD')
       READ(30,*) GOLEM
*      TEST GOLEM
       WRITE(*,*)' GOLEM(55,27,1)',GOLEM(55,27,1)     
       WRITE(*,*)' GOLEM(55,27,2)',GOLEM(55,27,2) 
       NO=0
       MO=0
       DO IZ=1,NZ
          DO IY=1,NY
             DO IX=1,NX
                IF (GOLEM(IX,IY,IZ) .GT. 0) THEN
                   IC = GOLEM(IX,IY,IZ)
                   MO = MAX (MO,IC)
                   DO IR=1,NO
                      IF (IREG(IR) .EQ. IC) GO TO 1000
                   END DO
                   NO=NO+1
                   IREG(NO)=IC
                   KREG(IC)=NO
                   WRITE(*,'(A,2I10)')' New number, old number: ', NO,IC
1000             CONTINUE
                END IF
             END DO
          END DO
       END DO
*      NO = number of different organs
*     MO = max. organ number before compacting
       WRITE(*,*) ' NO,MO',NO,MO
      OPEN(UNIT=31,FILE='golem.vxl',STATUS='UNKNOWN',FORM='UNFORMATTED')
       TITLE = 'Golem'
       WRITE(31) TITLE
       WRITE(31) NX,NY,NZ,NO,MO
       WRITE(31) DX,DY,DZ
       WRITE(31) GOLEM
       WRITE(31) (KREG(IC),IC=1,MO)
       STOP
       END

