C++*********************************************************************
C
C PJ3Q.F        SPEEDED UP                         FEB 2000 ARDEAN LEITH
C               LUNDOCREDANG PARAMETERS CHANGED    DEC 2000 ARDEAN LEITH
C               OPENDOC PARAMETERS                 DEC 2000 ARDEAN LEITH
C               OPFILEC                            FEB 03 ARDEAN LEITH
C               INCORE OPENDOC                     JUL 03 ARDEAN LEITH
C
C **********************************************************************
C=*                                                                    *
C=* This file is part of:   SPIDER - Modular Image Processing System.  *
C=* SPIDER System Authors:  Joachim Frank & ArDean Leith               *
C=* Copyright 1985-2010  Health Research Inc.,                         *
C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204.      *
C=* Email: spider@wadsworth.org                                        *
C=*                                                                    *
C=* SPIDER 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=* SPIDER 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=* You should have received a copy of the GNU General Public License  *
C=* along with this program. If not, see <http://www.gnu.org/licenses> *
C=*                                                                    *
C **********************************************************************
C
C PJ3Q
C
C PURPOSE:  COMPUTES PROJECTIONS OF A 3D VOLUME ACCORDING TO 
C           THREE EULERIAN ANGLES. DOES A WHOLE IMAGE SERIES. 
CC
C23456789012345678901234567890123456789012345678901234567890123456789012
C--*********************************************************************

         SUBROUTINE PJ3Q()

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

         COMMON /PAR/     LDPX,LDPY,LDPZ

         CHARACTER*80     FINPAT,FINPIC,FINDOC
         COMMON  /F_SPEC/ FINPAT,FINPIC,FINDOC

         CHARACTER*1      NULL
         COMMON           BUF(1024)
         LOGICAL          MD

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

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

#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
         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)

         NNN = NSAM*NROW*NSLICE

C        INITIALIZE NN & NMAT AND FIND NN & NMAT
C        DUM1 AND DUM2 ARE DUMMY VARIABLES 

         NN = 1
         NMAT =1 
         MD = .FALSE.
         CALL  PREPCUB_Q(DUM1,NSAM,NROW,NSLICE,BUF,NN,NMAT,
     &                   DUM2,RI,INVOL,MD) 

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

         MD = .TRUE.
C        READ BCKE AND PREPARE IPCUBE
         CALL PREPCUB_Q(BCKE,NSAM,NROW,NSLICE,BUF,NN,NMAT,
     &                   IPCUBE,RI,INVOL,MD)

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

C        READ SELECTION DOC FILE 
         CALL FILELIST(.FALSE.,INDOCS,FINPAT,NLETA,INUMBR,MAXKEY,NANG,
     &                 'DUMMY',IRTFLG)
         IF (IRTFLG .NE. 0) GOTO 9995         
         CLOSE(INDOCS)

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 9995

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

         ALLOCATE(ANGBUF(3,MAXKEY),STAT=IRTFLG)
         IF (IRTFLG .NE. 0) GOTO 9995 

C        RETRIEVE THE ANGLES FROM KEYED DOC FILE
         CALL LUNDOCREDANG(INDOCA,ANGBUF,MAXKEY,NGOTY,MAXGOTY,IRTFLG)
         CLOSE(INDOCAT)
         IF (IRTFLG .NE. 0) RETURN

C        PROJECT NOW
         CALL  WRITPRO(PROJ,INPRJ,NSAM,NROW,NUMTH,BCKE,NNN,
     &                 IPCUBE,NN,RI,INUMBR,NANG,MAXKEY,ANGBUF)

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

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

         CLOSE(INVOL)

         RETURN
         END