C++********************************************************************* C C PR3D.F ADDED FOURIER INPUT JULY 2000 ARDEAN LEITH C OPFILEC FEB 03 ARDEAN LEITH 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 TO CALCULATE THE 3-D PHASE RESIDUE OUTSIDE MISSING CONE, PR OF FOURIER C RINGS(RADIUS, DIRECTION RELATIVE TO Z) AND OF FOURIER SHELLS(RADIUS) IS C CALCULATED. C C IMAGE_PROCESSING_ROUTINE C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE PR3D INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' CHARACTER(LEN=MAXNAM) :: FILNAM1,FILNAM2 REAL, ALLOCATABLE, DIMENSION(:,:,:):: AIMG,BIMG REAL, ALLOCATABLE, DIMENSION(:) :: CSUM1,CSUM REAL, ALLOCATABLE, DIMENSION(:,:) :: PR,AMP,AVSUM REAL, ALLOCATABLE, DIMENSION(:) :: CSUM2 INTEGER, ALLOCATABLE, DIMENSION(:) :: LR REAL SSANG, WI CHARACTER*1 NULL,SER PARAMETER (NSCALE=20) DATA LUN1,LUN2/21,22/ #ifdef USE_MPI INCLUDE 'mpif.h' INTEGER MYPID, COMM, MPIERR C COMM = MPI_COMM_WORLD MPIERR = 0 CALL MPI_COMM_RANK(COMM, MYPID, MPIERR) #else MYPID = -1 #endif C INPUT FIRST IMAGE MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM1,LUN1,'O',ITYPE1,NSAM1,NROW1, & NSLICE1,MAXIM,'FIRST INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (NSLICE1 .LT. 2) THEN CLOSE(LUN1) CALL ERRT(2,'RF 3',NE) RETURN ELSEIF (ITYPE1 .LT. 0) THEN C FOURIER INPUT FILE LSD1 = NSAM1 NSAM = NSAM1 - MOD(-ITYPE1,10) ELSE C REAL INPUT FILE LSD1 = NSAM1 + 2 - MOD(NSAM1,2) NSAM = NSAM1 ENDIF C INPUT SECOND IMAGE MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM2,LUN2,'O',ITYPE2,NSAM2,NROW2, & NSLICE2,MAXIM,'SECOND INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) THEN CLOSE(LUN1) RETURN ELSEIF (ITYPE2 .LT. 0) THEN C SECOND FILE IS A FOURIER INPUT FILE LSD2 = NSAM2 ELSE LSD2 = NSAM2 + 2 - MOD(NSAM2,2) ENDIF IF (LSD1.NE.LSD2 .OR. NROW1.NE.NROW2 .OR. & NSLICE1 .NE. NSLICE2) THEN CALL ERRT(1,'RF 3',NE) GOTO 9999 ENDIF CALL RDPRM(WI, NOT_USED, 'RING WIDTH') CALL RDPRM2(SCALE1,SCALE2,NOT_USED, & 'SCALE FACTOR(LOWER,UPPER)') DSCALE = (SCALE2-SCALE1)/FLOAT(NSCALE-1) NULL = CHAR(0) CALL RDPRMC(SER,NUMC,.TRUE.,'MISSING CONE/WEDGE ANGLE (C/W)', & NULL,IRT) CALL RDPRM(SSANG,NOT_USED,'MAXIMUM TILT ANGLE') IF (SER.NE.'C' .AND. SER.NE.'W') SSANG = 90.0 CALL RDPRM(FACT,NOT_USED,'FACTOR FOR NOISE COMPARISON') NSLICE = NSLICE1 NROW = NROW1 LSD = LSD1 Y1 = FLOAT(MAX0(NSAM,NROW,NSLICE)) INC = INT(Y1/WI)/2+1 ALLOCATE (AIMG(LSD,NROW,NSLICE),BIMG(LSD,NROW,NSLICE), & STAT=IRTFLG) IF (IRTFLG.NE.0) THEN CALL ERRT(46,'RF 3, AIMG & BIMG',IER) GOTO 9999 ENDIF IF (ITYPE1 .GT. 0) THEN C FIRST INPUT FILE IS REAL SPACE, NOT FOURIER CALL READV(LUN1,AIMG,LSD,NROW,NSAM1,NROW,NSLICE) INV = 1 CALL FMRS_3(AIMG,NSAM1,NROW,NSLICE,INV) IF (INV .EQ. 0) THEN CALL ERRT(38,'RF 3 ',NE) GOTO 9999 ENDIF ELSE C FIRST INPUT IS FOURIER ALREADY CALL READV(LUN1,AIMG,LSD,NROW,NSAM1,NROW,NSLICE) ENDIF CLOSE(LUN1) IF (ITYPE2 .GT. 0) THEN C SECOND INPUT FILE IS REAL SPACE, NOT FOURIER CALL READV(LUN2,BIMG,LSD,NROW,NSAM2,NROW,NSLICE) INV = 1 CALL FMRS_3(BIMG,NSAM2,NROW,NSLICE,INV) IF (INV .EQ. 0)THEN CALL ERRT(38,'RF 3',NE) GOTO 9999 ENDIF ELSE C SECOND INPUT IS FOURIER ALREADY CALL READV(LUN2,BIMG,LSD,NROW,NSAM2,NROW,NSLICE) ENDIF CLOSE(LUN1) ALLOCATE(PR(NSCALE,INC), AMP(NSCALE,INC),CSUM1(INC), & LR(INC),CSUM(INC),CSUM2(INC), AVSUM(NSCALE,INC), & STAT=IRTFLG) IF (IRTFLG.NE.0) THEN CALL ERRT(46,'RF 3, ARRAYS',IER) GOTO 9999 ENDIF CALL PR3DB(AIMG,BIMG,PR,AMP,CSUM1,LR,CSUM,CSUM2, & AVSUM,LSD,NSAM,NROW,NSLICE,DSCALE,NSCALE,SCALE1, & SSANG,INC,Y1,WI,SER) #ifdef NEVER c************* INV = -1 CALL FMRS_3(AIMG,NSAM,NROW,NSLICE,INV) IF (INV .EQ. 0) THEN CALL ERRT(38,'RF 3 ',NE) GOTO 9999 ENDIF MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM1,LUN1,'U',ITYPE1,NSAM,NROW, & NSLICE,MAXIM,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL WRITEV(LUN1,AIMG,LSD,NROW,NSAM,NROW,NSLICE) CLOSE(LUN1) c********************* #endif C WRITE RESULT INTO DOC FILE AND RESULT FILE IF (MYPID .LE. 0) & WRITE(NOUT,*) '3D PHASE RESIDUE AND FOURIER SHELL CORRELATION' IF (MYPID .LE. 0) WRITE(NOUT,5600) WI 5600 FORMAT(1X,'RING WIDTH = ',G12.5) IF (MYPID .LE. 0) WRITE(NOUT,5700) 5700 FORMAT(10X,'|NUMBER|','|RING RADIUS', & '|DPH|','|FSC|','|FSCCRIT|','|VOXELS|') IF (MYPID .LE. 0) WRITE(NOUT,5800) 5800 FORMAT(10X,' ',' NORMALIZED|') CALL RFACTSD2(PR,AMP,CSUM1,LR,CSUM,CSUM2,AVSUM, & NSCALE,INC,WI,FACT,NOUT) 9999 IF (ALLOCATED(AIMG)) DEALLOCATE (AIMG) IF (ALLOCATED(BIMG)) DEALLOCATE (BIMG) IF (ALLOCATED(PR)) DEALLOCATE (PR) IF (ALLOCATED(AMP)) DEALLOCATE (AMP) IF (ALLOCATED(CSUM1)) DEALLOCATE (CSUM1) IF (ALLOCATED(LR)) DEALLOCATE (LR) IF (ALLOCATED(CSUM)) DEALLOCATE (CSUM) IF (ALLOCATED(CSUM2)) DEALLOCATE (CSUM2) IF (ALLOCATED(AVSUM)) DEALLOCATE (AVSUM) RETURN END