C ++******************************************************************** C * C PRJCQ.F SPEEDED UP FEB 2000 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 PRJCQ(CUBE,LTC,DM,B,N,IPCUBE,NN) * * C * C PURPOSE: PROJECTS CUBE INTO B * * C * C PARAMETERS: CUBE INPUT VOLUME SENT * C B OUTPUT PROJECTION IMAGE RET. * C NN CUBE DIMENSIONS SENT * C N IMAGE DIMENSION (SQUARE) SENT * C * C IMAGE_PROCESSING_ROUTINE * C * C 0 2 3 4 5 6 7 * C23456789012345678901234567890123456789012345678901234567890123456789012 C*********************************************************************** SUBROUTINE PRJCQ(CUBE,LTC,DM,B,N,IPCUBE,NN) DIMENSION DM(9),CUBE(LTC),B(N,N) INTEGER IPCUBE(5,NN) COMMON /PAR/ LDP,NM,LDPNM DO I=1,NN XB = (IPCUBE(3,I)-LDP)*DM(1)+(IPCUBE(4,I)-LDP)*DM(2)+ & (IPCUBE(5,I)-LDP)*DM(3) + LDPNM YB = (IPCUBE(3,I)-LDP)*DM(4)+(IPCUBE(4,I)-LDP)*DM(5)+ & (IPCUBE(5,I)-LDP)*DM(6) + LDPNM DO J=IPCUBE(1,I),IPCUBE(2,I) IQX = IFIX(XB) IQY = IFIX(YB) CT = CUBE(J) DIPX = (XB - IQX) DIPY = (YB - IQY) * CT DIPY1M = (CT - DIPY) DIPX1M = (1.0 - DIPX) B(IQX,IQY) = B(IQX,IQY) + DIPX1M * DIPY1M B(IQX+1,IQY) = B(IQX+1,IQY) + DIPX * DIPY1M B(IQX,IQY+1) = B(IQX,IQY+1) + DIPX1M * DIPY B(IQX+1,IQY+1)= B(IQX+1,IQY+1) + DIPX * DIPY XB = XB + DM(1) YB = YB + DM(4) ENDDO ENDDO END #ifdef NEVER C B(IQX,IQY) = B(IQX,IQY) + (1.0-DIPX)*(1.0-DIPY)*CT C B(IQXP1,IQY) = B(IQXP1,IQY) + DIPX *(1.0-DIPY)*CT C B(IQX,IQYP1) = B(IQX,IQYP1) + (1.0-DIPX)* DIPY *CT C B(IQXP1,IQYP1)= B(IQXP1,IQYP1) + DIPX * DIPY *CT #endif