C++******************************************************************* C C DEFOCUS.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 DEFOCUS(IRTFLG) C C PURPOSE: CALCULATE THE DEFOCUS AND AMPLITUDE CONTRAST COMPONENT C USING LEAST SQUARES METHOD C C VARIABLES: C KFR : ARRAY OF ALL THE MINIMUM FOR ONE IMAGE C A : AMPLITUDE OF ALL MINIMA C NP : NUMBER OF MINIMUS CHOSEN FOR EACH IMAGE C KP : ARRAY OF SP. FREQ. POINTS OF MINIMUS C NA : ARRAY OF ABBERATION COORESPONDING TO EACH MINIMUS C NUM : NUMBER OF IMAGE IN THE SERIES C C--******************************************************************* SUBROUTINE DEFOCUS(IRTFLG) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' C NOTE: DEFO003 PASSES BACK DATA IN BUF BUT C IT APPEARS UNUSED HERE, ALTHOUGH NEEDED BY NOISE.F al REAL KFR,KP,NA COMMON /COMMUN/ KFR(20),A(20),NP(20), KP(20,20),NA(20,20) COMMON /IOBUF/ BUF(NBUFSIZ) CHARACTER *81 IMFILE IRTFLG = 0 LUN1 = 8 CALL RDPRMI(NUM,NDUM,NOT_USED, & 'HOW MANY IMAGES IN THE SERIES') WRITE(NOUT,*)' INPUT IMAGE IN SEQUENCE' DO I=1,NUM WRITE(NOUT,*)'# ',I,' IMAGE' MAXIM = 0 CALL OPFILEC(0,.TRUE.,IMFILE,LUN1,'O',IFORM,NSAM,NROW,NSLICE, & MAXIM,'IMAGE', .FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN WRITE(NOUT,10)NSAM,NROW 10 FORMAT(' FILE DIMENSIONS:', I5,' X',I5) CALL DEFO003(I,N,KFR,A,NSAM,SPMAX,LUN1,BUF,20,IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL RDPRMI(NP(I),NDUM,NOT_USED, & 'HOW MANY POINTS DO YOU WANT?') IF (NUM .EQ. 1 .AND. NP(1) .EQ. 0) RETURN DO J=1,NP(I) WRITE(NOUT,8)J 8 FORMAT(' POINT #',I2) CALL RDPRM2(KP(I,J),NA(I,J),NOT_USED, & 'SP. FREQ. POINTS/ABBERATION(PI)') ENDDO ENDDO IF (NUM .GT. 1) THEN WRITE(NOUT,*) ' ENTER CONSTRAINTS: ' WRITE(NOUT,*) ' (1) SAME AMPLITUDE,' WRITE(NOUT,*) & ' (2) SAME AMPLITUDE AND DEFINE DEFOCUS INTERVAL,' WRITE(NOUT,*) ' (3) SAME DEFOCUS' CALL RDPRMI(NCONSTRAIN, NDUM,NOT_USED, & 'CONSTRAINTS: (1), (2) OR (3)') IF (NCONSTRAIN .EQ. 3) THEN WRITE(*,*) '***NO PROGRAM NOW' CALL ERRT(100,'DEFOCUS',NE) RETURN ELSEIF (NCONSTRAIN .EQ. 2) THEN CALL DEFO001(NUM,NP,KP,NA,NSAM,SPMAX) ELSE IF (NUM .GT. 11) THEN CALL DEFO2001(NUM,NP,KP,NA,NSAM,SPMAX) ELSE CALL DEFO1001(NUM,NP,KP,NA,NSAM,SPMAX) ENDIF ENDIF ELSE C SINGLE INPUT FILE CASE CALL DEFO1001(NUM,NP,KP,NA,NSAM,SPMAX) ENDIF RETURN END