C ++********************************************************************
C                                                                      *
C RDCLUS.F                 ADDED FACTOR CHOICE    AUG 00  ArDean Leith  *
C                          ALLOWED 50  FACTORS    MAY 01  ArDean Leith  *
C                          REWRITE FOR NEW FORMAT NOV 03  ArDean Leith  *
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 RDCLUS
C
C PURPOSE:  TRANSFER IMAGE COORDINATES ALONG FACTORS FROM 
C           CORRESPONDENCE ANALYSIS COORDINATES FILE (_IMC00) INTO A
C           DOCUMENT FILE. THIS DOCUMENT FILE CAN BE USED IN WEB 
C           'CORR MAP' OPERATION.                                                                  *
C***********************************************************************

	SUBROUTINE RDCLUS

	INCLUDE 'CMBLOCK.INC' 
	INCLUDE 'CMLIMIT.INC' 

        CHARACTER(LEN=MAXNAM) :: FILPRE,FILNMC,COMMENT
        COMMON /COMMUN/          FILPRE,FILNMC,COMMENT

        INTEGER, PARAMETER    :: MAXFACT = 500
	COMMON                   FACLIST(MAXFACT),DLIST(MAXFACT)

        CHARACTER(LEN=1)      :: NULL

	DATA  LUNI,NDOC/70,71/

        NULL   = CHAR(0)

        CALL FILERD(FILPRE,NLET,NULL,
     &              'CORAN/PCA FILE PREFIX (e.g. CORAN_)~',IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

C       OPEN IMAGE COORDINATE FILE
        FILNMC = FILPRE(1:NLET) // '_IMC'// NULL
        CALL OPAUXFILE(.FALSE.,FILNMC,DATEXC,LUNI,0,
     &                       'O', ' ',.TRUE.,IRTFLG)
        IF (IRTFLG .NE.0) RETURN

C       READ HEADER
C       NITEM -- NUMBER OF IMAGES
C       NFAC  -- NUMBER OF FACTORS USED IN THE ANALYSIS
C       NSAM, NROW -- NUMBER OF SAMPLES AND ROWS IN THE UNMASKED IMAGE

        READ(LUNI,*) NITEM, NFAC, NSAM, NROW, NDUM, KIND_PCA

        WRITE(NOUT,*) ' NUMBER OF FACTORS AVAILABLE: ',NFAC

        NMAX = NIMAX
        CALL RDPRAI(INUMBR,NMAX,NFACT,1,NFAC,'ENTER FACTOR NUMBERS',
     &              NULL,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

	DO  I=1,NITEM
C          WRITE(LUNI,90) (BLW(K),K=1,NFAC),WEIGHTI(J),CO(J),FIM,ACT

           READ(LUNI,*) (DLIST(K),K=1,NFAC),RWGT,DIO,FACLIST(1),ACTIV
C          KEY        = IMAGE NUMBER

           DO J = 1,NFACT
              FACLIST(J+1) = DLIST(INUMBR(J))
           ENDDO
           CALL SAVD(NDOC,FACLIST,NFACT+1,IRTFLG)
	ENDDO

        COMMENT = ' '
        WRITE(COMMENT,95)(INUMBR(I),I=1,NFACT)
95      FORMAT(' FACTORS: ',9(I2,', '),' ...')

        CALL LUNDOCPUTCOM(NDOC,COMMENT(1:77),IRTFLG)

	CALL SAVDC
	CLOSE(NDOC)
        CLOSE(LUNI)

        RETURN
	END