C++********************************************************************* C C AP_GETDAT.F 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 AP_GETDAT(ILIST,NUMIMG,LSAM,LROW,NSAM,NROW,NUMTH,EXPPAT,LUNIN, IGO,IEND, C LR1,LR2,LS1,LS2, X, IRTFLG) C C PURPOSE: READ SERIES OF WINDOWED IMAGE DATA INTO ARRAY X FOR 'AP' OPS. C DOES NOT CALL NORM3 C C PARAMETERS: C ILIST LIST OF IMAGE FILE NUMBERS (INPUT) C NUMIMG # OF IMAGES (INPUT) C LSAM,LROW IMAGE DIMENSIONS (INPUT) C NSAM,NROW OUTPUT IMAGE DIMENSIONS (INPUT) C EXPPAT IMAGE SERIES FILE TEMPLATE (INPUT) C LUNIN IMAGE FILE IO UNIT (INPUT) C IGO,IEND IMAGE INDEX RANGE (INPUT) C LR1,LR2,LS1,LS2 OUTPUT IMAGE WINDOW (INPUT) C ANGEXP THETA,SCALE... ARRAY (INPUT) C BUFTMP WORK ARRAY (-) C BUFOUT OUTPUT ARRAY (OUTPUT) C IRTFLG ERROR FLAG (OUTPUT) C C--********************************************************************* SUBROUTINE AP_GETDAT(ILIST,NUMIMG,LSAM,LROW,NSAM,NROW, & NUMTH,EXPPAT,LUNIN, IGO,IEND, & LR1,LR2,LS1,LS2, X, & IRTFLG) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' REAL :: X(NSAM,NROW,NUMTH) INTEGER :: ILIST(NUMIMG) CHARACTER (LEN=*) :: EXPPAT CHARACTER(LEN=MAXNAM) :: FILNAM LOGICAL :: WINDOW LOGICAL :: ONEIMAGE C ALLOCATABLE ARRAYS (BUFIN SELDOM USED) REAL, ALLOCATABLE :: BUFIN(:) WINDOW = (LR1 .NE. 1 .OR. LS1 .NE. 1 .OR. & LR2 .NE. LROW .OR. LS2 .NE. LSAM) IF (WINDOW) THEN ALLOCATE(BUFIN(LSAM), STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'AP_GETDAT; BUFIN',LSAM) RETURN ENDIF ENDIF C write(6,*) 'Reading images: ',igo,'...',iend ONEIMAGE = (ILIST(IGO) .LE. 0) DO ITI=IGO,IEND IF (.NOT. ONEIMAGE) THEN NLET = 0 CALL FILGET(EXPPAT,FILNAM,NLET,ILIST(ITI),IRTFLG) IF (IRTFLG .NE. 0) RETURN ELSE FILNAM = EXPPAT ENDIF MAXIM = 0 CALL OPFILEC(0,.FALSE.,FILNAM,LUNIN,'O',IFORM, & LSAMT,LROWT,NSLICE,MAXIM,' ',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL SIZCHK(UNUSED,LSAMT,LROWT,0,0, & LSAM, LROW, 0,0,IRTFLG) IF (IRTFLG .NE. 0) RETURN IT = ITI-IGO+1 IF (WINDOW) THEN C READ IN CENTRAL WINDOW FROM THE WHOLE IMAGE DO K2=LR1,LR2 CALL REDLIN(LUNIN,BUFIN,LSAM,K2) KT = K2-LR1+1 DO K3=LS1,LS2 X(K3-LS1+1,KT,IT) = BUFIN(K3) ENDDO ENDDO CLOSE(LUNIN) ELSE C READ IN THE WHOLE IMAGE CALL REDVOL(LUNIN,LSAM,LROW,1,1, X(1,1,IT),IRTFLG) CLOSE(LUNIN) IF (IRTFLG .NE. 0) RETURN ENDIF ENDDO IRTFLG = 0 END C **************************AP_GETDAT1P ************************* #ifdef USE_MPI C THE SAME AS AP_GETDAT EXCEPT THAT NO BROADCAST IN THE READ. C SUBROUTINE AP_GETDAT1P(ILIST,NUMIMG,LSAM,LROW,NSAM,NROW, & NUMTH,EXPPAT,LUNIN, IGO,IEND, & LR1,LR2,LS1,LS2, X, & IRTFLG) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' REAL :: X(NSAM,NROW,NUMTH) INTEGER :: ILIST(NUMIMG) CHARACTER (LEN=*) :: EXPPAT CHARACTER(LEN=MAXNAM) :: FILNAM LOGICAL :: WINDOW LOGICAL :: ONEIMAGE C AUTOMATIC ARRAY REAL :: BUFIN(LSAM) WINDOW = (LR1 .NE. 1 .OR. LS1 .NE. 1 .OR. & LR2 .NE. LROW .OR. LS2 .NE. LSAM) C write(6,*) 'Reading images: ',igo,'...',iend ONEIMAGE = (ILIST(IGO) .LE. 0) IF (ONEIMAGE) FILNAM = EXPPAT DO ITI=IGO,IEND IF (.NOT. ONEIMAGE) THEN NLET = 0 CALL FILGET(EXPPAT,FILNAM,NLET,ILIST(ITI),IRTFLG) IF (IRTFLG .NE. 0) RETURN ENDIF MAXIM = 0 CALL OPFILEC(0,.FALSE.,FILNAM,LUNIN,'O',IFORM, & LSAMT,LROWT,NSLICE,MAXIM,' ',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL SIZCHK(UNUSED,LSAMT,LROWT,0,0, & LSAM, LROW, 0,0,IRTFLG) IF (IRTFLG .NE. 0) RETURN IT = ITI-IGO+1 IF (WINDOW) THEN C READ IN CENTRAL WINDOW FROM THE WHOLE IMAGE DO K2=LR1,LR2 CALL REDLIN1P(LUNIN,BUFIN,LSAM,K2) KT = K2-LR1+1 DO K3=LS1,LS2 X(K3-LS1+1,KT,IT) = BUFIN(K3) ENDDO ENDDO CLOSE(LUNIN) ELSE C READ IN THE WHOLE IMAGE CALL REDVOL1P(LUNIN,LSAM,LROW,1,1, X(1,1,IT),IRTFLG) CLOSE(LUNIN) IF (IRTFLG .NE. 0) RETURN ENDIF ENDDO IRTFLG = 0 END #endif C **********************AP_GETDAT_RTSQ ************************* SUBROUTINE AP_GETDAT_RTSQ(ILIST,NUMIMG,LSAM,LROW,NSAM,NROW, & NUMTH,EXPPAT,LUNIN, IGO,IEND, & LR1,LR2,LS1,LS2, ANGINHEADER, & ANGEXP, BUFTMP,BUFOUT,IRTFLG) IMPLICIT NONE INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' INTEGER :: ILIST(NUMIMG) INTEGER :: NUMIMG INTEGER :: LSAM,LROW,NSAM,NROW,NUMTH CHARACTER (LEN=*) :: EXPPAT INTEGER :: LUNIN, IGO,IEND INTEGER :: LR1,LR2,LS1,LS2 LOGICAL :: ANGINHEADER REAL :: ANGEXP(8,NUMIMG) REAL :: BUFTMP(NSAM,NROW) REAL :: BUFOUT(NSAM,NROW,NUMTH) INTEGER :: IRTFLG INTEGER :: ITI,NLET,MAXIM,IFORMT,LSAMT,LROWT INTEGER :: NSLICE,IT,K2,KT,K3,IDUM REAL :: SCALE,UNUSED,SHXI,SHYI,THETA CHARACTER(LEN=MAXNAM) :: FILNAM LOGICAL :: WINDOW LOGICAL :: ONEIMAGE C AUTOMATIC ARRAYS REAL :: BUFIN(LSAM) SCALE = 1.0 WINDOW = (LR1 .NE. 1 .OR. LS1 .NE. 1 .OR. & LR2 .NE. LROW .OR. LS2 .NE. LSAM) ONEIMAGE = (ILIST(IGO) .LE. 0) C write(6,*) 'Reading images: ',igo,'...',iend DO ITI=IGO,IEND IF (ONEIMAGE) THEN FILNAM = EXPPAT ELSE NLET = 0 CALL FILGET(EXPPAT,FILNAM,NLET,ILIST(ITI),IRTFLG) IF (IRTFLG .NE. 0) RETURN ENDIF MAXIM = 0 CALL OPFILEC(0,.FALSE.,FILNAM,LUNIN,'O',IFORMT, & LSAMT,LROWT,NSLICE,MAXIM,' ',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL SIZCHK(UNUSED,LSAMT,LROWT,0,0, & LSAM, LROW, 0,0,IRTFLG) IF (IRTFLG .NE. 0) RETURN IT = ITI-IGO+1 IF (WINDOW) THEN C READ IN CENTRAL WINDOW FROM THE WHOLE IMAGE DO K2=LR1,LR2 CALL REDLIN(LUNIN,BUFIN,LSAM,K2) KT = K2-LR1+1 DO K3=LS1,LS2 BUFTMP(K3-LS1+1,KT) = BUFIN(K3) ENDDO ENDDO ELSE C READ IN THE WHOLE IMAGE CALL REDVOL(LUNIN,LSAM,LROW,1,1, BUFTMP,IRTFLG) IF (IRTFLG .NE. 0) RETURN ENDIF IF (ANGINHEADER) THEN C GET ANGLES FROM IMAGE HEADER CALL LUNGETVALS(LUNIN,IAPLOC + 1,8,ANGEXP(1,ITI),IRTFLG) ENDIF CLOSE(LUNIN) C SHIFT & ROTATE THE INPUT IMAGE --> BUFOUT THETA = ANGEXP(4,ITI) SHXI = ANGEXP(5,ITI) SHYI = ANGEXP(6,ITI) !print *,'rot2qs; thta,xy',THETA,SHXI,SHYI CALL ROT2QS(BUFTMP,BUFOUT(1,1,IT),LSAM,LROW, & THETA,SCALE,SHXI,SHYI,IDUM,0) ENDDO IRTFLG = 0 END