You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
536 lines
19 KiB
536 lines
19 KiB
2 years ago
|
C Copyright(C) 1999-2020 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
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE COMAND (A, INLINE, INTYP, CFIELD, IFIELD, RFIELD,
|
||
|
|
& NAMECO, BLKTYP, NAMES, TIMES, IPTIMS,
|
||
|
|
& IDELB, VISELB, SELELB,
|
||
|
|
& QAREC, INFREC, RETVRB, MERR)
|
||
|
|
C=======================================================================
|
||
|
|
C --*** COMAND *** (ALGEBRA) Process command
|
||
|
|
C -- Written by Amy Gilkey - revised 05/18/88
|
||
|
|
C --
|
||
|
|
C --COMAND processes an ALGEBRA command. The commands are:
|
||
|
|
C --
|
||
|
|
C -- TITLE Change database title
|
||
|
|
C --
|
||
|
|
C -- SAVE {N,E,G,A,var,...} Save input database variable
|
||
|
|
C -- DELETE {var,var,...} Delete assigned variable
|
||
|
|
C -- ALIAS {name,var,n} Assign alias to vector/tensor variables
|
||
|
|
C --
|
||
|
|
C -- TMIN {TMIN} Set minimum selected time
|
||
|
|
C -- TMAX {TMAX} Set maximum selected time
|
||
|
|
C -- DELTIME {DELT} Set selected time interval
|
||
|
|
C -- NINTV {NINTV} Change selected time interval
|
||
|
|
C -- ZINTV {NINTV} Change selected time interval(zero interval)
|
||
|
|
C -- ALLTIMES Select all times
|
||
|
|
C -- TIMES {t1,t2...} Select specified times
|
||
|
|
C -- STEPS {n1,n2...} Select specified steps
|
||
|
|
C --
|
||
|
|
C -- ZOOM {x1,x2,y1,y2,z1,z2} Set zoomed mesh limits
|
||
|
|
C -- VISIBLE {id1,...} Set element blocks to be written
|
||
|
|
C -- BLOCKS {id1,...} Set selected element blocks
|
||
|
|
C -- MATERIAL {id1,...} Set selected element blocks
|
||
|
|
C --
|
||
|
|
C -- LIST {option} Display database information
|
||
|
|
C -- SHOW {option} Display parameter setting
|
||
|
|
C -- HELP {option} Help on ALGEBRA
|
||
|
|
C --
|
||
|
|
C -- END Exit to evaluate equations (also EXIT)
|
||
|
|
C -- QUIT Exit but do not write database
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- A - IN - the dynamic memory base array
|
||
|
|
C -- INLINE - IN/OUT - the parsed input lines for the log file
|
||
|
|
C -- INTYP - IN - the input types from the free field reader
|
||
|
|
C -- CFIELD - IN - the character fields
|
||
|
|
C -- IFIELD - IN - the integer fields
|
||
|
|
C -- RFIELD - IN - the real fields
|
||
|
|
C -- NAMECO - IN - the coordinate names
|
||
|
|
C -- BLKTYP - IN - the element block names
|
||
|
|
C -- NAMES - IN - the global, nodal, and element variable names
|
||
|
|
C -- TIMES - IN - the database time steps
|
||
|
|
C -- IPTIMS - IN/OUT - the selected times steps
|
||
|
|
C -- IDELB - IN - the element block IDs
|
||
|
|
C -- VISELB(i) - IN/OUT - true iff element block i is to be written
|
||
|
|
C -- SELELB(i) - IN/OUT - true iff element block i is selected
|
||
|
|
C -- QAREC - IN - the QA records containing:
|
||
|
|
C -- (1) - the analysis code name
|
||
|
|
C -- (2) - the analysis code QA descriptor
|
||
|
|
C -- (3) - the analysis date
|
||
|
|
C -- (4) - the analysis time
|
||
|
|
C -- INFREC - IN - the information records
|
||
|
|
C -- RETVRB - OUT - returned action verb (END, QUIT, PRINT, LOG)
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses NDIM, NSTEPS of /DBNUMS/
|
||
|
|
C -- Sets TITLEO of /DBTITL/
|
||
|
|
C -- Sets NPTIMS, TMIN, TMAX, DELT, NINTV, WHONLY of /TIMES/
|
||
|
|
C -- Sets ISZOOM, ZMLIM of /ZOOM/
|
||
|
|
C -- Uses FNCNAM of /FNCTBL/
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
include 'ag_namlen.blk'
|
||
|
|
include 'ag_dbnums.blk'
|
||
|
|
include 'ag_dbtitl.blk'
|
||
|
|
include 'ag_times.blk'
|
||
|
|
include 'ag_zoom.blk'
|
||
|
|
include 'ag_filter.blk'
|
||
|
|
include 'ag_remove.blk'
|
||
|
|
include 'ag_fnctbc.blk'
|
||
|
|
|
||
|
|
common /debugc/ cdebug
|
||
|
|
common /debugn/ idebug
|
||
|
|
character*(mxstln) cdebug
|
||
|
|
|
||
|
|
LOGICAL FFEXST, FFNUMB, MATSTR
|
||
|
|
|
||
|
|
DIMENSION A(*)
|
||
|
|
CHARACTER*(*) INLINE(*)
|
||
|
|
INTEGER INTYP(*)
|
||
|
|
CHARACTER*(*) CFIELD(*)
|
||
|
|
INTEGER IFIELD(*)
|
||
|
|
REAL RFIELD(*)
|
||
|
|
CHARACTER*(namlen) NAMECO(*)
|
||
|
|
CHARACTER*(MXSTLN) BLKTYP(*)
|
||
|
|
CHARACTER*(namlen) NAMES(*)
|
||
|
|
REAL TIMES(*)
|
||
|
|
INTEGER IPTIMS(*)
|
||
|
|
INTEGER IDELB(*)
|
||
|
|
LOGICAL VISELB(NELBLK)
|
||
|
|
LOGICAL SELELB(NELBLK)
|
||
|
|
CHARACTER*(MXSTLN) QAREC(4,*)
|
||
|
|
CHARACTER*(MXLNLN) INFREC(*)
|
||
|
|
CHARACTER*(*) RETVRB
|
||
|
|
CHARACTER*1 OPTION
|
||
|
|
|
||
|
|
CHARACTER*(maxnam) VERB, WORD
|
||
|
|
CHARACTER*(mxstln) HLPTYP
|
||
|
|
LOGICAL ISON
|
||
|
|
LOGICAL HELP
|
||
|
|
LOGICAL XLIM, YLIM, ZLIM
|
||
|
|
INTEGER MERR
|
||
|
|
|
||
|
|
CHARACTER*(mxstln) CMDTBL(26)
|
||
|
|
SAVE CMDTBL
|
||
|
|
C --CMDTBL - the commands table
|
||
|
|
|
||
|
|
CHARACTER*(mxstln) HLPTBL(4)
|
||
|
|
SAVE HLPTBL
|
||
|
|
C --HLPTBL - the HELP type table
|
||
|
|
|
||
|
|
MERR = 0
|
||
|
|
|
||
|
|
C --Command table follows. Remember to change the dimensioned size when
|
||
|
|
C --changing the table.
|
||
|
|
DATA CMDTBL /
|
||
|
|
1 'TITLE ',
|
||
|
|
2 'SAVE ',
|
||
|
|
3 'DELETE ',
|
||
|
|
4 'ALIAS ',
|
||
|
|
5 'TMIN ',
|
||
|
|
6 'TMAX ',
|
||
|
|
7 'DELTIME ',
|
||
|
|
8 'NINTV ',
|
||
|
|
9 'ZINTV ',
|
||
|
|
* 'ALLTIMES ',
|
||
|
|
1 'TIMES ',
|
||
|
|
2 'STEPS ',
|
||
|
|
3 'ZOOM ',
|
||
|
|
4 'FILTER ',
|
||
|
|
5 'VISIBLE ',
|
||
|
|
6 'BLOCKS ',
|
||
|
|
7 'MATERIAL ',
|
||
|
|
8 'LOG ',
|
||
|
|
9 'LIST ',
|
||
|
|
* 'SHOW ',
|
||
|
|
1 'HELP ',
|
||
|
|
2 'END ',
|
||
|
|
3 'EXIT ',
|
||
|
|
4 'QUIT ',
|
||
|
|
4 'REMOVE ',
|
||
|
|
* ' ' /
|
||
|
|
|
||
|
|
C --HELP type table follows. Remember to change the dimensioned size when
|
||
|
|
C --changing the table.
|
||
|
|
DATA HLPTBL /
|
||
|
|
& 'RULES ',
|
||
|
|
* 'COMMANDS ',
|
||
|
|
* 'FUNCTION ',
|
||
|
|
& ' ' /
|
||
|
|
|
||
|
|
RETVRB = ' '
|
||
|
|
|
||
|
|
IFLD = 1
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
CALL ABRSTR (VERB, WORD, CMDTBL)
|
||
|
|
IF (VERB .EQ. ' ') VERB = WORD
|
||
|
|
|
||
|
|
IF (VERB .EQ. 'TITLE') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
CALL GETINP (0, 0, 'TITLE> ', TITLEO, IOSTAT)
|
||
|
|
INLINE(2) = TITLEO
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'ALIAS') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
CALL ALICMD (INLINE, INTYP(IFLD), CFIELD(IFLD), IFIELD(IFLD),
|
||
|
|
& NAMES, *150)
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'SAVE') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
CALL SAVCMD (INLINE, INTYP(IFLD), CFIELD(IFLD), NAMES, *150)
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'DELETE') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
CALL DELCMD (INLINE, INTYP(IFLD), CFIELD(IFLD), *150)
|
||
|
|
|
||
|
|
ELSE IF ((VERB .EQ. 'TMIN') .OR. (VERB .EQ. 'TMAX')
|
||
|
|
& .OR. (VERB .EQ. 'DELTIME')
|
||
|
|
& .OR. (VERB .EQ. 'NINTV') .OR. (VERB .EQ. 'ZINTV')
|
||
|
|
& .OR. (VERB .EQ. 'ALLTIMES')
|
||
|
|
& .OR. (VERB .EQ. 'TIMES') .OR. (VERB .EQ. 'STEPS')) THEN
|
||
|
|
CALL CMDTIM (INLINE, VERB, IFLD, INTYP, CFIELD, IFIELD,
|
||
|
|
& RFIELD, NSTEPS, TIMES, TMIN, TMAX, DELT,
|
||
|
|
& NINTV, NPTIMS, IPTIMS)
|
||
|
|
ELSE IF (VERB .EQ. 'FILTER') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
C ... Get name of element variable to use for filtering
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
if (.not. matstr(word, 'ELEMENTS', 1)) THEN
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "ELEMENTS". Syntax: FILTER ELEMENTS {elem_var}')
|
||
|
|
VERB = ' '
|
||
|
|
GOTO 150
|
||
|
|
ENDIF
|
||
|
|
CALL FFADDC (word, INLINE(1))
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
CALL DBVIX('E', 1, IEV)
|
||
|
|
IDXFLT = LOCSTR (WORD, NVAREL, NAMES(IEV))
|
||
|
|
if (idxflt .eq. 0) then
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Variable name specified does not exist on database.')
|
||
|
|
VERB = ' '
|
||
|
|
GOTO 150
|
||
|
|
end if
|
||
|
|
CALL FFADDC (NAMES(idxflt+iev-1), INLINE(1))
|
||
|
|
|
||
|
|
C ... Check for comparison -- uses fortran LT, LE, EQ, NE, GT, GE
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
if (.not. matstr(word, 'LT', 2) .and.
|
||
|
|
* .not. matstr(word, 'LE', 2) .and.
|
||
|
|
* .not. matstr(word, 'EQ', 2) .and.
|
||
|
|
* .not. matstr(word, 'NE', 2) .and.
|
||
|
|
* .not. matstr(word, 'GT', 2) .and.
|
||
|
|
* .not. matstr(word, 'GE', 2)) then
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "LT", "LE", "EQ", "NE", "GT", or "GE".')
|
||
|
|
VERB = ' '
|
||
|
|
GOTO 150
|
||
|
|
end if
|
||
|
|
CALL FFADDC (word, INLINE(1))
|
||
|
|
if (matstr(word, 'LT', 2)) cmpflt = 1
|
||
|
|
if (matstr(word, 'LE', 2)) cmpflt = 2
|
||
|
|
if (matstr(word, 'EQ', 2)) cmpflt = 3
|
||
|
|
if (matstr(word, 'NE', 2)) cmpflt = 4
|
||
|
|
if (matstr(word, 'GT', 2)) cmpflt = 5
|
||
|
|
if (matstr(word, 'GE', 2)) cmpflt = 6
|
||
|
|
|
||
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
||
|
|
& 'filter value', 0.0, VALFLT, *150)
|
||
|
|
CALL FFADDR (VALFLT, INLINE(1))
|
||
|
|
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
if (.not. matstr(word, 'TIME', 1)) THEN
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "TIME". Syntax:')
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
* 'FILTER ELEMENTS {elem_var} {CMP} {value} TIME {time}')
|
||
|
|
VERB = ' '
|
||
|
|
GOTO 150
|
||
|
|
ENDIF
|
||
|
|
CALL FFADDC (word, INLINE(1))
|
||
|
|
|
||
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
||
|
|
& 'database time', 0.0, TIMFLT, *150)
|
||
|
|
C ... Check that specified time is in range of times on database. Assume TIMES() is sorted.
|
||
|
|
if (timflt .lt. times(1)) then
|
||
|
|
call prterr('WARNING',
|
||
|
|
* 'Specified time is less than minimum database time.')
|
||
|
|
call prterr('CMDSPEC',
|
||
|
|
* 'Setting filter time to minimum database time.')
|
||
|
|
timflt = times(1)
|
||
|
|
else if (timflt .gt. times(nsteps)) then
|
||
|
|
call prterr('WARNING',
|
||
|
|
* 'Specified time is greater than maximum database time.')
|
||
|
|
call prterr('CMDSPEC',
|
||
|
|
* 'Setting filter time to maximum database time.')
|
||
|
|
timflt = times(nsteps)
|
||
|
|
end if
|
||
|
|
CALL FFADDR (TIMFLT, INLINE(1))
|
||
|
|
ISFILTER = .TRUE.
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'REMOVE') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
if (.not. matstr(word, 'ELEMENTS', 1)) THEN
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "ELEMENTS". Syntax: FILTER ELEMENTS {elem_var}')
|
||
|
|
VERB = ' '
|
||
|
|
GOTO 150
|
||
|
|
ENDIF
|
||
|
|
CALL FFADDC (word, INLINE(1))
|
||
|
|
C ... See if LOCAL or GLOBAL or nothing specified for id space...
|
||
|
|
IF (INTYP(IFLD) .EQ. 0) THEN
|
||
|
|
call ffchar(IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
if (matstr(word, 'GLOBAL', 1)) then
|
||
|
|
idsglobal = .true.
|
||
|
|
else if (matstr(word, 'LOCAL', 1)) then
|
||
|
|
idsglobal = .false.
|
||
|
|
end if
|
||
|
|
else
|
||
|
|
C ... Default is local ids or last set value.
|
||
|
|
if (irmcnt .eq. 0) then
|
||
|
|
idsglobal = .false.
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
C ... Gather ids of elements to delete...
|
||
|
|
99 continue
|
||
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
||
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
|
& 'element ID', 0, ID, *129)
|
||
|
|
IRMCNT = IRMCNT + 1
|
||
|
|
if (IRMCNT .gt. 1024) then
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Can only specify a maximum of 1024 elements to delete')
|
||
|
|
goto 129
|
||
|
|
end if
|
||
|
|
idsrem(irmcnt) = id
|
||
|
|
goto 99
|
||
|
|
END IF
|
||
|
|
129 continue
|
||
|
|
ISREMOVE = .TRUE.
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'ZOOM') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
CALL FFNEED (IFLD, INTYP, 'R', MIN(3,NDIM)*2,
|
||
|
|
& 'zoom mesh limits for all dimensions', *150)
|
||
|
|
DO 100 I = 1, MIN(3,NDIM)*2
|
||
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
||
|
|
& 'zoom mesh limit', 0.0, ZMLIM(I), *150)
|
||
|
|
CALL FFADDR (ZMLIM(I), INLINE(1))
|
||
|
|
100 CONTINUE
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, 'INSIDE', WORD)
|
||
|
|
IF (MATSTR (WORD, 'INSIDE', 1)) THEN
|
||
|
|
CALL FFADDC ('INSIDE', INLINE(1))
|
||
|
|
ZOOMIN = .TRUE.
|
||
|
|
ELSE IF (MATSTR (WORD, 'OUTSIDE', 1)) THEN
|
||
|
|
CALL FFADDC ('OUTSIDE', INLINE(1))
|
||
|
|
ZOOMIN = .FALSE.
|
||
|
|
END IF
|
||
|
|
C Set logical variables which determine if zoom mesh limits
|
||
|
|
C are of the correct format (minlimit < maxlimit)
|
||
|
|
XLIM = (ZMLIM(1) .LE. ZMLIM(2))
|
||
|
|
YLIM = (ZMLIM(3) .LE. ZMLIM(4))
|
||
|
|
IF (NDIM .EQ. 3) THEN
|
||
|
|
ZLIM = (ZMLIM(5) .LE. ZMLIM(6))
|
||
|
|
ELSE
|
||
|
|
ZLIM = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
IF ((.NOT. XLIM) .OR. (.NOT. YLIM) .OR.
|
||
|
|
& (.NOT. ZLIM)) THEN
|
||
|
|
C Zoom limits are incorrect
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Zoom limits are incorrect. (minlimit > maxlimit)')
|
||
|
|
INLINE(1) = ' '
|
||
|
|
ELSE
|
||
|
|
ISZOOM = .TRUE.
|
||
|
|
END IF
|
||
|
|
ELSE IF (VERB .EQ. 'VISIBLE') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
|
||
|
|
IF (.NOT. FFEXST (IFLD, INTYP)) THEN
|
||
|
|
|
||
|
|
C --Select all element blocks if no parameters
|
||
|
|
|
||
|
|
CALL INILOG (NELBLK, .TRUE., VISELB)
|
||
|
|
OPTION = '+'
|
||
|
|
|
||
|
|
ELSE IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
|
||
|
|
|
||
|
|
C --Strip off ADD or DELETE option
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
IF (MATSTR (WORD, 'ADD', 1)) THEN
|
||
|
|
CALL FFADDC ('ADD', INLINE(1))
|
||
|
|
OPTION = '+'
|
||
|
|
ELSE IF (MATSTR (WORD, 'DELETE', 1)) THEN
|
||
|
|
CALL FFADDC ('DELETE', INLINE(1))
|
||
|
|
OPTION = '-'
|
||
|
|
ELSE
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "ADD" or "DELETE" or element block ID')
|
||
|
|
GOTO 160
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C --De-select all element blocks so only listed blocks are selected
|
||
|
|
CALL INILOG (NELBLK, .FALSE., VISELB)
|
||
|
|
OPTION = '+'
|
||
|
|
END IF
|
||
|
|
|
||
|
|
110 CONTINUE
|
||
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
||
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
|
& 'element block ID', 0, ID, *120)
|
||
|
|
IELB = LOCINT (ID, NELBLK, IDELB)
|
||
|
|
IF (IELB .GT. 0) THEN
|
||
|
|
CALL FFADDI (ID, INLINE(1))
|
||
|
|
VISELB(IELB) = (OPTION .EQ. '+')
|
||
|
|
ELSE
|
||
|
|
CALL INTSTR (1, 0, ID, WORD, LSTR)
|
||
|
|
CALL PRTERR ('CMDERR', 'Element block ID ' //
|
||
|
|
& WORD(:LSTR) // ' does not exist, ignored')
|
||
|
|
END IF
|
||
|
|
120 CONTINUE
|
||
|
|
GOTO 110
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF ((VERB .EQ. 'BLOCKS') .OR. (VERB .EQ. 'MATERIAL')) THEN
|
||
|
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
IF (VERB .EQ. 'MATERIAL') VERB = 'BLOCKS'
|
||
|
|
|
||
|
|
IF (.NOT. FFEXST (IFLD, INTYP)) THEN
|
||
|
|
|
||
|
|
C --Select all element blocks if no parameters
|
||
|
|
CALL INILOG (NELBLK, .TRUE., SELELB)
|
||
|
|
OPTION = '+'
|
||
|
|
|
||
|
|
ELSE IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
|
||
|
|
|
||
|
|
C --Strip off ADD or DELETE option
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
IF (MATSTR (WORD, 'ADD', 1)) THEN
|
||
|
|
CALL FFADDC ('ADD', INLINE(1))
|
||
|
|
OPTION = '+'
|
||
|
|
ELSE IF (MATSTR (WORD, 'DELETE', 1)) THEN
|
||
|
|
CALL FFADDC ('DELETE', INLINE(1))
|
||
|
|
OPTION = '-'
|
||
|
|
ELSE
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "ADD" or "DELETE" or element block ID')
|
||
|
|
GOTO 160
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C --De-select all element blocks so only listed blocks are selected
|
||
|
|
CALL INILOG (NELBLK, .FALSE., SELELB)
|
||
|
|
OPTION = '+'
|
||
|
|
END IF
|
||
|
|
|
||
|
|
130 CONTINUE
|
||
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
||
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
|
& 'element block ID', 0, ID, *140)
|
||
|
|
IELB = LOCINT (ID, NELBLK, IDELB)
|
||
|
|
IF (IELB .GT. 0) THEN
|
||
|
|
CALL FFADDI (ID, INLINE(1))
|
||
|
|
SELELB(IELB) = (OPTION .EQ. '+')
|
||
|
|
ELSE
|
||
|
|
CALL INTSTR (1, 0, ID, WORD, LSTR)
|
||
|
|
CALL PRTERR ('CMDERR', 'Element block ID ' //
|
||
|
|
& WORD(:LSTR) // ' does not exist, ignored')
|
||
|
|
END IF
|
||
|
|
140 CONTINUE
|
||
|
|
GOTO 130
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETVRB = 'BLOCKS'
|
||
|
|
|
||
|
|
ELSE IF ((VERB .EQ. 'LOG') .or. (verb .eq. 'SAVELOG')) THEN
|
||
|
|
if (verb .eq. 'SAVELOG') then
|
||
|
|
call prterr ('CMDSPEC', 'Please use the LOG command')
|
||
|
|
verb = 'LOG'
|
||
|
|
end if
|
||
|
|
VERB = ' '
|
||
|
|
RETVRB = 'LOG'
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'LIST') THEN
|
||
|
|
VERB = ' '
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
CALL DBLIST (WORD, A, NAMECO, BLKTYP, NAMES,
|
||
|
|
& TIMES, IDELB, QAREC, INFREC, MERR)
|
||
|
|
IF (MERR .EQ. 1) RETURN
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'SHOW') THEN
|
||
|
|
VERB = ' '
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
CALL SHOW (WORD, CMDTBL, NAMECO, BLKTYP, NAMES,
|
||
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
||
|
|
|
||
|
|
IF (WORD .EQ. ' ') RETVRB = 'PRINT'
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'HELP') THEN
|
||
|
|
VERB = ' '
|
||
|
|
CALL ABRSTR (HLPTYP, WORD, HLPTBL)
|
||
|
|
ISON = HELP ('ALGEBRA', HLPTYP, ' ')
|
||
|
|
IF (.NOT. ISON) THEN
|
||
|
|
IF (HLPTYP .EQ. 'RULES') THEN
|
||
|
|
CONTINUE
|
||
|
|
ELSE IF (HLPTYP .EQ. 'COMMANDS') THEN
|
||
|
|
CALL SHOCMD ('COMMANDS', CMDTBL)
|
||
|
|
ELSE IF (HLPTYP .EQ. 'FUNCTION') THEN
|
||
|
|
CALL SHOCMD ('Available Functions:', FNCNAM)
|
||
|
|
ELSE
|
||
|
|
CALL SHOCMD ('HELP Options:', HLPTBL)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETVRB = 'PRINT'
|
||
|
|
|
||
|
|
ELSE IF ((VERB .EQ. 'END') .OR. (VERB .EQ. 'EXIT')) THEN
|
||
|
|
VERB = ' '
|
||
|
|
CALL FFADDC ('END', INLINE(1))
|
||
|
|
RETVRB = 'END'
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'QUIT') THEN
|
||
|
|
VERB = ' '
|
||
|
|
CALL FFADDC ('QUIT', INLINE(1))
|
||
|
|
RETVRB = 'QUIT'
|
||
|
|
|
||
|
|
C --This command allows selectable debugging
|
||
|
|
else if (verb .eq. 'DEBUG') then
|
||
|
|
verb = ' '
|
||
|
|
call ffchar (ifld, intyp, cfield, ' ', cdebug)
|
||
|
|
if (matstr (cdebug, 'EQUATION', 3)) then
|
||
|
|
call prtdeb ('EQUATION', 0)
|
||
|
|
else if (matstr (cdebug, 'VARIABLE', 3)) then
|
||
|
|
call prtdeb ('VARIABLE', 0)
|
||
|
|
else if (matstr (cdebug, 'ALL', 3)) then
|
||
|
|
call prtdeb ('VARIABLE', 0)
|
||
|
|
call prtdeb ('EQUATION', -1)
|
||
|
|
end if
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
CALL PRTERR ('CMDERR', '"' // VERB(:LENSTR(VERB))
|
||
|
|
& // '" is an invalid command')
|
||
|
|
VERB = ' '
|
||
|
|
GOTO 150
|
||
|
|
END IF
|
||
|
|
|
||
|
|
GOTO 160
|
||
|
|
|
||
|
|
150 CONTINUE
|
||
|
|
INLINE(1) = ' '
|
||
|
|
|
||
|
|
160 CONTINUE
|
||
|
|
IF (VERB .NE. ' ') THEN
|
||
|
|
CALL SHOW (VERB, CMDTBL, NAMECO, BLKTYP, NAMES,
|
||
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|