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.
710 lines
22 KiB
710 lines
22 KiB
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 CHKSYN (NINENT, IENTYP, CENTRY, RENTRY, NAMES,
|
|
& MAXENT, NUMENT, NAMENT, TYPENT, INXENT, VALENT, ITMENT,
|
|
& NERR)
|
|
C=======================================================================
|
|
|
|
C --*** CHKSYN *** (ALGEBRA) Assign equation entries and checks syntax
|
|
C -- Written by Amy Gilkey - revised 05/23/88
|
|
C --
|
|
C --CHKSYN assigns the equation entries from the input fields.
|
|
C --It assigns NAMENT, TYPENT, INXENT, VALENT, and ITMENT for each entry
|
|
C --(INXENT for a variable is assigned later). Entries may be added
|
|
C --or deleted from the equation. The equation syntax is also checked.
|
|
C --
|
|
C --Aliased variables are expanded in this routine.
|
|
C --
|
|
C --Parameters:
|
|
C -- NINENT - IN - the number of input entries
|
|
C -- IENTYP - IN - the free-field reader entry type
|
|
C -- 0 = name string
|
|
C -- 1,2 = number
|
|
C -- 3 = character or **
|
|
C -- CENTRY - IN - character string fields
|
|
C -- RENTRY - IN - numeric fields
|
|
C -- NAMES - IN - the global, nodal, and element variable names
|
|
C -- MAXENT - IN - the maximum number of entries + 1
|
|
C -- NUMENT - OUT - the number of entries (as in /ENT../)
|
|
C -- NAMENT - OUT - the equation entries (as in /ENT../)
|
|
C -- TYPENT - OUT - the type of each equation entry (as in /ENT../)
|
|
C -- INXENT - OUT - based on TYPENT (as in /ENT../)
|
|
C -- VALENT - OUT - based on TYPENT (as in /ENT../)
|
|
C -- ITMENT - OUT - based on TYPENT (as in /ENT../)
|
|
C -- NERR - I/O - the number of errors in the equation, may be set
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NUMALI, NAMALI, NIXALI, IXALI of /ALIAS../
|
|
C -- Uses FNCNAM of /FNCTB./
|
|
C -- Sets (by DATA) FNCNAM, FNCTYP, FNCSTO of /FNCTB./
|
|
|
|
PARAMETER (ICURTM = 1, ILSTTM = 2, IONETM = 3)
|
|
|
|
include 'exodusII.inc'
|
|
include 'ag_namlen.blk'
|
|
|
|
include 'ag_alias.blk'
|
|
include 'ag_fnctbc.blk'
|
|
|
|
INTEGER IENTYP(*)
|
|
CHARACTER*(*) CENTRY(*)
|
|
REAL RENTRY(*)
|
|
CHARACTER*(*) NAMES(*)
|
|
CHARACTER*(*) NAMENT(*)
|
|
CHARACTER TYPENT(*)
|
|
INTEGER INXENT(*)
|
|
REAL VALENT(*)
|
|
INTEGER ITMENT(*)
|
|
|
|
LOGICAL NOTDON
|
|
CHARACTER*5 STRA
|
|
|
|
CHARACTER*(MAXNAM+20) ENT20
|
|
C --ENT20 - long equation entry, before trucation
|
|
|
|
CHARACTER*(mxstln) ENT, LSTENT
|
|
C --ENT, LSTENT - single equation entries
|
|
CHARACTER LSTTYP
|
|
C --LSTTYP - single equation entry types
|
|
|
|
CHARACTER*10 OPSYM
|
|
SAVE OPSYM
|
|
C --OPSYM - the ordered operators, one to a character, order is used
|
|
C -- to determine the operator INXENT, space is reserved for
|
|
C -- end of line operator (# is 0) and unary minus (~ is 1)
|
|
|
|
INTEGER NPARM(MAXFNC)
|
|
SAVE NPARM
|
|
C --NPARM(i) - the required number of parameters for the function i
|
|
|
|
CHARACTER*(mxstln) FNCOLD(10), FNCNEW(10)
|
|
INTEGER IXFNC(10)
|
|
SAVE FNCOLD, FNCNEW, IXFNC
|
|
C --FNCOLD - old function names which have been replaced
|
|
C --FNCNEW - the corresponding new function names (in FNCNAM)
|
|
C --IXFNC - the index of the new function names in FNCTB.
|
|
|
|
LOGICAL FIRST
|
|
SAVE FIRST
|
|
SAVE IADD
|
|
C --FIRST - true only on the first time through routine
|
|
DATA FIRST / .TRUE. /
|
|
|
|
DATA OPSYM / ' +-*/^()=,' /
|
|
C --Note first space to reserve index 1 for unary minus
|
|
|
|
call infunc(nparm, fncold, fncnew)
|
|
|
|
IF (FIRST) THEN
|
|
IADD = 0
|
|
NUMFNO = 0
|
|
100 CONTINUE
|
|
IF (FNCOLD(NUMFNO+1) .NE. ' ') THEN
|
|
NUMFNO = NUMFNO + 1
|
|
IXFNC(NUMFNO) = LOCSTR (FNCNEW(NUMFNO), NUMFNC, FNCNAM)
|
|
GOTO 100
|
|
END IF
|
|
|
|
FIRST = .FALSE.
|
|
END IF
|
|
|
|
C --Assign TYPENT Constant, Operator, Variable or Function and
|
|
C --set INXENT, VALENT, and ITMENT
|
|
|
|
NUMENT = NINENT
|
|
IF (NUMENT .GE. MAXENT) THEN
|
|
CALL PRTERR ('CMDSPEC', 'Too many equation entries')
|
|
NERR = NERR + 1
|
|
NUMENT = MAXENT-1
|
|
END IF
|
|
|
|
DO 110 NENT = 1, NUMENT
|
|
|
|
ENT20 = CENTRY(NENT)
|
|
|
|
IF ((IENTYP(NENT) .EQ. 1) .OR. (IENTYP(NENT) .EQ. 2)) THEN
|
|
|
|
C --Constant - store value
|
|
|
|
NAMENT(NENT) = ENT20(1:MAXNAM)
|
|
TYPENT(NENT) = 'C'
|
|
INXENT(NENT) = -999
|
|
VALENT(NENT) = RENTRY(NENT)
|
|
ITMENT(NENT) = -999
|
|
|
|
ELSE IF (IENTYP(NENT) .EQ. 3) THEN
|
|
|
|
C --Operator - store index
|
|
|
|
NAMENT(NENT) = ENT20(1:1)
|
|
TYPENT(NENT) = 'O'
|
|
ISYM = INDEX (OPSYM, ENT20(1:1))
|
|
INXENT(NENT) = ISYM
|
|
VALENT(NENT) = -999
|
|
ITMENT(NENT) = -999
|
|
IF (ISYM .EQ. 0) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC',
|
|
& '"' // ENT20(1:1) // '" is not a valid operator')
|
|
END IF
|
|
|
|
ELSE
|
|
|
|
C --Variable (may be function) - store name and node/element
|
|
C --specifier and time specifier
|
|
|
|
IS = INDEX (ENT20, '$')
|
|
IF (IS .GT. 0) THEN
|
|
CALL CNVNUM (ENT20(IS+1:), NENUM, IERR)
|
|
IF ((IERR .NE. 0) .OR. (NENUM .LE. 0)) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', ENT20(:LENSTR(ENT20))
|
|
& // ' has an invalid node/element specifier')
|
|
NENUM = 1
|
|
END IF
|
|
ENT20(IS:) = ' '
|
|
ELSE
|
|
NENUM = 0
|
|
END IF
|
|
IS = INDEX (ENT20, ':')
|
|
IF (IS .GT. 0) THEN
|
|
ENT = ENT20(IS+1:)
|
|
IF (ENT .EQ. ' ') THEN
|
|
ITIME = ILSTTM
|
|
ELSE IF (ENT .EQ. '1') THEN
|
|
ITIME = IONETM
|
|
ELSE
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', ENT20(:LENSTR(ENT20))
|
|
& // ' has an invalid time specifier')
|
|
ITIME = ICURTM
|
|
END IF
|
|
ENT20(IS:) = ' '
|
|
ELSE
|
|
ITIME = ICURTM
|
|
END IF
|
|
|
|
IF (ENT20(MAXNAM+1:) .NE. ' ')
|
|
& CALL PRTERR ('CMDSPEC',
|
|
& 'WARNING - ' // ENT20(:LENSTR(ENT20))
|
|
& // ' is truncated to "' // ENT20(1:MAXNAM) // '"')
|
|
|
|
NAMENT(NENT) = ENT20(1:MAXNAM)
|
|
TYPENT(NENT) = 'V'
|
|
INXENT(NENT) = -999
|
|
VALENT(NENT) = NENUM
|
|
ITMENT(NENT) = ITIME
|
|
END IF
|
|
|
|
110 CONTINUE
|
|
|
|
C --Temporarily add a '#' to mark the end of the equation to eliminate
|
|
C --special end checks
|
|
|
|
NAMENT(NUMENT+1) = 'line end'
|
|
TYPENT(NUMENT+1) = 'O'
|
|
|
|
C --Distinguish between variables and functions (functions names are
|
|
C --followed by "(")
|
|
|
|
DO 120 NENT = 1, NUMENT
|
|
|
|
IF (TYPENT(NENT) .EQ. 'V') THEN
|
|
IF (NAMENT(NENT+1) .EQ. '(') THEN
|
|
|
|
ENT = NAMENT(NENT)
|
|
|
|
C --Locate the function name in the function table
|
|
|
|
INXF = LOCSTR (ENT, NUMFNC, FNCNAM)
|
|
IF (INXF .LE. 0) THEN
|
|
IX = LOCSTR (ENT, NUMFNO, FNCOLD)
|
|
IF (IX .GT. 0) THEN
|
|
INXF = IXFNC(IX)
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'WARNING - Please use function name "'
|
|
& // FNCNAM(INXF)(:LENSTR(FNCNAM(INXF)))
|
|
& // '" instead of "' // ENT(:LENSTR(ENT)) // '"')
|
|
ENT = FNCNAM(INXF)
|
|
END IF
|
|
END IF
|
|
|
|
IF (INXF .GT. 0) THEN
|
|
|
|
IF ((VALENT(NENT) .NE. 0)
|
|
& .OR. (ITMENT(NENT) .NE. ICURTM)) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', 'Function "'
|
|
& // ENT(:LENSTR(ENT)) // '" has a specifier')
|
|
END IF
|
|
|
|
C --Function - store name and index and number of parameters
|
|
|
|
NAMENT(NENT) = ENT
|
|
TYPENT(NENT) = 'F'
|
|
INXENT(NENT) = INXF
|
|
VALENT(NENT) = NPARM(INXF)
|
|
ITMENT(NENT) = -999
|
|
|
|
ELSE
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'Function "' // ENT(:LENSTR(ENT)) //
|
|
& '" is undefined or a variable is followed by "("')
|
|
END IF
|
|
END IF
|
|
END IF
|
|
120 CONTINUE
|
|
|
|
C --Find unary '+' or '-' and convert to constant or unary operator
|
|
|
|
NENT = 1
|
|
130 CONTINUE
|
|
IF (NENT .LT. NUMENT) THEN
|
|
NENT = NENT + 1
|
|
|
|
ENT = NAMENT(NENT)
|
|
|
|
IF ((ENT .EQ. '+') .OR. (ENT .EQ. '-')) THEN
|
|
|
|
LSTENT = NAMENT(NENT-1)
|
|
|
|
IF ((LSTENT .EQ. '=') .OR. (LSTENT .EQ. '(')
|
|
& .OR. (LSTENT .EQ. ',')) THEN
|
|
C --A unary '+' or '-' is found
|
|
|
|
IF ((ENT .EQ. '+') .OR. (TYPENT(NENT+1) .EQ. 'C')) THEN
|
|
|
|
C --If it is a '+', delete the sign
|
|
C --If it is a negative constant, delete the sign and alter
|
|
C --the constant
|
|
|
|
DO 140 J = NENT, NUMENT+1-1
|
|
NAMENT(J) = NAMENT(J+1)
|
|
TYPENT(J) = TYPENT(J+1)
|
|
INXENT(J) = INXENT(J+1)
|
|
VALENT(J) = VALENT(J+1)
|
|
ITMENT(J) = ITMENT(J+1)
|
|
140 CONTINUE
|
|
NUMENT = NUMENT - 1
|
|
|
|
IF (ENT .EQ. '-') VALENT(NENT) = - VALENT(NENT)
|
|
NENT = NENT - 1
|
|
|
|
ELSE
|
|
|
|
C --It is a signed expression, change to a unary minus
|
|
|
|
NAMENT(NENT) = '~'
|
|
INXENT(NENT) = 1
|
|
|
|
END IF
|
|
END IF
|
|
END IF
|
|
GOTO 130
|
|
END IF
|
|
|
|
C --Expand variable aliases
|
|
|
|
NENT = 0
|
|
150 CONTINUE
|
|
IF (NENT .LT. NUMENT) THEN
|
|
NENT = NENT + 1
|
|
|
|
IF (TYPENT(NENT) .EQ. 'V') THEN
|
|
|
|
IALI = LOCSTR (NAMENT(NENT), NUMALI, NAMALI)
|
|
|
|
IF (IALI .GE. 1) THEN
|
|
NALI = NIXALI(IALI)
|
|
|
|
C --Make room for alias expansion
|
|
|
|
IF (NUMENT+IADD .GE. MAXENT) THEN
|
|
CALL PRTERR ('CMDSPEC', 'Too many equation entries')
|
|
NERR = NERR + 1
|
|
NUMENT = MAXENT-1 - IADD
|
|
END IF
|
|
IADD = 2 * (NALI-1)
|
|
DO 160 J = NUMENT+1, NENT, -1
|
|
NAMENT(J+IADD) = NAMENT(J)
|
|
TYPENT(J+IADD) = TYPENT(J)
|
|
INXENT(J+IADD) = INXENT(J)
|
|
VALENT(J+IADD) = VALENT(J)
|
|
ITMENT(J+IADD) = ITMENT(J)
|
|
160 CONTINUE
|
|
NUMENT = NUMENT + IADD
|
|
|
|
C --Expand alias to "var, var, ..."
|
|
|
|
NAMENT(NENT) = NAMES(IXALI(1,IALI))
|
|
IX = NENT
|
|
ISYM = INDEX (OPSYM, ',')
|
|
|
|
DO 170 I = 2, NALI
|
|
NENT = NENT + 1
|
|
C --Mark comma as alias comma
|
|
NAMENT(NENT) = ',.ALIAS.'
|
|
TYPENT(NENT) = 'O'
|
|
INXENT(NENT) = ISYM
|
|
VALENT(NENT) = -999
|
|
ITMENT(NENT) = -999
|
|
NENT = NENT + 1
|
|
NAMENT(NENT) = NAMES(IXALI(I,IALI))
|
|
TYPENT(NENT) = TYPENT(IX)
|
|
INXENT(NENT) = INXENT(IX)
|
|
VALENT(NENT) = VALENT(IX)
|
|
ITMENT(NENT) = ITMENT(IX)
|
|
170 CONTINUE
|
|
END IF
|
|
END IF
|
|
GOTO 150
|
|
END IF
|
|
|
|
C --Check that the first entry is a variable
|
|
|
|
IF (TYPENT(1) .NE. 'V') THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'The assigned variable is not specified')
|
|
END IF
|
|
|
|
C --Check for proper '='
|
|
|
|
NES = 0
|
|
C --NES - the number of equal signs
|
|
|
|
DO 180 NENT = 1, NUMENT
|
|
IF (TYPENT(NENT) .EQ. 'O') THEN
|
|
IF (NAMENT(NENT) .EQ. '=') NES = NES + 1
|
|
END IF
|
|
180 CONTINUE
|
|
|
|
IF (NES .EQ. 1) THEN
|
|
IF (NAMENT(2) .NE. '=') THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', 'The "=" is misplaced')
|
|
END IF
|
|
ELSE IF (NES .LT. 1) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', 'The "=" is missing')
|
|
ELSE IF (NES .GT. 1) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', 'Extra "=" found')
|
|
END IF
|
|
|
|
C --Check for matched parenthesis, and mark the "level" on parenthesis
|
|
C --and commas
|
|
|
|
NPERR = 0
|
|
C --NPERR - set if too many right parenthesis at any time
|
|
NP = 0
|
|
C --NP - the number of parenthesis outstanding (+left, -right)
|
|
|
|
DO 190 NENT = 1, NUMENT
|
|
IF (TYPENT(NENT) .EQ. 'O') THEN
|
|
ENT = NAMENT(NENT)(1:1)
|
|
IF (ENT .EQ. '(') THEN
|
|
NP = NP + 1
|
|
ITMENT(NENT) = NP
|
|
ELSE IF (ENT .EQ. ')') THEN
|
|
ITMENT(NENT) = NP
|
|
NP = NP - 1
|
|
IF (NP .LT. 0) NPERR = NPERR + 1
|
|
ELSE IF (ENT .EQ. ',') THEN
|
|
ITMENT(NENT) = NP
|
|
C --Mark comma
|
|
IF (NAMENT(NENT) .EQ. ',') NAMENT(NENT) = ',.MARK.'
|
|
END IF
|
|
END IF
|
|
190 CONTINUE
|
|
|
|
IF ((NP .NE. 0) .OR. (NPERR .GT. 0)) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC', 'Parenthesis do not balance')
|
|
END IF
|
|
|
|
C --Check the number of parameters for all functions
|
|
|
|
DO 210 NENT = 1, NUMENT
|
|
|
|
IF (TYPENT(NENT) .EQ. 'F') THEN
|
|
|
|
IE = NENT + 1
|
|
IF (NAMENT(IE) .EQ. '(') THEN
|
|
NPFND = 1
|
|
C --NPFND - the number of parameters given for the function
|
|
NLEVEL = ITMENT(IE)
|
|
C --NLEVEL - the parenthesis level for the function
|
|
NOTDON = .TRUE.
|
|
|
|
200 CONTINUE
|
|
IF ((IE .LT. NUMENT) .AND. NOTDON) THEN
|
|
IE = IE + 1
|
|
IF (TYPENT(IE) .EQ. 'O') THEN
|
|
ENT = NAMENT(IE)(1:1)
|
|
IF (ENT .EQ. ')') THEN
|
|
IF (ITMENT(IE) .EQ. NLEVEL) NOTDON = .FALSE.
|
|
ELSE IF (ENT .EQ. ',') THEN
|
|
IF (ITMENT(IE) .EQ. NLEVEL) THEN
|
|
C --Parameter divider, count it and mark it
|
|
NPFND = NPFND + 1
|
|
NAMENT(IE) = ','
|
|
END IF
|
|
END IF
|
|
END IF
|
|
GOTO 200
|
|
END IF
|
|
|
|
ELSE
|
|
NPFND = 0
|
|
END IF
|
|
|
|
C --Set number of parameters for function if may vary
|
|
IF (VALENT(NENT) .LT. 0) VALENT(NENT) = NPFND
|
|
|
|
IF (NPFND .NE. VALENT(NENT)) THEN
|
|
NERR = NERR + 1
|
|
ENT = NAMENT(NENT)
|
|
NPEXP = VALENT(NENT)
|
|
CALL INTSTR (1, 0, NPEXP, STRA, LSTRA)
|
|
CALL PRTERR ('CMDSPEC', 'Expected ' // STRA(:LSTRA)
|
|
& // ' parameter(s) for function ' // ENT(:LENSTR(ENT)))
|
|
VALENT(NENT) = NPFND
|
|
END IF
|
|
END IF
|
|
|
|
210 CONTINUE
|
|
|
|
C --Check for non-parameter comma and reset scratch "level" and name
|
|
C --on operators
|
|
|
|
DO 230 NENT = 1, NUMENT
|
|
|
|
IF (TYPENT(NENT) .EQ. 'O') THEN
|
|
|
|
ITMENT(NENT) = -999
|
|
|
|
IF (NAMENT(NENT) .EQ. ',.ALIAS.') THEN
|
|
NERR = NERR + 1
|
|
ENT = NAMENT(NENT-1)
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'Invalid alias expansion starting with "'
|
|
& // ENT(:LENSTR(ENT)) // '"')
|
|
|
|
C --Wipe out commas for this alias to prevent repeated errors
|
|
IE = NENT
|
|
220 CONTINUE
|
|
IF (NAMENT(IE) .EQ. ',.ALIAS.') THEN
|
|
NAMENT(IE) = ','
|
|
IE = IE + 2
|
|
GOTO 220
|
|
END IF
|
|
|
|
ELSE IF (NAMENT(NENT) .EQ. ',.MARK.') THEN
|
|
NERR = NERR + 1
|
|
ENT = NAMENT(NENT+1)
|
|
CALL PRTERR ('CMDSPEC', 'Invalid "," before "'
|
|
& // ENT(:LENSTR(ENT)) // '"')
|
|
NAMENT(NENT) = ','
|
|
END IF
|
|
END IF
|
|
|
|
230 CONTINUE
|
|
|
|
C --Check for consecutive variables or operators, etc.
|
|
|
|
DO 240 NENT = 2, NUMENT
|
|
|
|
LSTENT = NAMENT(NENT-1)
|
|
ENT = NAMENT(NENT)
|
|
LSTTYP = TYPENT(NENT-1)
|
|
C --Set up a special type for ")" to prevent special checks
|
|
IF ((LSTTYP .EQ. 'O') .AND. (LSTENT .EQ. ')')) LSTTYP = ')'
|
|
|
|
IF (TYPENT(NENT) .EQ. 'O') THEN
|
|
IF (ENT .EQ. '(') THEN
|
|
IF ((LSTTYP .EQ. 'C') .OR. (LSTTYP .EQ. ')')) THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'Consecutive "' // LSTENT(:LENSTR(LSTENT))
|
|
& // '" and "' // ENT(:LENSTR(ENT)) // '" found')
|
|
END IF
|
|
ELSE IF (ENT .NE. '~') THEN
|
|
IF (LSTTYP .EQ. 'O') THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'Consecutive "' // LSTENT(:LENSTR(LSTENT))
|
|
& // '" and "' // ENT(:LENSTR(ENT)) // '" found')
|
|
END IF
|
|
END IF
|
|
|
|
ELSE
|
|
IF (LSTTYP .NE. 'O') THEN
|
|
NERR = NERR + 1
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'Consecutive "' // LSTENT(:LENSTR(LSTENT))
|
|
& // '" and "' // ENT(:LENSTR(ENT)) // '" found')
|
|
END IF
|
|
END IF
|
|
240 CONTINUE
|
|
|
|
IF ((TYPENT(NUMENT) .EQ. 'O')
|
|
& .AND. (NAMENT(NUMENT) .NE. ')')) THEN
|
|
NERR = NERR + 1
|
|
ENT = NAMENT(NUMENT)
|
|
CALL PRTERR ('CMDSPEC',
|
|
& 'Ending "' // ENT(:LENSTR(ENT)) // '" found')
|
|
END IF
|
|
|
|
RETURN
|
|
END
|
|
|
|
subroutine infunc(nparm, fncold, fncnew)
|
|
|
|
C This subroutine was created in order to initialize parameters
|
|
C that are in named common blocks. The reason these variables
|
|
C are set in the most labor intensive manner is that the
|
|
C current fortran compiler on the SGI does not seem to recognize
|
|
C BLOCK DATA files.
|
|
|
|
include 'exodusII.inc'
|
|
include 'ag_fnctbc.blk'
|
|
|
|
C PARAMETER (MAXFNC=50)
|
|
C PARAMETER (NUMFNC=39)
|
|
C --MAXFNC - the number of defined functions
|
|
C COMMON /FNCTBC/ FNCNAM(MAXFNC), FNCTYP(MAXFNC)
|
|
C COMMON /FNCTBL/ FNCSTO(MAXFNC)
|
|
C CHARACTER*8 FNCNAM
|
|
C CHARACTER FNCTYP
|
|
C LOGICAL FNCSTO
|
|
C -- Assigned (by DATA) in CHKALG
|
|
C --FNCNAM - the ordered function names, order is used to determine
|
|
C -- the function INXENT
|
|
C --FNCTYP(i) - the type of function i; ' ' for type determined by
|
|
C -- parameters
|
|
C --FNCSTO(i) - true iff function i needs storage (a time fC)
|
|
C --FNCSTO(i) - true iff function i needs storage (a time function)
|
|
|
|
integer nparm(numfnc)
|
|
character*(MXSTLN) fncold(10), fncnew(10)
|
|
|
|
C 1 2 3
|
|
C 12345678901234567890123456789012
|
|
FNCNAM(1) = 'AINT '
|
|
FNCNAM(2) = 'ANINT '
|
|
FNCNAM(3) = 'ABS '
|
|
FNCNAM(4) = 'MOD '
|
|
FNCNAM(5) = 'SIGN '
|
|
FNCNAM(6) = 'DIM '
|
|
FNCNAM(7) = 'MAX '
|
|
FNCNAM(8) = 'MIN '
|
|
FNCNAM(9) = 'SQRT '
|
|
FNCNAM(10) = 'EXP '
|
|
FNCNAM(11) = 'LOG '
|
|
FNCNAM(12) = 'LOG10 '
|
|
FNCNAM(13) = 'SIN '
|
|
FNCNAM(14) = 'COS '
|
|
FNCNAM(15) = 'TAN '
|
|
FNCNAM(16) = 'ASIN '
|
|
FNCNAM(17) = 'ACOS '
|
|
FNCNAM(18) = 'ATAN '
|
|
FNCNAM(19) = 'ATAN2 '
|
|
FNCNAM(20) = 'SINH '
|
|
FNCNAM(21) = 'COSH '
|
|
FNCNAM(22) = 'TANH '
|
|
FNCNAM(23) = 'TMAG '
|
|
FNCNAM(24) = 'PMAX '
|
|
FNCNAM(25) = 'PMIN '
|
|
FNCNAM(26) = 'PMAX2 '
|
|
FNCNAM(27) = 'PMIN2 '
|
|
FNCNAM(28) = 'IFLZ '
|
|
FNCNAM(29) = 'IFEZ '
|
|
FNCNAM(30) = 'IFGZ '
|
|
FNCNAM(31) = 'SUM '
|
|
FNCNAM(32) = 'SMAX '
|
|
FNCNAM(33) = 'SMIN '
|
|
FNCNAM(34) = 'ENVMAX '
|
|
FNCNAM(35) = 'ENVMIN '
|
|
FNCNAM(36) = 'UHIST '
|
|
FNCNAM(37) = 'UGLOB '
|
|
FNCNAM(38) = 'UNODE '
|
|
FNCNAM(39) = 'UELEM '
|
|
|
|
NPARM(1) = 1
|
|
NPARM(2) = 1
|
|
NPARM(3) = 1
|
|
NPARM(4) = 2
|
|
NPARM(5) = 2
|
|
NPARM(6) = 2
|
|
NPARM(7) = -1
|
|
NPARM(8) = -1
|
|
NPARM(9) = 1
|
|
NPARM(10) = 1
|
|
NPARM(11) = 1
|
|
NPARM(12) = 1
|
|
NPARM(13) = 1
|
|
NPARM(14) = 1
|
|
NPARM(15) = 1
|
|
NPARM(16) = 1
|
|
NPARM(17) = 1
|
|
NPARM(18) = 1
|
|
NPARM(19) = 2
|
|
NPARM(20) = 1
|
|
NPARM(21) = 1
|
|
NPARM(22) = 1
|
|
NPARM(23) = 6
|
|
NPARM(24) = 6
|
|
NPARM(25) = 6
|
|
NPARM(26) = 3
|
|
NPARM(27) = 3
|
|
NPARM(28) = 3
|
|
NPARM(29) = 3
|
|
NPARM(30) = 3
|
|
NPARM(31) = 1
|
|
NPARM(32) = 1
|
|
NPARM(33) = 1
|
|
NPARM(34) = 1
|
|
NPARM(35) = 1
|
|
NPARM(36) = -1
|
|
NPARM(37) = -1
|
|
NPARM(38) = -1
|
|
NPARM(39) = -1
|
|
|
|
do 100 i = 1, NUMFNC
|
|
fnctyp(i) = ' '
|
|
100 continue
|
|
FNCTYP(31) = 'G'
|
|
FNCTYP(32) = 'G'
|
|
FNCTYP(33) = 'G'
|
|
FNCTYP(36) = 'H'
|
|
FNCTYP(37) = 'G'
|
|
FNCTYP(38) = 'N'
|
|
FNCTYP(39) = 'E'
|
|
|
|
do 110 i = 1, NUMFNC
|
|
fncsto(i) = .FALSE.
|
|
110 continue
|
|
FNCSTO(32) = .TRUE.
|
|
FNCSTO(33) = .TRUE.
|
|
FNCSTO(34) = .TRUE.
|
|
FNCSTO(35) = .TRUE.
|
|
|
|
FNCOLD(1) = 'ATN2 '
|
|
FNCOLD(2) = 'PMX2 '
|
|
FNCOLD(3) = 'PMN2 '
|
|
FNCOLD(4) = ' '
|
|
|
|
FNCNEW(1) = 'ATAN2 '
|
|
FNCNEW(2) = 'PMAX2 '
|
|
FNCNEW(3) = 'PMIN2 '
|
|
FNCNEW(4) = ' '
|
|
|
|
return
|
|
end
|
|
|