C ++******************************************************************** C * C * 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 * C * C PURPOSE: * C * C PARAMETERS: * C IMAGE_PROCESSING_ROUTINE * C * C 0 2 3 4 5 6 7 * C23456789012345678901234567890123456789012345678901234567890123456789012 C*********************************************************************** FUNCTION FCNQ(P) DIMENSION P(3), IM(3) COMMON /DIMSPEC/ R COMMON /POINT/ XPO,YPO COMMON /QNORMA/ AA,AB COMMON /PARM/ NT COMMON /ITERU/ ITER POINTER XPO(:,:,:), YPO(:,:,:) DOUBLE PRECISION AA,AB DOUBLE PRECISION CHI,AV,RM(3,3),QR(3),DX,DY,DZ C EQUIVALENCE (IM(1),IX),(IM(2),IY),(IM(3),IZ) data pi/3.1415926/ KLX = LBOUND(XPO, DIM =1) KNX = UBOUND(XPO, DIM =1) KLY = LBOUND(XPO, DIM =2) KNY = UBOUND(XPO, DIM =2) KLZ = LBOUND(XPO, DIM =3) KNZ = UBOUND(XPO, DIM =3) ITER=ITER+1 write(nt,1020) (P(L)*180.0/PI,L=1,3) 1020 FORMAT(' FCNQ - new parameters ',3(1X,F9.4)) PHI=P(1)*180.0/PI THETA=P(2)*180.0/PI PSI=P(3)*180.0/PI CHI=0.0 RR=R*R CALL BLDR(RM,PSI,THETA,PHI) c$omp parallel do private(ix,iy,iz,rz,ry,rt,qr,a1,a2,a3,a4,a5,a6,a7,a8, c$omp& iox,ioy,ioz,dx,dy,dz,av),reduction(+:chi) DO IZ=KLZ,KNZ RZ=IZ*IZ DO IY=KLY,KNY RY=IY*IY+RZ DO IX=KLX,KNX RT=IX*IX+RY IF (RT .LE. RR) THEN C DO 3 I3=1,3 C QR(I3)=0.0 C DO 3 I2=1,3 C3 QR(I3)=QR(I3)+RM(I2,I3)*IM(I2) QR(1)=RM(1,1)*IX+RM(2,1)*IY+RM(3,1)*IZ QR(2)=RM(1,2)*IX+RM(2,2)*IY+RM(3,2)*IZ QR(3)=RM(1,3)*IX+RM(2,3)*IY+RM(3,3)*IZ IOX=QR(1)+FLOAT(1-KLX) DX=QR(1)+FLOAT(1-KLX)-IOX DX=DMAX1(DX,1.0D-5) IOX=IOX+KLX-1 IOY=QR(2)+FLOAT(1-KLY) DY=QR(2)+FLOAT(1-KLY)-IOY DY=DMAX1(DY,1.0D-5) IOY=IOY+KLY-1 IOZ=QR(3)+FLOAT(1-KLZ) DZ=QR(3)+FLOAT(1-KLZ)-IOZ DZ=DMAX1(DZ,1.0D-5) IOZ=IOZ+KLZ-1 C c C faster version : c A1 = YPO(IOX,IOY,IOZ) A2 = YPO(IOX+1,IOY,IOZ) - YPO(IOX,IOY,IOZ) A3 = YPO(IOX,IOY+1,IOZ) - YPO(IOX,IOY,IOZ) A4 = YPO(IOX,IOY,IOZ+1) - YPO(IOX,IOY,IOZ) A5 = YPO(IOX,IOY,IOZ) - YPO(IOX+1,IOY,IOZ) - YPO(IOX,IOY+1,IOZ) & + YPO(IOX+1,IOY+1,IOZ) A6 = YPO(IOX,IOY,IOZ) - YPO(IOX+1,IOY,IOZ) - YPO(IOX,IOY,IOZ+1) & + YPO(IOX+1,IOY,IOZ+1) A7 = YPO(IOX,IOY,IOZ) - YPO(IOX,IOY+1,IOZ) - YPO(IOX,IOY,IOZ+1) & + YPO(IOX,IOY+1,IOZ+1) A8 = YPO(IOX+1,IOY,IOZ) + YPO(IOX,IOY+1,IOZ)+ YPO(IOX,IOY,IOZ+1) & - YPO(IOX,IOY,IOZ)- YPO(IOX+1,IOY+1,IOZ) - YPO(IOX+1,IOY,IOZ+1) & - YPO(IOX,IOY+1,IOZ+1) + YPO(IOX+1,IOY+1,IOZ+1) AV= A1 + DZ*(A4 + A6*DX + (A7 + A8*DX)*DY) + A3*DY & + DX*(A2 + A5*DY) C********************************************************** C CHI=CHI+(XPO(IX,IY,IZ)-AV)*(XPO(IX,IY,IZ)-AV) CHI=CHI+XPO(IX,IY,IZ)*AV ENDIF ENDDO ENDDO ENDDO CHI=(CHI-AB)/AA FCNQ=1.0-CHI write(nt,*) & 'Iteration #',ITER,' Distance =',FCNQ,' r=',CHI END