C ********************************************************************** C C CONINT.FOR -- CREATED OCT 90 C ********************************************************************** C * AUTHOR: ArDean Leith C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C C CONINT(MAXDIM) C C PURPOSE: READS SPIDER 3-D PICTURE FILE, CREATES 3-D IMAGE C FILE CONTAINING NUMBERS FOR CONNECTED CLUSTERS C C PARAMETERS: MAXDIM PIXEL LIMIT PER SLICE C SLICES ARRAY ALLOCATION FOR SLICES C MAXTAB MAXIMUM NUMBER OF CLUSTERS C C CALLS: CCONECT FILSLI C MAPIM C EMPSLI EMPSLI C MAKTAB SHOSLI C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE CONINT(MAXDIM,MAXTAB) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' CHARACTER (LEN=MAXNAM) :: FILNAM C NSAMAX IS MAXIMUM NUMBER OF COL. IN IMAGE PARAMETER (NSAMAX = 10000) C NEQMAX IS MAXIMUM NUMBER OF PLACES IN BRANCHING EQUIV. TABLE PARAMETER (NEQMAX = 16000) C NSLMAX IS MAXIMUM NUMBER OF SLICES IN MSLICES TABLE PARAMETER (NSLMAX = 800) C NPIXMAX IS MAXIMUM NUMBER OF PIXELS IN 2 SLICES PARAMETER (NPIXMAX = 524288) C USED IN MAKTAB ONLY PARAMETER (NOTMAX = 10000) C WARNING MAKTAB AND MAPDIST ALSO USE UNLABELED COMMON!!! INTEGER * 2 SLICES COMMON SLICES(NPIXMAX),MSLICES(NSLMAX),IEQUIV(2,NEQMAX), & BUF(NSAMAX),NOTDONE(NOTMAX),NOTUSED(NOTMAX), & ISTACK(1) COMMON /DOC_BUF/ TABLE(1) C DIMENSION VALUES(3) CHARACTER * 1 NULL LOGICAL LASTSLI,DEBUGING DATA FLTZER/10E-30/ NULL = CHAR(0) DEBUGING = .FALSE. LUNIM = 11 LUNOUT = 12 NEQUIV = 0 LASTCLUS = 0 C OPEN SPIDER FILE AS INPUT 20 MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM,LUNIM,'O',IFORM,NSAM,NROW,NSLICE, & MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 NSLICE1 = NSLICE NPIXP1 = NSAM * NROW + 1 MAXPIX = NPIXMAX IF (NPIXP1 .GE. MAXPIX) THEN WRITE(NOUT,90) MAXPIX 90 FORMAT(' *** PGM LIMIT:',I7,' PIXELS, FILE SKIPPED'/) CALL ERRT(100,'CONINT',NE) GOTO 9999 ELSEIF (NSAM .GT. NSAMAX) THEN NTEMP = NSAMAX WRITE(NOUT,92) NTEMP 92 FORMAT(' *** PGM LIMIT:',I6,' COLUMNS, FILE SKIPPED'/) CALL ERRT(100,'CONINT',NE) GOTO 9999 ELSEIF (IMAMI .NE. 1) THEN IF (NSLICE .GT. 1) & WRITE(NOUT,*) ' NORMALIZING 3D FILE, PLEASE WAIT.' CALL NORM3(LUNIM,NSAM,NROW,NSLICE1,FMAX,FMIN,AV) ENDIF IF ((FMAX - FMIN) .LT. FLTZER) THEN WRITE(NOUT,*) ' *** ERROR: BLANK FILE SKIPPED ' CALL ERRT(100,'CONINT',NE) GOTO 9999 ENDIF 21 NUMSLI = NSLMAX CALL RDPRAI(MSLICES,NSLMAX,NUMSLI,1,NSLICE1, & 'ENTER SLICE NUMBERS',NULL,IRTFLG) IF (IRTFLG .EQ. -1) THEN CLOSE(LUNIM) GOTO 20 ENDIF NSLICE2 = NUMSLI C DISPLAY MAX AND MIN VALUE OF PICTURE , ASK FOR THE LEVEL WRITE(NOUT,91) FMIN,FMAX 91 FORMAT(' IMAGE RANGE: ',1PG11.3,'....',1PG11.3) C FIND THRESHOLD LEVEL FOR CLUSTERS 22 CALL RDPRM1S(THLEV,NOT_USED,'THRESHOLD LEVEL',IRTFLG) IF (IRTFLG .NE. 0) GOTO 21 23 MAXIM = 0 IFORM = 3 CALL OPFILEC(LUNIN,.TRUE.,FILNAM,LUNOUT,'N',IFORM, & NSAM,NROW,NSLICE,MAXIM,'CLUSTER OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .EQ. -1) GOTO 22 IF (IRTFLG .NE. 0) GOTO 9999 LASTSLI = .FALSE. DO IPTR = 1,NUMSLI IF (MOD(IPTR,2) .NE. 0) THEN C CURRENT SLICE IS IN SLICE1 INOW = 1 INEXT = NPIXP1 ELSE C NEXT SLICE GOES INTO SLICE1 INOW = NPIXP1 INEXT = 1 ENDIF ISLICE = MSLICES(IPTR) NREC1 = (ISLICE - 1) * NROW + 1 NREC2 = NREC1 + NROW - 1 IF (IPTR .EQ. 1) THEN C MUST LOAD CURRENT SLICE ALSO CALL FILSLI(LUNIM,BUF,NSAM,NREC1,NREC2,.TRUE., & THLEV,SLICES(1)) ENDIF IF (IPTR .LT. NUMSLI) THEN C LOAD NEW NEXT SLICE ISLICEN = MSLICES(IPTR+1) IF (ISLICEN .GT. NSLICE1) THEN C NO SUCH INPUT SLICE WRITE(NOUT,*) ' *** SLICE NOT AVAILABLE:',ISLICEN GOTO 40 ENDIF NREC1N = (ISLICEN - 1) * NROW + 1 NREC2N = NREC1N + NROW - 1 CALL FILSLI(LUNIM,BUF,NSAM,NREC1N,NREC2N,.TRUE., & THLEV,SLICES(INEXT)) ELSE LASTSLI = .TRUE. ENDIF C PROCESS CURRENT SLICE FOR CONNECTIVITY CALL CCONECT(NSAM,NROW,LUNOUT,SLICES(INOW), & SLICES(INEXT),LASTSLI,IEQUIV,NEQUIV, & NEQMAX,LASTCLUS,MAXTAB,IRTFLG) IF (IRTFLG .NE. 0) RETURN C STORE CURRENT SLICE IN OUTPUT FILE NREC1N = (IPTR - 1) * NROW + 1 NREC2N = NREC1N + NROW - 1 CALL EMPSLI(LUNOUT,BUF,NSAM,NREC1N,NREC2N,SLICES(INOW)) IF (DEBUGING) CALL SHOSLI(NOUT,BUF,NSAM,1,NSAM,SLICES(INOW)) WRITE(NOUT,96) ISLICE,NEQUIV,LASTCLUS 96 FORMAT(' After slice:',I4,', Branches=',I6,' Clusters=',I6) 40 CONTINUE ENDDO C ALL SLICES PROCESSED, START SECOND PASS THRU DATA FOR BRANCHES C****************** DEBUGING IF (DEBUGING) THEN WRITE(10,*) ' IEQUIV ' WRITE(10,793) ((IEQUIV(I,J),I=1,2),J=1,NEQUIV) 793 FORMAT(6(2I5,2X)) ISLICE = 10 WRITE(10,*) ' AFTER FIRST PASS STACK SLICE:',ISLICE NREC1 = (ISLICE - 1) * NROW + 1 NREC2 = NREC1 + NROW - 1 CALL FILSLI(LUNOUT,BUF,NSAM,NREC1,NREC2,.FALSE.,0.0,SLICES) WRITE(10,9099) WRITE(10,*) ' window one (200,90)...(240,200)' NREC1 = 90 NREC2 = 200 NSAM1 = 200 NSAM2 = 340 NSAM1 = 210 NSAM2 = 239 CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) NSAM1 = 240 NSAM2 = 269 WRITE(10,9099) CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) WRITE(10,9099) 9099 FORMAT('1') C WRITE(10,*) ' window two (415,190)...(475,325)' C NREC1 = 190 C NREC2 = 325 C NSAM1 = 415 C NSAM2 = 444 C CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) C WRITE(10,9099) C NSAM1 = 445 C NSAM2 = 475 C CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) ENDIF C******************************************* 888 WRITE(NOUT,*) ' ' WRITE(NOUT,*) ' Constructing mapping table, please wait.' CALL MAKTAB(IEQUIV,NEQUIV,TABLE,LASTCLUS,NTAB, & NOTDONE,NOTUSED,ISTACK,IRTFLG) c************DEBUGING IF (DEBUGING) THEN WRITE(10,*) ' TABLE ' WRITE(10,6993) (IT,TABLE(IT),IT=1,LASTCLUS) 6993 FORMAT(7(I5,1X,F5.0)) ENDIF C*************************************** NREC1 = 1 NREC2 = NROW * NSLICE2 WRITE(NOUT,*) ' Remapping cluster numbers, please wait.' CALL MAPIM(LUNOUT,LUNOUT,NSAM,NREC1,NREC2,TABLE,LASTCLUS, & BUF,IRTFLG) CCC VALUES(1) = 1.0 CCC VALUES(2) = NLAB CCC VALUES(3) = 0.0 C NEGATIVE IRTFLG SUPRESSES LABEL CHANGE OUTPUT CCC IRTFLG = -1 CCC CALL SETLAB(LUNOUT,NSAM,BUF,6,3,VALUES,'U',IRTFLG) C****************** DEBUGING IF (DEBUGING) THEN ISLICE = 10 WRITE(10,*) ' FINAL STACK SLICE:',ISLICE NREC1 = (ISLICE - 1) * NROW + 1 NREC2 = NREC1 + NROW - 1 CALL FILSLI(LUNOUT,BUF,NSAM,NREC1,NREC2,.FALSE.,0.0,SLICES) WRITE(10,9099) WRITE(10,*) ' window one (200,90)...(240,200)' NREC1 = 90 NREC2 = 200 NSAM1 = 200 NSAM2 = 340 NSAM1 = 210 NSAM2 = 239 CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) NSAM1 = 240 NSAM2 = 269 WRITE(10,9099) CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) C WRITE(10,9099) C WRITE(10,*) ' window two (415,190)...(475,325)' C NREC1 = 190 C NREC2 = 325 C NSAM1 = 415 C NSAM2 = 444 C CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) C WRITE(10,9099) C NSAM1 = 445 C NSAM2 = 475 C CALL SHOSLI2(10,BUF,NSAM,NSAM1,NSAM2,NREC1,NREC2,SLICES) ENDIF C*********************************************** 9999 CONTINUE C CLOSE THE FILES CLOSE(LUNOUT) CLOSE(LUNIM) RETURN END