C++********************************************************************* C C AP_GETANGA.F C ADDED CCROT RETRIEVAL FEB 05 ARDEAN LEITH C 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 AP_GETANGA(ILIST,NIMA,IMIT,ANGDOCNAM,IMGPAT, LUNIN,SA,ANGS,IRTFLG) C C PURPOSE: READ PROJ. ANGLES AND CONVERT TO UNITARY C DIRECTIONAL VECTORS. C C PARAMETERS: C ILIST LIST OF IMAGE FILE NUMBERS (INPUT) C NIMA NO. OF IMAGES (INPUT) C IMIT IMAGE NUMBER (0 IF ALL) (INPUT) C ANGDOCNAM ANGLES FILE NAME (INPUT) C IMGPAT IMAGE SERIES FILE TEMPLATE (INPUT) C LUNIMG IMAGE FILE IO UNIT (INPUT) C < 0 IMAGE ALREADY OPEN C LUNANG PROJ. ANGLE FILE IO UNIT (INPUT) C NWANT NUMBER OF PARAMS TO RETRIEVE (INPUT) C ANGS PROJ. ANGLES (OUTPUT) C NGOTX NUMBER OF ALIGNMENT PAR. RETURNED (OUTPUT) (OUTPUT) C IRTFLG ERROR FLAG (OUTPUT) C C--********************************************************************* SUBROUTINE AP_GETANGA(ILIST,NIMA,IMIT,ANGDOCNAM,IMGPAT, & LUNIMG,LUNANG,NWANT,ANGS,NGOTX,IRTFLG) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' INCLUDE 'F90ALLOC.INC' INTEGER, DIMENSION(NIMA) :: ILIST CHARACTER (LEN=*) :: ANGDOCNAM CHARACTER (LEN=*) :: IMGPAT REAL, DIMENSION(NWANT,NIMA) :: ANGS CHARACTER (LEN=MAXNAM) :: ANGDOCNAMPE CHARACTER(LEN=MAXNAM) :: FILNAM REAL, DIMENSION(15) :: BUFIN C DOC FILE POINTERS REAL, DIMENSION(:,:), POINTER :: ANGBUF LOGICAL :: ANGINHEADER NGOTX = 3 C READ ANGLES AND CONVERT TO UNITARY DIRECTIONAL VECTORS. IGO = 1 IEND = NIMA IF (IMIT > 0) THEN C 0NLY WANT ONE IMAGE'S ANGLES IGO = IMIT IEND = IMIT ENDIF ANGINHEADER = (ANGDOCNAM .EQ. CHAR(0) .OR. ANGDOCNAM .EQ. '*') IF (.NOT. ANGINHEADER) THEN C ANGLES ARE IN DOC FILE, GET THE FILE NAME CALL FILNAMANDEXT(ANGDOCNAM,DATEXC,ANGDOCNAMPE,NLET, & .TRUE.,IRTFLG) C RETRIEVE ARRAY WITH ANGLES DATA IN IT, CAN NOT USE C LUNDOCGETANG BECAUSE OF ILIST! MAXX = 8 + 1 IF (NWANT .GT. 7) MAXX = 11 + 1 ! GET CCROT ALSO MAXY = MAXVAL(ILIST(1:NIMA)) CALL GETDOCDAT(' ',.FALSE.,ANGDOCNAMPE,LUNANG,.FALSE., & MAXX,MAXY,ANGBUF,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 ENDIF DO IMI=IGO,IEND IV = IMI - IGO + 1 IF (IMIT > 0) IV = 1 IF (ANGINHEADER) THEN C ANGLES IN IMAGE HEADER MAXX = NWANT + 1 IF (NWANT .GE. 8) MAXX = 11 +1 IF (LUNIMG .GT. 0) THEN C MUST OPEN IMAGE ON LUNIMG FIRST NLET = 0 CALL FILGET(IMGPAT,FILNAM,NLET,ILIST(IMI),INTFLAG) MAXIM = 0 CALL OPFILEC(0,.FALSE.,FILNAM,LUNIMG,'O',IFORM, & LSAM,LROW,NSLICE,MAXIM,' ',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL LUNGETVALS(LUNIMG,IAPLOC + 1,MAXX,BUFIN,IRTFLG) CLOSE(LUNIMG) ELSEIF (LUNIMG .LT. 0) THEN C IMAGE ALREADY OPEN ON LUNIMG, DO NOT CLOSE CALL LUNGETVALS(-LUNIMG,IAPLOC + 1,MAXX,BUFIN,IRTFLG) ENDIF IF (IRTFLG .NE. 0) GOTO 9999 IF (BUFIN(4) .LE. 0) THEN CALL ERRT(102, & 'NO ANGLES IN HEADER OF IMAGE NUMBER',IMI) ANGS(:,IV) = 0.0 IRTFLG = 1 GOTO 9999 ENDIF C GET PROJECTION ANGLES FROM HEADER BUFFER ANGS(1:3,IV) = BUFIN(1:3) IF (NWANT .GE. 7) THEN C WANT OTHER ALIGNMENT PARAMETERS ALSO ANGS(4:7,IV) = BUFIN(6:9) ZT = MAXVAL(BUFIN(6:9)) IF (ZT .GT. 0.0) NGOTX = 7 ENDIF IF (NWANT .GE. 8) THEN C WANT CCROT PARAMETER ALSO ANGS(8,IV) = BUFIN(11) NGOTX = 8 ENDIF ELSE C READ ANGLES FROM DOC FILE ON LUNANG C EXTRACT ALIGN. PARAM. FROM ANGBUF KEY = ILIST(IMI) NLIST = 3 IF (NWANT .GE. 7) NLIST = 8 IF (NWANT .GE. 8) NLIST = 11 CALL LUNDOCGETKEY(LUNANG,ANGBUF(1,1),MAXX,MAXY,KEY, & BUFIN,NLIST,.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(102,'MISSING ANGLE FOR IMAGE',KEY) GOTO 9999 ENDIF ANGS(1:3,IV) = BUFIN(1:3) IF (NWANT .GE. 7) THEN C WANT OTHER ALIGNMENT PARAMETERS ALSO ANGS(4:6,IV) = BUFIN(6:8) ZT = MAXVAL(BUFIN(6:8)) IF (ZT .GT. 0.0) NGOTX = 7 ANGS(7,IV) = 0.0 IF (BUFIN(4) .LT. 0) ANGS(7,IV) = 1.0 ENDIF IF (NWANT .GE. 8) THEN C WANT CCROT PARAMETER ALSO ANGS(8,IV) = BUFIN(11) NGOTX = 8 ENDIF ENDIF ENDDO IRTFLG = 0 9999 CLOSE(LUNANG) IF (IMIT .LE. 0) CLOSE(LUNANG) C DEALLOCATE DOC. FILE MEMORY IF (ASSOCIATED(ANGBUF)) DEALLOCATE(ANGBUF) END SUBROUTINE AP_GETSATA(ANGIN,SATA,ICOL,NDIM,IRTFLG) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' REAL, DIMENSION(ICOL,NDIM) :: ANGIN REAL, DIMENSION(3,NDIM) :: SATA PARAMETER (QUADPI = 3.1415926535897932384626) PARAMETER (DGR_TO_RAD = (QUADPI/180)) DO I=1,NDIM SATA(1,I) = COS(ANGIN(3,I)*DGR_TO_RAD) * & SIN(ANGIN(2,I)*DGR_TO_RAD) SATA(2,I) = SIN(ANGIN(3,I)*DGR_TO_RAD) * & SIN(ANGIN(2,I)*DGR_TO_RAD) SATA(3,I) = COS(ANGIN(2,I)*DGR_TO_RAD) ENDDO IRTFLG = 0 END