C++*********************************************************************
C
C PJ3Q_N.F      SPEEDED UP                         FEB 2000 ARDEAN LEITH
C               LUNDOCREDANG PARAMETERS CHANGED    DEC 2000 ARDEAN LEITH
C               OPENDOC PARAMETERS                 DEC 2000 ARDEAN LEITH
C               REWRITTEN                          SEP 2003 PAWEL
C               REFRINGS OPTION                    FEB 05 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 PJ3Q_N
C
C PURPOSE:  COMPUTES PROJECTIONS OF A 3D VOLUME ACCORDING TO 
C           THREE EULERIAN ANGLES. DOES A WHOLE IMAGE SERIES. CAN
C           CREATE 'REFERENCE RINGS' FILE(S) ALSO 
C
C23456789012345678901234567890123456789012345678901234567890123456789012
C--*********************************************************************

         SUBROUTINE PJ3Q_N

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

         COMMON /PAR/     LDPX,LDPY,LDPZ

         CHARACTER(LEN=MAXNAM)                  :: FINPAT,FINPIC
         CHARACTER(LEN=1)                       :: NULL,MODE
         LOGICAL                                :: REFRINGS,MD

         REAL, ALLOCATABLE, DIMENSION(:)        :: BCKE
         INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: IPCUBE
         REAL, ALLOCATABLE, DIMENSION(:,:,:)    :: PROJ
         REAL, ALLOCATABLE, DIMENSION(:,:)      :: ANGBUF

         DATA  INVOL,INPRJ,INDOCAT,INDOCS,LUNRINGST/98,97,96,95,94/

#ifdef USE_MPI
         include 'mpif.h'
         ICOMM = MPI_COMM_WORLD
         CALL MPI_COMM_RANK(ICOMM, MYPID, MPIERR)
#else
         MYPID = -1 
#endif

         MAXKEY = NIMAX

         NULL = CHAR(0)

C        NANG - NUMBER OF ANGLES (PROJECTIONS)

C        OPEN INPUT VOLUME
         MAXIM  = 0
         IRTFLG = 0
         CALL OPFILEC(0,.TRUE.,FINPAT,INVOL,'O',IFORM,NSAM,NROW,NSLICE,
     &               MAXIM,'3-D INPUT',.FALSE.,IRTFLG)
         IF (IRTFLG .NE. 0)  RETURN

         CALL  RDPRM(RI,NOT_USED,'RADIUS OF THE OBJECT')

         LDPX = NSAM/2+1
         LDPY = NROW/2+1
         LDPZ = NSLICE/2+1

C        FIND NUMBER OF OMP THREADS
         CALL GETTHREADS(NUMTH)

         NMAT = NSAM*NROW*NSLICE

C        INITIALIZE NN  AND FIND NN 
C        DUM1 IS A DUMMY VARIABLE

         NN = 1
         MD = .FALSE.
         CALL PREPCUB_Q_N(NSAM,NN,DUM1,RI,MD,LDPX,LDPY,LDPZ) 

C        USE NMAT TO ALLOCATE (BCKE) 
         ALLOCATE(BCKE(NMAT),IPCUBE(5,NN),ANGBUF(3,MAXKEY),STAT=IRTFLG)
         IF (IRTFLG .NE. 0) THEN 
            MWANT = NMAT + 5 * NN + 3 * MAXKEY
            CALL ERRT(46,'PJ 3Q, BCKE...',MWANT)
            GOTO 9999   
         ENDIF

C        READ BCKE
	 CALL READV(INVOL,BCKE,NSAM,NROW,NSAM,NROW,NSLICE)
         CLOSE(INVOL)

C        PREPARE IPCUBE
         MD = .TRUE.
         CALL PREPCUB_Q_N(NSAM,NN,IPCUBE,RI,MD,LDPX,LDPY,LDPZ) 

         ALLOCATE(PROJ(NSAM,NROW,NUMTH),STAT=IRTFLG)
         IF (IRTFLG .NE. 0) THEN 
            MWANT = NSAM * NROW  * NUMTH
            CALL ERRT(46,'PJ 3Q, PROJ',MWANT)
            GOTO 9999   
         ENDIF

C        READ SELECTION DOC FILE 
         CALL FILELIST(.FALSE.,INDOCS,FINPAT,NLETA,INUMBR,MAXKEY,NANG,
     &        'ENTER ANGLE NUMBERS OR SELECTION DOC. FILE NAME',IRTFLG)
         IF (IRTFLG .NE. 0)  GOTO 9999         

C        OPEN ANGLES DOC FILE
         CALL OPENDOC(FINPIC,.TRUE.,NLETI,INDOCAT,INDOCA,.TRUE.,
     &     'ANGLES DOC',.TRUE.,.FALSE.,.FALSE.,NEWFILE,IRTFLG)
         IF (IRTFLG .NE. 0)  GOTO 9999

C        READ ANGLES FROM ANGLES DOC FILE.
C        ORDER IN THE DOCUMENT FILE IS PSI, THETA, PHI AND ANGLES ARE 
C        IN DEGREES! 

         CALL LUNDOCREDANG(INDOCA,ANGBUF,MAXKEY,NGOTY,MAXGOTY,IRTFLG)
         IF (IRTFLG .NE. 0) GOTO 9999
         IF (NGOTY .LT. NANG) THEN 
            CALL ERRT(102,'ONLY GOT ANGLES FOR IMAGES',NGOTY)
            GOTO 9999   
         ENDIF

         REFRINGS =  (FCHAR(7:7) .EQ. 'R') 
         LUNRINGS = 0
         IF (REFRINGS) THEN
C           WANT TO CREATE REFERENCE RINGS FILE
                     
            MR    = 5
            NR    = MIN(NSAM,NROW)
            ISKIP = 0
            CALL RDPRI3S(MR,NR,ISKIP,NOT_USED,
     &                  'FIRST, LAST RING, & RING SKIP',IRTFLG)
            IF (IRTFLG .NE. 0) GO TO 9999
            LUNRINGS = LUNRINGST

            MODE     = 'F'
         ENDIF

C        PROJECT NOW
         CALL WRITPRO_N(PROJ,INPRJ,NSAM,NROW,NSLICE,NUMTH,BCKE,NMAT,
     &                 IPCUBE,NN,RI,INUMBR,NANG,MAXKEY,ANGBUF,
     &                 LUNRINGS,MODE,MR,NR,ISKIP,IRTFLG)

         IF (MYPID .LE. 0) THEN
            WRITE(NOUT,90) NANG
90          FORMAT('  PJ 3Q FINISHED FOR: ',I7,'   PROJECTIONS -----',/)
            CALL FLUSHRESULTS()
         ENDIF

9999     IF(ALLOCATED(ANGBUF)) DEALLOCATE(ANGBUF)
         IF(ALLOCATED(PROJ))   DEALLOCATE(PROJ)
         IF(ALLOCATED(IPCUBE)) DEALLOCATE(IPCUBE)
         IF(ALLOCATED(BCKE))   DEALLOCATE(BCKE)

         CLOSE(INDOCAT)
         CLOSE(INDOCS)
         IF (REFRINGS) CLOSE(LUNRINGS)

         RETURN
         END