C++*********************************************************************
C
C  ROTQS.F                ADDED STACK OPERATION          98 ARDEAN LEITH 
C                         USED GETOLDSTACK          1/11/99 ARDEAN LEITH
C                         USED AUTO. ARRAYS         5/02/00 ARDEAN LEITH
C                         GETNEWSTACK PARAM.        2/24/03 ARDEAN LEITH
C                         IMGNUM IN STACK OUTPUT    6/24/05 ARDEAN LEITH
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   ROTQS(MAXDIM,LUN1,LUN2,LUN3,FILNAM,FILNAMO,NSAM,NROW,NSLICE,
C         MAXIM,IRTFLG)
C
C--*********************************************************************

      SUBROUTINE ROTQS(MAXDIM,LUN1,LUN2,LUN3,FILNAM,FILNAMO,
     &                 NSAM,NROW,NSLICE,MAXIM,IRTFLG)

      INCLUDE 'CMBLOCK.INC'

      COMMON         BUF(1)

      DIMENSION      ILIST(4)
      CHARACTER *(*) FILNAM,FILNAMO
      CHARACTER *81  DOCNAM

      REAL, ALLOCATABLE, DIMENSION(:) :: QBUF1
      REAL, DIMENSION(NSAM) ::           QBUF2

C     DOC FILE POINTER
      INCLUDE 'F90ALLOC.INC'
      REAL, DIMENSION(:,:), POINTER :: PBUF

      ALLOCATE (QBUF1(NSAM*NROW), STAT=IRTFLG)
      IF (IRTFLG .NE. 0) THEN 
         CALL ERRT(46,'ROTQS, QBUF1',IER)
         RETURN
      ENDIF  
   
      IRTFLG = 1

      IF (MAXIM .LT. 0) THEN
C        SINGLE IMAGE OPERATION
         CALL RDPRM2(THETA,SCLI,NOT_USED,'ROTATION ANGLE, SCALE')
	 IF (SCLI .EQ. 0.0) SCLI = 1.0

	 CALL  RDPRM2(SHXI,SHYI,NOT_USED,'SHIFTS IN X AND Y')

C        LOAD AND ROTATE SLICE BY SLICE
	 DO L=1,NSLICE
	   LB = (L-1)*NROW
	   DO J=1,NROW
	      CALL  REDLIN(LUN1,QBUF1(1+(J-1)*NSAM),NSAM,LB+J)
	   ENDDO

C          ROTATE THIS SLICE
	   CALL  ROT2QS(QBUF1,QBUF2,NSAM,NROW,THETA,SCLI,
     &                 SHXI,SHYI, LUN2,LB)
	 ENDDO

C        RESET FILE HEADER FOR ALTERATIONS IN STATISTICS
         CALL SETPRMB(BUF,LUN2,NSAM,IDUM,0.0,0.0,0.0,'U')
         IRTFLG = 0

      ELSE
C        WHOLE STACK OPERATION ---------------------------------- STACK

         NUMB = 4
         CALL RDPRAI(ILIST,4,NUMB,1,6,
     &      'ENTER REG. NUMBERS FOR ANGLE, SCALE, X, & Y SHIFT',
     &      'T',IRTFLG)
         IF (IRTFLG .NE. 0) GOTO 999

C        MAXX IS 1 + NUM OF REGISTERS SINCE PBUB CONTAINS KEY ALSO
         MAXX   = MAX(ILIST(1),ILIST(2),ILIST(3),ILIST(4)) + 1
         MAXY   = 0
         CALL GETDOCDAT('ANGLE/SCALE DOCUMENT',.TRUE.,DOCNAM,LUN3,
     &             .TRUE.,MAXX, MAXY,PBUF,IRTFLG)
         IF (IRTFLG .NE. 0) GOTO 999

         IMGNUM = 1
         DO WHILE (IMGNUM .LE. MAXIM)

C           GET INPUT IMAGE FROM STACK            
            CALL GETOLDSTACK(LUN1,NSAM,IMGNUM,
     &                       .TRUE.,.FALSE.,.TRUE.,IRTFLG)

            IF (IRTFLG .EQ. 0) THEN
C              CREATE OUTPUT IMAGE IN OUTPUT STACK
               CALL GETNEWSTACK(LUN1,LUN2,NSAM,IMGNUM,IRTFLG)

               IF (IRTFLG .EQ. 0) THEN
C                 OUTPUT IMAGE CREATED OK
                  THETA = PBUF(ILIST(1) + 1, IMGNUM)
                  IF (ILIST(2) .GT. 0) THEN
                     SCLI  = PBUF(ILIST(2) + 1, IMGNUM)
	             IF (SCLI .EQ. 0.0) SCLI = 1.0
                  ELSE
                     SCLI  = 1.0
                  ENDIF

                  SHXI  = PBUF(ILIST(3) + 1, IMGNUM)
                  SHYI  = PBUF(ILIST(4) + 1, IMGNUM)

C                 LOAD AND ROTATE SLICE BY SLICE
	          DO L=1,NSLICE
	             LB = (L-1)*NROW
	             DO J=1,NROW
	               CALL  REDLIN(LUN1,QBUF1(1+(J-1)*NSAM),NSAM,LB+J)
	             ENDDO
              
	             CALL ROT2QS(QBUF1,QBUF2,NSAM,NROW,
     &                           THETA,SCLI,SHXI,SHYI, LUN2,LB)
                  ENDDO

                  WRITE(NOUT,90) IMGNUM,THETA,SCLI,SHXI,SHYI 
90                FORMAT(' IMAGE: ',I6,
     &                   '  ANGLE: ',G10.3,
     &                   '  SCALE: ',G10.3,
     &                   '  SHIFTS(',G10.3,',',G10.3,')')

C                 RESET HEADER FOR ALTERATIONS IN STATISTICS
                  CALL SETPRMB(BUF,LUN2,NSAM,IDUM,0.0,0.0,0.0,'U')
               ENDIF
            ENDIF
            IMGNUM = IMGNUM + 1
         ENDDO

C        DEALLOCATE DOC. FILE MEMORY
         IF (ASSOCIATED(PBUF)) THEN
            DEALLOCATE(PBUF)
            NULLIFY (PBUF)
         ENDIF
      ENDIF

999   DEALLOCATE(QBUF1)

      RETURN
      END