C++********************************************************************* C C ADD.F CHANGED 7/21/86 MN C OUTPUT FILES CHANGED AUG 96 ARDEAN LEITH C REWRITTEN MAR 99 ARDEAN LEITH C DIV BUG SEP 03 ARDEAN LEITH C C ********************************************************************** 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 ADD(VOLBUF,LUNIN,IFORMT,NSAM,NROW,NSLICE,SIGT) C C PURPOSE: ADD, SUBTRACT, OR MULTIPLY IMAGES C OR MULTIPLY FOURIER TRANSFORMS C BOTH IMAGES HAVE TO HAVE THE SAME SIZE. C C PARAMETERS: C VOLBUF INPUT VOLUME (#1) C LUNIN I/O UNIT NUMBER OF INPUT FILE #2 C IFORMT IFORM OF INPUT VOLUME C NSAM,NROW X & Y DIMENSIONS OF IMAGES C NSLICE Z DIMENSION OF IMAGES C SIGT +1 1 IS ADDED TO 2 C -1 2 IS SUBTRACTED FROM 1 C +2 1 IS MULTIPLIED WITH 2 C -2 2 IS DIVIDED BY 1, C OR COMPLEX FOURIER MULTIPLICATION WITH CONJUGATE C -3 COMPLEX 2 IS DIVIDED BY COMPLEX 1 C +5 ARITHMETIC OR OF 1 WITH 2 C C VARIABLES: IFORM (TYPE) FILE TYPE SPECIFIER. C +1 R 2-D IMAGE C +3 R3 3-D IMAGE C -11 O2 2-D FOURIER TRANSFORM, MIXED RADIX ODD C -12 E2 2-D FOURIER TRANSFORM, MIXED RADIX EVEN C -21 O3 3-D FOURIER TRANSFORM, MIXED RADIX ODD C -22 E3 3-D FOURIER TRANSFORM, MIXED RADIX EVEN C C C SUPPORT_ROUTINE C C 1 2 3 4 5 6 7 C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE ADD(VOLBUF,LUNIN,IFORMT,NSAM,NROW,NSLICE,SIGN) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' DIMENSION VOLBUF(1) COMMON /IOBUF/ BUF(NBUFSIZ) C DOES NOT WORK ON SOME ODD FILE FORMATS NO LONGER IN USE IF (IFORMT.EQ.0 .OR. IFORMT.EQ.8 .OR. IFORMT.EQ.11 .OR. & IFORMT.EQ.12 .OR. IFORMT.EQ.16 .OR. IFORMT.EQ.-9) THEN CALL ERRT(39,'ADD',NE) RETURN ENDIF C SIGT MAY BE A CONSTANT SIGT = SIGN IF (FCHAR(4:4) .EQ. 'D' .OR. FCHAR(1:2) .EQ. '12') THEN C DIVIDE IF (IFORMT .LT. 0) THEN C FOURIER FILES SIGT = -3.0 WRITE(NOUT,*) 'COMPLEX DIVISION' ELSE SIGT = -2.0 WRITE(NOUT,*) 'DIVISION' ENDIF ELSEIF (FCHAR(4:4) .EQ. 'M') THEN SIGT = -2.0 WRITE(NOUT,*) 'COMPLEX MULTIPLICATION -- (X) * CONJG(Y)' ELSEIF (FCHAR(4:4) .EQ. 'O') THEN SIGT = +5.0 WRITE(NOUT,*) 'ARITHMETIC OR' ENDIF NREC = NROW * NSLICE ILOC = 0 IF (SIGT .EQ. +1.0) THEN C SIGT +1 2 IS ADDED TO 1 --------------------- ADD DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSAM ILOC = ILOC + 1 VOLBUF(ILOC) = VOLBUF(ILOC) + BUF(ISAM) ENDDO ENDDO ELSEIF (SIGT .EQ. -1.0) THEN C SIGT -1 2 IS SUBTRACTED FROM 1 --------------- SUB DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSAM ILOC = ILOC + 1 VOLBUF(ILOC) = VOLBUF(ILOC) - BUF(ISAM) ENDDO ENDDO ELSEIF (SIGT .EQ. +2.0) THEN C SIGT +2 2 IS MULTIPLIED BY 1 ---------------- MULT IF (IFORM .GT. 0) THEN C REAL FILES DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSAM ILOC = ILOC + 1 VOLBUF(ILOC) = VOLBUF(ILOC) * BUF(ISAM) ENDDO ENDDO ELSEIF (IFORM .LT. 0) THEN C FOURIER FILES CALL CADD(VOLBUF,LUNIN,IFORMT,NSAM,NROW,NSLICE,SIGT) ENDIF ELSEIF (SIGT .EQ. -2.0) THEN C SIGT -2 1 IS DIVIDED BY 2 ----------------- DIVIDE C OR COMPLEX FOURIER MULTIPLICATION WITH CONJUGATE WRITE(NOUT,*) 'DIVISION' IF (IFORM.GT.0) THEN IZCOUN = 0 DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSAM ILOC = ILOC + 1 IF (BUF(ISAM) .NE. 0) THEN VOLBUF(ILOC) = VOLBUF(ILOC) / BUF(ISAM) ELSE VOLBUF(ILOC) = 0.0 IZCOUN = IZCOUN + 1 ENDIF ENDDO ENDDO IF (IZCOUN .GT. 0) WRITE(NOUT,160) IZCOUN 160 FORMAT(' --- WARNING: ',I7,' OUTPUT PIXELS SET TO 0.0 ', & 'WHEN DIVISION BY 0 ATTEMPTED') ELSEIF (IFORM .LT. 0) THEN C COMPLEX FOURIER MULTIPLICATION WITH CONJUGATE CALL CADD(VOLBUF,LUNIN,IFORMT,NSAM,NROW,NSLICE,SIGT) ENDIF ELSEIF (SIGT .EQ. -3.0) THEN C SIGT -3 COMPLEX 2 IS DIVIDED BY COMPLEX 1 ---- DIV WRITE(NOUT,*) 'COMPLEX DIVISION' CALL CADD(VOLBUF,LUNIN,IFORMT,NSAM,NROW,NSLICE,SIGT) ELSEIF (SIGT.EQ.+5.0) THEN C SIGT +5 ARITHMETIC OR OF 1 WITH 2 -------------- OR IF (IFORM .GT. 0) THEN DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSAM ILOC = ILOC + 1 B = BUF(ISAM) IF (B .EQ. 0.0) B = VOLBUF(ILOC) VOLBUF(ILOC) = B ENDDO ENDDO ELSE C NOT IMPLEMENTED FOR FOURIER CALL ERRT(2,'ADD',NE) ENDIF ELSE C UNKNOWN SIGT CALL ERRT(23,'ADD',NE) ENDIF RETURN END C++********************************************************************* C C CADD.F WRITTEN MAR 99 ARDEAN LEITH C C ********************************************************************** C C CADD IS USED AS KLUDGE TO AVOID EQUIVALENCING VOLBUF TO C CVOLBUFF C C ********************************************************************** SUBROUTINE CADD(CVOLBUF,LUNIN,IFORMT,NSAM,NROW,NSLICE,SIGT) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMPLEX CVOLBUF(1) COMMON /IOBUF/ BUF(NBUFSIZ) COMPLEX CBUF(1) EQUIVALENCE (BUF(1),CBUF(1)) NREC = NROW * NSLICE ILOC = 0 IF (SIGT .EQ. +2.0) THEN C SIGT +2 2 IS MULTIPLIED BY 1 C FOURIER FILES NSH = NSAM / 2 DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSH ILOC = ILOC + 1 CVOLBUF(ILOC) = CVOLBUF(ILOC) * CBUF(ISAM) ENDDO ENDDO ELSEIF (SIGT .EQ. -2.0) THEN C COMPLEX 1 FOURIER MULTIPLICATION WITH 2 CONJUGATE NSH = NSAM / 2 DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSH ILOC = ILOC + 1 CVOLBUF(ILOC) = CVOLBUF(ILOC) * CONJG(CBUF(ISAM)) ENDDO ENDDO ELSEIF (SIGT .EQ. +3.0) THEN C SIGT +3 1 IS SQUARED NSH = NSAM / 2 DO ISAM=1,NREC*NSH CVOLBUF(ISAM) = CVOLBUF(ISAM) *CONJG(CVOLBUF(ISAM)) ENDDO ELSEIF (SIGT .EQ. -3.0) THEN C SIGT -3 COMPLEX 1 IS DIVIDED BY COMPLEX 2 NSH = NSAM / 2 DO IREC=1,NREC CALL REDLIN(LUNIN,BUF,NSAM,IREC) DO ISAM=1,NSH ILOC = ILOC + 1 CVOLBUF(ILOC) = CVOLBUF(ILOC) / CBUF(ISAM) ENDDO ENDDO ENDIF END