C++*********************************************************************
C    QALI.F
C                  USED OPFILE                     DEC 99 AL
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     3D ORIENTATION SEARCH  02/14/9D
C     ROTATION MATRIX CORRECTED
C     ROTATION AROUND ARBITRARY POINT MODE='A'
C
C     IMAGE_PROCESSING_ROUTINE
C
C23456789012345678901234567890123456789012345678901234567890123456789012
C **********************************************************************

        SUBROUTINE QALI(MODE)

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

        REAL, DIMENSION(:,:,:), POINTER   ::   XPO
        REAL, DIMENSION(:,:,:), POINTER   ::   YPO

        COMMON /POINT/ XPO,YPO

        CHARACTER(LEN=MAXNAM)   ::  FILNAM
        CHARACTER*1   MODE
        COMMON  /DIMSPEC/  R
        COMMON  /PARM/  NT,PIT(4)

        DATA  LUN1,LUN2/77,78/

C       ASK FOR DATA FILE
        NT=NOUT

        MAXIM = 0
        CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',IFORM,NSAM,NROW,NSLICE,
     &               MAXIM,'REFERENCE 3D',.TRUE.,IRTFLG)
        IF (IRTFLG .NE. 0)  THEN
           CLOSE (LUN1)
           RETURN
        ENDIF

        IF (IFORM.NE.3
     &     .OR. (.NOT.(NSAM.EQ.NROW .AND. NROW.EQ.NSLICE))) THEN
           CALL  ERRT(1,'OR 3Q ',NE)
           CLOSE (LUN2)
           RETURN
        ENDIF

        MAXIM = 0
        CALL OPFILEC(0,.TRUE.,FILNAM,LUN2,'O',IFORM,NSM,NRW,NSL,
     &               MAXIM,'SECOND',.TRUE.,IRTFLG)
        IF (IRTFLG .NE. 0) THEN
           CLOSE (LUN2)
           RETURN
        ENDIF

        IF (NSAM.NE.NSM.OR.NROW.NE.NRW.OR.NSLICE.NE.NSL)  THEN
           CALL  ERRT(1,'OR 3Q ',NE)
           CLOSE (LUN2)
           RETURN
        ENDIF

        CALL  RDPRMI(NRAD,NDUMP,NOT_USED,'RADIUS OF THE MASK')
        R=NRAD
        IF (MODE.EQ.'A')  THEN
           CALL  RDPRMI(NX,NY,NOT_USED,'CENTER OF ROTATION NX, NY')
           CALL  RDPRMI(NZ,NDUMP,NOT_USED,'CENTER OF ROTATION NZ')
        ENDIF
        WRITE(NOUT,*) ' INITIAL EULERIAN ANGLES'
        CALL  RDPRM2(PIT(1),PIT(2),NOT_USED,'PHI, THETA')
        CALL  RDPRM(PIT(3),NOT_USED,'PSI')
 
           NSM=NSAM
           NRM=NROW
           NLM=NSLICE
           IF (MODE.EQ.'A')  THEN
              KLX=-NX+1
              KNX=NSAM-NX
              KLY=-NY+1
              KNY=NROW-NY
              KLZ=-NZ+1
              KNZ=NSLICE-NZ
           ELSE
              KLX=-NSAM/2
              IF (MOD(NSAM,2).EQ.0)  THEN
                 KNX=NSAM/2-1
              ELSE
                 KNX=-KLX
              ENDIF
              KLY=-NROW/2
              IF (MOD(NROW,2).EQ.0)  THEN
                 KNY=NROW/2-1
              ELSE
                 KNY=-KLY
              ENDIF
              KLZ=-NSLICE/2
              IF (MOD(NSLICE,2).EQ.0)  THEN
                 KNZ=NSLICE/2-1
              ELSE
                 KNZ=-KLZ
              ENDIF
           ENDIF

           ALLOCATE (XPO(KLX:KNX,KLY:KNY,KLZ:KNZ), STAT=IRTFLG)
           IF (IRTFLG.NE.0) THEN 
              CALL ERRT(46,'QALI, XPO',IER)
              CLOSE(LUN1)
              CLOSE(LUN2)
              RETURN
           ENDIF

           ALLOCATE (YPO(KLX:KNX,KLY:KNY,KLZ:KNZ), STAT=IRTFLG)
           IF (IRTFLG.NE.0) THEN 
              CALL ERRT(46,'QALI, YPO',IER)
	      DEALLOCATE (XPO)
              CLOSE(LUN1)
              CLOSE(LUN2)
              RETURN
           ENDIF

        CALL READV(LUN1,XPO,NSAM,NROW,NSAM,NROW,NSLICE)
        CLOSE(LUN1)

        CALL READV(LUN2,YPO,NSAM,NROW,NSAM,NROW,NSLICE)
        CLOSE(LUN2)

        CALL  QNRF(XPO,YPO,KLX,KNX,KLY,KNY,KLZ,KNZ,R)
       
        CALL  UQU

C       IF (NSEL(1).NE.0) PARAM(NSEL(1))=PIT(1)
C       IF (NSEL(2).NE.0) PARAM(NSEL(2))=PIT(2)
C       IF (NSEL(3).NE.0) PARAM(NSEL(3))=PIT(3)
C       IF (NSEL(4).NE.0) PARAM(NSEL(4))=PIT(4)
        CALL REG_SET_NSEL(1,4,PIT(1),PIT(2),PIT(3),PIT(4),0.0,IRTFLG)

        WRITE (NDAT,2600)
2600    FORMAT (//' ',80('-')//' ',
     &              'END OF COMPUTATION',//' ',80('-'))

	DEALLOCATE (XPO)
	DEALLOCATE (YPO)

        CLOSE(LUN1)
        CLOSE(LUN2)

        END


