C ++************************************************************************ C C PICKSV 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 $$ PICKSV C C PURPOSE: PICKS A X OR Y SLICE OUT OF A 3-D VOLUME FILE C C 0 2 3 4 5 6 7 C23456789012345678901234567890123456789012345678901234567890123456789012 C ********************************************************************** SUBROUTINE PICKSV(LUN3,LUN2,NSAM,NROW,NSLICE) INCLUDE 'CMBLOCK.INC' COMMON BUF(1) IF (FCHAR(4:4) .NE. 'X') THEN CALL RDPRMI(IROW,IDUM,NOT_USED,'Y-SLICE NUMBER') IF (IROW .LE. 0 .OR. IROW .GT. NROW) THEN CALL ERRT(24,'PICKSV',NE) RETURN ENDIF DO ISLICE=1,NSLICE IRECT = (ISLICE-1)*NROW+IROW CALL REDLIN(LUN3,BUF,NSAM,IRECT) CALL WRTLIN(LUN2,BUF,NSAM,ISLICE) ENDDO ELSE CALL RDPRMI(ISAM,IDUM,NOT_USED,'X-SLICE NUMBER') IF (ISAM .LE. 0 .OR. ISAM .GT. NSAM) THEN CALL ERRT(24,'PICKSV',NE) RETURN ENDIF DO ISLICE=1,NSLICE IRECT = (ISLICE-1)*NROW DO I=1,NROW CALL REDLIN(LUN3,BUF,NSAM,IRECT+I) BUF(NSAM+I) = BUF(ISAM) ENDDO CALL WRTLIN(LUN2,BUF(NSAM+1),NROW,ISLICE) ENDDO ENDIF END