C++************************************************************************ C C PR3DB.F 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 PURPOSE: CALCULATE THE 3-D PHASE RESIDUE OUTSIDE MISSING CONE, C PR OF FOURIER RINGS(RADIUS, DIRECTION RELATIVE TO Z) AND C OF FOURIER SHELLS(RADIUS) IS CALCULATED. C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE PR3DB(A,B,PR,AMP,CSUM1,LR,CSUM,CSUM2, & AVSUM,LSD,NSAM,NROW,NSLICE,DSCALE,NSCALE,SCALE1,SSANG, & INC,Y1,WI,SER) DIMENSION A(LSD,NROW,NSLICE),B(LSD,NROW,NSLICE) DIMENSION PR(NSCALE,INC),AMP(NSCALE,INC),AVSUM(NSCALE,INC) DIMENSION CSUM1(INC),CSUM2(INC),LR(INC) DIMENSION CSUM(INC) CHARACTER*1 SER PARAMETER (QUADPI = 3.141592653589793238462643383279502884197) PARAMETER (RAD_TO_DGR = (180.0/QUADPI)) PARAMETER (DGR_TO_RAD = (QUADPI/180)) ZANG=(90.0-SSANG)*DGR_TO_RAD ND2=NSAM/2 NR2=NROW/2 C for 2D case set NS2 to one NS2 = MAX0(1,NSLICE/2) DO L=1,INC LR(L) = 0 CSUM(L) = 0.0 CSUM1(L) = 0.0 CSUM2(L) = 0.0 DO NSC=1,NSCALE PR(NSC,L)=0.0 AVSUM(NSC,L)=0.0 AMP(NSC,L) =0.0 ENDDO ENDDO DO K=1,NSLICE IIK=(K-1) IF(IIK.GT.NS2) IIK=IIK-NSLICE PK=(FLOAT(IIK)/FLOAT(NS2))**2 DO J=1,NROW IIJ=(J-1) IF(IIJ.GT.NR2) IIJ=IIJ-NROW PJ=(FLOAT(IIJ)/FLOAT(NR2))**2 DO I=1,LSD,2 III=(I-1)/2 C skip Hermitian related values IF (III.GT.0 .OR.(IIK.GE.0 .AND. & (IIJ.GE.0 .OR. IIK.NE.0))) THEN PII = (FLOAT(III)/FLOAT(ND2))**2 R = SQRT(PII+PJ+PK)*0.5 IF (R .GT. 0.0) THEN R1 = SQRT(PII+PK)*0.5 ! r1=(x^2+z^2)^0.5 !if(r1.gt.0.05) goto 3 IF (SER .EQ. 'C') THEN IF (ACOS(AMIN1(1.0,SQRT(PK)/R)).LT.ZANG) GO TO 3 ELSEIF (SER .EQ. 'W') THEN IF (R1 .EQ. 0.0) THEN FI = ACOS(1.0) ELSE FI = ACOS(AMIN1(1.0,SQRT(PK)/R1)) ENDIF IF (FI .LT. ZANG) GO TO 3 ENDIF L = NINT(R*2*(INC-1))+1 IF (L .GT. INC) GO TO 3 LR(L) = LR(L) + 2 IF (A(I,J,K) .NE. 0.0)THEN PHA = ATAN2(A(I+1,J,K),A(I,J,K))*RAD_TO_DGR ELSE PHA = 0 ENDIF IF (B(I,J,K) .NE. 0.0)THEN PHB = ATAN2(B(I+1,J,K),B(I,J,K))*RAD_TO_DGR ELSE PHB = 0.0 ENDIF DPH = PHA-PHB IF (DPH .GT. 180.0) DPH=360.0-DPH IF (DPH .LT. -180.0) DPH=360.0+DPH QA = SQRT(A(I,J,K)**2+A(I+1,J,K)**2) QB = SQRT(B(I,J,K)**2+B(I+1,J,K)**2) CSUM(L)= & CSUM(L)+A(I,J,K)*B(I,J,K)+A(I+1,J,K)*B(I+1,J,K) CSUM1(L) = CSUM1(L)+QA*QA CSUM2(L) = CSUM2(L)+QB*QB C SCALES DPH=DPH*DPH DO NSC=1,NSCALE SCALE = SCALE1+(NSC-1)*DSCALE QBS = QB*SCALE AVSUM(NSC,L) = AVSUM(NSC,L)+ABS(QA-QBS) PR(NSC,L) = PR(NSC,L)+((QA+QBS)/2.)*DPH AMP(NSC,L) = AMP(NSC,L)+((QA+QBS)/2.) ENDDO ENDIF ENDIF 3 CONTINUE ENDDO ENDDO ENDDO END