C Copyright(C) 1999-2020, 2022 National Technology & Engineering Solutions C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with C NTESS, the U.S. Government retains certain rights in this software. C C See packages/seacas/LICENSE for details SUBROUTINE COMMAND (A, IA, TITLE, TIME, ITMSEL, MAT, DISP, * CRD, LINK, DENSTY, WAVE, ISEVOK, * NAMEGL, NAMENV, NAMEEL, * NQAREC, QAREC, NINFO, INFREC, DBNAME) C READ AND INTERPRET ALL INPUT DATA include 'exodusII.inc' CHARACTER*80 TITLE, COMMENT INTEGER IA(*) DIMENSION A(*), TIME(*), MAT(6,*), DISP(NUMNP,*), CRD(NUMNP,*), * LINK(*), DENSTY(*), WAVE(*) INTEGER ITMSEL(*), ISEVOK(*) CHARACTER*(MXSTLN) NAMEGL(*), NAMENV(*), NAMEEL(*) CHARACTER*(MXLNLN) INFREC(*) CHARACTER*(MXSTLN) QAREC(4,*) CHARACTER*(*) DBNAME include 'nu_cvty.blk' include 'nu_ptim.blk' include 'nu_mass.blk' include 'nu_logs.blk' include 'nu_numg.blk' include 'nu_varcnt.blk' include 'nu_cav.blk' include 'nu_nset.blk' include 'nu_io.blk' DIMENSION TRANGE(3), CENT(3) PARAMETER (MXNAM = 132) DIMENSION KV(MXNAM), RV(MXNAM), IVAL(MXNAM) CHARACTER*32 CV(MXNAM), NAME, CTMP CHARACTER*16 LABEL(32), TYPE, PROMPT CHARACTER*8 GMTHD, SORTYP, LISTYP, OPT LOGICAL FIRST, EXOSAV, ALLTIM, ISON, SORUP, ISHELP, LTMP, * LTMP2, LTMP3, LTMP4, CENTER LOGICAL FFNUMB, FFMATC, HELP, MATSTR, FFEXST CHARACTER*8 CMDTBL(38), SORTBL(12), LISTBL(20) SAVE CMDTBL, SORTBL, LISTBL C --CMDTBL - the valid commands table C --SORTBL - the valid sort options table C --LISTBL - the valid list options table C --Command table follows. Remember to change the dimensioned size when C --changing the table. DATA CMDTBL / * 'AXISYMME', 'CAVITY ', 'COMMENT ', 'DELTIME ', 'DENSITY ', * 'EXIT ', 'END ', 'EXODUS ', 'GAP ', 'HELP ', * 'LIMITS ', 'LIST ', 'LOCATE ', 'OVERLAP ', 'PLANE ', * 'PLANAR ', 'PROPERTI', 'SORT ', 'TIMES ', 'TMAX ', * 'TMIN ', 'MASS ', 'PRINT ', 'ECHO ', 'SELECT ', * 'WAVESPEE', 'TIMESTEP', 'ALLTIMES', 'NINTV ', 'ZINTV ', * 'SUM ', 'AVERAGE ', 'CONDITIO', 'ESUM ', 'EAVERAGE', * 'QUIT ', 'MCAVITY ', ' '/ DATA SORTBL / * 'X ', 'Y ', 'Z ', 'T ', 'DISTANCE', * 'RADIAL ', 'PARAMETR', 'ANGLE ', 'THETA ', 'PHI ', * 'NONE ', ' '/ DATA LISTBL / * 'SSETS ', 'SIDESETS', 'NSETS ', 'NODESETS', 'VARS ', * 'VARIABLE', 'BLOCKS ', 'MATERIAL', 'TIMES ', 'STEPS ', * 'COMMANDS', 'SORT ', 'STIMES ', 'NAMES ', 'SELECTED', * 'INFORMAT', 'QA ', 'VOLUME ', 'NODALVOL', ' '/ DATA FIRST /.TRUE./, PROMPT /' NUMBERS> '/ DATA GMTHD /'DISTANCE'/, SORTYP /'NONE'/, SORUP /.TRUE./ AXI = .TRUE. EXOSAV = EXODUS IF (FIRST) THEN FIRST = .FALSE. CALL HEADER (NDIM, TITLE, NUMEL, NUMNP, AXI) END IF DO 10 IBLK = 1, NELBLK MAT(5,IBLK) = 1 10 CONTINUE if (nstep .gt. 0) then CALL INILOG (NSTEP, .TRUE., ITMSEL) TMIN = TIME(1) TMAX = TIME(NSTEP) else tmin = 0.0 tmax = 0.0 end if STMIN = TMIN STMAX = TMAX LSTSEL= NSTEP IOMIN = 6 IOMAX = 7 NQUAD = 1 C ... GET SOME SCRATCH SPACE CALL MDRSRV ('SCRTCH', ISCR, NDIM*NUMNP) CALL MDRSRV ('SCRTC2', ISCR2, NDIM*NUMNP) CALL MDRSRV ('SORTMP', ISMP, MAX(NUMEL, NUMNP) ) CALL MDRSRV ('NODSEL', INDSEL, NUMNP) CALL MDRSRV ('ELMSEL', IELSEL, NUMEL) CALL MDRSRV ('BLKSCR', IBLSC, NELBLK+1) call MDRSRV ('NBLSEL', INSEL, NELBLK+1) CALL MDSTAT (NERRS, NUSED) IF (NERRS .GT. 0) THEN CALL MEMERR STOP END IF CALL INILOG (NUMNP, .TRUE., IA(INDSEL)) CALL INILOG (NUMEL, .TRUE., IA(IELSEL)) NSELND = NUMNP NSELEL = NUMEL 20 CONTINUE PRINT *, ' ' CALL FREFLD (0, 0, PROMPT(:LENSTR(PROMPT)+1), MXNAM, IOS, NF, KV, * CV, IVAL, RV) IF (IOS .NE. 0) CV(1) = 'EXIT' KV(MIN(MXNAM,NF)+1) = -999 NAME = CV(1) CALL ABRSTR (NAME, CV(1), CMDTBL) IFLD = 2 IF (NAME .EQ. ' ') NAME = CV(1) C ...SCAN FOR INPUT CARD MATCH IF (NAME.EQ.' ') THEN GO TO 20 C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'ECHO') THEN CALL FFONOF (IFLD, KV, CV, ISON, *20) IF (ISON) THEN IOMIN = ITERM IF (IOMAX .EQ. IHARD) THEN CALL PRTERR ('CMDSPEC', * 'Results output to both the terminal and list file') ELSE CALL PRTERR ('CMDSPEC', * 'Results output to terminal only') END IF ELSE IOMIN = IHARD IOMAX = IHARD CALL PRTERR ('CMDSPEC', * 'Results output to list file only') END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'PRINT') THEN CALL FFONOF (IFLD, KV, CV, ISON, *20) IF (ISON) THEN IOMAX = IHARD IF (IOMIN .EQ. ITERM) THEN CALL PRTERR ('CMDSPEC', * 'Results output to both the terminal and list file') ELSE CALL PRTERR ('CMDSPEC', * 'Results output to list file only') END IF ELSE IOMIN = ITERM IOMAX = ITERM CALL PRTERR ('CMDSPEC', 'Results output to terminal only') END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'COMMENT') THEN IFLD = 2 IF (MATSTR(CV(2), 'PAGE', 1)) THEN WRITE (IHARD, 40) IFLD = 3 END IF ICOM = MIN(1, IVAL(IFLD)) DO 30 IC = 1, ICOM CALL GETINP (0, 0, 'COMMENT> ', COMMENT, IOSTAT) WRITE (IHARD,50) COMMENT(:LENSTR(COMMENT)) 30 CONTINUE 40 FORMAT ('1') 50 FORMAT (1X,A) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'EXODUS') THEN CALL CKEXOD (EXOSAV, *20) CALL FFONOF (IFLD, KV, CV, EXODUS, *20) IF (EXODUS) THEN CALL PRTERR ('CMDSPEC', * 'Calculations performed for all selected time steps') ELSE CALL PRTERR ('CMDSPEC', * 'Calculations performed for undeformed geometry only') END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'HELP') THEN ISHELP = HELP ('NUMBERS', 'COMMANDS', CV(2) ) IF (.NOT. ISHELP) CALL SHOCMD ('COMMANDS', CMDTBL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'AXISYMME') THEN AXI = .TRUE. CALL PRTERR ('CMDSPEC', 'Axisymmetric Body Geometry') C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'PLANAR' .OR. NAME .EQ. 'PLANE') THEN AXI = .FALSE. CALL PRTERR ('CMDSPEC', 'Planar Body Geometry') C----------------------------------------------------------------------- ELSE IF (NAME .EQ.'PROPERTI' .OR. NAME .EQ. 'MASS') THEN C ... SET NUMBER OF QUADRATURE POINTS CALL FFINTG (IFLD, KV, IVAL, * 'number of quadrature points', 1, NQUAD, *20) IF (NQUAD .NE. 1 .AND. NQUAD .NE. 2**NDIM) THEN IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR', * 'quadrature order must be 1 or 4') IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR', * 'quadrature order must be 1 or 8') GO TO 20 END IF CALL FFREAL (IFLD, KV, RV, * 'common material density', 0.0, CDENS, *20) IF (CDENS .GT. 0.) THEN CALL INIREA (NELBLK, CDENS, DENSTY) CALL INISTR (NELBLK, ' ', LABEL) ELSE IF (CDENS .LT. 0.) THEN CALL PRTERR ('CMDERR', * 'density must be greater than zero') GO TO 20 END IF CALL MASSPR (A, TIME, ITMSEL, DENSTY, MAT, * DISP, NQUAD, LABEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'TIMESTEP') THEN CALL FFREAL (IFLD, KV, RV, * 'common material wavespeed', 0.0, CWAVE, *20) IF (CWAVE .GT. 0.) THEN CALL INIREA (NELBLK, CWAVE, WAVE) CALL INISTR (NELBLK, ' ', LABEL) ELSE IF (CWAVE .LT. 0.) THEN CALL PRTERR ('CMDERR', * 'wavespeed must be greater than zero') GO TO 20 END IF IF (WAVE(1) .EQ. 0.) THEN CALL GETWAV (MAT, WAVE, NELBLK, LABEL) END IF CALL FFREAL (IFLD, KV, RV, * 'critical damping fraction', 0.06, EPSLON, *20) CALL ESTIME (CRD, WAVE, LINK, MAT, LABEL, NDIM, 2**NDIM, * NELBLK, A(ISCR), A(ISCR2), EPSLON, NUMNP ) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'DENSITY') THEN CALL GETDEN (MAT, DENSTY, NELBLK, LABEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'WAVESPEE') THEN CALL GETWAV (MAT, WAVE, NELBLK, LABEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'CAVITY') THEN NUMCAV = 0 60 CONTINUE IF (FFNUMB (IFLD, KV)) THEN NUMCAV = MIN(NUMCAV + 1, MAXCAV) CALL FFINTG (IFLD, KV, IVAL, * 'cavity boundary flag', 0, ICAV(NUMCAV), *20) GO TO 60 END IF CENT(1) = 0.0 CENT(2) = 0.0 CENT(3) = 0.0 CENTER = .FALSE. C ... For 3d, if no center specified use 0,0,0 unless user enters 'centroid' IF (NDIM .eq. 3) then center = .true. end if IF (FFMATC (IFLD, KV, CV, 'CENTROID', 5)) THEN CENTER = .FALSE. ELSE IF (FFMATC (IFLD, KV, CV, 'CENTER', 1)) THEN CALL FFREAL (IFLD, KV, RV, 'X coordinate of center', * 0.0, CENT(1), *20) CALL FFREAL (IFLD, KV, RV, 'Y coordinate of center', * 0.0, CENT(2), *20) IF (NDIM .EQ. 3) THEN CALL FFREAL (IFLD, KV, RV, 'Z coordinate of center', * 0.0, CENT(3), *20) END IF CENTER = .TRUE. ELSE END IF CALL CAVITY (A, CRD, A(IBC1), A(IBC2), A(IBC3), A(IBC4), * A(IBC5),A(IBC6), A(IBC7), A(IBC8), DISP, NUMNP, NDIM, * NUMESS, TIME, ITMSEL, TITLE, CENT, CENTER) ELSE IF (NAME .EQ. 'MCAVITY') THEN NUMCAV = 0 66 CONTINUE IF (FFNUMB (IFLD, KV)) THEN NUMCAV = MIN(NUMCAV + 1, MAXCAV) CALL FFINTG (IFLD, KV, IVAL, * 'cavity boundary flag', 0, ICAV(NUMCAV), *20) GO TO 66 END IF CENT(1) = 0.0 CENT(2) = 0.0 CENT(3) = 0.0 CENTER = .FALSE. C ... For 3d, if no center specified use 0,0,0 unless user enters 'centroid' IF (NDIM .eq. 3) then center = .true. end if IF (FFMATC (IFLD, KV, CV, 'CENTROID', 5)) THEN CENTER = .FALSE. ELSE IF (FFMATC (IFLD, KV, CV, 'CENTER', 1)) THEN CALL FFREAL (IFLD, KV, RV, 'X coordinate of center', * 0.0, CENT(1), *20) CALL FFREAL (IFLD, KV, RV, 'Y coordinate of center', * 0.0, CENT(2), *20) IF (NDIM .EQ. 3) THEN CALL FFREAL (IFLD, KV, RV, 'Z coordinate of center', * 0.0, CENT(3), *20) END IF CENTER = .TRUE. ELSE END IF CALL MULTI_CAVITY (A, CRD, A(IBC1), A(IBC2), A(IBC3), A(IBC4), * A(IBC5),A(IBC6), A(IBC7), A(IBC8), DISP, NUMNP, NDIM, * NUMESS, TIME, ITMSEL, TITLE, CENT, CENTER) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'GAP') THEN CALL FFINTG (IFLD, KV, IVAL, * 'gap master surface', 0, IMAS, *20) CALL FFINTG (IFLD, KV, IVAL, * 'gap slave surface', 0, ISLV, *20) CALL FFREAL (IFLD, KV, RV, * 'maximum gap matching distance', 0.0, DMAX, *20) CALL FFCHAR (IFLD, KV, CV, GMTHD, GMTHD) IF (MATSTR(GMTHD, 'DISTANCE', 1)) THEN GMTHD = 'DISTANCE' ELSE IF (MATSTR(GMTHD, 'NORMAL', 1)) THEN GMTHD = 'NORMAL' ELSE CALL PRTERR ('CMDERR', '"' // GMTHD(:LENSTR(GMTHD)) & // '" is an invalid matching option') GO TO 20 END IF CALL GAPINI (A, CRD, A(IBC1), A(IBC2), A(IBC3), A(IBC4), * A(IBC5),A(IBC6), A(IBC7), A(IBC8), DISP, NUMNP, NDIM, * NUMESS, TIME, ITMSEL, TITLE, IMAS, ISLV, * DMAX,GMTHD) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'OVERLAP') THEN CALL FFINTG (IFLD, KV, IVAL, * 'overlap master surface', 0, IMAS, *20) CALL FFINTG (IFLD, KV, IVAL, * 'overlap slave surface', 0, ISLV, *20) CALL OVRLAP(A, CRD, A(IBC1), A(IBC2), A(IBC3), A(IBC4), * A(IBC5),A(IBC6), A(IBC7), A(IBC8), DISP, NUMNP, NDIM, * NUMESS, TIME, ITMSEL, TITLE, IMAS, ISLV, NUMEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'SELECT') THEN IF (MATSTR(CV(2), 'ALL', 3)) THEN DO 70 IBLK = 1, NELBLK MAT(5,IBLK) = 1 70 CONTINUE CALL INILOG(NUMNP, .TRUE., IA(INDSEL)) CALL INILOG(NUMEL, .TRUE., IA(IELSEL)) CALL PRTERR ('CMDSPEC', * 'All Blocks, Elements, and Nodes Selected') ELSE IF (MATSTR(CV(2), 'BLOCKS', 1)) THEN IF (MATSTR(CV(3), 'ALL', 1) .OR. NF .EQ. 2) THEN DO 80 IBLK = 1, NELBLK MAT(5,IBLK) = 1 80 CONTINUE CALL PRTERR ('CMDSPEC', * 'All Blocks, Elements, and Nodes Selected') ELSE DO 90 IBLK = 1, NELBLK MAT(5,IBLK) = 0 90 CONTINUE DO 100 IBLK = 3, NF IF (IVAL(IBLK).GT.0 .AND. IVAL(IBLK).LE.NELBLK) THEN MAT(5,IVAL(IBLK)) = 1 ELSE COMMENT = 'Invalid block number: ' CALL FFADDI (IVAL(IBLK), COMMENT) CALL PRTERR ('CMDERR', COMMENT(:LENSTR(COMMENT))) END IF 100 CONTINUE END IF CALL SELNOD (MAT, LINK, A(INDSEL), NUMNP, 2**NDIM, NELBLK, * NSELND) CALL SELELM (MAT, A(IELSEL), NUMEL, NELBLK, NSELEL) CALL SHWBLK (NELBLK, MAT, NSELND, NSELEL) ELSE IF (MATSTR(CV(2), 'MATERIAL', 1)) THEN IF (MATSTR(CV(3), 'ALL', 1)) THEN DO 110 IBLK = 1, NELBLK MAT(5,IBLK) = 1 110 CONTINUE ELSE DO 120 IBLK = 1, NELBLK MAT(5,IBLK) = 0 120 CONTINUE DO 140 IFLD = 3, NF IMAT = 0 DO 130 IBLK = 1, NELBLK IF (IVAL(IFLD) .EQ. MAT(1,IBLK)) IMAT = IBLK 130 CONTINUE IF (IMAT .NE. 0) THEN MAT(5,IMAT) = 1 ELSE COMMENT = 'Invalid Material Number: ' CALL FFADDI (IVAL(IFLD), COMMENT) CALL PRTERR ('CMDERR', COMMENT(:LENSTR(COMMENT))) END IF 140 CONTINUE END IF CALL SELNOD (MAT, LINK, A(INDSEL), NUMNP, 2**NDIM, NELBLK, * NSELND) CALL SELELM (MAT, A(IELSEL), NUMEL, NELBLK, NSELEL) CALL SHWBLK (NELBLK, MAT, NSELND, NSELEL) ELSE IF (MATSTR(CV(2), 'SIDESETS', 1) .OR. * MATSTR(CV(2), 'SSETS', 1)) THEN CALL SELSSN (A(INDSEL), NUMNP, NF-2, IVAL(3), * A(IBC1), A(IBC3), A(IBC5), A(IBC7), NUMESS, * NUMSEL) ELSE IF (MATSTR(CV(2), 'NODESETS', 1) .OR. * MATSTR(CV(2), 'NSETS', 1)) THEN CALL SELSSN (A(INDSEL), NUMNP, NF-2, IVAL(3), * A(INS1), A(INS2), A(INS3), A(INS4), NUMNPS, * NUMSEL) ELSE IF (MATSTR(CV(2), 'BOX', 1)) THEN CALL SELBOX (A(IR), NUMNP, NDIM, RV(3), A(INDSEL), 'Nodes') CALL SELBOX (A(IECEN), NUMEL, NDIM, RV(3), A(IELSEL), * 'Elements') ELSE CALL PRTERR ('CMDERR', '"' // CV(2)(:LENSTR(CV(2))) & // '" is an invalid or nonunique SELECT option') END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'LIST') THEN CALL ABRSTR (LISTYP, CV(2), LISTBL) IF (CV(2) .EQ. ' ') THEN CALL SHOCMD ('Valid LIST options', LISTBL) ELSE IF (LISTYP .EQ. ' ') THEN CALL PRTERR ('CMDERR', '"' // CV(2)(:LENSTR(CV(2))) & // '" is an invalid or nonunique LIST option') CALL SHOCMD ('Valid LIST options', LISTBL) ELSE IF (LISTYP .EQ. 'SSETS' .OR. LISTYP .EQ. 'SIDESETS') THEN IF (NUMESS .EQ. 0) THEN CALL PRTERR ('CMDSPEC', 'No side sets to list') ELSE CALL SHOWFL ('S', NUMESS, A(IBC1), A(IBC2), A(IBC3)) END IF ELSE IF (LISTYP .EQ. 'NSETS' .OR. LISTYP .EQ. 'NODESETS') THEN IF (NUMNPS .EQ. 0) THEN CALL PRTERR ('CMDSPEC', 'No node sets to list') ELSE CALL SHOWFL ('N', NUMNPS, A(INS1), A(INS2), A(1)) END IF ELSE IF (LISTYP .EQ.'VARS' .OR. LISTYP .EQ.'VARIABLE') THEN CALL DBPINI ('*', NDB, TITLE, NDIM, NUMNP, NUMEL, NELBLK, * NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL, LESSDF, * NVARGL, NVARNP, NVAREL, DBNAME) ELSE IF (LISTYP .EQ.'BLOCKS' .OR. LISTYP .EQ.'MATERIAL') THEN CALL SHWBLK (NELBLK, MAT, NSELND, NSELEL) ELSE IF (LISTYP .EQ. 'TIMES') THEN CALL CKEXOD (EXOSAV, *20) CALL DBPTIM ('*', NSTEP, TIME) ELSE IF (LISTYP .EQ. 'STEPS') THEN CALL CKEXOD (EXOSAV, *20) CALL DBPTIM ('NM', NSTEP, TIME) ELSE IF (LISTYP .EQ. 'STIMES' .OR. * LISTYP .EQ. 'SELECTED' .AND. MATSTR(CV(3),'TIMES',1)) THEN CALL CKEXOD (EXOSAV, *20) CALL STIMES ('*', .FALSE., .TRUE., NSTEP, TIME, ITMSEL) ELSE IF (LISTYP .EQ. 'COMMANDS') THEN CALL SHOCMD ('COMMANDS', CMDTBL) ELSE IF (LISTYP .EQ. 'SORT') THEN CALL SHOCMD ('Valid SORT fields', SORTBL) ELSE IF (LISTYP .EQ. 'NAMES') THEN CALL CKEXOD (EXOSAV, *20) CALL DBPNAM ('*', NVARGL, NVARNP, NVAREL, * NAMEGL, NAMENV, NAMEEL) ELSE IF (LISTYP .EQ. 'SELECTED') THEN IF (MATSTR(CV(4),'RANGE',1)) THEN OPT = 'R' ELSE OPT = ' ' END IF IF (MATSTR(CV(3),'NODES',1)) THEN CALL LISSEL (OPT//'L', 'Nodes', IOMIN, IOMAX, * IDUM, A(INDSEL), NUMNP) ELSE IF (MATSTR(CV(3),'ELEMENTS',1)) THEN CALL LISSEL (OPT//'L', 'Elements', IOMIN, IOMAX, * IDUM, A(IELSEL), NUMEL) ELSE CALL PRTERR ('CMDERR', '"' // CV(3)(:LENSTR(CV(3))) & // '" is an invalid LIST SELECTED option') END IF ELSE IF (LISTYP .EQ. 'QA' .OR. LISTYP .EQ. 'INFORMAT') THEN IF ((NQAREC .GT. 0) .OR. (NINFO .GT. 0)) THEN CALL DBPQA ('*', NQAREC, QAREC, NINFO, INFREC) END IF ELSE IF (LISTYP .EQ. 'VOLUME') THEN CALL PRVOL (ndim, CRD, link, numnp, numel, 8, & a(ismp), IHARD) CALL PRTERR ('CMDSPEC', * 'Element Volumes were written to the list file') ELSE IF (LISTYP .EQ. 'NODALVOL') THEN CALL PRNVOL (ndim, CRD, link, numnp, numel, 8, & a(ismp), IHARD) CALL PRTERR ('CMDSPEC', * 'Nodal Volumes were written to the list file') ELSE CALL PRTERR ('CMDERR', '"' // CV(2)(:LENSTR(CV(2))) & // '" is an invalid or nonunique LIST option') END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'TMIN') THEN CALL CKEXOD (EXOSAV, *20) CALL FFREAL (IFLD, KV, RV, * 'minimum selected time', TMIN, STMIN, *20) CALL SELTIM (TIME, ITMSEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'TMAX') THEN CALL CKEXOD (EXOSAV, *20) CALL FFREAL (IFLD, KV, RV, * 'maximum selected time', TMAX, STMAX, *20) CALL SELTIM (TIME, ITMSEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ.'TIMES') THEN CALL CKEXOD (EXOSAV, *20) CALL FFRRNG (IFLD, KV, CV, RV, 'time selection', * TIME(NSTEP), TRANGE, *20) IF (TRANGE(3) .GT. 0.0) THEN STMIN = TRANGE(1) STMAX = TRANGE(2) STDEL = TRANGE(3) ELSE STMIN = TRANGE(2) STMAX = TRANGE(1) STDEL = TRANGE(3) END IF CALL SELTIM (TIME, ITMSEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'DELTIME') THEN CALL CKEXOD (EXOSAV, *20) CALL FFREAL (IFLD, KV, RV, * 'selected time interval', 0.0, STDEL, *20) CALL SELTIM (TIME, ITMSEL) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'ALLTIMES') THEN CALL CKEXOD (EXOSAV, *20) STMIN = TMIN STMAX = TMAX STDEL = 0.0 CALL SELTIM (TIME, ITMSEL) EXODUS = .TRUE. C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'NINTV') THEN CALL CKEXOD (EXOSAV, *20) CALL FFINTG (IFLD, KV, IVAL, * 'time step interval', 10, NINTV, *20) CALL SELINV (TIME, ITMSEL, NINTV) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'ZINTV') THEN CALL CKEXOD (EXOSAV, *20) CALL FFINTG (IFLD, KV, IVAL, * 'time step interval', 10, NINTV, *20) CALL SELINV (TIME, ITMSEL, -NINTV) C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'EXIT' .OR. NAME .EQ. 'END' & .or. name .eq. 'QUIT') THEN GO TO 190 C ... LOCATE NODES|ELEMENTS WITHIN toler OF LINE|PLANE|POINT C --- FORMAT: locate nodes line x1,y1,[z1] x2,y2,[z2], toler1, toler2 type C locate nodes plane x1,y1,[z1] i2,j2,[k2], toler1, toler2 C locate nodes point x1,y1,[z1] toler1, toler2 C locate elements line x1,y1,[z1] x2,y2,[z2], toler1, toler2 type C locate elements plane x1,y1,[z1] i2,j2,[k2], toler1, toler2 C locate elements point x1,y1,[z1] toler1, toler2 C x1, y1, z1, x2, y2, z2 = Coordinate locations C i2, j2, k2 = Normal Vector to plane C If TOLER2 .EQ. 0, then TOLER1 = Maximum Distance for locate C If TOLER2 .NE. 0, then TOLER1 = Minimum Distance for locate, C TOLER2 = Maximum Distance for locate. C If TYPE .EQ. BOUNDED, then only search within line C If TYPE .EQ. UNBOUNDED, then search along projection of line C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'LOCATE') THEN TYPE = 'UNBOUNDE' DO 150 I=NF,4,-1 IF (KV(I) .EQ. 0) THEN TYPE = CV(I)(:16) GO TO 160 END IF 150 CONTINUE 160 CONTINUE IF (MATSTR(CV(2),'NODES',1)) THEN NUMLEN = NUMNP IPTR = IR ISEL = INDSEL ELSE IF (MATSTR(CV(2),'ELEMENTS',1)) THEN NUMLEN = NUMEL IPTR = IECEN ISEL = IELSEL ELSE CALL PRTERR ('CMDERR', '"' // CV(2)(:LENSTR(CV(2))) & // '" is an invalid option') GO TO 170 END IF CALL LOCTOL (CV(3), NDIM, RV, KV) IF (MATSTR(CV(3), 'LINE', 1)) THEN IF (NDIM .EQ. 3) THEN CALL LINE3 (A(IPTR), NUMLEN, A(ISCR), A(ISCR+NUMNP), * NDIM, RV(4), RV(7), RV(10), CV(2), TYPE, SORTYP, * A(ISMP), SORUP, IDUM, '*', A(ISEL)) ELSE CALL LINE2 (A(IPTR), NUMLEN, A(ISCR), A(ISCR+NUMNP), * NDIM, RV(4), RV(6), RV(8), CV(2), TYPE, SORTYP, * A(ISMP), SORUP, IDUM, '*', A(ISEL)) END IF ELSE IF (MATSTR(CV(3), 'PLANE', 2)) THEN IF (NDIM .EQ. 3) THEN CALL PLANE3 (A(IPTR), NUMLEN, A(ISCR), A(ISCR+NUMNP), * NDIM, RV(4), RV(7), RV(10), CV(2), SORTYP, * A(ISMP), SORUP, IDUM, '*', A(ISEL)) ELSE CALL PRTERR ('CMDERR', * 'use locate node/element line for 2D') END IF ELSE IF (MATSTR(CV(3), 'POINT', 2)) THEN IF (NDIM .EQ. 3) THEN CALL POINT3 (A(IPTR), NUMLEN, A(ISCR), * NDIM, RV(4), RV(7), CV(2), SORTYP, * A(ISMP), A(ISCR2), SORUP, IDUM, '*', A(ISEL)) ELSE CALL POINT2 (A(IPTR), NUMLEN, A(ISCR), * NDIM, RV(4), RV(6), CV(2), SORTYP, * A(ISMP), A(ISCR2), SORUP, IDUM, '*', A(ISEL)) END IF ELSE CALL PRTERR ('CMDERR', '"' // CV(3)(:LENSTR(CV(3))) & // '" is an invalid LOCATE option') GO TO 170 END IF 170 CONTINUE C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'SORT') THEN IF (CV(2) .EQ. ' ') CV(2) = 'NONE' IF (CV(3) .EQ. ' ') CV(3) = 'UP' CALL ABRSTR (SORTYP, CV(2), SORTBL) IF (SORTYP .EQ. ' ') THEN CALL PRTERR ('CMDERR', '"' // CV(2)(:LENSTR(CV(2))) & // '" is an invalid or nonunique SORT option') SORTYP = 'NONE' END IF IF (MATSTR(CV(3), 'UP', 1) .OR. * MATSTR(CV(3), 'ASCENDIN', 1) .OR. * MATSTR(CV(3), 'INCREASI', 1) ) THEN SORUP = .TRUE. ELSE IF (MATSTR(CV(3), 'DOWN', 1) .OR. * MATSTR(CV(3), 'DESCENDI', 1) .OR. * MATSTR(CV(3), 'DECREASI', 1) ) THEN SORUP = .FALSE. ELSE CALL PRTERR ('CMDERR', '"' // CV(3)(:LENSTR(CV(3))) & // '" is an invalid SORT order') SORUP = .TRUE. END IF IF (SORUP) THEN CALL PRTERR ('CMDSPEC', * 'Sorting on field ' // SORTYP(:LENSTR(SORTYP)) // * ' in ascending order.') ELSE CALL PRTERR ('CMDSPEC', * 'Sorting on field ' // SORTYP(:LENSTR(SORTYP)) // * ' in descending order.') END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'LIMITS') THEN CALL MDRSRV ('XYZMIN', IXYZMN, NELBLK*NDIM) CALL MDRSRV ('XYZMAX', IXYZMX, NELBLK*NDIM) CALL MDSTAT (NERRS, NUSED) IF (NERRS .GT. 0) THEN CALL MEMERR STOP END IF IF (MATSTR(CV(2), 'ALLTIMES', 1) .AND. EXOSAV .AND. ISDIS) THEN ALLTIM = .TRUE. ELSE ALLTIM = .FALSE. END IF IF (ALLTIM) THEN CALL LIMITS (A(IXYZMN), A(IXYZMX), CRD, LINK, MAT, NDIM, * NELBLK, 2**NDIM, ALLTIM, TIME, ITMSEL, * DISP, NUMNP) ELSE CALL LIMITS (A(IXYZMN), A(IXYZMX), CRD, LINK, MAT, NDIM, * NELBLK, 2**NDIM, ALLTIM, TIME, ITMSEL, * CRD, NUMNP) END IF CALL MDDEL ('XYZMIN') CALL MDDEL ('XYZMAX') CALL MDSTAT (NERRS, NUSED) IF (NERRS .GT. 0) THEN CALL MEMERR STOP 'MEMORY' END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'SUM' .OR. NAME .EQ. 'AVERAGE') THEN LTMP2 = .FALSE. LTMP3 = .FALSE. CALL CKEXOD (EXOSAV, *20) IF (NAME .EQ. 'SUM') THEN LTMP = .FALSE. ELSE LTMP = .TRUE. END IF CALL FFCHAR (IFLD, KV, CV, ' ', NAME) IND = LOCSTR (NAME, NVARNP, NAMENV) IF (IND .EQ. 0) THEN CALL PRTERR ('ERROR', '"' // NAME(:LENSTR(NAME)) & // '" is not a valid nodal variable name') ELSE IPTR = INDSEL LTMP2 = .FALSE. LTMP3 = .FALSE. 180 CONTINUE CALL FFCHAR (IFLD, KV, CV, 'RADIAL', CTMP) IF (MATSTR(CTMP, 'LINEAR', 1)) THEN LTMP2 = .FALSE. ELSE IF (MATSTR(CTMP, 'RADIAL', 1)) THEN LTMP2 = .TRUE. ELSE IF (MATSTR(CTMP, 'ABSOLUTE', 1)) THEN LTMP3 = .TRUE. ELSE CALL PRTERR ('ERROR', '"' // CTMP(:LENSTR(CTMP)) & // '" is not a valid option') GO TO 20 END IF IF (FFEXST (IFLD, KV)) GO TO 180 CALL SUMNOD (CRD, DISP, A(ISCR), NDIM, NUMNP, IND, * A(IPTR), NAMENV(IND), TIME, ITMSEL, $ LTMP2, LTMP, LTMP3) END IF C----------------------------------------------------------------------- ELSE IF (NAME .EQ. 'ESUM' .OR. NAME .EQ. 'EAVERAGE') THEN LTMP2 = .FALSE. LTMP3 = .FALSE. CALL CKEXOD (EXOSAV, *20) IF (NAME .EQ. 'ESUM') THEN LTMP = .FALSE. ELSE LTMP = .TRUE. END IF CALL FFCHAR (IFLD, KV, CV, ' ', NAME) IND = LOCSTR (NAME, NVAREL, NAMEEL) IF (IND .EQ. 0) THEN CALL PRTERR ('ERROR', '"' // NAME(:LENSTR(NAME)) & // '" is not a valid element variable name') ELSE IPTR = IELSEL LTMP4 = .FALSE. LTMP2 = .TRUE. LTMP3 = .FALSE. 182 CONTINUE CALL FFCHAR (IFLD, KV, CV, 'DENSITY', CTMP) C ... Determine whether element variable is per unit volume or is total IF (MATSTR(CTMP, 'DENSITY', 1)) THEN LTMP4 = .TRUE. ELSE IF (MATSTR(CTMP, 'TOTAL', 1)) THEN LTMP2 = .FALSE. ELSE IF (MATSTR(CTMP, 'ABSOLUTE', 1)) THEN LTMP3 = .TRUE. ELSE IF (MATSTR(CTMP, 'AVERAGE', 1)) THEN LTMP3 = .TRUE. ELSE CALL PRTERR ('ERROR', '"' // CTMP(:LENSTR(CTMP)) & // '" is not a valid option') GO TO 20 END IF IF (FFEXST (IFLD, KV)) GO TO 182 CALL SUMELM (CRD, DISP, A(ISCR), MAT, NDIM, NUMNP, IND, * A(IPTR), NAMEEL(IND), TIME, ITMSEL, $ LTMP, LTMP2, LTMP3, LTMP4, numel, link, 2**ndim, & nelblk, a(ismp), ISEVOK, A(IBLSC), A(INSEL)) END IF C ---------------------------------------- ELSE IF (NAME .EQ. 'CONDITIO' ) THEN LTMP = .FALSE. CALL FFCHAR (IFLD, KV, CV, 'NODEBUG', CTMP) IF (MATSTR(CTMP, 'DEBUG', 1)) LTMP = .TRUE. CALL MDRSRV ('SUMRY', ISUMR, 16*NELBLK) CALL MDRSRV ('ISUMR', IISUM, 8*NELBLK) CALL MDRSRV ('ASPECT', IASPEC, NUMEL) CALL MDRSRV ('SKEW', ISKEW, NUMEL) CALL MDRSRV ('TAPER', ITAPER, NUMEL) CALL MDRSRV ('AREA', IAREA, NUMEL) IF (NDIM .EQ. 3) THEN CALL MDRSRV ('SKEWX', ISKX, NUMEL) CALL MDRSRV ('SKEWY', ISKY, NUMEL) CALL MDRSRV ('SKEWZ', ISKZ, NUMEL) CALL MDRSRV ('TAPRX', ITPX, NUMEL) CALL MDRSRV ('TAPRY', ITPY, NUMEL) CALL MDRSRV ('TAPRZ', ITPZ, NUMEL) CALL MDRSRV ('JACOB', IJAC, NUMEL) END IF CALL MDSTAT (NERRS, NUSED) IF (NERRS .GT. 0) THEN CALL MEMERR STOP 'MEMORY' END IF NNODES = 2**NDIM IF (NDIM .EQ. 2) THEN CALL CON2D(CRD, NDIM, NUMNP, LINK, NNODES, NUMEL, MAT, * NELBLK, A(IELSEL), A(IASPEC), A(ISKEW), A(ITAPER), * A(IAREA), A(ISUMR), A(IISUM), LTMP) ELSE CALL CON3D(CRD, NDIM, NUMNP, LINK, NNODES, NUMEL, MAT, * NELBLK, A(IELSEL), A(IASPEC), A(ISKEW), A(ITAPER), * A(IAREA), A(ISUMR), A(IISUM), A(ISKX), A(ISKY), A(ISKZ), * A(ITPX), A(ITPY), A(ITPZ), A(IJAC), LTMP) END IF CALL MDDEL ('SUMRY') CALL MDDEL ('ISUMR') CALL MDDEL ('ASPECT') CALL MDDEL ('SKEW') CALL MDDEL ('TAPER') CALL MDDEL ('AREA') IF (NDIM .EQ. 3) THEN CALL MDDEL ('SKEWX') CALL MDDEL ('SKEWY') CALL MDDEL ('SKEWZ') CALL MDDEL ('TAPRX') CALL MDDEL ('TAPRY') CALL MDDEL ('TAPRZ') CALL MDDEL ('JACOB') END IF CALL MDSTAT (NERRS, NUSED) IF (NERRS .GT. 0) THEN CALL MEMERR STOP 'MEMORY' END IF ELSE CALL PRTERR ('CMDERR', '"' // NAME(:LENSTR(NAME)) & // '" is an invalid or nonunique command') END IF GO TO 20 190 CONTINUE RETURN END