C++********************************************************************* C C HDLS.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 HDLS(NDOC,NDOUT) C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE HDLS(NDOC,NDOUT) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON Q(1024) CHARACTER(LEN=MAXNAM) :: DOCFIL INTEGER TOTEL CHARACTER*1 NULL NULL = CHAR(0) CALL RDPRM(THRESHOLD,NOT_USED,'THRESHOLD (0-1)') CALL FILERD(DOCFIL,NLETI,NULL,'DENDROGRAM DOCUMENT',IRTFLG) IF (IRTFLG .NE. 0) RETURN C NO. OF OBJECTS IN A GROUP X41 = 0.0 TOTEL = 0.0 C NO. OF GROUPS X42 = 1.0 NLIST = 2 K = 0 K2 = 1 778 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 X32 = Q(2) K = K+1 X41 = X41+1.0 GOTO 778 ENDIF X22=Q(2) K=K+1 IF (X32 .LT. THRESHOLD) THEN X41 = X41+1.0 X32 = X22 ELSE Q(1) = X42 Q(2) = X41 CALL SAVD(NDOUT,Q,NLIST,IRTFLG) IF (IRTFLG.EQ.-1) GOTO 5 IF (X42 .EQ. 1.0) WRITE(NOUT,122) 122 FORMAT(' GROUP NUMBER NUMBER OF ELEMENTS') WRITE(NOUT,123) X42,X41 123 FORMAT(1X,F5.0,10X,2F10.0) TOTEL = TOTEL+X41 X42 = X42+1.0 X41 = 1.0 X32 = X22 ENDIF GOTO 778 ENDIF Q(1) = X42 Q(2) = X41 CALL SAVD(NDOUT,Q,NLIST,IRTFLG) IF (IRTFLG .EQ. -1) GOTO 5 WRITE(NOUT,123) X42,X41 TOTEL=TOTEL+X41 WRITE(NOUT,33) TOTEL,X42 33 FORMAT(' TOTAL NUMBER OF OBJECTS =',I9, & ' NUMBER OF CLASSES =',F9.0) 5 CALL SAVDC CLOSE(NDOUT) CLOSE(NDOC) END