C C++********************************************************************* C C UTIL1.F TITLE PROCESSING MODIFIED NOV 87 ARDEAN LEITH C LONG FILE NAMES ADDED DEC 88 ARDEAN LEITH C ALTERED 4/21/93 MAHIEDDINE LADJADJ C ALTERED 8/25/93 JING SU C LI COMMAND REWRITTEN 8/30/96 ARDEAN LEITH C TT COMMAND REWRITTEN 6/28/97 ARDEAN LEITH C ST PARAMETERS ALTERED SEPT 98 ARDEAN LEITH C 'TT COP' ADDED JUNE 99 ARDEAN LEITH C 'CA SM' ALTERED AUG 99 ARDEAN LEITH C 'TF CTS' ALTERED NOV 00 HAIXIAO GAO C 'TF CTF' REMOVED JAN 01 ARDEAN LEITH C 'TF CRF' ADDED JAN 11 Paul Penczek C 'TF ECTF' ADDED JUL 31 Paul Penczek C 'TF ECTF' --> 'TF ED' JUN 02 Bill Baxter C 'HI E' ADDED FEB 03 ARDEAN LEITH C OPFILEC FEB 03 ARDEAN LEITH C 'HI J' ADDED MAR 03 ARDEAN LEITH C 'PK DR' ADDED MAR 03 BIMAL RATH C 'CA' REWRITE SEP 03 ARDEAN LEITH C 'TF EA' REMOVED NOV 03 PAUL PENCZEK C 'TF ED' REPLACED NOV 03 PAUL PENCZEK C 'CA SMI' ADDED JAN 04 ARDEAN LEITH C 'HI J' VMIN, VMAX FEB 04 ArDean Leith C TRAFC & TRAFCT MERGED MAR 04 ArDean Leith C ~7 REPLACES IRTFLG APR 04 ARDEAN LEITH C 'PK 3R' NOV 04 ARDEAN LEITH C 'TF SIM' ADDED NOV 07 BIMAL RATH C 'TF LM4'ADDED MAR 06 ZHONG HUANG C 'HI DOC' DUPLICATES HI D MAR 06 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 UTIL1(MAXDIM,IRTRET) C C PURPOSE: ORIGINALLY A DRIVER FOR ROUTINES REQUIRING ONLY ONE FILE C C PARAMETERS: MAXDIM MAX LENGTH OF COMMON BUFFER C C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 C--********************************************************************* SUBROUTINE UTIL1(MAXDIM,IRTRET) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' PARAMETER (NFUNC=19) CHARACTER(LEN=2), DIMENSION(NFUNC) :: FUNC(NFUNC) CHARACTER(LEN=MAXNAM) :: FILNAM,CLINE LOGICAL :: DOCPRNT,TERMPRNT CHARACTER(LEN=1) :: NULL DATA FUNC/'DE', 'DU', 'FI', 'HI', 'LI', & 'MO', 'PK', 'RA', 'RN', 'TT', & 'ST', 'TF', 'FS', 'CA', 'GR', & 'CG', 'CV', 'CL', 'HD'/ NULL = CHAR(0) IRTRET = 0 IRTFLG = 0 LUN1 = 8 LUN2 = 12 LUN3 = 7 LUN4 = 9 LUN5 = 13 LUNDOC = LUN2 MAXIM = 0 MAXIM2 = 0 DO IFUNC = 1,NFUNC IF (FCHAR(1:2) .EQ. FUNC(IFUNC)(1:2)) THEN GOTO ( 1, 2, 3, 4, 5, & 6, 7, 9,10,11, & 12,13,14,15,16, & 17,18,19,20), (IFUNC) ENDIF ENDDO C OPERATION NOT IN UTIL1, RETURN TO CALLER RETURN C OPERATION ------------------------------------------------ 'DE' 1 CALL DELETF(FILNAM,LUN1) RETURN C DO NOT USE GOTO 9000 HERE AS IT CAUSES DOUBLE CLOSING ERROR C OPERATION ----------------------------------------------- 'DU' C OPEN INPUT FILE, NO FOURIER INPUT ALLOWED 2 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C DETERMINE HSIG & HMODE CALL HIST(LUN1,0,0,NSAM,NROW,NSLICE,HMIN,HMAX,HSIG,HMODE) C REMOVE OUT-LIERS CALL DUST(LUN1,NSAM,NROW,NSLICE,HSIG,HMODE,IRTFLG) GOTO 9000 C OPERATION ----------- FILE INFO ------------------------ 'FI' 3 IF (FCHAR(4:4) .EQ. 'A') THEN C FILE INFO FOR MULTIPLE FILES CALL FILERD(FILNAM,NLETI,NULL,'FILE INFO. ON',IRTFLG) IF (IRTFLG .EQ. -1) GOTO 9000 CALL FILGEN(FILNAM,NLETI,LUN1) ELSEIF (FCHAR(4:4) .EQ. 'H') THEN C RETRIEVE HEADER VARIABLE CONTENTS FROM SINGLE FILE CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'Z',ITYPE,NSAM,NROW,NSLICE, & MAXIM,'RETRIEVE HEADER VALUES FROM',.TRUE.,IRTFLG) IF (IRTFLG .EQ. 0) THEN C FILE FOUND CALL INQUIREHEAD(LUN1,NSAM,IRTFLG) ENDIF ELSEIF (FCHAR(4:4) .EQ. 'N') THEN C FILE INFO FOR SINGLE FILE, NO ERROR STOP IF NOT FOUND CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'Z',ITYPE,NSAM,NROW,NSLICE, & MAXIM,'FILE INFO. ON',.TRUE.,IRTFLG) IF (IRTFLG .EQ. 0) THEN C FILE FOUND CALL FILDAT(LUN1,NSAM) ELSE C FILE NOT FOUND, SET REGISTER FOR NSAM, NROW, NSLICE TO ZERO CALL REG_SET(1,0.0,NULL,IRTFLG) CALL REG_SET(2,0.0,NULL,IRTFLG) CALL REG_SET(3,0.0,NULL,IRTFLG) CALL REG_SET(4,0.0,NULL,IRTFLG) CALL REG_SET(7,0.0,NULL,IRTFLG) ENDIF ELSEIF (FCHAR(4:4) .EQ. 'T') THEN C TEST OF FILENAME SUBSTITUTION MECHANISM CALL FILERD(FILNAM,NLET1,NULL,'TEST FILE NAME',IRTFLG) IF (IRTFLG .EQ. -1) RETURN IRTFLG = -999 CALL RDPRMC(CLINE,NLET2,.TRUE.,'CORRECT NAME',NULL,IRTFLG) IF (IRTFLG .EQ. 0 .AND. & FILNAM(1:NLET1) .NE. CLINE(1:NLET2)) THEN WRITE(NOUT,*) '*** ERROR IN FILENAME FORMATION!!!' WRITE(NOUT,9065) FILNAM(1:NLET1),CLINE(1:NLET2) 9065 FORMAT( '*** GOT: ',A,' -- SHOULD BE: ',A/) CALL ERRT(100,'DRIV1',NE) ENDIF ELSE C FILE INFO FOR SINGLE FILE, ERROR IF NOT FOUND CALL FILERD(FILNAM,NLETI,NULL,'FILE INFO. ON',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (FILNAM(1:1) .EQ. '?') THEN C OLD FASHIONED "FR" SETTING WRITE(NOUT,*) '*** OBSOLETE: PLEASE USE OPERATION FR NOW!' IRTRET = 1 BACKSPACE(NIN) IBCNT = IBCNT - 1 RETURN ENDIF ILOCAT = INDEX(FILNAM,'@') IF (FCHAR(4:4) .EQ. '[' .AND. ILOCAT .EQ. NLETI) THEN C NEED HEADER LOCATION MAXIM = 2 ENDIF IF (FCHAR(4:4) .EQ. 'X' .AND. ILOCAT .EQ. NLETI) THEN C NEED HEADER LOCATION MAXIM = 2 ENDIF CALL OPFILEC(0,.FALSE.,FILNAM,LUN1,'O',ITYPE, & NSAM,NROW,NSLICE,MAXIM,' ',.TRUE.,IRTFLG) IF (IRTFLG .EQ. 0) CALL FILDAT(LUN1,NSAM) ENDIF GOTO 9000 C OPERATION -------------- HISTOGRAM ----------------------- 'HI' 4 IF (FCHAR(4:6) .EQ. 'DOC') THEN WRITE(NOUT,*) ' *** USE OPERATION: HD D' GOTO 9000 ENDIF C OPEN INPUT FILE, FOURIER NOT ALLOWED CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE1,NSAM1,NROW1,NSLICE, & MAXIM,'INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 IF (FCHAR(4:4) .EQ. 'E') THEN C ENTROPY HISTOGRAM CALL ENTROP(LUN1,NSAM1,NROW1,NSLICE,ENTROPY,IRTFLG) ELSEIF (FCHAR(4:4) .EQ. 'J') THEN C JOINT HISTOGRAM FOR MUTUAL SHARED INFORMATION C MAKE SURE STATISTICS ARE CURRENT FMIN1 = FMIN FMAX1 = FMAX IF (IMAMI .NE. 1 .AND. ITYPE1 .GE. 0) & CALL NORM3(LUN1,NSAM1,NROW1,NSLICE,FMAX1,FMIN1,AV) C OPEN SECOND INPUT FILE, FOURIER ALLOWED CALL OPFILEC(0,.TRUE.,FILNAM,LUN2,'O',ITYPE2, & NSAM2,NROW2,NSLICE2, MAXIM2,'SECOND INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 8999 IF(NSAM2.NE.NSAM1.OR.NROW2.NE.NROW1.OR.NSLICE2.NE.NSLICE)THEN CALL ERRT(1,'UTIL1',IDUM) GOTO 8999 ENDIF C MAKE SURE STATISTICS ARE CURRENT FMIN2 = FMIN FMAX2 = FMAX IF (IMAMI .NE. 1.AND. ITYPE1 .GE. 0) & CALL NORM3(LUN2,NSAM2,NROW2,NSLICE2,FMAX2,FMIN2,AV) IF (ITYPE1 .GE. 0) THEN C NOT FOURIER CALL RDPRI1S(NBINS,NOT_USED, & 'ENTER NUMBER OF BINS IN HISTOGRAM',IRTFLG) IF (NBINS .LT. 1) THEN CALL ERRT(1,'UTIL1',IDUM) GOTO 8999 ENDIF WRITE(NOUT,*) ' FIRST IMAGE RANGE: ',FMIN1,'.....',FMAX1 WRITE(NOUT,*) ' SECOND IMAGE RANGE: ',FMIN2,'.....',FMAX2 VMIN = MIN(FMIN1,FMIN2) VMAX = MAX(FMAX1,FMAX2) CALL RDPRM2S(VMIN,VMAX,NOT_USED,'HISTOGRAM RANGE',IRTFLG) IF (IRTFLG .NE. 0) RETURN CALL JOHIST(LUN1,LUN2,NSAM1,NROW1,NSLICE,NBINS, & FMIN1,FMAX1,FMIN2,FMAX2,VMIN,VMAX,IRTFLG) ELSE C FOURIER NBINSA = 128 NBINSP = 360 CALL RDPRIS(NBINSA,NBINSP,NOT_USED, & 'ENTER NUMBER OF AMPLITUDE & PHASE BINS IN HISTOGRAM', & IRTFLG) IF (NBINSA .LT. 1 .OR. NBINSP .LT. 1) THEN CALL ERRT(1,'UTIL1',IDUM) GOTO 8999 ENDIF CALL JOHISTF(LUN1,LUN2,NSAM1,NROW1,NSLICE, & NBINSA,NBINSP,IRTFLG) ENDIF GOTO 8999 ELSEIF (FCHAR(4:4) .NE. 'M') THEN C NORMAL HISTOGRAM CALL HIST(LUN1,0,LUN2,NSAM1,NROW1,NSLICE,HMIN,HMAX, & HSIG,HMODE) ELSE C HISTOGRAM UNDER MASK --------------------------------- 'HI M' IFORM1 = IFORM CALL OPFILEC(0,.TRUE.,FILNAM,LUN2,'O',ITYPE, & NSAM2,NROW2,NSLICE2,MAXIM2,'MASK',.FALSE.,IRTFLG) IFORM2 = IFORM IF (IRTFLG .EQ. -1) THEN CLOSE(LUN1) GOTO 4 ELSEIF (IRTFLG .NE. 0) THEN GOTO 9000 ELSEIF (NSAM1 .NE. NSAM2 .OR. NROW1 .NE. NROW2. OR. & NSLICE .NE. NSLICE2 .OR. IFORM1 .NE. IFORM2) THEN C IMAGES NUST HAVE SAME DIMENSIONS CALL ERRT(1,'UTIL1',NE) CLOSE(LUN2) GOTO 9000 ENDIF CALL HIST(LUN1,LUN2,LUN3,NSAM1,NROW1,NSLICE,HMIN,HMAX, & HSIG,HMODE) CLOSE(LUN2) ENDIF GOTO 9000 C OPERATION --- HISTOGRAM OF A DOCUMENT FILE COLUMN---------- 'HD' 20 CALL HISD(LUN3) CLOSE(LUN3) GOTO 9000 C OPERATION ---------------------------------------------- 'LI' C CHECK FOR 'LI R' WHICH DOES NOT USE INPUT FILE JUST REGISTERS 5 IF (FCHAR(4:4) .EQ. 'R') THEN C FOR 'LI R', 'LI RT', 'LI RD' CALL ERRT(101,'OPERATION NO LONGER SUPPORTED',NE) ccc CALL LISTREGS() GOTO 9000 ENDIF C NEED INPUT FILE, USE ~7 TO ALLOW STACK HEADER ACCESS CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM,'INPUT~7',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (FCHAR (4:5) .EQ. '2D') THEN C UNDOCUMENTED COMMAND 'LI 2D' CALLED LISTIM CALL ERRT(101,'THIS OPERATION NO LONGER SUPPORTED',NE) ELSE DOCPRNT = .FALSE. IF (FCHAR(4:4) .EQ. 'D') DOCPRNT = .TRUE. TERMPRNT = .FALSE. IF (FCHAR(4:4) .EQ. 'T') TERMPRNT = .TRUE. CALL REG_GET_USED(NSEL_USED) IF (NSEL_USED .GT. 0) THEN C SINGLE NUMBER (REGISTER) OPTION: CALL LISTITR(FILNAM,LUN1,NSAM,NROW,NSLICE) ELSE CALL LISTIT(FILNAM,LUN1,NSAM,NROW,NSLICE,DOCPRNT,TERMPRNT) ENDIF ENDIF GOTO 9000 C OPERATION ---------------- MODEL ------------------------- 'MO' 6 NSAM2 = 0 NROW2 = 0 NSLICE = 1 IFORM = 1 IF (FCHAR(4:4) .EQ. '3') THEN NSLICE = 0 IFORM = 3 ENDIF CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'U',IFORM,NSAM2,NROW2,NSLICE, & MAXIM,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0 .AND. FILNAM(1:1) .NE. '*') GOTO 9000 IF (FCHAR(4:4) .EQ. '3') THEN IF (FCHAR(5:5) .EQ. 'H') THEN CALL ERRT(101,'OPERATION NO LONGER SUPPORTED',IDUM) GOTO 9000 ELSE C FOR 'MO 3' CALL MODEL3(LUN1,LUN2,FILNAM,NSAM2,NROW2,NSLICE) CLOSE(LUN2) ENDIF ELSE C FOR 'MO' CALL MODEL(LUN1,NSAM2,NROW2) ENDIF GOTO 9000 C OPERATION ---------------- PEAK SEARCH ------------------- 'PK' C PEAK SEARCH 7 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM1,NROW1,NSLICE1, & MAXIM,'INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 FMAX1 = FMAX IF (FCHAR(4:4) .EQ. 'M') THEN IF (IMAMI.NE.1) & CALL NORM3(LUN1,NSAM1,NROW1,NSLICE1,FMAX1,FMIN1,AVR1) CALL SPEAKM(LUN1,NSAM1,NROW1,NSLICE1,FMAX1) ELSEIF (FCHAR(4:4) .EQ. '3') THEN CALL SPEAK3(LUN1,NSAM1,NROW1,NSLICE1,FCHAR(5:5),LUNDOC) ELSE CALL RDPRMI(ML,NOR,NOT_USED, & 'ENTER NUMBER OF PEAKS, CENTER ORIGIN OVERRIDE (0/1)') IF (ML .LT. 1) ML = 1 IF (FCHAR(4:4).EQ. 'C' .OR. FCHAR(5:5).EQ.'C') THEN CALL SPEAKC(FILNAM,LUN1,NSAM1,NROW1,MAXDIM,FCHAR(4:4), & LUNDOC,ML,NOR) ELSEIF ( FCHAR(5:5).EQ.'R') THEN CALL SPEAKR(FILNAM,LUN1,NSAM1,NROW1,MAXDIM,FCHAR(4:4), & LUNDOC,ML,NOR) ELSE CALL SPEAK(FILNAM,LUN1,NSAM1,NROW1,MAXDIM,FCHAR(4:4), & LUNDOC,ML,NOR) ENDIF ENDIF GOTO 9000 C OPERATION ------------- RAMP ----------------------------- 'RA' 9 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (ITYPE .NE. 1) THEN CALL ERRT(2,'RAMP',NE) GOTO 9001 ENDIF CALL OPFILEC(LUN1,.TRUE.,FILNAM,LUN2,'U',ITYPE,NSAM,NROW,NSLICE, & MAXIM2,'OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL RAMP_P(LUN1,LUN2,NSAM,NROW,NOUT) GOTO 8999 C OPERATION ----------------- RENAME ---------------------- 'RN' 10 WRITE(NOUT,*) '*** RENAME OPERATION NO LONGER SUPPORTED' GOTO 9001 C OPERATION ------------CHANGE TITLE---------------------- 'TT' 11 IF (FCHAR(4:4) .EQ. 'C') THEN C OPEN THE FILE THAT CONTAINS DESIRED TITLE CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE, & NSAM1,NROW1,NSLICE1, & MAXIM,'TITLE SOURCE',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9001 ENDIF C OPEN THE FILE THAT RECEIVES TITLE CALL OPFILEC(0,.TRUE.,FILNAM,LUN2,'O',ITYPE,NSAM1,NROW1,NSLICE1, & MAXIM,'OUTPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C GET NEW TITLE HERE IF (FCHAR(4:4) .EQ. 'C') THEN CALL LUNGETTITLE(LUN1,CTIT,LENTIT,IRTFLG) ELSE CALL RDPRMC(CTIT,LENTIT,.FALSE.,'NEW TITLE',NULL,IRTFLG) ENDIF IF (IRTFLG .NE. 0) GOTO 9000 C TITLE ALTERATION CAN PROCEED NOW CALL TITLE(LUN2,CTIT,LENTIT,.TRUE.,IRTFLG) CLOSE(LUN2) GOTO 9000 C OPERATION ------ SET BUFFER LOCATIONS ------------------- 'ST' C DISP OF "Z" WILL ALLOW CORRECTING STACK ERROR C PROMPT ENDING ~7 WILL ALLOW OPENING STACK WITHOUT @ 12 CONTINUE CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'Z',ITYPE, & NSAM,NROW,NSLICE, MAXIM,'INPUT~7',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN C SET LABEL VALUES TO SOLICITED INPUT CALL SETVAL(LUN1,NSAM,NROW,NSLICE) GOTO 9000 C OPERATION ------------TRANSFER FUNCTION ----------------- 'TF' 13 LENF = LNBLNK(FCHAR(4:)) LENCOMMA = INDEX(FCHAR(4:4+LENF-1),',') IF (LENCOMMA .GT. 1) LENF = LENCOMMA-1 LENBLANK = INDEX(FCHAR(4:4+LENF-1),' ') IF (LENBLANK .GT. 1) LENF = LENBLANK-1 SELECT CASE(FCHAR(4:4+LENF-1)) CASE ('D') CALL TRAFD(LUN1) CASE ('C') CALL TRAFC(LUN1,.FALSE.) CASE ('C3') CALL TRAFC3(LUN1) CASE ('DDF') CALL DEFOCUS(IRTFLG) CASE ('DNS') CALL NOISE(IRTFLG) CASE ('DEV') CALL ENVELOPE(IRTFLG) CASE ('CT') CALL TRAFC(LUN1,.TRUE.) CASE ('CT3') CALL TRAFCT3(LUN1) CASE ('CTS') CALL RCTFSS CASE ('SIM') CALL TRAFSIM(LUN1) CASE ('CRF') CALL TFCRF CASE ('ED') CALL TFED CASE ('L') CALL TRAFL CASE ('LM4') CALL TFLM4 CASE ('RCTF') CALL RCTF CASE ('SNR') CALL TFSNR CASE DEFAULT CALL TRAF(LUN1) END SELECT GOTO 9000 C OPERATION -------------- FILE STATISTICS ---------------- 'FS' 14 NSTACK = -1 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE,NSAM,NROW,NSLICE, & NSTACK,'INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 C FIND STATISTICS CALL QSTAT(FILNAM,LUN1,LUN2,NSAM,NROW,NSLICE,NSTACK) CLOSE(LUN2) GOTO 9000 C OPERATION ---------CLUSTER ANALYSIS ------------------ 'CA' 15 SELECT CASE(FCHAR(4:)) CASE ('S') C FACTOR MAP CALCULATION CALL JPMSK1() CASE ('SM','SME') C FACTOR MAP PLOT CALL SGRAF(LUN1,LUN2,LUN3,LUN4) CLOSE(LUN2) CASE ('SMI') C INACTIVE FACTOR MAP PLOT CALL JPMSK3(LUN1,LUN2,LUN3,LUN4,LUN5) CASE ('SR', 'SRD', 'SRI', 'SRA', 'SRE') C IMAGE RECONSTITUTION CALL JPMSK2(LUN1,LUN2,LUN3,LUN4,LUN5) CLOSE(LUN3) CLOSE(LUN4) CLOSE(LUN5) CASE ('VIS') C VISUAL MAP CREATION CALL VISMAP(LUN1,LUN2,LUN3,LUN4) CASE DEFAULT C 'CA E', 'CA ES', removed PAP 10/05/99 CALL ERRT(101,'UNIDENTIFIED OPERATION',IDUM) END SELECT GOTO 8999 C GRAPH A ROW IN RESULTS FILE ------------------------------ 'GR' 16 CALL OPFILEC(0,.TRUE.,FILNAM,LUN1,'O',ITYPE, & NSAM1,NROW1,NSLICE, MAXIM,'INPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9000 CALL GRAPHP(LUN1,NSAM1,NROW1) GOTO 9000 C OPERATION ------- CENTER OF GRAVITY --------------------- 'CG' C 3-D CENTER OF GRAVITY AND RADIUS OF GYRATION 17 IF(FCHAR(4:5).EQ.'PH') THEN CALL CENT GOTO 9001 ENDIF CALL CENGR3(LUN1) GOTO 9000 C OPERATION ----------------------------------------------- 'CV' C POCS PROGRAMS (06/05/90) C MODULAR POCS PROGRAMS: (12/5/91) M.R. 18 IF (FCHAR(4:8) .EQ. 'REPL2') THEN C tdfrepl uses old Fourier format and was disabled CALL ERRT(41,'CV REPL2',NE) C CALL TDFREPL(LUN1,LUN2,LUN3) ELSE CALL MRREPLACE(LUN1,LUN2) ENDIF GOTO 9000 C OPERATION ------------------------------------------------ 'CL' 19 SELECT CASE (FCHAR(4:5)) CASE('KM') ! KMEANS CLUSTERING CALL SUBKMNS(LUN1,LUN2) CASE('HC') ! HIERARCHICAL CLUSTERING CALL HCLS(LUN1,LUN2,LUN3) CASE('HD') ! HIERARCHICAL CLUSTERING, CALCULATE CLASSES CALL HDLS(LUN1,LUN2) CASE('HE') ! HIERARCHICAL CLUSTERING, CREATE DOC FILE CALL HELS(LUN1,LUN2) CASE('CL') ! HIERARCHICAL CLUSTERING CALL SCLASSI(LUN1,LUN2,LUN3) CLOSE(LUN3) END SELECT GOTO 9001 C -------------------------------------------------------- END 8999 CLOSE(LUN2) 9000 CLOSE(LUN1) 9001 CONTINUE RETURN END