C++********************************************************************* C C CCRS_3.F C PGI BUG FEB 10 2006 ArDean Leith C REAL CALCULATIONS FEB 11 2006 Bimal Rath C MOD PGI COMPILER BUG FEB 19 2008 ArDean Leith C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2008 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 CCRS_3(X,Y,O,LS,NSAM,NROW,NSLICE) C C PURPOSE: CALCULATES CIRCULAR CROSCORRELATION, NON-POWER-OF-TWO C DIMENSIONS C C PARAMETERS: X,Y FOURIER TRANSFORMS (SENT) C O F(X*CONJG(Y)) (RET.) C LS NSAM+2-MOD(NSAM,2) (SENT) C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE CCRS_3(X,Y,O, LS,NSAM,NROW,NSLICE) C REAL :: X((NSAM+2-MOD(NSAM,2)),NROW,NSLICE) C ABOVE ON PGI COMPILER 7.1 FAILS TO COMPILE PROPERLY SOMETIMES REAL :: X(LS,NROW,NSLICE) REAL :: Y(LS,NROW,NSLICE) REAL :: O(LS,NROW,NSLICE) DOUBLE PRECISION :: PI2 PI2 = 8.0 * DATAN(1.0D0) ITMP = NSAM / 2 SX = PI2 * FLOAT(ITMP) / FLOAT(NSAM) ITMP = NROW / 2 SY = PI2 * FLOAT(ITMP) / FLOAT(NROW) ITMP = NSLICE / 2 SZ = PI2 * FLOAT(ITMP) / FLOAT(NSLICE) Cc$omp parallel do private(i,j,k,iy,iz,arg,argy,argz,tmpr,tmpi) DO K=1,NSLICE IZ = K - 1 IF (IZ .GT. (NSLICE/2)) IZ = IZ - NSLICE ARGZ = SZ * IZ DO J=1,NROW IY = J - 1 IF (IY .GT. (NROW/2)) IY = IY - NROW ARGY = SY * IY + ARGZ DO I=1,LS,2 ARG = SX * (I-1)/2 + ARGY TMPR = X(I,J,K) * Y(I,J,K) + & X(I+1,J,K) * Y(I+1,J,K) TMPI = X(I+1,J,K) * Y(I,J,K) - & X(I,J,K) * Y(I+1,J,K) O(I,J,K) = TMPR * COS(ARG) - TMPI * SIN(ARG) O(I+1,J,K) = TMPI * COS(ARG) + TMPR * SIN(ARG) ENDDO ENDDO ENDDO INS = -1 CALL FMRS_3(O,NSAM,NROW,NSLICE,INS) END #ifdef NEVER OREAL = TMPR * COS(ARG) - TMPI * SIN(ARG) OIMG = TMPI * COS(ARG) + TMPR * SIN(ARG) O(I,J,K) = OREAL O(I+1,J,K) = OIMG #endif