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 TRAP FOR MISSING DOC KEY 5/20/09 ARDEAN LEITH C MPI 5/20/09 ARDEAN LEITH C WRTVOL(LUN1 BUG 6/25/10 ARDEAN LEITH C GETNEWSTACK PARAM OCT 2010 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 * 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' INCLUDE 'CMLIMIT.INC' INTEGER :: ILIST(4) CHARACTER (LEN=*) :: FILNAM,FILNAMO CHARACTER (LEN=MAXNAM) :: DOCNAM REAL, ALLOCATABLE :: QBUF1(:) REAL, DIMENSION(NSAM) :: QBUF2 ! WORKING ARRAY C DOC FILE POINTER INCLUDE 'F90ALLOC.INC' REAL, POINTER :: PBUF(:,:) CALL SET_MPI(ICOMM,MYPID,IRTFLG) ALLOCATE (QBUF1(NSAM*NROW), STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN MWANT = NSAM * NROW CALL ERRT(46,'ROTQS, QBUF1',MWANT) 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 CALL REDVOL(LUN1,NSAM,NROW,L,L,QBUF1,IRTFLG) 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(LUN2, 0.0,0.0, 0.0,0.0) CALL SETPRMS(LUN2, 0.0,IRTFLG) 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,.FALSE.,NSAM,IMGNUM,IRTFLG) IF (IRTFLG .EQ. 0) THEN C OUTPUT IMAGE CREATED OK IGOT = 0 IF (IMGNUM .LE. MAXY) IGOT = PBUF(ILIST(1), IMGNUM) IF (IGOT .LE. 0) THEN C GOT IMAGE BUT NO TRANSFORM AVAILABLE IN DOC FILE C COPY SLICE BY SLICE DO L=1,NSLICE CALL REDVOL(LUN1,NSAM,NROW,L,L,QBUF1,IRTFLG) CALL WRTVOL(LUN2,NSAM,NROW,L,L,QBUF1,IRTFLG) ENDDO IF (MYPID .LE. 0) WRITE(NOUT,91) IMGNUM 91 FORMAT(' IMAGE: ',I6,' COPIED,', & ' LACKS KEY IN DOC FILE') ELSE C GOT IMAGE AND TRANSFORM IS AVAILABLE IN DOC FILE THETA = PBUF(ILIST(1) + 1, IMGNUM) SCLI = 1.0 IF (ILIST(2) .GT. 0) THEN SCLI = PBUF(ILIST(2) + 1, IMGNUM) IF (SCLI .EQ. 0.0) 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 CALL REDVOL(LUN1,NSAM,NROW,L,L,QBUF1,IRTFLG) CALL ROT2QS(QBUF1,QBUF2,NSAM,NROW, & THETA,SCLI,SHXI,SHYI, LUN2,LB) ENDDO IF (MYPID .LE. 0) & 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 FILE HEADER FOR ALTERATIONS IN STATISTICS CALL SETPRMB(LUN2, 0.0,0.0, 0.0,0.0) CALL SETPRMS(LUN2, SCLI,IRTFLG) !PIXSIZ ENDIF 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