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.
2380 lines
84 KiB
2380 lines
84 KiB
C Copyright(C) 1999-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
|
|
|
|
C -*- Mode: fortran -*-
|
|
C=======================================================================
|
|
SUBROUTINE COMAND (NDBIN, EXECUT,
|
|
& IDELB, NUMELB, NUMLNK, NUMATR,
|
|
& IDNPS, NNNPS, NDNPS, IXNNPS, IXDNPS,
|
|
$ LTNNPS, FACNPS,
|
|
& IDESS, NEESS, NNESS, IXEESS, IXNESS,
|
|
$ LTEESS, LTSESS, FACESS,
|
|
& XN, YN, ZN, XEXPL, YEXPL, ZEXPL, MODBLK,
|
|
* ISATRB, ATRSCL, IEQUIV, MAPNOD, MAPEL,
|
|
$ IELBST, INPSST, IESSST,
|
|
* NQAREC, QAREC, NINFO, INFREC, BLKTYP,
|
|
* ebname, nsname, ssname, atname,
|
|
* namegv, nvargl, namenv, nvarnp, nameev, nvarel,
|
|
* namemv, nvarns, namesv, nvarss, INOD2EL,
|
|
* SWPSS, SMOOTH, USRSUB, CENTRD,
|
|
& NSTEPS, TIMES, ITIMST, A, IA, *)
|
|
#if defined(__INTEL_COMPILER) && (__INTEL_COMPILER == 1300)
|
|
cDEC$ OPTIMIZE:2
|
|
#endif
|
|
C=======================================================================
|
|
|
|
C --*** COMAND *** (GREPOS) Input and process commands
|
|
C -- Written by Amy Gilkey - revised 05/09/88
|
|
C -- Modified by Greg Sjaardema - 02/06/89
|
|
C --
|
|
C --COMAND inputs and executes an user command.
|
|
C --
|
|
C --Parameters:
|
|
C -- IDNPS - IN - the IDs of existing node sets
|
|
C -- IDESS - IN - the IDs of existing side sets
|
|
C -- IBPARM - IN - the block parameters (defined by the block type)
|
|
C -- IDELB - IN - the ids for each block
|
|
C -- NUMELB - IN - the number of elements for each block
|
|
C -- NUMLNK - IN - the number of nodes per element for each block
|
|
C -- XN, YN, ZN - IN - the nodal coordinates
|
|
C -- XEXPL, YEXPL, ZEXPL - IN - the offsets if EXPLODE option
|
|
C -- * - return statement for QUIT
|
|
C --
|
|
C --Common Variables:
|
|
C -- Sets NDIM, NUMNP, NUMEL, NELBLK,
|
|
C -- NUMNPS, LNPSNL, NUMESS, LESSEL, LESSNL of /DBNUMS/
|
|
C -- Sets DOTRAN, NNREPL, NEREPL, DIM3, NRTRAN, D3TRAN, ZGRAD,
|
|
C -- CENTER, NUMCOL of /PARAMS/
|
|
C -- Sets XOFFS, YOFFS, ZOFFS of /XYZOFF/
|
|
C -- Sets ROT3D, ROTMAT, ROTCEN of /XYZROT/
|
|
|
|
PARAMETER (MAXFLD = 64)
|
|
|
|
include 'gp_params.blk'
|
|
include 'gp_namlen.blk'
|
|
include 'gp_dbnums.blk'
|
|
include 'gp_dbtitl.blk'
|
|
include 'gp_xyzoff.blk'
|
|
include 'gp_xyzrot.blk'
|
|
include 'gp_xyzmir.blk'
|
|
include 'gp_xyzero.blk'
|
|
include 'gp_xyzscl.blk'
|
|
include 'gp_xyzwrp.blk'
|
|
include 'gp_nsset.blk'
|
|
include 'gp_splxyz.blk'
|
|
include 'gp_smooth.blk'
|
|
include 'gp_snap.blk'
|
|
include 'gp_deform.blk'
|
|
include 'gp_combine.blk'
|
|
include 'gp_attrot.blk'
|
|
|
|
INTEGER IDELB(*)
|
|
INTEGER NUMELB(*)
|
|
INTEGER NUMLNK(*)
|
|
INTEGER NUMATR(*)
|
|
INTEGER IELBST(*), INPSST(*), IESSST(*), ITIMST(*)
|
|
INTEGER IEQUIV(*), MAPNOD(*), MAPEL(*)
|
|
|
|
logical glonod, absolute
|
|
|
|
INTEGER IDNPS(*), NNNPS(*), NDNPS(*), IXNNPS(*),
|
|
$ IXDNPS(*), LTNNPS(*)
|
|
REAL FACNPS(*)
|
|
|
|
INTEGER IDESS(*), NEESS(*), NNESS(*), IXEESS(*), IXNESS(*)
|
|
INTEGER LTEESS(*), LTSESS(*)
|
|
REAL FACESS(*)
|
|
REAL TIMES(*)
|
|
|
|
REAL XN(*), YN(*), ZN(*)
|
|
REAL XEXPL(*), YEXPL(*), ZEXPL(*)
|
|
REAL ATRSCL(2,*)
|
|
REAL A(*)
|
|
INTEGER IA(*)
|
|
|
|
LOGICAL FFEXST, MATSTR, HELP
|
|
|
|
CHARACTER*(256) STRING
|
|
CHARACTER*(mxlnln) INFREC(*)
|
|
CHARACTER*(mxstln) QAREC(4,*)
|
|
CHARACTER*(mxstln) BLKTYP(*)
|
|
character*(maxnam) ebname(*), nsname(*), ssname(*),
|
|
* namenv(*), nameev(*), namemv(*), namegv(*), namesv(*), ATNAME(*)
|
|
|
|
INTEGER INOD2EL(*)
|
|
CHARACTER*(256) CTEMP
|
|
CHARACTER*8 STRA
|
|
CHARACTER*1 ITYPE
|
|
CHARACTER*(128) WORD, VERB, LISTYP, WORD2, NEWNM, OLDNM
|
|
INTEGER INTYP(MAXFLD+1)
|
|
CHARACTER*(128) CFIELD(MAXFLD)
|
|
INTEGER IFIELD(MAXFLD)
|
|
REAL RFIELD(MAXFLD)
|
|
LOGICAL ISHELP, DELOK, SMOOTH
|
|
LOGICAL SWPSS, USRSUB, EXECUT, CENTRD
|
|
LOGICAL DOALLA, DOALLB, ISATRB, ATRWRN
|
|
|
|
INTEGER IRNG(3)
|
|
|
|
REAL RNUM(9)
|
|
CHARACTER*20 RSTR(9)
|
|
|
|
LOGICAL FIRST
|
|
SAVE FIRST
|
|
|
|
CHARACTER*(mxstln) MYNAME
|
|
CHARACTER*(mxstln) CMDTBL(41), LISTBL(15)
|
|
SAVE CMDTBL, LISTBL
|
|
C --CMDTBL - the valid commands table
|
|
|
|
C --Command table follows. Remember to change the dimensioned size when
|
|
C --changing the table.
|
|
DATA CMDTBL /
|
|
1 'OFFSET ', 'REVOLVE ', 'REVCEN ', 'MIRROR ', 'NAME ',
|
|
2 'LIST ', 'SHOW ', 'HELP ', 'ZERO ', 'RENAME ',
|
|
3 'END ', 'EXIT ', 'QUIT ', 'SCALE ',
|
|
4 'CHANGE ', 'DELETE ', 'EXPLODE ', 'SHIFT ',
|
|
5 'INCREMENT', 'LIMITS ', 'ADJUST ', 'RANDOMIZE',
|
|
6 'SMOOTH ', 'SWAP ', 'USERSUBROUTINE', 'SNAP ',
|
|
7 'MOVE ', 'WARP ', 'EXECUTE ', 'COMBINE ', 'CENTROIDS',
|
|
8 'UNDELETE', 'KEEP ', 'EQUIVALENCE', 'DEFORM ',
|
|
9 'ELEMENTIZE','ROTATE ', 'MERGE ', 'TMIN ', 'TMAX ',
|
|
$ ' ' /
|
|
|
|
DATA LISTBL /
|
|
* 'SSETS ', 'SIDESETS', 'NSETS ', 'NODESETS', 'VARS ',
|
|
* 'VARIABLE', 'BLOCKS ', 'MATERIAL', 'COMMANDS', 'INFORMATION',
|
|
* 'QA ', 'TIMES ', 'STEPS ', 'NAMES ', ' '/
|
|
|
|
DATA MYNAME /'GREPOS'/
|
|
DATA FIRST /.TRUE./
|
|
C --Initialize
|
|
|
|
EXECUT = .FALSE.
|
|
|
|
LNAM = LENSTR(MYNAME)
|
|
MBLK = MAX(NELBLK, NUMNPS)
|
|
CALL INIREA ( MBLK, 0.0, XEXPL)
|
|
CALL INIREA ( MBLK, 0.0, YEXPL)
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL INIREA ( MBLK, 0.0, ZEXPL)
|
|
END IF
|
|
|
|
CALL INIINT(NVARNP, 0, INOD2EL)
|
|
|
|
C...Initialize attribute rotation
|
|
REVATT = .FALSE.
|
|
ROTALL = .FALSE.
|
|
ROTTYP = .FALSE.
|
|
ATTIND = -1
|
|
ATTBLK = -1
|
|
ROTBLK = "NONE"
|
|
CALL INIREA (3*3, 0.0, ROTATT)
|
|
DO I = 1, 3
|
|
ROTATT(I,I) = 1.0
|
|
END DO
|
|
|
|
C...Initialize attribute scaling
|
|
ATRWRN = .FALSE.
|
|
CALL SCLATR(NELBLK, IDELB, NUMATR, 0, .TRUE., 0, .TRUE., 1.0,
|
|
* ATRSCL, .FALSE., .TRUE.)
|
|
|
|
if (FIRST) then
|
|
C... Initialization code that should only be executed once
|
|
|
|
C... Node equivalencing
|
|
equiv = .FALSE.
|
|
eqtoler = -1.0
|
|
do i=1, numnp
|
|
iequiv(i) = i
|
|
end do
|
|
|
|
C... Initialize Material, NodeSet, SideSet status
|
|
C -- 0 = same
|
|
C -- - = delete
|
|
C -- n = combine with entity n
|
|
do 10 i=1, nelblk
|
|
ielbst(i) = 0
|
|
10 continue
|
|
do 20 i=1, numnps
|
|
inpsst(i) = 0
|
|
20 continue
|
|
do 30 i=1, numess
|
|
iessst(i) = 0
|
|
30 continue
|
|
do 40 i=1, nsteps
|
|
itimst(i) = 0
|
|
40 continue
|
|
first = .false.
|
|
end if
|
|
C...Initialize transformation variables
|
|
ADJTYP = 0
|
|
XOFFS = 0.0
|
|
YOFFS = 0.0
|
|
ZOFFS = 0.0
|
|
XMIRR = 1.0
|
|
YMIRR = 1.0
|
|
ZMIRR = 1.0
|
|
XZERO = 0.0
|
|
YZERO = 0.0
|
|
ZZERO = 0.0
|
|
XSCAL = 1.0
|
|
YSCAL = 1.0
|
|
ZSCAL = 1.0
|
|
XRAND = 0.0
|
|
YRAND = 0.0
|
|
ZRAND = 0.0
|
|
|
|
IWARP = 0
|
|
MODBLK = 0
|
|
IDEFST = 0
|
|
|
|
SPLOFF = .FALSE.
|
|
SWPSS = .FALSE.
|
|
SMOOTH = .FALSE.
|
|
USRSUB = .FALSE.
|
|
CENTRD = .FALSE.
|
|
|
|
ROT3D = .FALSE.
|
|
CALL INIREA (3*3, 0.0, ROTMAT)
|
|
DO 100 I = 1, 3
|
|
ROTMAT(I,I) = 1.0
|
|
100 CONTINUE
|
|
|
|
CALL MINMAX (NUMNP, XN, XMIN, XMAX)
|
|
ROTCEN(1) = XMIN
|
|
CALL MINMAX (NUMNP, YN, YMIN, YMAX)
|
|
ROTCEN(2) = YMIN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL MINMAX (NUMNP, ZN, ZMIN, ZMAX)
|
|
ROTCEN(3) = ZMIN
|
|
ELSE
|
|
ROTCEN(3) = 0.0
|
|
END IF
|
|
|
|
C ... Initialize SNAP variables
|
|
numsnp = 0
|
|
|
|
110 CONTINUE
|
|
|
|
C --Read command line
|
|
|
|
WRITE (*, *)
|
|
CALL FREFLD (0, 0, 'GREPOS> ', MAXFLD,
|
|
& IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
IF (IOSTAT .LT. 0) GOTO 430
|
|
IF (NUMFLD .EQ. 0) GOTO 110
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
if (numfld .gt. maxfld) then
|
|
write (string, 1) numfld, maxfld
|
|
1 format('There were ',i3, ' words entered on the command line,'
|
|
$ ' but only ',i3,' are allowed.')
|
|
CALL PRTERR ('WARNING', STRING(:LENSTR(STRING)))
|
|
CALL PRTERR ('CMDSPEC',
|
|
$ ' Please enter the command on two or more lines')
|
|
CALL PRTERR ('CMDSPEC',' ')
|
|
end if
|
|
|
|
IFLD = 1
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL ABRSTR (VERB, WORD, CMDTBL)
|
|
IF (VERB .EQ. ' ') VERB = WORD
|
|
|
|
C --Perform command
|
|
|
|
IF (VERB .EQ. '?') THEN
|
|
CALL SHOCMD ('COMMANDS', CMDTBL)
|
|
VERB = ' '
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'OFFSET' .OR. VERB .EQ. 'SHIFT') THEN
|
|
|
|
C ... Originally offset just asked for NDIM values. It was changed
|
|
C to go by axis type (OFFSET Y 1.0). We do maintain compatibility
|
|
C and check for both types of input.
|
|
|
|
RMULT = 0.0
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
120 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'SPLINE', 1)) THEN
|
|
SPLOFF = .TRUE.
|
|
CALL GETSPL(A)
|
|
ELSE IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XOFFS = 0.0
|
|
YOFFS = 0.0
|
|
ZOFFS = 0.0
|
|
RMULT = 0.0
|
|
ELSE IF (MATSTR (WORD, 'ADD', 2)) THEN
|
|
C ... Set for cumulative offsets/shifts
|
|
RMULT = 1.0
|
|
ELSE IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'model offset', 0.0, TOFFS, *130)
|
|
XOFFS = RMULT * XOFFS + TOFFS
|
|
YOFFS = RMULT * YOFFS + TOFFS
|
|
ZOFFS = RMULT * ZOFFS + TOFFS
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X coordinate offset', 0.0, TOFFS, *130)
|
|
XOFFS = RMULT * XOFFS + TOFFS
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y coordinate offset', 0.0, TOFFS, *130)
|
|
YOFFS = RMULT * YOFFS + TOFFS
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z coordinate offset', 0.0, TOFFS, *130)
|
|
ZOFFS = RMULT * ZOFFS + TOFFS
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z allowed for 3D database only')
|
|
END IF
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z", "ALL", "ADD", or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "ALL", "ADD", or "RESET"')
|
|
GOTO 130
|
|
END IF
|
|
GOTO 120
|
|
END IF
|
|
ELSE
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X coordinate offset', XOFFS, XOFFS, *130)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y coordinate offset', YOFFS, YOFFS, *130)
|
|
IF (NDIM .EQ. 3) CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z coordinate offset', ZOFFS, ZOFFS, *130)
|
|
END IF
|
|
130 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'ADJUST') THEN
|
|
C... ADJUST {CENTER|MINIMUM|MAXIMUM} {X|Y|Z} adjustment
|
|
C... ADJUST {MINIMUM|MAXIMUM} {X|Y|Z} adjustment
|
|
|
|
C... Calculate offset such that the value in the generated mesh
|
|
C (ignoring any other offsets, scales, or rotations)
|
|
C will equal the input value.
|
|
|
|
C...EXAMPLE:adjust maximum x 10
|
|
C will set the maximum x in the generated mesh equal to 10.
|
|
|
|
140 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR(WORD, 'MAXIMUM', 3)) THEN
|
|
ADJTYP = 1
|
|
ELSE IF (MATSTR(WORD, 'MINIMUM', 3)) THEN
|
|
ADJTYP = 2
|
|
ELSE IF (MATSTR(WORD, 'CENTER', 3)) THEN
|
|
ADJTYP = 3
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Expected "MINIMUM", "MAXIMUM", or "CENTER"')
|
|
GO TO 150
|
|
END IF
|
|
END IF
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X adjustment', 0.0, TOFFS, *150)
|
|
IF (ADJTYP .EQ. 1) THEN
|
|
XOFFS = TOFFS - XMAX
|
|
ELSE IF (ADJTYP .EQ. 2) THEN
|
|
XOFFS = TOFFS - XMIN
|
|
ELSE IF (ADJTYP .EQ. 3) THEN
|
|
XOFFS = TOFFS - (XMAX+XMIN)/2.0
|
|
END IF
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y adjustment', 0.0, TOFFS, *150)
|
|
IF (ADJTYP .EQ. 1) THEN
|
|
YOFFS = TOFFS - YMAX
|
|
ELSE IF (ADJTYP .EQ. 2) THEN
|
|
YOFFS = TOFFS - YMIN
|
|
ELSE IF (ADJTYP .EQ. 3) THEN
|
|
YOFFS = TOFFS - (YMAX+YMIN)/2.0
|
|
END IF
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z adjustment', 0.0, TOFFS, *150)
|
|
IF (ADJTYP .EQ. 1) THEN
|
|
ZOFFS = TOFFS - ZMAX
|
|
ELSE IF (ADJTYP .EQ. 2) THEN
|
|
ZOFFS = TOFFS - ZMIN
|
|
ELSE IF (ADJTYP .EQ. 3) THEN
|
|
ZOFFS = TOFFS - (ZMAX+ZMIN)/2.0
|
|
END IF
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z allowed for 3D database only')
|
|
END IF
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", or "Z"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X" or "Y"')
|
|
GOTO 150
|
|
END IF
|
|
GOTO 140
|
|
END IF
|
|
150 CONTINUE
|
|
VERB = 'OFFSET'
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'LIMITS') THEN
|
|
call limits('Input Mesh Limits:', ndim,
|
|
& xmin, xmax, ymin, ymax, zmin, zmax)
|
|
VERB = ' '
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'EXPLODE') THEN
|
|
DO 170 IBLK = 1, NELBLK
|
|
WRITE (CTEMP, 10010) 'Offset for Material ', idelb(iblk),' > '
|
|
10010 FORMAT (1X, A, I10, A)
|
|
CALL SQZSTR (CTEMP, LSTR)
|
|
|
|
CALL FREFLD (0, 0, CTEMP(:LENSTR(CTEMP)+1), MAXFLD,
|
|
& IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
IF (IOSTAT .LT. 0) GOTO 430
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
IFLD = 1
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, XEXPL(IBLK), *160)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, YEXPL(IBLK), *160)
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, ZEXPL(IBLK), *160)
|
|
END IF
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
MODBLK = 1
|
|
VERB = ' '
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'ZERO') THEN
|
|
180 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XZERO = 0.0
|
|
YZERO = 0.0
|
|
ZZERO = 0.0
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'minimum X coordinate', 0.0, XZERO, *190)
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'minimum Y coordinate', 0.0, YZERO, *190)
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'minimum Z coordinate', 0.0, ZZERO, *190)
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z allowed for 3D database only')
|
|
END IF
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z" or "RESET"')
|
|
GOTO 190
|
|
END IF
|
|
GOTO 180
|
|
END IF
|
|
|
|
190 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'SCALE') THEN
|
|
200 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
|
|
IF (.NOT. MATSTR(WORD, 'ATTRIBUTE', 2) .AND.
|
|
* ISATRB .AND. .NOT. ATRWRN) THEN
|
|
CALL PRTERR ('WARNING',
|
|
* 'Some element blocks have attributes which ' //
|
|
* 'may also need scaling.')
|
|
ATRWRN = .TRUE.
|
|
END IF
|
|
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XSCAL = 1.0
|
|
YSCAL = 1.0
|
|
ZSCAL = 1.0
|
|
|
|
ELSE IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'model scale factor', 1.0, TSCAL, *230)
|
|
XSCAL = XSCAL * ABS(TSCAL)
|
|
YSCAL = YSCAL * ABS(TSCAL)
|
|
ZSCAL = ZSCAL * ABS(TSCAL)
|
|
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X scale factor', 1.0, TSCAL, *230)
|
|
XSCAL = XSCAL * ABS(TSCAL)
|
|
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y scale factor', 1.0, TSCAL, *230)
|
|
YSCAL = YSCAL * ABS(TSCAL)
|
|
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z scale factor', 1.0, TSCAL, *230)
|
|
ZSCAL = ZSCAL * ABS(TSCAL)
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z allowed for 3D database only')
|
|
END IF
|
|
|
|
ELSE IF (MATSTR(WORD, 'ATTRIBUTE', 2)) THEN
|
|
C ... SCALE ATTRIBUTE {num|ALL} BLOCK {id|ALL} scale
|
|
C ... SCALE ATTRIBUTE RESET
|
|
C ... See if next field is integer (id) or word ('all')
|
|
VERB = ' '
|
|
STRING = 'SCALE ATTRIBUTE {id|ALL} BLOCK {id|ALL} {scale}'
|
|
IF (.NOT. ISATRB) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
* 'There are no attributes on this database')
|
|
GO TO 230
|
|
END IF
|
|
|
|
ATRWRN = .TRUE.
|
|
DOALLA = .FALSE.
|
|
DOALLB = .FALSE.
|
|
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
DOALLA = .TRUE.
|
|
ELSE IF (MATSTR (WORD, 'RESET', 2)) THEN
|
|
CALL SCLATR(NELBLK, IDELB, NUMATR, 0, .TRUE., 0,
|
|
* .TRUE., 1.0, ATRSCL, .TRUE., .TRUE.)
|
|
GO TO 230
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 230
|
|
END IF
|
|
ELSE
|
|
C ... Field is Attribute number
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'attribute ID', 0, IDATR, *420)
|
|
END IF
|
|
|
|
C ... Next word should be 'BLOCK'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (.NOT.(MATSTR (WORD, 'BLOCK', 1))) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "BLOCK"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 230
|
|
END IF
|
|
C ... Now find block id or 'ALL'
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
DOALLB = .TRUE.
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 230
|
|
END IF
|
|
ELSE
|
|
C ... Field is Attribute number
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'block ID', 0, IDBLK, *420)
|
|
END IF
|
|
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
* 'attribute scale factor', 1.0, ASCALE, *230)
|
|
|
|
C ... Setup the scale and echo to the user
|
|
CALL SCLATR(NELBLK, IDELB, NUMATR, IDATR, DOALLA,
|
|
* IDBLK, DOALLB, ASCALE, ATRSCL, .TRUE., .TRUE.)
|
|
|
|
ELSE IF (MATSTR(WORD, 'BLOCK', 1)) THEN
|
|
DO 220 IBLK = 1, NELBLK
|
|
CALL INTSTR (1, 0, IDELB(IBLK), WORD, LW)
|
|
WRITE (CTEMP, 10020)
|
|
$ 'Scale factor for Material ', WORD(:LW),'> '
|
|
10020 FORMAT (1X, 3A)
|
|
CALL FREFLD (0, 0, CTEMP(:LENSTR(CTEMP)+1), MAXFLD,
|
|
& IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
IF (IOSTAT .LT. 0) GOTO 430
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
IFLD = 1
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, XEXPL(IBLK), *210)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, YEXPL(IBLK), *210)
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, ZEXPL(IBLK), *210)
|
|
END IF
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
MODBLK = 2
|
|
VERB = ' '
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z", "ALL", "ATTRIBUTE", or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "ALL", "ATTRIBUTE", or "RESET"')
|
|
GOTO 230
|
|
END IF
|
|
GOTO 200
|
|
END IF
|
|
|
|
230 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'DEFORM') THEN
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
IDEFST = 0
|
|
ELSE IF (WORD .EQ. 'STEP') THEN
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
& 'deform step', 0, IDEFST, *235)
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Expected "STEP", or "RESET"')
|
|
GOTO 235
|
|
END IF
|
|
END IF
|
|
|
|
235 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'RANDOMIZE') THEN
|
|
240 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XRAND = 0.0
|
|
YRAND = 0.0
|
|
ZRAND = 0.0
|
|
ELSE IF (MATSTR (WORD, 'ALL', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'model random factor', 0.0, TRAND, *270)
|
|
XRAND = ABS(TRAND)
|
|
YRAND = ABS(TRAND)
|
|
ZRAND = ABS(TRAND)
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X random factor', 0.0, TRAND, *270)
|
|
XRAND = ABS(TRAND)
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y random factor', 0.0, TRAND, *270)
|
|
YRAND = ABS(TRAND)
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z random factor', 0.0, TRAND, *270)
|
|
ZRAND = ABS(TRAND)
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z allowed for 3D database only')
|
|
END IF
|
|
ELSE IF (MATSTR(WORD, 'BLOCK', 1)) THEN
|
|
DO 260 IBLK = 1, NELBLK
|
|
CALL INTSTR (1, 0, IDELB(IBLK), WORD, LW)
|
|
WRITE (CTEMP, 10030)
|
|
$ 'Random factor for Material ', WORD(:LW),'> '
|
|
10030 FORMAT (1X, 3A)
|
|
CALL FREFLD (0, 0, CTEMP(:LENSTR(CTEMP)+1), MAXFLD,
|
|
& IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
IF (IOSTAT .LT. 0) GOTO 430
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
IFLD = 1
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, XEXPL(IBLK), *250)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, YEXPL(IBLK), *250)
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, ZEXPL(IBLK), *250)
|
|
END IF
|
|
250 CONTINUE
|
|
260 CONTINUE
|
|
MODBLK = 3
|
|
VERB = ' '
|
|
ELSE IF (MATSTR(WORD,'NODESETS',3) .OR.
|
|
$ MATSTR(WORD,'NSETS', 3) ) THEN
|
|
DO 265 IBLK = 1, NUMNPS
|
|
CALL INTSTR (1, 0, IDNPS(IBLK), WORD, LW)
|
|
WRITE (CTEMP, 10030)
|
|
$ 'Random factors (x y z) for Nodeset ', WORD(:LW),'> '
|
|
CALL FREFLD (0, 0, CTEMP(:LENSTR(CTEMP)+1), MAXFLD,
|
|
& IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
IF (IOSTAT .LT. 0) GOTO 430
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
IFLD = 1
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, XEXPL(IBLK), *255)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, YEXPL(IBLK), *255)
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& CTEMP, 0.0, ZEXPL(IBLK), *255)
|
|
END IF
|
|
255 CONTINUE
|
|
265 CONTINUE
|
|
MODBLK = 4
|
|
VERB = ' '
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z", "ALL", or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "ALL", or "RESET"')
|
|
GOTO 270
|
|
END IF
|
|
GOTO 240
|
|
END IF
|
|
|
|
270 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'MIRROR') THEN
|
|
|
|
280 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XMIRR = 1.
|
|
YMIRR = 1.
|
|
ZMIRR = 1.
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
XMIRR = -1.
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
YMIRR = -1.
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
ZMIRR = -1.
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z not allowed for 2D database')
|
|
END IF
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z" or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", or "RESET"')
|
|
GOTO 290
|
|
END IF
|
|
GOTO 280
|
|
END IF
|
|
|
|
290 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'REVOLVE' .OR. VERB .EQ. 'ROTATE') THEN
|
|
DEGANG = ATAN2(0.0, -1.0) / 180.0
|
|
|
|
300 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
ROT3D = .FALSE.
|
|
CALL INIREA (3*3, 0.0, ROTMAT)
|
|
DO 310 I = 1, 3
|
|
ROTMAT(I,I) = 1.0
|
|
310 CONTINUE
|
|
ELSE IF (NDIM .EQ. 3 .AND.
|
|
* ((WORD .EQ. 'X') .OR. (WORD .EQ. 'Y')
|
|
& .OR. (WORD .EQ. 'Z')) ) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'angle of rotation', 0.0, DEG, *320)
|
|
ROT3D = .TRUE.
|
|
CALL ROTXYZ (WORD, DEG * DEGANG, ROTMAT)
|
|
ELSE IF (NDIM .EQ. 2 .AND. (WORD .EQ. 'Z') ) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'angle of rotation', 0.0, DEG, *320)
|
|
ROT3D = .TRUE.
|
|
CALL ROTXYZ (WORD, DEG * DEGANG, ROTMAT)
|
|
|
|
ELSE IF (MATSTR(WORD, 'ATTRIBUTE', 2)) THEN
|
|
C ... REVOLVE ATTRIBUTE {which} BLOCK {id|ALL} {x|y|z} {angle}
|
|
C ... REVOLVE ATTRIBUTE {which} TYPE {blk_type}
|
|
C ... REVOLVE ATTRIBUTE RESET
|
|
C ... Next field is integer (which)
|
|
VERB = ' '
|
|
STRING = 'REVOLVE/ROTATE ATTRIBUTE {index} BLOCK {id|ALL}'
|
|
IF (.NOT. ISATRB) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
* 'There are no attributes on this database')
|
|
GO TO 320
|
|
END IF
|
|
|
|
ROTALL = .FALSE.
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'HELP', 2)) THEN
|
|
CALL PRTERR('CMDREQ',
|
|
*'REVOLVE ATTRIBUTE {index} BLOCK {id|ALL} {X|Y|Z} {angle}')
|
|
CALL PRTERR('CMDREQ',
|
|
*'REVOLVE ATTRIBUTE {index} TYPE {type} {X|Y|Z} {angle}')
|
|
CALL PRTERR('CMDREQ',
|
|
*'REVOLVE ATTRIBUTE RESET')
|
|
ELSE IF (MATSTR (WORD, 'RESET', 2)) THEN
|
|
REVATT = .FALSE.
|
|
CALL INIREA (3*3, 0.0, ROTATT)
|
|
DO I = 1, 3
|
|
ROTATT(I,I) = 1.0
|
|
END DO
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "RESET"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 320
|
|
END IF
|
|
ELSE
|
|
C ... Field is Attribute index -- first of ndim attributes involed in revolve. 1-based
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'attribute index', 0, ATTIND, *420)
|
|
END IF
|
|
|
|
C ... Next word should be 'BLOCK'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF ((MATSTR (WORD, 'BLOCK', 1))) THEN
|
|
C ... Now find block id or 'ALL'
|
|
ROTTYP = .FALSE.
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
ROTALL = .TRUE.
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 320
|
|
END IF
|
|
ELSE
|
|
C ... Field is block id
|
|
ROTALL = .FALSE.
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'block ID', 0, ATTBLK, *420)
|
|
END IF
|
|
|
|
ELSE IF ((MATSTR (WORD, 'TYPE', 1))) THEN
|
|
ROTTYP = .TRUE.
|
|
C ... Now find block type
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', ROTBLK)
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "BLOCK" or "TYPE"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 320
|
|
END IF
|
|
339 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (NDIM .EQ. 3 .AND. ((WORD .EQ. 'X') .OR.
|
|
* (WORD .EQ. 'Y') .OR. (WORD .EQ. 'Z')) ) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'angle of rotation', 0.0, DEG, *320)
|
|
REVATT = .TRUE.
|
|
CALL ROTXYZ (WORD, DEG * DEGANG, ROTATT)
|
|
ELSE IF (NDIM .EQ. 2 .AND. (WORD .EQ. 'Z') ) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'angle of rotation', 0.0, DEG, *320)
|
|
REVATT = .TRUE.
|
|
CALL ROTXYZ (WORD, DEG * DEGANG, ROTATT)
|
|
END IF
|
|
GO TO 339
|
|
END IF
|
|
|
|
IF (REVATT) THEN
|
|
WRITE (*, 9940) 'Rotation matrix for selected attributes:'
|
|
DO I = 1, 3
|
|
IX = (I-1) * 3
|
|
DO J = 1, 3
|
|
RNUM(IX+J) = ROTATT(I,J)
|
|
END DO
|
|
END DO
|
|
CALL NUMSTR (9, 4, RNUM, RSTR, LR)
|
|
DO I = 1, 3
|
|
IX = (I-1) * 3
|
|
WRITE (*, 9940) (' ', RSTR(IX+J)(:LR), J=1,3)
|
|
9940 FORMAT (1X, 20A)
|
|
END DO
|
|
ELSE
|
|
WRITE (*, 9940) 'No rotation defined for generated mesh'
|
|
END IF
|
|
C ... End of "revolve attribute" parsing
|
|
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z", "ATTRIBUTE" or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "Z", "ATTRIBUTE" or "RESET"')
|
|
GOTO 320
|
|
END IF
|
|
GOTO 300
|
|
END IF
|
|
|
|
320 CONTINUE
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'REVCEN') THEN
|
|
CALL MINMAX (NUMNP, XN, XMIN, XMAX)
|
|
CALL MINMAX (NUMNP, YN, YMIN, YMAX)
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL MINMAX (NUMNP, ZN, ZMIN, ZMAX)
|
|
ELSE
|
|
ZMIN = 0.0
|
|
END IF
|
|
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X revolution center', XMIN, ROTCEN(1), *420)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y revolution center', YMIN, ROTCEN(2), *420)
|
|
IF (NDIM .EQ. 3) CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z revolution center', ZMIN, ROTCEN(3), *420)
|
|
IF (NDIM .EQ. 2) ROTCEN(3) = 0.0
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'LIST') THEN
|
|
CALL ABRSTR (LISTYP, CFIELD(2), LISTBL)
|
|
IF (CFIELD(2) .EQ. ' ') THEN
|
|
CALL SHOCMD ('Valid LIST options', LISTBL)
|
|
ELSE IF (LISTYP .EQ. ' ') THEN
|
|
CALL PRTERR ('CMDERR', '"' // CFIELD(2)(:LENSTR(CFIELD(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,IDESS,IA(KNESS),IA(KNDSS),SSNAME)
|
|
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, IDNPS, IA(KNNNS), IA(1), NSNAME)
|
|
END IF
|
|
ELSE IF (LISTYP .EQ.'VARS' .OR. LISTYP .EQ.'VARIABLE') THEN
|
|
CALL DBPINI ('TISV', NDBIN, TITLE, NDIM, NUMNP, NUMEL,
|
|
& NELBLK, NUMNPS, LNPSNL, LNPSNL, NUMESS, LESSEL, LESSDF,
|
|
* NVARGL, NVARNP, NVAREL, NVARNS, NVARSS, ' ')
|
|
ELSE IF (LISTYP .EQ.'BLOCKS' .OR. LISTYP .EQ.'MATERIAL') THEN
|
|
CALL DBPELB ('N', NELBLK, IDELB, NUMELB, NUMLNK, NUMATR,
|
|
& BLKTYP, EBNAME, ATNAME, IDUM, IDUM, IDUM, IDUM)
|
|
ELSE IF (LISTYP .EQ. 'COMMANDS') THEN
|
|
CALL SHOCMD ('COMMANDS', CMDTBL)
|
|
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. 'TIMES' .OR. LISTYP .EQ. 'STEPS') THEN
|
|
if (nsteps .eq. 0) then
|
|
CALL PRTERR ('CMDSPEC', 'No timesteps on database')
|
|
else
|
|
do 324 itim = 1, nsteps
|
|
if (itimst(itim) .eq. 0) then
|
|
STRA = ' Active'
|
|
else
|
|
STRA = 'Inactive'
|
|
end if
|
|
write (*, 10060) itim, times(itim), stra
|
|
10060 FORMAT( 'Step ', i6, ', Time = ', 1pe12.5,1x, A)
|
|
324 continue
|
|
end if
|
|
ELSE IF (LISTYP .EQ. 'NAMES') THEN
|
|
WRITE (*, 10070) 'Global: ', (NAMEGV(I), I=1,NVARGL)
|
|
WRITE (*, 10070) 'Nodal: ', (NAMENV(I), I=1,NVARNP)
|
|
WRITE (*, 10070) 'Element: ', (NAMEEV(I), I=1,NVAREL)
|
|
WRITE (*, 10070) 'Nodeset: ', (NAMEMV(I), I=1,NVARNS)
|
|
WRITE (*, 10070) 'Sideset: ', (NAMESV(I), I=1,NVARSS)
|
|
10070 FORMAT (4X, A, :, 2 (2X, A), :, /, (14X, 2 (2X, A)))
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // CFIELD(2)(:LENSTR(CFIELD(2)))
|
|
& // '" is an invalid or nonunique LIST option')
|
|
END IF
|
|
VERB = ' '
|
|
|
|
ELSE IF ((VERB .EQ. 'SHOW') .OR. (VERB .EQ. 'LIST')) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL ABRSTR (VERB, WORD, CMDTBL)
|
|
CALL SHOW (VERB, WORD)
|
|
VERB = ' '
|
|
|
|
C=======================================================================
|
|
C NAME BLOCK|SIDESET|SSET|NODESET|NSET id newname
|
|
C NAME ATTRIBUTE attindex BLOCK id newname
|
|
|
|
ELSE IF (VERB .EQ. 'NAME') THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
|
|
itype = ' '
|
|
IF (MATSTR(WORD, 'BLOCK', 2)) THEN
|
|
itype = 'B'
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',3) .OR.
|
|
$ MATSTR(WORD,'SSETS', 3) ) THEN
|
|
itype = 'S'
|
|
ELSE IF (MATSTR(WORD,'NODESETS',3) .OR.
|
|
$ MATSTR(WORD,'NSETS', 3) ) THEN
|
|
itype = 'N'
|
|
ELSE IF (MATSTR(WORD,'ATTRIBUTE',3)) THEN
|
|
itype = 'A'
|
|
END IF
|
|
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'entity ID', 0, IDOLD, *420)
|
|
if (itype .eq. 'A') then
|
|
C.. Skip over 'block' and get block id
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'block ID', 0, IDBLK, *420)
|
|
end if
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
if (itype .eq. 'B') then
|
|
CALL NEWNAM ('B', IDELB, EBNAME, NELBLK, IDOLD, WORD)
|
|
else if (itype .eq. 'N') then
|
|
CALL NEWNAM ('N', IDNPS, NSNAME, NUMNPS, IDOLD, WORD)
|
|
else if (itype .eq. 'S') then
|
|
CALL NEWNAM ('S', IDESS, SSNAME, NUMESS, IDOLD, WORD)
|
|
else if (itype .eq. 'A') then
|
|
CALL NEWATT (IDELB, IDBLK, NELBLK, IDOLD, NUMATR, ATNAME,
|
|
* WORD)
|
|
end if
|
|
verb = ' '
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'RENAME') THEN
|
|
write (*,*) 'In rename'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD2)
|
|
if (.NOT. MATSTR (WORD2, 'VARIABLE', 2)) THEN
|
|
call PRTERR('CMDERR',
|
|
* 'SYNTAX: RENAME [global|nodal|node|element|nodeset|nset|'//
|
|
* 'sideset|sset] VARIABLE [oldname] [newname]')
|
|
go to 399
|
|
end if
|
|
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', OLDNM)
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', NEWNM)
|
|
|
|
IF (MATSTR(WORD, 'GLOBAL', 2)) THEN
|
|
CALL RENAM(WORD, NAMEGV, NVARGL, OLDNM, NEWNM)
|
|
ELSE IF (MATSTR(WORD,'NODESET',5) .OR.
|
|
$ MATSTR(WORD,'NSET', 3) ) THEN
|
|
CALL RENAM(WORD, NAMEMV, NVARNS, OLDNM, NEWNM)
|
|
ELSE IF (MATSTR(WORD, 'NODAL', 4) .OR.
|
|
* MATSTR(WORD,'NODE', 4)) THEN
|
|
CALL RENAM(WORD, NAMENV, NVARNP, OLDNM, NEWNM)
|
|
ELSE IF (MATSTR(WORD, 'ELEMENT', 2)) THEN
|
|
CALL RENAM(WORD, NAMEEV, NVAREL, OLDNM, NEWNM)
|
|
ELSE IF (MATSTR(WORD,'SIDESET',3) .OR.
|
|
$ MATSTR(WORD,'SSET', 3) ) THEN
|
|
CALL RENAM(WORD, NAMESV, NVARSS, OLDNM, NEWNM)
|
|
END IF
|
|
|
|
399 CONTINUE
|
|
verb = ' '
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'CHANGE') THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
|
|
IF (MATSTR(WORD, 'TYPE', 2)) THEN
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'block ID', 0, IDOLD, *420)
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL NEWNAM ('b', IDELB, BLKTYP, NELBLK, IDOLD, WORD)
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',3) .OR.
|
|
$ MATSTR(WORD,'SSETS', 3) ) THEN
|
|
C========================================================================
|
|
C ... CHANGE SIDESET {id|ALL} FACTOR {value}
|
|
C ... See if next field is integer (id) or word ('all')
|
|
VERB = ' '
|
|
STRING = 'CHANGE SIDESET {id|ALL} FACTOR {value}'
|
|
IF (NUMESS .EQ. 0) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
* 'There are no sidesets on this database')
|
|
GO TO 420
|
|
END IF
|
|
|
|
DOALLA = .FALSE.
|
|
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
DOALLA = .TRUE.
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
ELSE
|
|
C ... Field is sideset id
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'sideset ID', 0, IDSET, *420)
|
|
END IF
|
|
|
|
C ... Next word should be 'FACTOR' or an id
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (.NOT.(MATSTR (WORD, 'FACTOR', 1))) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "FACTOR"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
* 'distribution factor value', 1.0, AVALUE, *420)
|
|
|
|
C ... Setup the scale and echo to the user
|
|
if (DOALLA) then
|
|
CALL INIREA (LESSNL, AVALUE, FACESS)
|
|
ELSE
|
|
iss = locint(idset, numess, idess)
|
|
IF (iss .EQ. 0) THEN
|
|
WRITE (STRING, 10040) 'Sideset', idset
|
|
10040 FORMAT (A,I5,' does not exist')
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
goto 420
|
|
END IF
|
|
call inirea(nness(iss), avalue, facess(ixness(iss)))
|
|
ENDIF
|
|
ELSE
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,'new ID', 0, IDNEW, *420)
|
|
CALL NEWID ('S', IDESS, NUMESS, IDNEW, IDSET)
|
|
END IF
|
|
|
|
ELSE IF (MATSTR(WORD,'NODESETS',3) .OR.
|
|
$ MATSTR(WORD,'NSETS', 3) ) THEN
|
|
C========================================================================
|
|
C ... CHANGE NODESET {id|ALL} FACTOR {value}
|
|
C ... See if next field is integer (id) or word ('all')
|
|
VERB = ' '
|
|
STRING = 'CHANGE NODESET {id|ALL} FACTOR {value}'
|
|
IF (NUMNPS .EQ. 0) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
* 'There are no nodesets on this database')
|
|
GO TO 420
|
|
END IF
|
|
|
|
DOALLA = .FALSE.
|
|
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
DOALLA = .TRUE.
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
ELSE
|
|
C ... Field is nodeset id
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'nodeset ID', 0, IDSET, *420)
|
|
END IF
|
|
|
|
C ... Next word should be 'FACTOR' or an id
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (.NOT.(MATSTR (WORD, 'FACTOR', 1))) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "FACTOR"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
* 'distribution factor value', 1.0, AVALUE, *420)
|
|
|
|
C ... Setup the scale and echo to the user
|
|
if (DOALLA) then
|
|
CALL INIREA (LNPSNL, AVALUE, FACNPS)
|
|
ELSE
|
|
iss = locint(idset, numnps, idnps)
|
|
IF (iss .EQ. 0) THEN
|
|
WRITE (STRING, 10040) 'Nodeset', idset
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
goto 420
|
|
END IF
|
|
call inirea(ndnps(iss), avalue, facnps(ixdnps(iss)))
|
|
ENDIF
|
|
ELSE
|
|
C ... Changing id. Get the new id.
|
|
CALL FFINTG (IFLD, INTYP, IFIELD, 'new ID', 0, IDNEW, *420)
|
|
CALL NEWID ('N', IDNPS, NUMNPS, IDNEW, IDSET)
|
|
END IF
|
|
|
|
ELSE IF (MATSTR(WORD, 'ATTRIBUTE', 3)) THEN
|
|
C========================================================================
|
|
C ... CHANGE ATTRIBUTE {num|ALL} BLOCK {id|ALL} {value}
|
|
C ... CHANGE ATTRIBUTE RESET
|
|
C ... See if next field is integer (id) or word ('all')
|
|
VERB = ' '
|
|
STRING = 'CHANGE ATTRIBUTE {id|ALL} BLOCK {id|ALL} {value}'
|
|
IF (.NOT. ISATRB) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
* 'There are no attributes on this database')
|
|
GO TO 420
|
|
END IF
|
|
|
|
ATRWRN = .TRUE.
|
|
DOALLA = .FALSE.
|
|
DOALLB = .FALSE.
|
|
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
DOALLA = .TRUE.
|
|
ELSE IF (MATSTR (WORD, 'RESET', 2)) THEN
|
|
CALL SCLATR(NELBLK, IDELB, NUMATR, 0, .TRUE., 0,
|
|
* .TRUE., 0.0, ATRSCL, .TRUE., .FALSE.)
|
|
GO TO 420
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
ELSE
|
|
C ... Field is Attribute number
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'attribute ID', 0, IDATR, *420)
|
|
END IF
|
|
|
|
C ... Next word should be 'BLOCK'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (.NOT.(MATSTR (WORD, 'BLOCK', 1))) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "BLOCK"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
C ... Now find block id or 'ALL'
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
DOALLB = .TRUE.
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 420
|
|
END IF
|
|
ELSE
|
|
C ... Field is Attribute number
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
$ 'block ID', 0, IDBLK, *420)
|
|
END IF
|
|
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
* 'attribute value', 1.0, AVALUE, *420)
|
|
|
|
C ... Setup the scale and echo to the user
|
|
CALL SCLATR(NELBLK, IDELB, NUMATR, IDATR, DOALLA,
|
|
* IDBLK, DOALLB, AVALUE, ATRSCL, .TRUE., .FALSE.)
|
|
|
|
ELSE
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
* 'old ID', 0, IDOLD, *420)
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
* 'new ID', 0, IDNEW, *420)
|
|
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
CALL NEWID ('M', IDELB, NELBLK, IDNEW, IDOLD)
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
$ MATSTR(WORD,'NSETS', 1) ) THEN
|
|
CALL NEWID ('N', IDNPS, NUMNPS, IDNEW, IDOLD)
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
$ MATSTR(WORD,'SSETS', 1)) THEN
|
|
CALL NEWID ('S', IDESS, NUMESS, IDNEW, IDOLD)
|
|
END IF
|
|
END IF
|
|
VERB = ' '
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'INCREMENT') THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
* 'increment', 0, IDINC, *420)
|
|
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
CALL INCID ('M', IDELB, NELBLK, IDINC)
|
|
ELSE IF (MATSTR(WORD,'NODESETS',5) .OR.
|
|
$ MATSTR(WORD,'NSETS', 2)) THEN
|
|
CALL INCID ('N', IDNPS, NUMNPS, IDINC)
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
$ MATSTR(WORD,'SSETS', 1)) THEN
|
|
CALL INCID ('S', IDESS, NUMESS, IDINC)
|
|
ELSE IF (MATSTR(WORD,'NODEMAP',5) .OR.
|
|
$ MATSTR(WORD,'NMAP', 2)) THEN
|
|
CALL INCMAP (MAPNOD, NUMNP, IDINC)
|
|
ELSE IF (MATSTR(WORD,'ELEMMAP',5) .OR.
|
|
$ MATSTR(WORD,'EMAP', 2)) THEN
|
|
CALL INCMAP (MAPEL, NUMEL, IDINC)
|
|
END IF
|
|
VERB = ' '
|
|
|
|
C=======================================================================
|
|
else if (verb .eq. 'MERGE') THEN
|
|
C ... Syntax: MERGE {global|local} Node {node_1} into node {node_2}
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
if (matstr(word, 'GLOBAL', 3)) then
|
|
glonod = .true.
|
|
else if (matstr(word, 'LOCAL', 3)) then
|
|
glonod = .false.
|
|
else
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Expected "global" or "local" following "merge"')
|
|
go to 420
|
|
end if
|
|
c ... skip 'node'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
|
|
C ... Get the two nodes to be equivalenced...
|
|
CALL FFINTG (IFLD, INTYP, IFIELD, 'Node1', 0, node1, *420)
|
|
C ... Skip 'node into'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
CALL FFINTG (IFLD, INTYP, IFIELD, 'Node2', 0, node2, *420)
|
|
|
|
if (glonod) then
|
|
node1 = ng2l('node', node1, numnp, mapnod)
|
|
node2 = ng2l('node', node2, numnp, mapnod)
|
|
end if
|
|
|
|
if (node1 .gt. numnp .or. node2 .gt. numnp) then
|
|
CALL PRTERR ('CMDERR', 'Node index exceeds node count')
|
|
else
|
|
C ... Grepos has requirement that the highest numbered node be removed
|
|
C in the equiv process. However, in user specification, they want
|
|
C to specify which node is removed. If it is the lower-numbered node,
|
|
C simply replace the coordinates of the higher numbered node with the
|
|
C coordinates of the lower-numbered node.
|
|
if (node1 .lt. node2) then
|
|
if (IEQUIV(node2) .ne. node2) then
|
|
call prterr ('CMDERR',
|
|
* 'Node already merged, cannot specify twice')
|
|
else
|
|
IEQUIV(node2) = -node1
|
|
xn(node1) = xn(node2)
|
|
if (ndim .ge. 2) yn(node1) = yn(node2)
|
|
if (ndim .eq. 3) zn(node1) = zn(node2)
|
|
endif
|
|
else
|
|
if (IEQUIV(node1) .ne. node1) then
|
|
call prterr ('CMDERR',
|
|
* 'Node already merged, cannot specify twice')
|
|
else
|
|
IEQUIV(node1) = -node2
|
|
end if
|
|
end if
|
|
equiv = .TRUE.
|
|
EQTOLER = -1.0
|
|
end if
|
|
verb = ' '
|
|
|
|
ELSE IF (VERB .EQ. 'EQUIVALENCE') THEN
|
|
C ... Syntax: EQUIVALENCE tolerance
|
|
C ... Syntax: EQUIVALENCE RESET
|
|
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 3)) THEN
|
|
EQUIV = .FALSE.
|
|
EQTOLER = 0.0
|
|
do i=1, numnp
|
|
iequiv(i) = i
|
|
end do
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', 'Expected "RESET"')
|
|
END IF
|
|
verb = ' '
|
|
ELSE
|
|
EQUIV = .TRUE.
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Tolerance', 0.0, EQTOLER, *420)
|
|
IF (EQTOLER .LT. 0.0) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
& "Tolerance must be greater than 0.0.")
|
|
EQUIV = .FALSE.
|
|
END IF
|
|
END IF
|
|
|
|
C=======================================================================
|
|
ELSE IF (VERB .EQ. 'COMBINE') THEN
|
|
C ... Syntax: COMBINE entity RESET (Not Implemented yet)
|
|
C ... Syntax: COMBINE BLOCK id_final WITH BLOCK id1, id2, ..., idn
|
|
C ... Syntax: COMBINE MATERIAL id_final WITH MATERIAL id1, id2, ..., idn
|
|
C ... Syntax: COMBINE NODESET id_final WITH NODESET id1, id2, ..., idn
|
|
C ... Syntax: COMBINE SIDESET id_final WITH SIDESET id1, id2, ..., idn
|
|
C Sets ids of id1, id2, ..., idn to -idfinal
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
* 'ID', 0, IDFINL, *420)
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
$ "Missing Keyword 'MATERIALS/NODESETS/SIDESETS'")
|
|
GO TO 420
|
|
END IF
|
|
|
|
C ... This should be the keyword 'WITH'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD2)
|
|
if (.NOT. MATSTR(WORD2, 'WITH', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
$ 'Expected keyword "WITH", found "' //
|
|
$ WORD2(:lenstr(word2)) // '".')
|
|
go to 420
|
|
end if
|
|
|
|
C ... This should be the entity type. Must match WORD.
|
|
C Matching assumed, not checked.
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD2)
|
|
if (.NOT. MATSTR(WORD2, WORD, 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
$ 'Expected keyword "'//word(:lenstr(word))//'" found "' //
|
|
$ WORD2(:lenstr(word2)) // '".')
|
|
go to 420
|
|
end if
|
|
|
|
325 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
* 'ID', 0, ID, *420)
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
CALL COMID ('Material', IDELB, IELBST, NELBLK, IDFINL, ID)
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
CALL COMID ('Nodeset', IDNPS, INPSST, NUMNPS, IDFINL, ID)
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
CALL COMID ('Sideset', IDESS, IESSST, NUMESS, IDFINL, ID)
|
|
ELSE
|
|
write (string, 326) word(:lenstr(word))
|
|
326 format('"',A,
|
|
$ '" is an invalid or nonunique COMBINE option')
|
|
call sqzstr(string, lstr)
|
|
CALL PRTERR ('CMDERR', string(:lstr))
|
|
END IF
|
|
GOTO 325
|
|
END IF
|
|
VERB = ' '
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'DELETE') THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR(WORD,'QAINFO',3)) THEN
|
|
NQAREC = 0
|
|
NINFO = 1
|
|
INFREC(NINFO) =
|
|
$ 'All previous QA and INFO records deleted by GREPOS'
|
|
CALL PRTERR ('CMDSPEC',
|
|
$ 'All QA and INFO records deleted.')
|
|
ELSE IF (MATSTR(WORD,'QA',2)) THEN
|
|
NQAREC = 0
|
|
NINFO = NINFO + 1
|
|
INFREC(NINFO) =
|
|
$ 'All previous QA records deleted by GREPOS'
|
|
CALL PRTERR ('CMDSPEC',
|
|
$ 'All QA records deleted.')
|
|
ELSE IF (MATSTR(WORD,'INFORMATION',2)) THEN
|
|
NINFO = 1
|
|
INFREC(NINFO) =
|
|
$ 'All previous INFO records deleted by GREPOS'
|
|
CALL PRTERR ('CMDSPEC',
|
|
$ 'All INFO records deleted.')
|
|
ELSE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD2)
|
|
IF (MATSTR (WORD2, 'MAP', 3)) THEN
|
|
IF (MATSTR (WORD, 'NODE', 2)) THEN
|
|
do i=1, numnp
|
|
mapnod(i) = i
|
|
end do
|
|
ELSE IF (MATSTR (WORD, 'ELEMENT', 2)) THEN
|
|
do i=1, numel
|
|
mapel(i) = i
|
|
end do
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid DELETE MAP -- NODE or ELEMENT')
|
|
GO TO 333
|
|
END IF
|
|
ELSE IF (MATSTR (WORD2, 'ALL', 2)) THEN
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
do i=1, nelblk
|
|
ielbst(i) = -idelb(i)
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All material blocks deleted.')
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
do i=1, numnps
|
|
inpsst(i) = -idnps(i)
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All nodesets deleted.')
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
do i=1, numess
|
|
iessst(i) = -idess(i)
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All sidesets deleted.')
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid or nonunique DELETE option')
|
|
GO TO 333
|
|
END IF
|
|
|
|
ELSE IF (MATSTR (WORD2, 'NAMES', 2)) THEN
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
do i=1, nelblk
|
|
#if defined(__XLF__)
|
|
ebname(i) = " "
|
|
#else
|
|
ebname(i) = ""
|
|
#endif
|
|
end do
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'All material block names deleted.')
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
do i=1, numnps
|
|
#if defined(__XLF__)
|
|
nsname(i) = " "
|
|
#else
|
|
nsname(i) = ""
|
|
#endif
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All nodeset names deleted.')
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
do i=1, numess
|
|
#if defined(__XLF__)
|
|
ssname(i) = " "
|
|
#else
|
|
ssname(i) = ""
|
|
#endif
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All sideset names deleted.')
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid DELETE NAME option')
|
|
GO TO 333
|
|
END IF
|
|
|
|
ELSE IF (MATSTR (WORD2, 'ATTRIBUTES', 2)) THEN
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
do i=1, nelblk
|
|
numatr(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'All element block attributes deleted.')
|
|
END IF
|
|
ELSE IF (MATSTR (WORD2, 'RESET', 2)) THEN
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
do i=1, nelblk
|
|
ielbst(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'All material blocks undeleted.')
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
do i=1, numnps
|
|
inpsst(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All nodesets undeleted.')
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
do i=1, numess
|
|
iessst(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All sidesets undeleted.')
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid or nonunique DELETE option')
|
|
GO TO 333
|
|
END IF
|
|
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL" or "RESET"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 333
|
|
END IF
|
|
ENDIF
|
|
END IF
|
|
|
|
C ... Ids only. Either a list or range (or both)
|
|
330 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
|
|
C --Scan numeric range
|
|
|
|
CALL FFVRNG (IFLD, INTYP, CFIELD, IFIELD,
|
|
& WORD, -1, IRNG, *333)
|
|
|
|
C --Store the range selected
|
|
|
|
DO 332 I = IRNG(1), IRNG(2), IRNG(3)
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
CALL DELID ('M', IDELB, IELBST, NELBLK, I, .TRUE.)
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
CALL DELID ('N', IDNPS, INPSST, NUMNPS, I, .TRUE.)
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',2) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
CALL DELID ('S', IDESS, IESSST, NUMESS, I, .TRUE.)
|
|
ELSE IF (MATSTR(WORD,'STEPS',2) .OR.
|
|
& MATSTR(WORD,'TIMES', 1) ) THEN
|
|
if (i .le. nsteps) then
|
|
ITIMST(I) = 1
|
|
else
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Step number is out of range')
|
|
end if
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid or nonunique DELETE option')
|
|
END IF
|
|
332 CONTINUE
|
|
|
|
GOTO 330
|
|
END IF
|
|
END IF
|
|
333 CONTINUE
|
|
VERB = ' '
|
|
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'UNDELETE' .OR. VERB .EQ. 'KEEP') THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
C ... Field is character
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD2)
|
|
IF (MATSTR (WORD2, 'ALL', 2)) THEN
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
do i=1, nelblk
|
|
ielbst(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All material blocks undeleted.')
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
do i=1, numnps
|
|
inpsst(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All nodesets undeleted.')
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
do i=1, numess
|
|
iessst(i) = 0
|
|
end do
|
|
CALL PRTERR ('CMDSPEC','All sidesets undeleted.')
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid or nonunique DELETE option')
|
|
GO TO 336
|
|
END IF
|
|
|
|
ELSE
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected keyword "ALL"')
|
|
CALL PRTERR('CMDREQ', STRING(:LENSTR(STRING)))
|
|
GO TO 336
|
|
END IF
|
|
ELSE
|
|
335 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
|
|
C --Scan numeric range
|
|
CALL FFVRNG (IFLD, INTYP, CFIELD, IFIELD,
|
|
& WORD, -1, IRNG, *336)
|
|
|
|
C --Store the range selected
|
|
DO I = IRNG(1), IRNG(2), IRNG(3)
|
|
IF (MATSTR(WORD,'MATERIALS',1) .OR.
|
|
& MATSTR(WORD, 'BLOCKS',1)) THEN
|
|
CALL DELID ('M', IDELB, IELBST, NELBLK, I, .FALSE.)
|
|
ELSE IF (MATSTR(WORD,'NODESETS',1) .OR.
|
|
& MATSTR(WORD,'NSETS', 1) ) THEN
|
|
CALL DELID ('N', IDNPS, INPSST, NUMNPS, I, .FALSE.)
|
|
ELSE IF (MATSTR(WORD,'SIDESETS',2) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
CALL DELID ('S', IDESS, IESSST, NUMESS, I, .FALSE.)
|
|
ELSE IF (MATSTR(WORD,'STEPS',2) .OR.
|
|
& MATSTR(WORD,'TIMES', 1) ) THEN
|
|
if (i .le. nsteps) then
|
|
ITIMST(I) = 0
|
|
else
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Step number is out of range')
|
|
end if
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid or nonunique DELETE option')
|
|
END IF
|
|
END DO
|
|
|
|
GOTO 335
|
|
END IF
|
|
END IF
|
|
336 CONTINUE
|
|
VERB = ' '
|
|
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'SWAP') THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR(WORD,'SIDESETS',1) .OR.
|
|
& MATSTR(WORD,'SSETS', 1) ) THEN
|
|
340 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
* 'ID', 0, IDNEW, *420)
|
|
CALL SWPID ('S', IDESS, NUMESS, IDNEW, DELOK)
|
|
IF (DELOK) SWPSS = .TRUE.
|
|
GOTO 340
|
|
END IF
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
|
|
& // '" is an invalid or nonunique SWAP option')
|
|
END IF
|
|
VERB = ' '
|
|
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'TMIN') then
|
|
call ffreal (ifld, intyp, rfield,
|
|
$ 'Minimum Time', 0.0, tmin, *345)
|
|
do itim = 1, nsteps
|
|
if (times(itim) .lt. tmin) then
|
|
itimst(itim) = 1
|
|
end if
|
|
end do
|
|
345 continue
|
|
VERB = ' '
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'TMAX') then
|
|
call ffreal (ifld, intyp, rfield,
|
|
$ 'Maximum Time', 0.0, tmax, *346)
|
|
do itim = 1, nsteps
|
|
if (times(itim) .gt. tmax) then
|
|
itimst(itim) = 1
|
|
end if
|
|
end do
|
|
346 continue
|
|
VERB = ' '
|
|
C========================================================================
|
|
|
|
ELSE IF (VERB .EQ. 'SMOOTH') then
|
|
SMOOTH = .TRUE.
|
|
call ffreal (ifld, intyp, rfield,
|
|
$ 'Tolerance', 1.0e-6, toler, *350)
|
|
call ffintg (ifld, intyp, ifield,
|
|
$ 'Iterations', 100, NIT, *350)
|
|
call ffreal (ifld, intyp, rfield,
|
|
$ 'Relaxation Factor', 1.0, R0, *350)
|
|
|
|
350 continue
|
|
|
|
C ... SNAP
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'SNAP') then
|
|
if (ffexst(ifld, intyp)) then
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
NUMSNP = 0
|
|
go to 360
|
|
ELSE
|
|
call PRTERR('CMDERR', 'Expected "RESET" or sideset id')
|
|
go to 370
|
|
END IF
|
|
END IF
|
|
|
|
if (ffexst(ifld, intyp)) then
|
|
numsnp = numsnp + 1
|
|
if (numsnp .gt. mxsnap) then
|
|
call PRTERR('CMDERR', 'Too many snap sets specified')
|
|
go to 370
|
|
end if
|
|
|
|
ismtyp(numsnp) = ISNAP
|
|
usnorm(numsnp) = PNORM
|
|
snptol(numsnp) = 0.0
|
|
gap(numsnp) = 0.0
|
|
C ... NOTE: This value is squared in snpnod, don't increase too big.
|
|
delmax(numsnp) = 1.0e15
|
|
|
|
call ffintg (ifld, intyp, ifield,
|
|
$ 'sideset to snap nodes from', 0, IDSSSL(numsnp), *370)
|
|
imat = locint(idsssl(numsnp), numess, idess)
|
|
IF (IMAT .EQ. 0) THEN
|
|
WRITE (STRING, 10040) 'Sideset', idsssl(numsnp)
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
NUMSNP = NUMSNP - 1
|
|
GO TO 370
|
|
END IF
|
|
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (.NOT. MATSTR (WORD, 'TO', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected required keyword "TO"')
|
|
NUMSNP = NUMSNP - 1
|
|
GO TO 370
|
|
END IF
|
|
|
|
call ffintg (ifld, intyp, ifield,
|
|
$ 'sideset to snap nodes to', 0, IDSSMA(numsnp), *370)
|
|
imat = locint(idssma(numsnp), numess, idess)
|
|
IF (IMAT .EQ. 0) THEN
|
|
WRITE (STRING, 10040) 'Sideset', idssma(numsnp)
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
NUMSNP = NUMSNP - 1
|
|
GO TO 370
|
|
END IF
|
|
end if
|
|
|
|
360 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
numsnp = 0
|
|
go to 360
|
|
else IF (MATSTR(WORD, 'NORMAL', 1)) THEN
|
|
USNORM(NUMSNP) = PNORM
|
|
VECTOR(1,numsnp) = 0.0
|
|
VECTOR(2,numsnp) = 0.0
|
|
VECTOR(3,numsnp) = 0.0
|
|
else IF (MATSTR(WORD, 'EDGE', 1)) THEN
|
|
USNORM(NUMSNP) = PEDGE
|
|
VECTOR(1,numsnp) = 0.0
|
|
VECTOR(2,numsnp) = 0.0
|
|
VECTOR(3,numsnp) = 0.0
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 1.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 1.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 1.0
|
|
ELSE IF (WORD .EQ. 'MINUSX') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = -1.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'MINUSY') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = -1.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'MINUSZ') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = -1.0
|
|
ELSE IF (MATSTR(WORD, 'VECTOR', 1)) THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'vector X coordinate', 0.0, VECTOR(1,NUMSNP), *370)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'vector Y coordinate', 0.0, VECTOR(2,NUMSNP), *370)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'vector Z coordinate', 0.0, VECTOR(3,NUMSNP), *370)
|
|
ELSE IF (MATSTR(WORD, 'RADIAL', 1)) THEN
|
|
USNORM(NUMSNP) = PRAD
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (MATSTR(WORD, 'CENTER', 1)) THEN
|
|
USNORM(NUMSNP) = PRAD
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X center', 0.0, VECTOR(1,NUMSNP), *370)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y center', 0.0, VECTOR(2,NUMSNP), *370)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z center', 0.0, VECTOR(3,NUMSNP), *370)
|
|
ELSE IF (MATSTR(WORD, 'TOLERANCE', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Tolerance', 0.0, SNPTOL(NUMSNP), *370)
|
|
ELSE IF (MATSTR(WORD, 'MAXDELTA', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'MaxDelta', 1.0E15, DELMAX(NUMSNP), *370)
|
|
ELSE IF (MATSTR(WORD, 'GAP', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* '"GAP" not supported for "SNAP" command')
|
|
END IF
|
|
GO TO 360
|
|
END IF
|
|
end if
|
|
370 CONTINUE
|
|
VERB = 'SNAP'
|
|
|
|
C ... MOVE
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'MOVE') then
|
|
if (ffexst(ifld, intyp)) then
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
NUMSNP = 0
|
|
go to 380
|
|
ELSE IF (MATSTR (WORD, 'GLOBAL', 3) .OR.
|
|
* MATSTR (WORD, 'LOCAL', 3)) THEN
|
|
C ... Syntax here is:
|
|
C MOVE GLOBAL NODE {id} TO {x} {y} {z} (absolute move)
|
|
C MOVE LOCAL NODE {id} TO {x} {y} {z}
|
|
C MOVE GLOBAL NODE {id} BY {x} {y} {z} (relative move)
|
|
C MOVE LOCAL NODE {id} BY {x} {y} {z}
|
|
glonod = .FALSE.
|
|
if (matstr(word, 'GLOBAL', 3)) glonod = .TRUE.
|
|
|
|
c ... skip 'node'
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
if (.NOT. MATSTR (WORD, 'NODE', 2)) THEN
|
|
call PRTERR('CMDERR',
|
|
* 'SYNTAX: Move {global|local} NODE {id} {TO|BY} x y z')
|
|
go to 390
|
|
end if
|
|
|
|
C ... Get the id of the node to be moved
|
|
CALL FFINTG (IFLD, INTYP, IFIELD, 'Node', 0, node, *420)
|
|
if (glonod) then
|
|
node = ng2l('node', node, numnp, mapnod)
|
|
end if
|
|
if (node .le. 0 .or. node .gt. numnp) then
|
|
CALL PRTERR ('CMDERR', 'Node index exceeds node count')
|
|
go to 390
|
|
end if
|
|
|
|
C ... See if absolute or relative
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
absolute = .false.
|
|
if (MATSTR (WORD, 'TO', 2)) THEN
|
|
absolute = .true.
|
|
else if (MATSTR (WORD, 'BY', 2)) THEN
|
|
absolute = .false.
|
|
else
|
|
call PRTERR('CMDERR',
|
|
* 'Expected "TO" or "BY" in move command')
|
|
go to 390
|
|
|
|
end if
|
|
|
|
x = 0.0
|
|
y = 0.0
|
|
z = 0.0
|
|
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X value', 0.0, X, *420)
|
|
if (ndim .gt. 1) then
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y value', 0.0, Y, *420)
|
|
if (ndim .gt. 2) then
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z value', 0.0, Z, *420)
|
|
end if
|
|
end if
|
|
|
|
C ... Move the node...
|
|
if (absolute) then
|
|
xn(node) = x
|
|
if (ndim .ge. 2) yn(node) = y
|
|
if (ndim .eq. 3) zn(node) = z
|
|
else
|
|
xn(node) = xn(node) + x
|
|
if (ndim .ge. 2) yn(node) = yn(node) + y
|
|
if (ndim .eq. 3) zn(node) = zn(node) + z
|
|
end if
|
|
VERB = ' '
|
|
go to 420
|
|
ELSE
|
|
call PRTERR('CMDERR',
|
|
* 'Expected "RESET", "GLOBAL", "LOCAL", or sideset id')
|
|
go to 390
|
|
END IF
|
|
END IF
|
|
|
|
if (ffexst(ifld, intyp)) then
|
|
numsnp = numsnp + 1
|
|
if (numsnp .gt. mxsnap) then
|
|
call PRTERR('CMDERR', 'Too many snap sets specified')
|
|
go to 390
|
|
end if
|
|
|
|
ismtyp(numsnp) = IMOVE
|
|
usnorm(numsnp) = PNORM
|
|
snptol(numsnp) = 0.0
|
|
gap(numsnp) = 0.0
|
|
C ... NOTE: This value is squared in snpnod, don't increase too big.
|
|
delmax(numsnp) = 1.0e15
|
|
|
|
call ffintg (ifld, intyp, ifield,
|
|
$ 'sideset to move nodes from', 0, IDSSSL(numsnp), *390)
|
|
imat = locint(idsssl(numsnp), numess, idess)
|
|
IF (IMAT .EQ. 0) THEN
|
|
WRITE (STRING, 10050) idsssl(numsnp)
|
|
10050 FORMAT ('Sideset ',I5,' does not exist')
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
NUMSNP = NUMSNP - 1
|
|
GO TO 390
|
|
END IF
|
|
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (.NOT. MATSTR (WORD, 'TO', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Expected required keyword "TO"')
|
|
NUMSNP = NUMSNP - 1
|
|
GO TO 390
|
|
END IF
|
|
|
|
call ffintg (ifld, intyp, ifield,
|
|
$ 'sideset to move nodes to', 0, IDSSMA(numsnp), *390)
|
|
imat = locint(idssma(numsnp), numess, idess)
|
|
IF (IMAT .EQ. 0) THEN
|
|
WRITE (STRING, 10050) idssma(numsnp)
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
NUMSNP = NUMSNP - 1
|
|
GO TO 390
|
|
END IF
|
|
end if
|
|
|
|
380 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
numsnp = 0
|
|
go to 380
|
|
else IF (MATSTR(WORD, 'NORMAL', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* '"NORMAL" not supported for "MOVE" command')
|
|
go to 390
|
|
else IF (MATSTR(WORD, 'EDGE', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* '"EDGE" not supported for "MOVE" command')
|
|
go to 390
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 1.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 1.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 1.0
|
|
ELSE IF (WORD .EQ. 'MINUSX') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = -1.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'MINUSY') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = -1.0
|
|
VECTOR(3,NUMSNP) = 0.0
|
|
ELSE IF (WORD .EQ. 'MINUSZ') THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
VECTOR(1,NUMSNP) = 0.0
|
|
VECTOR(2,NUMSNP) = 0.0
|
|
VECTOR(3,NUMSNP) = -1.0
|
|
ELSE IF (MATSTR(WORD, 'VECTOR', 1)) THEN
|
|
USNORM(NUMSNP) = PVECT
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'vector X coordinate', 0.0, VECTOR(1,NUMSNP), *390)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'vector Y coordinate', 0.0, VECTOR(2,NUMSNP), *390)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'vector Z coordinate', 0.0, VECTOR(3,NUMSNP), *390)
|
|
ELSE IF (MATSTR(WORD, 'RADIAL', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* '"RADIAL" not supported for "MOVE" command')
|
|
go to 390
|
|
ELSE IF (MATSTR(WORD, 'CENTER', 1)) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* '"CENTER" not supported for "MOVE" command')
|
|
go to 390
|
|
ELSE IF (MATSTR(WORD, 'TOLERANCE', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Tolerance', 0.0, SNPTOL(NUMSNP), *390)
|
|
ELSE IF (MATSTR(WORD, 'MAXDELTA', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'MaxDelta', 1.0E15, DELMAX(NUMSNP), *390)
|
|
ELSE IF (MATSTR(WORD, 'GAP', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Gap', 0.0, GAP(NUMSNP), *390)
|
|
END IF
|
|
GO TO 380
|
|
END IF
|
|
end if
|
|
390 CONTINUE
|
|
VERB = 'MOVE'
|
|
|
|
C --- BEGINNING OF WARP
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'WARP') THEN
|
|
IF (NDIM .NE. 3) THEN
|
|
CALL PRTERR('CMDERR',
|
|
* 'Warp cannot be specified for 2D databases')
|
|
GO TO 410
|
|
END IF
|
|
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD,
|
|
* 'HELP', WORD)
|
|
|
|
IF (MATSTR(WORD, 'HELP', 1)) THEN
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Syntax: WARP {XAXIS|YAXIS|ZAXIS|ORIGIN} RADIUS {radius}'//
|
|
* ' NORMAL {X|Y|Z}')
|
|
VERB = ' '
|
|
GO TO 410
|
|
ELSE IF (MATSTR(WORD, 'XAXIS', 1)) THEN
|
|
IWARP = -1
|
|
ELSE IF (MATSTR(WORD, 'YAXIS', 1)) THEN
|
|
IWARP = -2
|
|
ELSE IF (MATSTR(WORD, 'ZAXIS', 1)) THEN
|
|
IWARP = -3
|
|
ELSE IF (MATSTR(WORD, 'ORIGIN', 1)) THEN
|
|
IWARP = 1
|
|
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', 'Invalid WARP Option')
|
|
IWARP = 0
|
|
GO TO 410
|
|
END IF
|
|
|
|
400 continue
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RADIUS', 1)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
* 'reference distance', 0.0, WRPDIS, *410)
|
|
IF (WRPDIS .LE. 0.0) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Reference radius must be greater than zero')
|
|
IWARP = 0
|
|
GO TO 410
|
|
END IF
|
|
ELSE IF (MATSTR (WORD, 'NORMAL', 1)) THEN
|
|
NRMWRP = 0
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, 'X', WORD)
|
|
IF (MATSTR(WORD, 'X', 1)) THEN
|
|
NRMWRP = 1
|
|
ELSE IF (MATSTR(WORD, 'Y', 1)) THEN
|
|
NRMWRP = 2
|
|
ELSE IF (MATSTR(WORD, 'Z', 1)) THEN
|
|
NRMWRP = 3
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', 'Invalid WARP NORMAL Option')
|
|
END IF
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', 'Invalid WARP Option')
|
|
IWARP = 0
|
|
GO TO 410
|
|
END IF
|
|
GO TO 400
|
|
ELSE
|
|
GO TO 410
|
|
END IF
|
|
|
|
410 CONTINUE
|
|
IF (IWARP .NE. 0) THEN
|
|
if (wrpdis .le. 0.0) then
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Reference radius must be greater than zero')
|
|
IWARP = 0
|
|
end if
|
|
if (nrmwrp .eq. 0) then
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Normal Vector Axis must be specified')
|
|
IWARP = 0
|
|
end if
|
|
END IF
|
|
|
|
C... User Subroutine
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'USERSUBROUTINE') then
|
|
call ffonof (ifld, intyp, cfield, USRSUB, *420)
|
|
|
|
C... Convert nodal variable to element variable (average nodal quantities)
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'ELEMENTIZE') then
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
|
|
IF (MATSTR(WORD, 'HELP', 1)) THEN
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Syntax: ELEMENTIZE {nodal_variable_name}')
|
|
VERB = ' '
|
|
goto 420
|
|
END IF
|
|
C ... Search for name in list of nodal variables.
|
|
index = locstr(word, nvarnp, namenv)
|
|
|
|
if (index .eq. 0) then
|
|
write (STRING,*) 'Could not find nodal variable ',
|
|
* word(:lenstr(word)),
|
|
* ' Enter "list names" to see valid names.'
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('ERROR', STRING(:LSTR))
|
|
else
|
|
inod2el(index) = 1
|
|
write (STRING,*) 'Elementizing nodal variable ',
|
|
* word(:lenstr(word))
|
|
CALL SQZSTR (STRING, LSTR)
|
|
CALL PRTERR ('CMDSPEC', STRING(:LSTR))
|
|
end if
|
|
VERB = ' '
|
|
|
|
C... Output element centroids
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'CENTROIDS') then
|
|
call ffonof (ifld, intyp, cfield, CENTRD, *420)
|
|
|
|
C... Help
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'HELP') THEN
|
|
ISHELP = HELP (MYNAME(:LNAM), 'COMMANDS', CFIELD(IFLD))
|
|
IF (.NOT. ISHELP) THEN
|
|
CALL PRTERR('CMDREQ', 'Help is not available at this time')
|
|
END IF
|
|
VERB = ' '
|
|
|
|
C========================================================================
|
|
ELSE IF ((VERB .EQ. 'END') .OR. (VERB .EQ. 'EXIT')) THEN
|
|
CALL SCNEOF
|
|
GOTO 430
|
|
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'EXECUTE') THEN
|
|
CALL SHOW(VERB, ' ')
|
|
EXECUT = .TRUE.
|
|
GOTO 430
|
|
|
|
C========================================================================
|
|
ELSE IF (VERB .EQ. 'QUIT') THEN
|
|
call prterr('WARNING',
|
|
& 'Aborting current execution; no output file will be written')
|
|
CALL SCNEOF
|
|
RETURN 1
|
|
|
|
C========================================================================
|
|
ELSE
|
|
CALL PRTERR ('CMDERR', '"' // VERB(:LENSTR(VERB))
|
|
& // '" is an invalid command')
|
|
VERB = ' '
|
|
END IF
|
|
|
|
420 CONTINUE
|
|
|
|
IF (VERB .NE. ' ') THEN
|
|
CALL SHOW (VERB, ' ')
|
|
END IF
|
|
|
|
GOTO 110
|
|
|
|
430 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C=======================================================================
|
|
integer function ng2l (type, idglo, num, map)
|
|
C=======================================================================
|
|
|
|
C --G2L locates the local node/element corresponding to the global id
|
|
C --
|
|
C --Parameters:
|
|
C -- TYPE - IN - 'node' or 'element'
|
|
C -- NUM - IN - the number of node/elements
|
|
C -- MAP - IN - the node/element number map
|
|
|
|
C ... TYPE = Node or Element
|
|
CHARACTER*(*) TYPE
|
|
INTEGER MAP(*)
|
|
|
|
CHARACTER*128 STRA
|
|
LOGICAL FOUND
|
|
|
|
ng2l = idglo
|
|
found = .FALSE.
|
|
do i = 1, num
|
|
if (idglo .eq. map(i)) then
|
|
ng2l = i
|
|
return
|
|
end if
|
|
end do
|
|
|
|
write (stra, 10000) type, idglo
|
|
call sqzstr(stra, lstra)
|
|
call prterr('WARNING', stra(:lstra))
|
|
RETURN
|
|
|
|
10000 FORMAT (' No local ',A,' has global id equal to ',I10)
|
|
END
|
|
|