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.5 ) PARAMETER ( DY = 0.5 ) PARAMETER ( DZ =-3. ) PARAMETER ( NX = 20 ) PARAMETER ( NY = 20 ) PARAMETER ( NZ = 1 ) DIMENSION GOLEM(NX,NY,NZ) INTEGER*4 GOLEM CHARACTER TITLE*80 DIMENSION IREG(5000), KREG(5000) INTEGER*2 IREG, KREG * CALL CMSPPR DO IC = 1, 1000 KREG(IC) = 0 END DO OPEN(UNIT=30,FILE='pinakas.txt',STATUS='OLD') READ(30,*) GOLEM 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(*,'(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='ct.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