C++********************************************************************* C C FOURING_Q.F C DE-OMP PARRALEL LOOP FOR FFTW3 USE MAR 08 ARDEAN LEITH 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 FOURING_Q(CIRC,LCIRC,NUMR,NRING,EO,MODE) C C PARAMETERS: C CIRC - FT OF RINGS MULTIPLIED BY WEIGHTS (SENT/RET) C EO WEIGHTING? RET. C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE FOURING_Q(CIRC,LCIRC,NUMR,NRING,EO,MODE) INTEGER NUMR(3,NRING) DIMENSION CIRC(LCIRC) CHARACTER*1 MODE DOUBLE PRECISION E,EO,QT,PI PI = 4.0 * DATAN(1.0D0) IF (MODE .EQ. 'F') PI = 2*PI E = 0.0 c$omp parallel do private(i,j,nsirt,qt),reduction(+:e) DO I=1,NRING NVAL = NUMR(3,I) - 2 IGO = NUMR(2,I) QT = REAL(NUMR(1,I)) * PI / REAL(NVAL) !PI * N / (N-2) DO J=IGO, IGO+NVAL-1 E = E + QT * DBLE(CIRC(J)) * CIRC(J) ENDDO ENDDO EO = E CC parallel do private(i,nsirt,inv) (FAILS WITH FFTW3) DO I=1,NRING INV = +1 NVAL = NUMR(3,I)-2 CALL FMRS_1(CIRC(IGO),NVAL,INV) ENDDO END