C++********************************************************************* C C CHANGEVAL.F C ADDED NREPL OCT 2007 ARDEAN LEITH C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2007 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 CHANGEVAL(LUN1,LUN2,NSAM,NROW,NSLICE) C C PURPOSE: CHANGE A SPECIFIC VALUE IN AN IMAGE FILE C C CALLED BY: UTIL2 C C--******************************************************************** SUBROUTINE CHANGEVAL(LUN1,LUN2,NSAM,NROW,NSLICE) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON /IOBUF/ BUF(NBUFSIZ) REAL NEWVAL CALL RDPRM2S(OLDVAL,NEWVAL,NOT_USED,'OLD AND NEW VALUES',IRTFLG) IF (IRTFLG .LT. 0) RETURN NREPL = 0 IRECT = 0 DO J=1, NSLICE DO I=1,NROW IRECT = IRECT + 1 CALL REDLIN(LUN1,BUF,NSAM,IRECT) DO K=1,NSAM IF (BUF(K) .EQ. OLDVAL) THEN BUF(K) = NEWVAL NREPL = NREPL + 1 ENDIF ENDDO CALL WRTLIN(LUN2,BUF,NSAM,IRECT) ENDDO ENDDO CALL SETPRM(LUN2,NSAM,NROW,0.,0.,0.,'U') FREPL = FLOAT(NREPL) CALL REG_SET_NSEL(1,1, FREPL,0.0, 0.0, 0.0, 0.0,IRTFLG) WRITE(NOUT,*) ' PIXELS REPLACED: ',NREPL END