C++********************************************************************* C C PR3D.F ADDED FOURIER INPUT JUL 00 ARDEAN LEITH C OPFILEC FEB 03 ARDEAN LEITH C OUTPUT FORMAT, ERROR TRAP NOV 09 ARDEAN LEITH C OUTPUT FORMAT, SIZCHK FEB 11 ARDEAN LEITH 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 PURPOSE: CALCULATE 3-D PHASE RESIDUE OUTSIDE MISSING CONE, C PR OF FOURIER RINGS(RADIUS, DIRECTION RELATIVE TO Z) AND C OF FOURIER SHELLS (RADIUS). 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(LEN=1) :: NULL,SER PARAMETER (NSCALE=20) DATA LUN1,LUN2/21,22/ CALL SET_MPI(ICOMM,MYPID,MPIERR) NULL = CHAR(0) C INPUT FIRST IMAGE MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM1,LUN1,'O',ITYPE1,NSAM1,NROW1, & NSLICE1,MAXIM,'FIRST VOLUME',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (NSLICE1 < 2) THEN C ONLY FOR VOLUMES CLOSE(LUN1) CALL ERRT(2,'RF 3',NE) RETURN ELSEIF (ITYPE1 < 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 VOLUME',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) THEN GOTO 9998 ELSEIF (ITYPE2 .LT. 0) THEN C SECOND FILE IS A FOURIER INPUT FILE LSD2 = NSAM2 ELSE LSD2 = NSAM2 + 2 - MOD(NSAM2,2) ENDIF CALL SIZCHK(UNUSED,LSD1,NROW1,NSLICE1,0, & LSD2,NROW2,NSLICE2,0,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL RDPRM(WI, NOT_USED, 'RING WIDTH') CALL RDPRM2(SCALE1,SCALE2,NOT_USED, & 'SCALE FACTOR (LOWER,UPPER)') DSCALE = (SCALE2-SCALE1) / FLOAT(NSCALE-1) 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 MWANT = 2*LSD*NROW*NSLICE CALL ERRT(46,'RF 3, AIMG & BIMG',MWANT) GOTO 9999 ENDIF IF (ITYPE1 > 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 IF (ITYPE2 > 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 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 MWANT = 3*NSCALE*INC + 4*INC CALL ERRT(46,'PR3D; PR...',MWANT) GOTO 9999 ENDIF C CALCULATIONS 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 IF (MYPID .LE. 0) & WRITE(NOUT,*) ' 3D PHASE RESIDUE AND FOURIER SHELL CORRELATION' IF (MYPID .LE. 0) WRITE(NOUT,5600) WI 5600 FORMAT(' RING WIDTH: ',1PG12.5) IF (VERBOSE .AND. MYPID .LE. 0) WRITE(NOUT,5700) 5700 FORMAT(10X,'|NORM-FREQ |DPH| |FSC|', & ' |FSCCRIT| |VOXELS|') C WRITE RESULT INTO DOC FILE AND RESULT FILE CALL RFACTSD2(PR,AMP,CSUM1,LR,CSUM,CSUM2,AVSUM, & NSCALE,INC,WI,FACT,NOUT,.FALSE.) IF (MYPID .LE. 0) WRITE(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) 9998 CLOSE(LUN1) CLOSE(LUN2) RETURN END