C++************************************************ 6/23/80 2/20/81 VAX C C VTIL2.F FILENAMES LENGTHENED 1/89 ARDEAN LEITH C CHANGED 4/93 M. LADJADJ C CHANGED 8/93 JING SU C PJ CYL NEEDED OPFILE 9/01 ARDEAN LEITH C OPFILEC 3/18/03 ARDEAN LEITH C IRTFLG = 0 10/28/03 ARDEAN LEITH C PJ CASE 04/13/05 ARDEAN LEITH C 'PJ RG' REMOVED 10/18/05 ARDEAN LEITH C CASE 12/20/06 ARDEAN LEITH C 'RB' ADDED 1/02/07 ARDEAN LEITH C 'BPD' ADDED 1/23/07 ARDEAN LEITH C 'PJ RG' REMOVED 10/18/05 ARDEAN LEITH C 'PJ 3G' ADDED 3/28/07 ARDEAN LEITH C 'BP 3G' ADDED 3/28/07 ARDEAN LEITH C 'BPD --> BP, BP --> OLD' 6/08/08 ARDEAN LEITH C 'BP NF --> BP 3N' 6/16/08 ARDEAN LEITH C WIW3D_OLD 10/17/08 ARDEAN LEITH C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2008 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 VTIL2 C C HANDLES: 'PS SK CS PJ BP DC DR MF RB BPD(13) ' C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE VTIL2(MAXDIM) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' PARAMETER (MAXSAM = 4096) COMMON BUF(MAXSAM + 1) CHARACTER(LEN=MAXNAM) :: FILNAM,FIL LUN1 = 8 LUN2 = 9 LUN3 = 10 LUN4 = 11 MAXIM = 0 MAXIM2 = 0 IRTFLG = 0 SELECT CASE(FCHAR(1:2)) CASE ('RB') ! -------- ROTATE & BACK PROJECT ----------- RB SELECT CASE(FCHAR(4:5)) CASE ('32') ! CALL WIW32D_DL(.TRUE.) CASE ('3F') ! CALL WIW3D_DL(.TRUE.) CASE DEFAULT CALL ERRT(101,'UNKNOWN OPERATION',NDUM) END SELECT CASE ('DC') ! -------------- DECIMATE ------------------- DC CALL DECIMATE CASE ('DR') ! --------------- ERROR --------------------- DR SELECT CASE(FCHAR(4:6)) CASE ('ERR') ! C CALCULATE ERROR MEASURES BETWEEN 2 VOLUMES CALL COMP3D(LUN1,LUN2) CASE ('DIF') ! C CALCULATE ERROR MEASURES BETWEEN 2 VOLUMES WITHIN C BOUNDARIES OF A MASK, SCALE VOLS AND CALCULATE C DIFFERENCE VOL CALL COMP3DMAD(LUN1,LUN2,LUN3,LUN4) CASE DEFAULT CALL ERRT(101,'UNKNOWN/OBSOLETE OPERATION',NDUM) END SELECT CASE ('MF') ! ------------------------------------------- MF C FIT SPHERE MODEL TO A 3-D RECONSTRUCTION CALL ERRT(101, & 'OBSOLETE SUBROUTINE (LUNA OR MATVEC) CALLED',NE) CASE ('SK') ! -------------- STACK SLICES --------------- SK CALL STACK(LUN1,LUN2,FCHAR(4:)) CASE ('CS') ! ---- ARBITRARY SLICING (SAME AS "PS A") ---- CS C ARBITRARY DIRECTION OF SLICING (SAME AS "PS A") CALL CSLICE CASE ('PS') ! -----------------PICK SLICE ---------------- PS IF (FCHAR(4:4) .EQ. 'A') THEN C ARBITRARY DIRECTION OF SLICING CALL CSLICE ELSE CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE, & NSAM1,NROW1,NSLICE1, MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 IF (IFORM .NE. 3) THEN CALL ERRT(2,'VTIL2',NE) GOTO 9999 ENDIF FMIN1 = FMIN FMAX1 = FMAX AV1 = AV SIG1 = SIG ITYPE = 1 IF (FCHAR(4:4) .EQ. 'Z') THEN C WANT Z SLICE NSLICE = 1 CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM1,NROW1,NSLICE,MAXIM2,'OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL PICKSL(LUN1,LUN2,NSAM1,NROW1,NSLICE1) NSAM = NSAM1 ELSE C WANT X OR Y SLICE NSAM = NSAM1 IF (FCHAR(4:4) .EQ. 'X') NSAM = NROW1 NSLICE = 1 CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM,NSLICE1,NSLICE,MAXIM2,'OUTPUT',.FALSE.,IRTFLG) CALL PICKSV(LUN1,LUN2,NSAM1,NROW1,NSLICE1) ENDIF IF (FCHAR(5:5) .EQ. 'N') THEN C KEEP FMIN AND FMAX SAME FOR ALL SLICES IF (MYPID .LE. 0) WRITE(NOUT,*) & ' SETTING FMIN & FMAX:',FMIN1,FMAX1 SIG = SIG1 CALL SETPRM(LUN2,NSAM,IDUM,FMAX1,FMIN1,AV1,'U') ENDIF ENDIF CASE ('PJ') ! -------------- PROJECTION ----------------- PJ C MOST "PJ" ROUTINES OPEN THEIR OWN FILES NCT = lnblnkn(FCHAR) SELECT CASE(FCHAR(4:NCT)) CASE ('3') CALL PJ3_N CASE ('3O') CALL PJ3 CASE ('3Q') CALL PJ3Q_N() CASE ('3G') CALL PJ3G() ! GRIDDED PROJECTION? MAR 07 CASE ('3Q O','3QO') CALL PJ3Q() CASE ('ST') CALL MRRSURF CASE ('SU') CALL MRSURF CASE ('SHAD') CALL MRREFL CASE ('COL') CALL MRNCOLOR CASE ('A','AT') C PROJECT VOLUME USING EXPONENTIAL ATTENUATION C OPEN FIRST INPUT FILE CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',IFORM, & NSAM1,NROW1,NSLICE1, & MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL MRPRREP(LUN1,LUN2,MAXDIM,IER) CASE ('C','CY','CYL') C CYLINDRICAL PROJECTION MAXLEN = MAXDIM - MAXSAM IF ((NSLICE1 * NSAM1) .GE. MAXLEN) THEN IF (MYPID .LE. 0) WRITE(NOUT,1999) MAXLEN 1999 FORMAT(' *** NSAM * NSLICE1 > ',I6,' NOT ALLOWED') CALL ERRT(31,'VTIL2',IER) GOTO 9999 ENDIF CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',IFORM, & NSAM1,NROW1,NSLICE1, & MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL MRCP(NSAM1,NROW1,NSLICE1,LUN1,LUN2,LUN3,BUF(1), & BUF(MAXSAM + 1),MAXSAM) CASE DEFAULT CALL ERRT(101,'UNKNOWN/OBSOLETE OPERATION',NDUM) END SELECT CALL FLUSHRESULTS CASE ('BP') ! -------- BACK PROJECTION ------------------ BP C ALL "BP" ROUTINES OPEN THEIR OWN FILES IF (FCHAR(7:7) .EQ. 'O') THEN CALL WIW3D_OLD GOTO 9999 ELSEIF (FCHAR(8:8) .EQ. 'O') THEN CALL WIW32D_OLD GOTO 9999 ENDIF SELECT CASE(FCHAR(4:5)) CASE ('W2') ! CALL WGBP2(MAXDIM) CASE ('RP') ! CALL REPS CASE ('R2') ! CALL BPWR(MAXDIM) CASE ('S2') ! CALL BPS2(MAXDIM) CASE ('3D') ! CALL BCQ(MAXDIM) CASE ('3F') ! CALL WIW3D_DL(.FALSE.) CASE ('3N') CALL NN4 ! 'BP NF' DOCUMENTED JUNE 2008 al CASE ('32') ! IF (FCHAR(6:6) .EQ. 'N') THEN CALL NN24 ! UNDOCUMENTED OPERATION (HIGH MEMORY) ELSE CALL WIW32D_DL(.FALSE.) ENDIF CASE ('CG') ! CALL REPCG CASE ('3G') ! TO RESURRECT GRIDDED BP al CALL WIW3G CASE DEFAULT CALL ERRT(101,'UNKNOWN/OBSOLETE OPERATION',NDUM) END SELECT RETURN END SELECT C---------------------------------------------------------------------- 9999 CLOSE(LUN1) CLOSE(LUN2) END