C++********************************************************************* C C HELS.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 HELS(NDOC,NDOUT) C C--********************************************************************* SUBROUTINE HELS(NDOC,NDOUT) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' PARAMETER (NDLI = 2) DIMENSION DLIST(NDLI) COMMON Q(1024) INTEGER X41,X42,TOTEL CHARACTER(LEN=MAXNAM) :: FINP,FINPAT,DOCFIL CHARACTER*1 NULL NULL = CHAR(0) CALL RDPRM(THRESHOLD,NOT_USED,'THRESHOLD') CALL FILERD(DOCFIL,NLETI,NULL,'DENDROGRAM DOCUMENT',IRTFLG) IF (IRTFLG .NE. 0) RETURN NMAX = 0 CALL FILSEQP(FINPAT,NLET,ILIST,NMAX,NIMA, & 'ENTER TEMPLATE FOR SELECTION DOC',IRTFLG) C # OF OBJECTS IN A GROUP X41 = 0 TOTEL = 0.0 C # OF GROUPS X42 = 1 NLIST = 2 K = 0 K2 = 1 778 CONTINUE LERR = -1 KP1 = K+1 CALL UNSAV(DOCFIL,K,NDOC,KP1,Q,2,LERR,K2) IF (LERR.EQ.0) THEN IF(K.EQ.0) THEN X31 = Q(1) X32 = Q(2) K = K+1 X41 = X41+1 CALL FILGET(FINPAT,FINP,NLET,X42,INTFLAG) DLIST(1) = X41 DLIST(2) = X31 IAP = 0 CALL SAVDN1(NDOUT,FINP,DLIST,NDLI,X41-1,IAP) GOTO 778 ENDIF X21 = Q(1) X22 = Q(2) K = K+1 IF (X32 .LT. THRESHOLD) THEN X41 = X41+1 DLIST(1) = X41 DLIST(2) = X21 IAP = 1 CALL SAVDN1(NDOUT,FINP,DLIST,NDLI,K,IAP) X32 = X22 ELSE CLOSE(NDOUT) IF (X42.EQ.1) WRITE(NOUT,122) 122 FORMAT(' Group number ','Number of elements') WRITE(NOUT,123) X42,X41 123 FORMAT(1X,I5,14X,I10) TOTEL = TOTEL + X41 X42 = X42 + 1 CALL FILGET(FINPAT,FINP,NLET,X42,INTFLAG) X41 = 1 X32 = X22 DLIST(1) = X41 DLIST(2) = X21 IAP = 0 CALL SAVDN1(NDOUT,FINP,DLIST,NDLI,X41-1,IAP) ENDIF GOTO 778 ENDIF WRITE(NOUT,123) X42,X41 TOTEL = TOTEL+X41 WRITE(NOUT,33) TOTEL,X42 33 FORMAT(' Total number of objects = ',I10, & ' Number of classes = ',I10) 5 CLOSE(NDOC) CLOSE(NDOUT) RETURN END