C ++************************************************************************ C C INTERP3 USED ALLOCATE MAY 00 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 INTERP3(LUN1,LUN2,NSAM,NROW,NSLICE,NSAM1,NROW1,NSLICE1,MAXMEM) C C PURPOSE: 3 D INTERPOLATION C * C ********************************************************************** SUBROUTINE INTERP3(LUN1,LUN2,NSAM,NROW,NSLICE, & NSAM1,NROW1,NSLICE1,MAXMEM) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON BAF(1) COMMON /IOBUF/ BUF(NBUFSIZ) REAL, ALLOCATABLE, DIMENSION(:) :: QPT C ALLOCATE MEMORY IF NEEDED MEMWANT = NSAM * NROW * NSLICE IF (MEMWANT .GT. MAXMEM) THEN C ALLOCATE MEMORY TO HOLD VOLUME ALLOCATE (QPT(MEMWANT), STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'INTERP3, QPT',NDUM) RETURN ENDIF WRITE(NOUT,*) 'ALLOCATED MEMORY FOR VOLUME:',MEMWANT C LOAD VOLUME CALL READV(LUN1,QPT,NSAM,NROW,NSAM,NROW,NSLICE) C CALL INTERPOLATION ROUTINE CALL IRP3(QPT,BUF,NSAM,NROW,NSLICE, & NSAM1,NROW1,NSLICE1,LUN2) DEALLOCATE(QPT) ELSE C USE COMMON BLOCK TO HOLD VOLUME WRITE(NOUT,*) 'USED COMMON BLOCK FOR VOLUME' C LOAD VOLUME CALL READV(LUN1,BAF,NSAM,NROW,NSAM,NROW,NSLICE) C CALL INTERPOLATION ROUTINE CALL IRP3(BAF,BUF,NSAM,NROW,NSLICE, & NSAM1,NROW1,NSLICE1,LUN2) ENDIF RETURN END