C++********************************************************************* C C BOXX.F C NORM3 CALL NOT INVOKED FOR MODE 2 BUG MAR 01 ARDEAN LEITH C SETPRM REMOVED MAY 09 ARDEAN LEITH C C ********************************************************************** C=* * C=* This file is part of: SPIDER - Modular Image Processing System. * C=* SPIDER System Authors: Joachim Frank & ArDean Leith * C=* Copyright 1985-2010 Health Research Inc., * C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204. * C=* Email: spider@wadsworth.org * C=* * C=* SPIDER 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=* SPIDER 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=* You should have received a copy of the GNU General Public License * C=* along with this program. If not, see * C=* * C ********************************************************************** C C BOXX(LUN1,LUN2,NSAM,NROW,NSLICE,MAXDIM) C C PARAMETERS: C LUN1 LOGICAL UNIT NUMBER OF FILE C LUN2 LOGICAL UNIT NUMBER OF FILE C NSAM NUMBER OF SAMPLES C NROW NUMBER OF ROWS C NSLICE NUMBER OF SLICES C MAXDIM MAXIMUM BUFFER SPACE AVAILABLE C C PURPOSE: BOXX DOES OPERATIONS INVOLVING LOCAL BOX C MODE 1 > SUBTRACTIVE BOX FILTERING C MODE 2 > RETURNS FMIN IF PT .LT. XAVG C FMAX IF PT .GE. XAVG C MODE 3 > RETURNS LOCAL AVERAGE FOR POINT C MODE 4 > DIVISIVE CONTRAST CORRECTION C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE BOXX(LUN1,LUN2,NSAM,NROW,NSLICE,MAXDIM) INCLUDE 'CMBLOCK.INC' COMMON X(1) INTEGER DS,DR,DL,A1 CHARACTER *1 ANS,NULL NULL = CHAR(0) 8877 CALL RDPRMC(ANS,NC,.TRUE., & '(H)IGH PASS / (L)OW PASS / (T)HRES / (D)IVIS',NULL,IRTFLG) MODE = INDEX('HTLD',ANS) IF (MODE .LE. 0) THEN CALL ERRT(101,'UNKNOWN OPTION',NERROR) GOTO 8877 ENDIF C INITIALIZATION IF (MODE .EQ. 4 ) THEN IF(IMAMI.NE.1) CALL NORM3(LUN1,NSAM,NROW,NSLICE,FMAX,FMIN,AV) IF (MODE .EQ. 4) AV1 = AV * 0.1 ENDIF FMINN = FMIN FMAXX = FMAX IF (FMIN .GE. FMAX) THEN FMINN = 0.0 FMAXX = 2.0 ENDIF 3355 CALL RDPRMI(DS,DR,NOT_USED,' LOCAL AREA SIZE COL, ROWS') IF (DS .LE. 0) THEN CALL ERRT(31,'BOXX',NERROR) GOTO 3355 ENDIF IF (DR .EQ. 0) DR = DS IF (NSLICE .GT. 1) THEN C FIND SLICE DIMENSION OF BOX CALL RDPRMI(DL,IDXUTV,NOT_USED,' LOCAL AREA SIZE SLICES') IF (DL .EQ. 0) DL = DS WRITE(NOUT,90) DS,DR,DL 90 FORMAT(' BOX SIZE: ',I3,' x',I3,' x',I3) ELSE WRITE(NOUT,91) DS,DR 91 FORMAT(' BOX SIZE: ',I3,' x',I3) ENDIF CALL RDPRM(F,NOT_USED,'FILTER WEIGHT (0.0->1.0)') FC = 1.0 - F IF (NSLICE .LE. 1) THEN C 2-D C---------------------------------------------------------------------- A1 = DR * NSAM IF (A1 + NSAM .GT. MAXDIM) THEN C INSUFFICIENT BUFFER SPACE CALL ERRT(6,'BOXX',NERROR) RETURN ENDIF KT = 1 KR = 1 MOVWAY = 2 I = -1 DO J=1,NROW JOFF = MOD(J-1,DR)*NSAM IF (MOVWAY .EQ. 3) KT=NSAM C *** START OFF OR GO DOWN *** IF (MODE .EQ. 1) THEN C *** MODE 1 EQUATIONS *** CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,KR) POINT = X(JOFF+KT) X(A1+KT) = F*(POINT-XAVG)+POINT*FC ELSEIF (MODE .EQ. 2) THEN C *** MODE 2 EQUATIONS *** CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,KR) POINT = X(JOFF+KT) X(A1+KT) = F*FMINN+FC*POINT IF (POINT.GE.XAVG) X(A1+KT)=F*FMAXX+FC*POINT ELSEIF (MODE .EQ. 3) THEN C *** MODE 3 EQUATIONS *** CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,KR) X(A1+KT) = XAVG*F + FC*X(JOFF+KT) ELSEIF (MODE .EQ. 4) THEN C *** MODE 4 EQUATIONS *** CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,KR) POINT = X(JOFF+KT) X(A1+KT) = F*POINT/(XAVG+AV1)+POINT*FC ENDIF DO K=2,NSAM KT=K IF (MOVWAY .EQ. 3) KT=NSAM+1-K C *** MOVE RIGHT OR LEFT *** IF (MODE .EQ. 1) THEN CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,MOVWAY) POINT = X(JOFF+KT) X(A1+KT) = F*(POINT-XAVG)+POINT*FC ELSEIF (MODE .EQ. 2) THEN CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,MOVWAY) POINT = X(JOFF+KT) X(A1+KT) = F*FMINN+FC*POINT IF (POINT .GE. XAVG) X(A1+KT)=F*FMAXX+FC*POINT ELSEIF (MODE .EQ. 3) THEN CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,MOVWAY) X(A1+KT) = XAVG ELSEIF (MODE .EQ. 4) THEN CALL AVERG(LUN1,XAVG,J,KT,NSAM,NROW,DS,DR,MOVWAY) POINT = X(JOFF+KT) X(A1+KT) = F*POINT/(XAVG+AV1)+POINT*FC ENDIF ENDDO I = -I MOVWAY = MOVWAY+I KT = 1 CALL WRTLIN(LUN2,X(A1+1),NSAM,J) KR = 4 ENDDO C------------------------------------------------------------------------- ELSE C 3D A1 = DL*NSAM*NROW IF (A1+NSAM .GT. MAXDIM) THEN C INSUFFICIENT BUFFER SPACE CALL ERRT(6,'BOXX',NERROR) RETURN ENDIF I = -1 MOVWAY = 2 IS = -1 MOVSID = 4 KR = 1 DO L=1,NSLICE LOFF=MOD(L-1,DL)*NSAM*NROW DO J=1,NROW IF (MOVWAY.EQ.3) THEN KT=NSAM ELSE KT=1 ENDIF IF (MOVSID .EQ. 5) THEN KJ=NROW+1-J ELSE KJ=J ENDIF IF (J .EQ. 1) THEN IF (MODE .EQ. 1) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,KR) NI=LOFF+(KJ-1)*NSAM+KT POINT=X(NI) NO=A1+KT X(NO)=F*(POINT-XAVG)+POINT*FC GOTO 85 ELSEIF (MODE .EQ. 2) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,KR) NI=LOFF+(KJ-1)*NSAM+KT POINT=X(NI) NO=A1+KT X(NO)=F*FMINN+FC*POINT IF (POINT .GE. XAVG) X(NO)=F*FMAXX+FC*POINT GOTO 85 ELSEIF (MODE .EQ. 3) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,KR) NI=LOFF+(KJ-1)*NSAM+KT POINT=X(NI) NO=A1+KT X(NO)=XAVG*F + FC*POINT GOTO 85 ELSEIF (MODE .EQ. 4) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,KR) NI=LOFF+(KJ-1)*NSAM+KT POINT=X(NI) NO=A1+KT X(A1+KT)=F*POINT/(XAVG+AV1)+POINT*FC GOTO 85 ENDIF ELSE IF (MODE .EQ. 1) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVSID) NI=LOFF+(KJ-1)*NSAM+KT POINT=X(NI) NO=A1+KT X(NO)=F*(POINT-XAVG)+POINT*FC GOTO 85 ELSEIF (MODE .EQ. 2) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVSID) NI = LOFF+(KJ-1)*NSAM+KT POINT = X(NI) NO = A1+KT X(NO) = F*FMINN+FC*POINT IF (POINT.GE.XAVG)X(NO) = F*FMAXX+FC*POINT GOTO 85 ELSEIF (MODE .EQ. 3) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVSID) NI = LOFF+(KJ-1)*NSAM+KT POINT = X(NI) NO = A1+KT X(NO) = XAVG*F + FC*POINT GOTO 85 ELSEIF (MODE .EQ. 4) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVSID) NI = LOFF+(KJ-1)*NSAM+KT POINT = X(NI) NO = A1+KT X(A1+KT) = F*POINT/(XAVG+AV1)+POINT*FC ENDIF ENDIF 85 CONTINUE DO 810 K=2,NSAM IF (MOVWAY.EQ.3) THEN KT = NSAM+1-K ELSE KT = K ENDIF IF (MODE .EQ. 1) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVWAY) NI = LOFF+(KJ-1)*NSAM+KT POINT = X(NI) NO = A1+KT X(NO) = F*(POINT-XAVG)+POINT*FC GOTO 810 ELSEIF (MODE .EQ. 2) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVWAY) NI = LOFF+(KJ-1)*NSAM+KT POINT = X(NI) NO = A1+KT X(NO) =F*FMINN+FC*POINT IF (POINT.GE.XAVG) X(NO) = F*FMAXX+FC*POINT GOTO 810 ELSEIF (MODE .EQ. 3) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVWAY) NO = A1+KT X(NO) = XAVG GOTO 810 ELSEIF (MODE .EQ. 4) THEN CALL AVERG3(LUN1,XAVG,KJ,KT,L,NSAM,NROW,NSLICE, & DS,DR,DL,MOVWAY) NI = LOFF+(KJ-1)*NSAM+KT POINT = X(NI) NO = A1+KT X(A1+KT) = F*POINT/(XAVG+AV1)+POINT*FC ENDIF 810 CONTINUE I = -I MOVWAY = MOVWAY+I NLIN = (L-1)*NROW+KJ CALL WRTLIN(LUN2,X(A1+1),NSAM,NLIN) ENDDO IS = -IS MOVSID = MOVSID+IS KR = 6 ENDDO ENDIF END