C++********************************************************************* C C ENHANC.F FIXED UNDEFINED BOTTOM BUG APR 02 ARDEAN LEITH C REMOVED 'CE L" (HAS NOT WORKED IN 16 YRS) ARDEAN LEITH C SETPRMB PARAMETERS MAY 09 ARDEAN LEITH C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2009 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 ENHANC(FILNAM,LUNI,LUNO,NSAM,NROW) C C PURPOSE: IMAGE ENHANCEMENT ROUTINE. CALLS OTHER ROUTINES FOR C HISTOGRAM BASED ENHANCEMENTS AND DOES THRESHOLDING. C C PARAMETERS: C FILNAM NAME OF FILE C LUNI LOGICAL UNIT NUMBER OF INPUT FILE C LUNO LOGICAL UNIT NUMBER OF OUTPUT FILE C NSAM,NROW DIMENSIONS OF FILE C C--******************************************************************* SUBROUTINE ENHANC(FILNAM,LUNI,LUNO,NSAM,NROW,NSLICE) COMMON BUF(1) INCLUDE 'CMBLOCK.INC' DIMENSION VAL(4) CHARACTER(LEN=*) :: FILNAM CHARACTER(LEN=1) :: NULL,IRESH,ANS EQUIVALENCE(B1,VAL(1)),(T1,VAL(2)),(B2,VAL(3)),(T2,VAL(4)) NULL = CHAR(0) MAPA = NSAM+128 CALL RDPRMC(ANS,NC,.TRUE., & '(S)INGLE, (A)UTOMATIC OR (D)OUBLE MAPPING? (S/A/D)',NULL,IRT) IF (IRT .EQ. -1) RETURN IF (ANS .EQ. 'A') THEN CALL RDPRM(PERC,NOT_USED,'INTEGRAL THRESHOLD PERCENT') CALL RDPRMC(IRESH,NC,.TRUE.,'PLOT RESULT HISTOGRAM? (Y/N)', & NULL,IRT) ENDIF IF (ANS .EQ. 'S' .OR. ANS .EQ. 'A') THEN CALL RDPRM(BOTTOM,NOT_USED,'BOTTOM DENSITY VALUE') CALL RDPRM(TOP, NOT_USED,'TOP DENSITY VALUE') IF (BOTTOM .GE. TOP) GOTO 650 ENDIF C DETERMINE HISTOGRAM FROM IMAGE CALL HIST(LUNI,0,0,NSAM,NROW,NSLICE,HMIN,HMAX,HSIG,HMODE) 94 HINCO = (HMAX - HMIN) / 127.0 WRITE(NOUT,1111) HMIN,HMAX 1111 FORMAT(' HISTOGRAM MINIMUM =',F10.5, & ' HISTOGRAM MAXIMUM =',F10.5) IF (ANS .EQ. 'D') THEN C NON-UNIQUE MAPPING WITH DOUBLE LINEAR MAPPING FUNCTION 100 CALL RDPRM(B1,NOT_USED,'BOTTOM1') IF (B1 .LT. FMIN) B1 = FMIN CALL RDPRM(T1,NOT_USED,'TOP1') CALL RDPRM(B2,NOT_USED,'BOTTOM2') CALL RDPRM(T2,NOT_USED,'TOP2') IF (T2 .GT. FMAX) T2 = FMAX C CHECK IF B1,T1,B2,T2 ARE ORDERED ACCORDING TO INCREASING VALUE A = VAL(1) DO I = 1,4 A = AMAX1(A,VAL(I)) IF (A .NE. VAL(I)) GOTO 650 ENDDO IF (B1 .NE. T1) THEN IF (B2 .NE. T2) GOTO 130 BOTTOM = B1 TOP = T1 ELSE BOTTOM = B2 TOP = T2 ENDIF GOTO 30 130 NB1 = (B1-HMIN) / HINCO + 1.5 NT1 = (T1-HMIN) / HINCO + 1.5 C NEW DENSITY INCREMENT ON LEFT HAND SIDE HINCN1 = 2.0 / FLOAT(NT1-NB1) NB2 = (B2-FMIN) / HINCO+1.5 NT2 = (T2-FMIN) / HINCO+1.5 C NEW DENSITY INCREMENT ON RIGHT HAND SIDE HINCN2 = 2.0 / FLOAT(NT2-NB2) IF (NB1 .GE. 2) THEN DO K = 1,NB1-1 BUF(MAPA+K) = 0. ENDDO ENDIF DO K = NB1,NT1 BUF(MAPA+K) = FLOAT(K-NB1)* HINCN1 ENDDO IF (NT1 .NE. NB2) THEN DO K = NT1+1,NB2-1 BUF(MAPA+K) = 2. ENDDO ENDIF DO K = NB2,NT2 BUF(MAPA+K) = FLOAT(K-NB2)*HINCN2 ENDDO IF (NT2 .NE. 128) THEN DO K = NT2+1,128 BUF(MAPA+K) = 2. ENDDO ENDIF GOTO 500 ELSEIF (ANS .EQ. 'A') THEN P = PERC*FLOAT(NSAM)*FLOAT(NROW)*FLOAT(NSLICE)/100. ADD = 0.0 DO I = 1,128 IM = I ADD = ADD + BUF(NSAM+I) WRITE(NDAT,2222)I,P,ADD,BUF(NSAM+I) 2222 FORMAT(1X,I3,3F10.5) IF (ADD .GT. P) GOTO 97 ENDDO 97 BOTTOM = FLOAT(IM)*HINCO+HMIN ADD = 0. DO I = 128,IM,-1 IC = I ADD = ADD+BUF(NSAM+I) IF (ADD .GT. P) GOTO 99 ENDDO 99 TOP = FLOAT(IC)*HINCO+HMIN ENDIF 30 IF (BOTTOM .LT. FMIN) BOTTOM = FMIN IF (TOP .GT. FMAX) TOP = FMAX IF (BOTTOM .EQ. FMIN .AND. TOP .EQ. FMAX) RETURN NB = (BOTTOM-HMIN)/HINCO+1.5 NT = (TOP-HMIN)/HINCO+1.5 WRITE(NOUT,31)BOTTOM,TOP 31 FORMAT(' BOTTOM DENSITY ',G10.2,' , TOP DENSITY ',G10.2) HINCN = 2./FLOAT(NT-NB) IF (NB .GE. 2) THEN DO K = 1,NB-1 BUF(MAPA+K) = 0. ENDDO ENDIF 70 DO K = NB,NT BUF(MAPA+K) = FLOAT(K-NB)*HINCN ENDDO IF (NT .NE. 128) THEN DO K = NT+1,128 BUF(MAPA+K) = 2. ENDDO ENDIF C APPLY MAPPING FUNCTION TO DATA. C RESULT IS NORMALIZED BETWEEN 0. AND 2. 500 CALL GRAPHS(NDAT,BUF(MAPA+1),128,1,0,1.0,IRTFLG) AV = 0. DO I = 1,NROW*NSLICE CALL REDLIN(LUNI,BUF,NSAM,I) DO K = 1,NSAM MAP = (BUF(K)-HMIN)/HINCO+1.5 T = BUF(MAPA+MAP) AV = AV +T BUF(K) = T ENDDO CALL WRTLIN(LUNO,BUF,NSAM,I) ENDDO FMAX = 0.0 FMIN = 0.0 CALL SETPRMB(LUNO, 0.0,0.0, 0.0,0.0) IF (IRESH .EQ. 'Y') & CALL HIST(LUNO,0,0,NSAM,NROW,NSLICE,HMIN,HMAX,HSIG,HMODE) RETURN 650 CALL ERRT(14,'ENHANC',NE) RETURN END