C++*********************************************************************
C
C BPWR.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 BPWR.FOR
C R**2 weighting,                             03/04/92
C
C23456789012345678901234567890123456789012345678901234567890123456789012
C--*********************************************************************

         SUBROUTINE BPWR(MAXMEM)

         INCLUDE 'CMBLOCK.INC'
         INCLUDE 'CMLIMIT.INC'
         INCLUDE 'F90ALLOC.INC'
         CHARACTER*80      FINPAT,FINPIC,FOUT
         COMMON  /F_SPEC/  FINPAT,FINPIC,FOUT,NLET,NLOT

         PARAMETER  (NILMAX=2000)
         COMMON     DUMMY(80),BUF(1024),ILIST(NILMAX),Q(1)
         REAL, DIMENSION(:), ALLOCATABLE :: Q1,Q2

         CHARACTER * 1  NULL

         DATA  INPIC/99/

         NULL = CHAR(0)

         CALL  FILERD(FINPAT,NLET,NULL,
     &      'ENTER TEMPLATE FOR 2-D IMAGE NAME',IRTFLG)

         CALL  FILERD(FOUT,NLOT,NULL,
     &      'ENTER TEMPLATE FOR 2-D OUTPUT IMAGE',IRTFLG)

         CALL  FILERD(FINPIC,NLETI,NULL,'SELECTION DOC',IRTFLG)

         CALL  RDPRM(FM,NOT_USED,
     &      'CUT-OFF FREQUENCY OF PARZEN FILTER')
         K    = 0
         K2   = 1
         NANG = 0
778      LERR = -1
         IF(NANG.EQ.NILMAX)  THEN
            WRITE(NOUT,*) '*** Too many images, list truncated'
            GOTO  779
         ENDIF

         KP1 = K+1
         CALL  UNSAV(FINPIC,K,INPIC,KP1,Q,1,LERR,K2)
         IF (LERR.EQ.0)  THEN
            NANG = NANG+1
            ILIST(NANG)=Q(1)
            K=K+1
            GOTO  778
         ENDIF

779      CLOSE(INPIC)
         WRITE(NOUT,2001) NANG
2001     FORMAT(' Number of images=',I5)
         CALL  FILGET(FINPAT,FINPIC,NLET,ILIST(1),INTFLG)
         MAXIM = 0
         CALL OPFILEC(0,.FALSE.,FINPIC,INPIC,'O',IFORM,NSAM,NROW,NSL,
     &               MAXIM,' ',.FALSE.,IRTFLG)
         IF (IRTFLG .NE. 0) RETURN
         CLOSE(INPIC)

         N2S = 2*NSAM
         N2R = 2*NROW

        ALLOCATE(Q1(N2R*(N2S+2)),Q2(N2R*(N2S+2)), STAT=IRTFLG)
        IF (IRTFLG.NE.0) THEN 
           CALL ERRT(46,'BP R2',IER)
        ENDIF
	 IF (FM.GE.0.0)  THEN
            WRITE(NOUT,1001)  N2S,N2R
1001        FORMAT(//'  R**2 weighting of 2D images',/,
C     &               '  Memory needed - ',I8,/,
     &               '  Dimensions used:',2I8,/)
	 ELSE
            WRITE(NOUT,1003)  N2S,N2R
1003        FORMAT(//'  R*   weighting of 2D images',/,
C     &               '  Memory needed - ',I8,/,
     &               '  Dimensions used:',2I8,/)
	 ENDIF
         IF (MEMTOT .GT. MAXMEM)  THEN
            CALL ERRT(102,'YOUR BUFFER LENGTH IS ONLY',MAXMEM)
            RETURN
         ENDIF

         CALL  BPWR_Q(BUF,Q1,Q2,FM,ILIST,NANG,N2S,N2R,NSAM,NROW)
         IF (ALLOCATED(Q1))  DEALLOCATE(Q1)
         IF (ALLOCATED(Q2))  DEALLOCATE(Q2)
         END