C++********************************************************************* C C UTIL3.F LONG FILENAMES ARDEAN LEITH 10/88 C MAHIEDDINE LADJADJ 4/23/93 C JING SU 8/31/93 C REWRITTEN ARDEAN LEITH 1/15/98 C ROT CALL CHANGED ARDEAN LEITH 8/02/00 C ADDED 'ER' ARDEAN LEITH 2/16/01 C ADDED 'ER SK' ARDEAN LEITH 4/23/01 C ADDED 'ER EDM' ARDEAN LEITH 5/16/01 C ADDED 'RT 3DQ' ARDEAN LEITH 4/10/01 C ADDED 'ER WA ' ARDEAN LEITH 4/25/02 C OPFILEC ARDEAN LEITH 2/18/03 C 'RT 3D' LUN closed ARDEAN LEITH 4/30/03 C MRQLI1 -> APMASTER ARDEAN LEITH 9/ 5/03 C MPI CHAO YANG 10/30/03 C REMOVED RCONV ARDEAN LEITH 11/24/03 C 'RT QS' SELECTED FILES ARDEAN LEITH 12/15/06 C 'RTD **' ARDEAN LEITH 1/15/07 C ORACFMSKM CALL ARDEAN LEITH 3/19/08 C 'OR S' CALL ARDEAN LEITH 6/06/08 C 'OR R' CALL ARDEAN LEITH 6/06/08 C SETPRMB PARAMETERS ARDEAN LEITH 5/19/09 C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2009 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 UTIL3(MAXDIM) C C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 C--********************************************************************* SUBROUTINE UTIL3(MAXDIM) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON BUF(1) CHARACTER(LEN=MAXNAM) :: FILNAM,FILNM1,FILNAMO CHARACTER (LEN=1) :: CDUM,NULL INTEGER,PARAMETER :: NFUNC=16 CHARACTER (LEN=2), DIMENSION(NFUNC) :: FUNC(NFUNC) LOGICAL :: MIRROR LOGICAL :: ASKPEAKS DATA FUNC/'ED', 'RC', 'RT', 'BC', 'CT', & 'OR', 'FC', 'SL', 'RO', 'OD', & 'MK', 'AF', 'OP', 'DI', 'ER', & '13'/ CALL SET_MPI(icomm,mypid,mpierr) ! SET MYPID NULL = CHAR(0) LUN1 = 7 LUN2 = 8 LUN3 = 9 LUNDOC = 89 IRTFLG = 0 MAXIM1 = 0 MAXIM2 = 0 DO IFUNC = 1, NFUNC IF (FCHAR(1:2) .EQ. FUNC(IFUNC)) THEN GOTO (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, & 16) IFUNC ENDIF ENDDO RETURN C OPERATION ------------- EDGE ----------------------------- 'ED' 1 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (NSLICE .GT. 1) THEN C DOES NOT WORK ON 3-D FILES CALL ERRT(101,'SORRY DOES NOT WORK ON 3-D FILES',NE) GOTO 9000 ENDIF C OPEN AN OUTPUT FILE WITH DIMENSIONS BASED ON FIRST INPUT FILE CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE,NSAM,NROW,NSLICE, & MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL EDGE(LUN1,LUN2,LUN3,NSAM,NROW) GOTO 9000 C OPERATION -------- REAL CONVOLUTION ---------------------- 'RC' 2 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C OPEN AN OUTPUT FILE WITH DIMENSIONS BASED ON FIRST INPUT FILE CALL OPFILEC(LUN1,.TRUE.,FILNAMO,LUN2,'U',ITYPE,NSAM,NROW, & NSLICE,MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL RCONV(LUN1,LUN2,LUN3,NSAM,NROW,NSLICE,1,MAXDIM) GOTO 9000 C OPERATION -- ROTATE & SCALE (NEW IMPLEMENTATION------ 'RTD SQ' 16 IF (FCHAR(4:5) .NE. 'SQ') THEN CALL ERRT(101,'UNKNOWN OPERATION',NE) GOTO 9000 ENDIF CALL ROTQSS_DL(LUN1,LUN2,LUNDOC,IRTFLG) GOTO 9000 C OPERATION -------- ROTATE ----------------------------- 'RT **' 3 IF (FCHAR(4:5) .EQ. 'SQ') THEN C OPERATION -- ROTATE & SCALE ----------------------- 'RT SQ' CALL FILERD(FILNAM,NLET,NULL, & 'INPUT FILE NAME OR TEMPLATE (E.G. STK@****)~',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 LOCAT = INDEX(FILNAM(1:NLET),'@') LOCAST = INDEX(FILNAM(1:NLET),'*') IF (LOCAT .GT. 0 .AND. LOCAST .GT. LOCAT) THEN C HAVE A STACKED FILE TEMPLATE CALL ROTQSS(FILNAM,LUN1,LUN2,LUNDOC,IRTFLG) GOTO 9000 ELSE C OPEN INPUT FILE (MAY BE A WHOLE STACK) MAXIM1 = 1 CALL OPFILEC(0,.FALSE.,FILNAM,LUN1,'O',ITYPE, & NSAM,NROW,NSLICE, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 ENDIF ELSE C OPEN INPUT FILE CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 ENDIF IF (FCHAR(4:4) .EQ. '3' .AND. ITYPE .NE. 3) THEN CALL ERRT(101,'NOT A VOLUME',NE) GOTO 9000 ENDIF FMAX1 = FMAX FMIN1 = FMIN IMAMI1 = IMAMI C RECORD INPUT IMAGE AVERAGE IN CASE NEEDED FOR BACKGROUND AV1 = AV C OPERATION -------- ROTATE 90, 180, 270 ---------------- 'RT 90' C SPECIAL ARRANGEMENT FOR 'RT 90' (DO NOT KNOW DIMENSIONS YET) IF (FCHAR(4:5) .EQ. '90') THEN C 90, 180, OR 270 DEGREE ROTATION OF VOLUME CALL REFORM0(LUN1,LUN2,NSAM,NROW,NSLICE,MAXDIM,IRTFLG) GOTO 9000 END IF C OPEN OUTPUT FILE WITH SAME DIMENSIONS AS INPUT FILE MAXIM2 = 0 IF (FCHAR(4:5) .EQ. 'SQ' .AND. MAXIM1 .GE. 0) MAXIM2 = 1 CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE,NSAM,NROW,NSLICE, & MAXIM2,'OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (FCHAR(4:5) .EQ. '3D' .OR. FCHAR(4:5) .EQ. '3A')THEN C OPERATION -------- ROTATE 3D 3A -------------------- 'RT 3??' CALL ROTAS3(LUN1,LUN2,NSAM,NROW,NSLICE,FCHAR(4:6)) GOTO 9000 ELSEIF (FCHAR(4:5) .EQ. '3L') THEN C OPERATION -------- ROTATE 3D AROUND LINE ------------ 'RT 3L' CALL ROTAL3(LUN1,LUN2,NSAM,NROW,NSLICE,FCHAR(4:6)) GOTO 9000 ELSEIF (FCHAR(4:4) .EQ. '3') THEN C OPERATION -------- ROTATE 3 ------------------------- 'RT 3' 320 IF (IMAMI1 .NE. 1) & CALL NORM3(LUN1,NSAM,NROW,NSLICE,FMAX1,FMIN1,AV1) IFANGL = 0 IFSHIF = 0 CALL ROT3(LUN1,LUN2,NSAM,NROW,NSLICE,AV1, & IFANGL,ALPH,BETA,GAMA,IFSHIF,SHX,SHY,SHZ) GOTO 9000 ELSEIF (FCHAR(4:5) .EQ. 'SQ') THEN C OPERATION -------- ROTATE & SCALE ------------------ 'RT SQ' CALL ROTQS(MAXDIM,LUN1,LUN2,LUN3,FILNAM,FILNAMO, & NSAM,NROW,NSLICE,MAXIM1,IRTFLG) GOTO 9000 ENDIF C OPERATION -------- ROTATE ------------------------------ 'RT' C OPERATION -------- ROTATE USE MIN AS BACK. ------------- 'RT M' C OPERATION -------- ROTATE SPECIFY BACK ----------------- 'RT B' C OPERATION -------- ROTATE AROUND ARBITRARY CENTER ----- 'RT C' CALL RDPRM(THETA,NOT_USED,'ROTATION ANGLE') TH = THETA * DATAN(1.0D0) / 45.0D0 IF (FCHAR(4:4) .NE. 'B') THEN C BACKGROUND IS INPUT IMAGE AVERAGE, C EXCEPT FOR "RT M" WHERE BACKGROUND IS MINIMUM IF (IMAMI1 .NE. 1) & CALL NORM3(LUN1,NSAM,NROW,NSLICE,FMAX1,FMIN1,AV1) IF (FCHAR(4:4) .EQ. 'M') AV1 = FMIN1 ELSE C FOR "RT B" MUST SUPPLY BACKGROUND CALL RDPRM(AV1,NOT_USED,'ENTER BACKGROUND') END IF C SET ROTATION CENTER SHX = 0.0 SHY = 0.0 IF (FCHAR(4:4) .EQ. 'C') THEN C ROTATE AROUND AN ARBITRARY CENTER IF (NSAM*(1+NROW) .GT. MAXDIM) THEN CALL ERRT (101, & 'VARIABLE CENTER NOT AVAILABLE FOR THIS SIZE IMAGE',NE) GOTO 9000 ENDIF CALL RDPRM(SHX,NOT_USED,'X-SHIFT') CALL RDPRM(SHY,NOT_USED,'Y-SHIFT') ENDIF C CAN DO IMAGE OR VOLUME DO ISLICE = 1, NSLICE C ROTATE SLICE IN-CORE NROWS = (ISLICE-1)*NROW+1 NROWE = NROWS + NROW - 1 CALL ROT32(LUN1,LUN2,NSAM,NROWS,NROWE,1,TH,AV1,SHX,SHY) END DO C SET HEADER FOR ALTERATIONS IN IMAGE DUE TO OPERATIONS CALL SETPRMB(LUN2, 0.0,0.0, 0.0,0.0) GOTO 9000 C OPERATION ------------------------------------------------ 'BC' 4 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM1,NROW1,NSLIC1, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IMAMI1 = IMAMI AV1 = AV C OPEN AN OUTPUT FILE WITH DIMENSIONS SAME AS INPUT FILE CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM1,NROW1,NSLIC1, MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C BOX CONVOLUTION IMAMI = IMAMI1 AV = AV1 CALL BOXX(LUN1,LUN2,NSAM1,NROW1,NSLIC1,MAXDIM) C SET HEADER FOR ALTERATIONS IN IMAGE DUE TO OPERATION CALL SETPRMB(LUN2, 0.0,0.0, 0.0,0.0) GOTO 9000 C OPERATION ----------------- CONCATENATE -------------------'CT' 5 WRITE(NOUT,*) ' OPERATION "CT" NO LONGER SUPPORTED' GOTO 9000 C OPERATION -------- ORIENTATIONAL SEARCH ---------------- 'OR' 6 IF (FCHAR(4:4) .EQ. '2') THEN C OPERATION -------- ORIENTATIONAL SEARCH ------------- 'OR 2' C OPERATION -------- ORIENTATIONAL SEARCH ------------- 'OR 2M' IF (mypid .LE. 0) WRITE(NOUT,888) 888 FORMAT(' OBSOLETE OPERATION, NEXT TIME PLEASE USE: ',/) ASKPEAKS = (FCHAR(4:5) .EQ. '2M') CALL ORMD(ASKPEAKS) RETURN ELSEIF (FCHAR(4:4) .EQ. 'R') THEN C OPERATION -------- ORIENTATIONAL SEARCH ------------- 'OR R' C REPLACES 'OR 2' & 'OR 2M' CALL ORMD(.TRUE.) RETURN ELSEIF (FCHAR(4:4) .EQ. 'A') THEN C OPERATION -------------------------------------------- 'OR A' IF (FCHAR(5:5) .EQ. 'M') THEN CALL ERRT(101,'OPERATION IS NOW: ',NE) RETURN ENDIF CALL ORACFMSK() RETURN ELSEIF (FCHAR(4:4) .EQ. 'Q') THEN C OPERATION -------------------------------------------- 'OR M' IF (FCHAR(5:5) .EQ. 'M') THEN CALL ERRT(101,'OPERATION IS NOW: ',NE) RETURN ENDIF CALL ORACFMSKM() RETURN ELSEIF (FCHAR(4:4) .EQ. 'S') THEN C OPERATION REPLACES 'MQ' & 'NQ' ---------------------- 'OR SH' CALL APMASTER('F','ORS') RETURN ELSEIF (FCHAR(4:5) .EQ. 'MQ') THEN C OPERATION ------------------------------------------- 'OR MQ' IF (mypid .LE. 0) WRITE(NOUT,887) 887 FORMAT(' OBSOLETE OPERATION, NEXT TIME PLEASE USE: ',/) CALL APMASTER('F','ORM') RETURN ELSEIF (FCHAR(4:5) .EQ. 'NQ') THEN C OPERATION ------------------------------------------ 'OR NQ' IF (mypid .LE. 0) WRITE(NOUT,887) CALL APMASTER('F','ORN') RETURN ELSEIF (FCHAR(4:5) .EQ. '3Q') THEN C OPERATION ------------------------------------------ 'OR 3Q' CALL QALI('Q') GOTO 9911 ELSEIF (FCHAR(4:5) .EQ. '3A') THEN C OPERATION ------------------------------------------ 'OR 3A' CALL QALI('A') GOTO 9911 END IF GOTO 9911 C OPERATION ------------------------------------------------ 'FC' 7 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM1,NROW1,NSLIC1, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (NSLIC1 .NE. 1) THEN C DOES NOT WORK ON 3-D FILES CALL ERRT(2,'UTIL3',NE) GOTO 9000 END IF FMAX1 = FMAX FMIN1 = FMIN IMAMI1 = IMAMI C OPEN AN OUTPUT FILE WITH SAME DIMENSIONS AS INPUT FILE CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM1,NROW1,NSLIC1, MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C FILE CONTOUR FMAX = FMAX1 FMIN = FMIN1 IMAMI = IMAMI1 CALL CNTRFL(LUN1,LUN2,NSAM1,NROW1,NSLIC1,MAXDIM) C SOME OPTIONS REQUIRE RESCALING (AL 28 JAN 92) CALL SETPRMB(LUN2, 0.0,0.0, 0.0,0.0) GOTO 9000 C OPERATION ----------------------- SLICE -------------------'SL' 8 CALL SLICE(MAXDIM,LUN1,LUN2,LUN3) GOTO 9000 C OPERATION --------- ROTATIONAL AVERAGE --------------------'RO' 9 IF (FCHAR(4:4) .EQ. 'I') THEN CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE, & NSAM1,NROW1,NSLIC1, MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (NSLIC1 .NE. 1) THEN C OPERATION DOES NOT WORK ON 3-D FILES CALL ERRT(2,'UTIL3',NE) GOTO 9000 ENDIF C OPEN AN OUTPUT FILE IFORM = 1 CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM1,NROW1,NSLIC1,MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C ROTATIONAL AVERAGING CALL RADAVI(LUN1,LUN2,NSAM1,NROW1,MAXDIM) ELSE CALL RADAV(LUN1,LUN2) ENDIF GOTO 9000 C OPERATION ----------- OPTICAL DENSITY -------------------- 'OD' C OD CONVERSION 10 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM1,NROW1,NSLIC1, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (NSLIC1 .NE. 1) THEN C DOES NOT WORK ON 3-D FILES CALL ERRT(2,'UTIL3',NE) GOTO 9000 END IF C OPEN AN OUTPUT FILE WITH DIMENSIONS SAME AS INPUT FILE CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM1,NROW1,NSLIC1, MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL OD(LUN1,LUN2,LUN3,NSAM1,NROW1,MAXDIM) GOTO 9000 11 IF (FCHAR(4:5) .EQ. '3') THEN C OPERATION ----------- MARKER ------------------------ 'MK 3' CALL MRK3(MAXDIM) ELSEIF (FCHAR(4:6) .EQ. 'RT') THEN C OPERATION ----------- MARKER ----------------------- 'MK RT' CALL MRRT(MAXDIM) ELSE C OPERATION ----------- MARKER -------------------------- 'MK' CALL MRK(MAXDIM) ENDIF RETURN C OPERATION ----------- TRANSFORMATION --------------------- 'AF' 12 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE, & NSAM1,NROW1,NSLIC1, MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C OPEN AN OUTPUT FILE WITH SAME DIMENSIONS AS INPUT FILE IF (MAXIM1 .GE. 0) MAXIM2 = 1 CALL OPFILEC(LUN1,.TRUE.,FILNAMO,LUN2,'U',ITYPE, & NSAM1,NROW1,NSLIC1,MAXIM2,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL AF(MAXDIM,LUN1,LUN2,LUN3,FILNAM,FILNAMO, & NSAM1,NROW1,NSLIC1,MAXIM1,IRTFLG) GOTO 9000 C OPERATION -------- ORIENTATION OF PROJECTIONS ------------ 'OP' 13 CALL POLQS(MAXDIM) RETURN C OPERATION -------- DILATION ------------------------------ 'DI' 14 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE, & NSAM,NROW,NSLICE, MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE, & NSAM,NROW,NSLICE,MAXIM2,'OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL DILATION(LUN1,LUN2,NSAM,NROW,NSLICE) GOTO 9000 C OPERATION -------- EROSION ------------------------------- 'ER' 15 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM1,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN FMIN1 = FMIN FMAX1 = FMAX CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE,NSAM,NROW,NSLICE, & MAXIM2,'OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (FCHAR(4:5) .EQ. 'SK') THEN C BINARY SKELETON CALL SKELETON(LUN1,LUN2,NSAM,NROW,NSLICE) ELSEIF (FCHAR(4:4) .EQ. 'E') THEN C EUCLIDEAN DISTANCE MAP CALL EDM(LUN1,LUN2,NSAM,NROW,NSLICE,FMIN1,FMAX1) ELSEIF (FCHAR(4:4) .EQ. 'W') THEN C WATERSHED MAP CALL WATERSHD(LUN1,LUN2,NSAM,NROW,NSLICE) ELSE CALL EROSION(LUN1,LUN2,NSAM,NROW,NSLICE) ENDIF GOTO 9000 9000 CLOSE(LUN1) CLOSE(LUN2) CLOSE(LUN3) 9911 RETURN END #ifdef NEVER C OPERATION -------- ROTATE ----------------------------- 'RT **' 3 IF (FCHAR(4:5) .EQ. 'SQ') THEN C OPERATION -- ROTATE & SCALE ----------------------- 'RT SQ' CALL ROTQSS_DL(LUN1,LUN2,LUNDOC,IRTFLG) GOTO 9000 ENDIF C OPERATION -------- ROTATE 90, 180, 270 ---------------- 'RT 90' C SPECIAL ARRANGEMENT FOR 'RT 90' (DO NOT KNOW DIMENSIONS YET) IF (FCHAR(4:5) .EQ. '90') THEN C 90, 180, OR 270 DEGREE ROTATION OF VOLUME CALL REFORM0(LUN1,LUN2,NSAM,NROW,NSLICE,MAXDIM,IRTFLG) GOTO 9000 END IF C OPEN OUTPUT FILE WITH SAME DIMENSIONS AS INPUT FILE MAXIM2 = 0 IF (FCHAR(4:5) .EQ. 'SQ' .AND. MAXIM1 .GE. 0) MAXIM2 = 1 CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE,NSAM,NROW,NSLICE, & MAXIM2,'OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (FCHAR(4:5) .EQ. '3D' .OR. FCHAR(4:5) .EQ. '3A')THEN C OPERATION -------- ROTATE 3D 3A -------------------- 'RT 3??' CALL ROTAS3(LUN1,LUN2,NSAM,NROW,NSLICE,FCHAR(4:6)) GOTO 9000 ELSEIF (FCHAR(4:5) .EQ. '3L') THEN C OPERATION -------- ROTATE 3D AROUND LINE ------------ 'RT 3L' CALL ROTAL3(LUN1,LUN2,NSAM,NROW,NSLICE,FCHAR(4:6)) GOTO 9000 ELSEIF (FCHAR(4:4) .EQ. '3') THEN C OPERATION -------- ROTATE 3 ------------------------- 'RT 3' 320 IF (IMAMI1 .NE. 1) & CALL NORM3(LUN1,NSAM,NROW,NSLICE,FMAX1,FMIN1,AV1) IFANGL = 0 IFSHIF = 0 CALL ROT3(LUN1,LUN2,NSAM,NROW,NSLICE,AV1, & IFANGL,ALPH,BETA,GAMA,IFSHIF,SHX,SHY,SHZ) GOTO 9000 ENDIF C OPERATION -------- ROTATE ------------------------------ 'RT' C OPERATION -------- ROTATE USE MIN AS BACK. ------------- 'RT M' C OPERATION -------- ROTATE SPECIFY BACK ----------------- 'RT B' C OPERATION -------- ROTATE AROUND ARBITRARY CENTER ----- 'RT C' CALL RDPRM(THETA,NOT_USED,'ROTATION ANGLE') TH = THETA * DATAN(1.0D0) / 45.0D0 IF (FCHAR(4:4) .NE. 'B') THEN C BACKGROUND IS INPUT IMAGE AVERAGE, C EXCEPT FOR "RT M" WHERE BACKGROUND IS MINIMUM IF (IMAMI1 .NE. 1) & CALL NORM3(LUN1,NSAM,NROW,NSLICE,FMAX1,FMIN1,AV1) IF (FCHAR(4:4) .EQ. 'M') AV1 = FMIN1 ELSE C FOR "RT B" MUST SUPPLY BACKGROUND CALL RDPRM(AV1,NOT_USED,'ENTER BACKGROUND') END IF C SET ROTATION CENTER SHX = 0.0 SHY = 0.0 IF (FCHAR(4:4) .EQ. 'C') THEN C ROTATE AROUND AN ARBITRARY CENTER IF (NSAM*(1+NROW) .GT. MAXDIM) THEN CALL ERRT (101, & 'VARIABLE CENTER NOT AVAILABLE FOR THIS SIZE IMAGE',NE) GOTO 9000 ENDIF CALL RDPRM(SHX,NOT_USED,'X-SHIFT') CALL RDPRM(SHY,NOT_USED,'Y-SHIFT') ENDIF C CAN DO IMAGE OR VOLUME DO ISLICE = 1, NSLICE C ROTATE SLICE IN-CORE NROWS = (ISLICE-1)*NROW+1 NROWE = NROWS + NROW - 1 CALL ROT32(LUN1,LUN2,NSAM,NROWS,NROWE,1,TH,AV1,SHX,SHY) END DO C SET HEADER FOR ALTERATIONS IN IMAGE DUE TO OPERATIONS CALL SETPRMB(LUN2, 0.0,0.0, 0.0,0.0) GOTO 9000 #endif