C++********************************************************************* C C DEFO003.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 DEFO003(INUM,N,KFR,A,NSAM,SPMAX,LUN1,BUF,NUMMIN,IRTFLG) C C PURPOSE: SEARCH THE MINIMA C C PARAMETERS: C INUM : POSITION OF THE IMAGE IN THE SERIES (SENT) C ICOUNT: NUMBER OF MINIMA (RET.) C KFR : ARRAY OF SP. FREQ. POINTS OF MINIMUM C A : C NSAM : DIMENSION OF IMAGE (SENT.) C SPMAX : MAX. OF SP. FREQUENCE (RET.) C LUN1: (SENT) C BUF : (RET.) C NUMMIN: (SENT) C IRTFLG: C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE DEFO003(INUM,ICOUNT,KFR,A,NSAM,SPMAX,LUN1, & BUF,NUMMIN,IRTFLG) C NSAM APEARS TO BE LIMITED TO 512 al C (I DID NOT WRITE THIS MESS al!!!!) INCLUDE 'CMBLOCK.INC' REAL, DIMENSION(NUMMIN) :: A,B,KFR REAL, DIMENSION(NSAM) :: BUF CHARACTER *1 CHO,NULL LOGICAL FLAG NULL = CHAR(0) FLAG = .TRUE. IRTFLG = 1 IF (INUM .EQ. 1) THEN CALL RDPRM(SPMAX,NOT_USED,'MAXIMUM SP. FREQ [A-1]') ENDIF 20 WRITE(NOUT,25) 25 FORMAT(' SEARCHING FOR MINIMA') CALL RDPRMI(NEIB,NDUM,NOT_USED, & ' SEARCH NEIGHBOUR AREA[POINT]') CALL REDLIN(LUN1,BUF,NSAM,1) SC = SPMAX/FLOAT(NSAM) ICOUNT = 0 DO I=1,NSAM-1 BX = BUF(I) IF (BX .LT. BUF(I+1)) THEN DO J=I,I-NEIB,-1 IF (BX .GT. BUF(J)) FLAG=.FALSE. ENDDO DO J=I,I+NEIB IF (BX .GT. BUF(J)) FLAG=.FALSE. ENDDO IF (FLAG) THEN IF (ICOUNT .GE. NUMMIN) THEN CALL ERRT(101,'EXCESSIVE NUMBER OF MINIMA',NDUM) RETURN ENDIF ICOUNT = ICOUNT + 1 C FIT INTO PARABOLIC C Y=A1+A2*X+A3*X**2 C A3=[(Y1-Y3)(X2-X3)-(Y2-Y3)(X1-X3)]/[(X1^2-X3^2)(X2-X3)- C (X2^2-X3^2)(X1-X3)] C A2=[(Y1-Y3)(X2^2-X3^2)-(Y2-Y3)(X1^2-X3^2)]/[(X1-X3) C (X2^2-X3^2)-(X2-X3) C *(X1^2-X3^2)] C A1=[(Y1X3^2-Y3X1^2)(X2X3^2-X3X2^2)-(Y2X3^2-Y3X2^2) C (X1X3^2-X3X1^2)]/ C [(X3^2-X1^2)(X2X3^2-X3X2^2)-(X3^2-X2^2)(X1X3^2-X3X1^2)] C XMIN=-0.5A2/A3 C YMIN=A1-0.25A2^2/A3 X1=FLOAT(I-1) X2=FLOAT(I) X3=FLOAT(I+1) Y1=BUF(I-1) Y2=BUF(I) Y3=BUF(I+1) A1=((Y1*X3**2-Y3*X1**2)*(X2*X3**2-X3*X2**2)- & (Y2*X3**2-Y3*X2**2)* (X1*X3**2-X3*X1**2)) A1=A1/((X3**2-X1**2)*(X2*X3**2-X3*X2**2)-(X3**2-X2**2)* & (X1*X3**2-X3* X1**2)) A2=((Y1-Y3)*(X2**2-X3**2)-(Y2-Y3)*(X1**2-X3**2)) A2=A2/((X1-X3)*(X2**2-X3**2)-(X2-X3)*(X1**2-X3**2)) A3=((Y1-Y3)*(X2-X3)-(Y2-Y3)*(X1-X3)) A3=A3/((X1**2-X3**2)*(X2-X3)-(X2**2-X3**2)*(X1-X3)) A(ICOUNT) = A1-0.25*A2**2/A3 KFR(ICOUNT) = -0.5*A2/A3 ELSE FLAG = .TRUE. ENDIF ENDIF ENDDO WRITE(NOUT,50) 50 FORMAT(' IMAGE HAS FOLLOWING MINIMA') DO I=1,ICOUNT B(I) = ABS(KFR(I))*SC WRITE(NOUT,*) '#',I,KFR(I),B(I),'(A-1)',' A=',A(I) ENDDO CALL RDPRMC(CHO,NC,.TRUE.,'CHANGE SEARCHING NEIGHBOUR (Y/N)', & NULL,IRT) IF (CHO .EQ. 'Y' .OR. CHO .EQ. 'y') GOTO 20 CLOSE(LUN1) IRTFLG = 0 RETURN END