C++*********************************************************************
C
C  WRITPRO.F                SPEEDED UP     FEB 2000 ARDEAN LEITH
C                           VERBOSE OUTPUT NOV 2000 ARDEAN LEITH
C                           PUT ANGLES IN HEADER JUN 2001 ARDEAN LEITH
C                           OPFILEC              FEB   03 ARDEAN LEITH
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 WRITPRO(PROJ,INPAT,NSAM,NROW,NUMTH,BCKE,NNN,
C         IPCUBE,NN,RI,ISELECT,NANG,MAXKEY,ANGBUF)
C
C PARAMETERS:
C                NUMTH       NUMBER OF OMP THREADS                SENT
C                RI          RADIUS                               SENT
C
C PURPOSE: COMPUTES A PROJECTION OF A 3D VOLUME ACCORDING TO THE 
C          THREE EULERIAN ANGLES
C
C IMAGE_PROCESSING_ROUTINE
C
C23456789012345678901234567890123456789012345678901234567890123456789012
C--*********************************************************************

         SUBROUTINE WRITPRO(PROJ,INPAT,NSAM,NROW,NUMTH,BCKE,NNN,
     &                      IPCUBE,NN,RI,ISELECT,NANG,MAXKEY,ANGBUF)

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

         INTEGER, DIMENSION(MAXKEY)          :: ISELECT
         REAL,    DIMENSION(3,MAXKEY)        :: ANGBUF
         REAL,    DIMENSION(NSAM,NROW,NUMTH) :: PROJ
         REAL,    DIMENSION(NNN)             :: BCKE
         REAL,    DIMENSION(5,NN)            :: IPCUBE
         REAL,    DIMENSION(4)               :: BUFOUT

         CHARACTER(LEN=MAXNAM)   ::  FINP

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

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

#ifdef SP_IBMSP3
         CALL FLUSHRESULTS
#endif

C        GET FINPAT TEMPLATE ONLY (NOT ILIST)
         NMAX = 0
         CALL  FILSEQP(FINPAT,NLET,ILIST,NMAX,NIMA,
     &        'ENTER TEMPLATE FOR 2-D PROJECTION',IRTFLG)

         IFORM = 1
         NSL   = 1
 
         IANG  = 1
         DO WHILE (IANG .LE. NANG)
            NEEDED = MIN(IANG+NUMTH-1,NANG)
c$omp       parallel do private(i,ifile)
            DO I=IANG,NEEDED
               IFILE  = ISELECT(I)
               CALL WPRO(PROJ(1,1,I-IANG+1),NSAM,NROW,BCKE,NNN,IPCUBE,
     &            NN,ANGBUF(3,IFILE),ANGBUF(2,IFILE),ANGBUF(1,IFILE),RI)
            END DO

C           WRITE PROJECTIONS TO OUTPUT FILES
            DO I=IANG,NEEDED
               IFILE  = ISELECT(I)

               IF (VERBOSE) THEN
#ifdef USE_MPI
                  IF (MYPID .EQ. 0) THEN
                     WRITE(NOUT,333) IFILE,
     &                  ANGBUF(1,IFILE),ANGBUF(2,IFILE),ANGBUF(3,IFILE)
                  ENDIF
#else
                  WRITE(NOUT,333) IFILE,
     &               ANGBUF(1,IFILE),ANGBUF(2,IFILE),ANGBUF(3,IFILE)
#endif
333               FORMAT(' PROJECTION #',I7,
     &                '  PSI=',F6.1,' THETA=',F6.1,' PHI=',F6.1)
               ENDIF

C              CREATE OUTPUT FILENAME
               CALL FILGET(FINPAT,FINP,NLET,IFILE,IRTFLG)

C              OPEN FILE
               MAXIM = 0
               CALL OPFILEC(0,.FALSE.,FINP,INPAT,'U',IFORM,
     &                      NSAM,NROW,NSL,MAXIM,' ',.FALSE.,IRTFLG)

               DO J=1,NROW
                  CALL WRTLIN(INPAT,PROJ(1,J,I-IANG+1),NSAM,J)
               ENDDO

C              PUT ANGLES IN HEADER
               BUFOUT(1) = ANGBUF(1,IFILE)
               BUFOUT(2) = ANGBUF(2,IFILE)
               BUFOUT(3) = ANGBUF(3,IFILE)
               BUFOUT(4) = 1.0
               CALL LUNSETVALS(INPAT,IAPLOC+1,4,BUFOUT,IRTFLG)

               CLOSE(INPAT)
            ENDDO

            IANG = IANG + NUMTH

         ENDDO

         RETURN
         END