C++*********************************************************************
C
C DIST_P.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 PARAMETERS:
C        NFAC   - NUMBER OF PARAMETERS IN ONE RECORD
C        MAXFA  - ACTUAL NUMBER OF PARAMETERS USED
C        IDK    - IMAGE OR PIXEL IDS                             (RET.)
C        D      -                                                (RET.)
C
C23456789012345678901234567890123456789012345678901234567890123456789012
C--*********************************************************************

         SUBROUTINE DIST_P(D,MDIM,IDK,NKLA,W,INUM,
     &                     MAXFA,NFAC,LUNF,ITYPE)

         REAL, DIMENSION(MDIM)     :: D
         REAL, DIMENSION(MAXFA)    :: W
         INTEGER, DIMENSION(NKLA)  :: IDK 
         INTEGER, DIMENSION(MAXFA) :: INUM
         
         DOUBLE PRECISION :: Q

C        AUTOMATIC ARRAYS
         REAL, DIMENSION(NFAC)  :: COO,COB

C        INTERNAL FUNCTION
         MONO(K1,K2)=MIN0(K1,K2)+((MAX0(K1,K2)-1)*(MAX0(K1,K2)-2)/2)

C        ZERO ARRAY
         D  = 0.0

         REWIND(LUNF)
         IF (ITYPE .EQ. 1) THEN
C           UNFORMATTED FILE FOR IMAGE DATA
            READ(LUNF) NDUM,NDUM

            DO I=1,NKLA
               READ(LUNF) (COB(J),J=1,NFAC),FIM
               IDK(I) = FIM
	    ENDDO
         ELSE
C           FORMATTED FILE FOR IMAGE OR PIXEL COOR.
            READ(LUNF,*) IDUM, IDUM, IDUM, IDUM, IDUM, IDUM

            DO I=1,NKLA
                READ(LUNF,*) (COB(J),J=1,NFAC),ADUM,BDUM,FIM,CDUM
                IDK(I) = FIM
	    ENDDO
         ENDIF

         DO K1=1,NKLA-1
            KK = NKLA-K1+1
            REWIND(LUNF)

            IF (ITYPE .EQ. 1) THEN
               READ(LUNF)
            ELSE
               READ(LUNF,*) IDUM, IDUM, IDUM, IDUM, IDUM, IDUM
            ENDIF

            DO K2=1,NKLA-K1
               IF (ITYPE .EQ. 1) THEN
                  READ(LUNF)   (COO(J),J=1,NFAC),FIM
               ELSE
                  READ(LUNF,*) (COO(J),J=1,NFAC),FDUM,FDUM,FDUM,FDUM
               ENDIF

               Q = 0.0D0
               DO L=1,MAXFA
                  LL = INUM(L)
                  Q  = Q + (DBLE(W(L)) * (COO(LL) - COB(LL)))**2
               ENDDO
               M    = MONO(K2,KK)
               D(M) = Q
            ENDDO
            COB   = COO
	 ENDDO

         CLOSE(LUNF)
         END