C++********************************************************************* C C ORMD.F C OPFILEC FEB 03 ARDEAN LEITH C REWRITTEN JUN 08 ARDEAN LEITH C APRINGS_INIT_PLANS PARAMS JUN 11 ARDEAN LEITH C C ********************************************************************** C=* * C=* This file is part of: SPIDER - Modular Image Processing System. * C=* SPIDER System Authors: Joachim Frank & ArDean Leith * C=* Copyright 1985-2011 Health Research Inc., * C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204. * C=* Email: spider@wadsworth.org * C=* * C=* SPIDER 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=* SPIDER 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=* You should have received a copy of the GNU General Public License * C=* along with this program. If not, see * C=* * C ********************************************************************** C C ORMD() C C PURPOSE: DETERMINES ROTATIONAL ORIENTATION BETWEEN TWO IMAGES USING C RESAMPLING INTO POLAR COORDINATES. SAME AS: C 'AP REF' OR 'AP SH' WITHOUT THE TRANSLATIONAL SEARCH AND C IT ONLY ACTS ON A SINGLE PAIR OF IMAGES. C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE ORMD(ASKPEAKS) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' CHARACTER (LEN=MAXNAM) :: FILNAM,REFNAM,OUTANG INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NUMR REAL, ALLOCATABLE, DIMENSION(:,:) :: X CHARACTER (LEN=1) :: ASK,NULL,MODE LOGICAL :: NEWFILE CHARACTER(LEN=80) :: COMMEN LOGICAL :: ASKPEAKS INTEGER, PARAMETER :: NPLANS = 14 #ifndef SP_32 INTEGER *8 :: FFTW_PLANS(NPLANS) #else INTEGER *4 :: FFTW_PLANS(NPLANS) #endif DATA LUNREF,LUNEXP,LUNDOC/50,51,52/ NULL = CHAR(0) C ASK FOR DATA FILES MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM,LUNEXP,'O',ITYPE,NSAM,NROW, & NSLICE,MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN MAXIM = 0 CALL OPFILEC(0,.TRUE.,REFNAM,LUNREF,'O',ITYPE,NSAM1,NROW1, & NSLICE1,MAXIM,'REFERENCE',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 IF (NSAM .NE. NSAM1 .OR. & NROW .NE. NROW1 .OR. & NSLICE .NE. NSLICE1) THEN CALL ERRT(102,'FILES MUST HAVE SAME DIMENSIONS:',NSAM) ENDIF ISKIP = 0 CALL RDPRI3S(MR,NR,ISKIP,NOT_USED, & 'FIRST, LAST RING, & RING STEP',IRTFLG) IF (ISKIP .LE. 0) THEN ISKIP = 1 CALL RDPRI1S(ISKIP,NOT_USED,'RING STEP',IRTFLG) ENDIF IF (IRTFLG .NE. 0) GOTO 9999 ISKIP = MAX(1,ISKIP) NRAD = MIN(NSAM/2-1, NROW/2-1) -1 IF (MR .LE. 0) THEN CALL ERRT(101,'FIRST RING MUST BE > 0',NE) GOTO 9999 ELSEIF (NR .GE. NRAD) THEN CALL ERRT(102,'LAST RING MUST BE < ',NRAD) GOTO 9999 ENDIF MODE = 'F' CALL RDPRMC(ASK,NA,.TRUE.,'(F)ULL OR (H)ALF CIRCLE',NULL,IRT) IF (IRT .NE. 0) GOTO 9999 IF (ASK .EQ. 'H') MODE = 'H' NPEAK = 1 IF (ASKPEAKS) THEN CALL RDPRI1S(NPEAK,NOT_USED,'NUMBER OF PEAKS',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 NPEAK = MAX(1,NPEAK) ENDIF IF (NPEAK .GT. 1) THEN C OPEN PEAK OUTPUT DOC FILE (FOR APPENDING) NOUTANG = LUNDOC CALL OPENDOC(OUTANG,.TRUE.,NLET,LUNDOC,NOUTANG,.TRUE., & 'OUTPUT ANGLE DOCUMENT',.FALSE.,.TRUE.,.TRUE., & NEWFILE,IRTFLG) COMMEN = ' ANGLE, PEAK-HEIGHT ' CALL LUNDOCPUTCOM(LUNDOC,COMMEN,IRTFLG) ENDIF C FIND NUMBER OF REFERENCE-RINGS NRING = 0 DO I=MR,NR,ISKIP NRING = NRING + 1 ENDDO ALLOCATE(NUMR(3,NRING),STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'NUMR',3*NRING) GOTO 9999 ENDIF C INITIALIZE NUMR ARRAY WITH RING RADII NRING = 0 DO I=MR,NR,ISKIP NRING = NRING+1 NUMR(1,NRING) = I ENDDO C CALCULATE: NUMR & LCIRC CALL ALPRBS_Q(NUMR,NRING,LCIRC,MODE) MAXRIN = NUMR(3,NRING) C CALCULATE ACTUAL DIMENSION OF AN IMAGE TO BE INTERPOLATED C 2*(NO. OF RINGS)+(0'TH ELEMENT)+2*(MARGIN OF 1) c NRA = MIN(((NSAM-1)/2)*2+1, ((NROW-1)/2)*2+1, 2*NR+3) al NRA = MIN(((NSAM-1)/2)*2+1, ((NROW-1)/2)*2+1, 2*NR+6) LSAM = NSAM LROW = NROW NSAM = NRA NROW = NRA ! write(6,*)' Size:',lsam,lrow,'--> ',nsam,nrow ALLOCATE (X(NSAM,NROW), STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'ORMD, X',NSAM*NROW) GOTO 9999 ENDIF C INITIALIZE FFTW3 PLANS FOR USE WITHIN OMP || SECTIONS CALL APRINGS_INIT_PLANS(NUMR,NRING, & FFTW_PLANS,NPLANS,NSAM,NROW,IRTFLG) CALL ORMD_P(NSAM,NROW, LSAM,LROW, & NRING,LCIRC,MAXRIN,NUMR,X,NPEAK,MODE,FFTW_PLANS, & LUNEXP,LUNREF,LUNDOC) 9999 CALL FFTW3_KILLPLANS(FFTW_PLANS,NPLANS,IRTFLG) CLOSE(LUNREF) CLOSE(LUNEXP) CLOSE(LUNDOC) IF (ALLOCATED(NUMR)) DEALLOCATE (NUMR) IF (ALLOCATED(X)) DEALLOCATE (X) END