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.
504 lines
18 KiB
504 lines
18 KiB
C Copyright(C) 1999-2020, 2023 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 IRENNP (A, NNPS1, NNPS2, IDNPS, NNNPS,
|
|
& RENNP, MATNS1, MATNS2, TOLER, CLOSE, MATMAT,
|
|
$ XSCL, YSCL, ZSCL, XOFF, YOFF, ZOFF, NDIM, IEXPCT)
|
|
C=======================================================================
|
|
|
|
C --*** IRENNP *** (GJOIN) Input node renumber information from user
|
|
C -- Written by Amy Gilkey - revised 02/23/88
|
|
C --
|
|
C --IRENNP requests node renumbering information from the user. This
|
|
C --includes whether the nodes need to be combined and if nodal point
|
|
C --set should be used in combining the nodes.
|
|
C --Other transformations to the mesh database are also performed here
|
|
C --including: mirroring and offsetting
|
|
C --
|
|
C --Parameters:
|
|
C -- A - IN/OUT - the dynamic memory array
|
|
C -- NNPS1 - IN - the number of nodal point sets in the first database
|
|
C -- NNPS2 - IN - the number of nodal point sets in the second database
|
|
C -- IDNPS - IN - the IDs for each set
|
|
C -- NNNPS - IN - the number of nodes for each set
|
|
C -- RENNP - OUT - true iff the nodes need to be combined
|
|
C -- MATNS1 - OUT - the number of the first nodal point set
|
|
C -- MATNS2 - OUT - the number of the second nodal point set
|
|
C -- TOLER - OUT - tolerance to be used for equivalencing
|
|
C -- CLOSE - OUT - true if match closest node on equivalence
|
|
C (This is now default, cannot be turned off)
|
|
|
|
PARAMETER (MAXFLD = 10)
|
|
|
|
include 'gj_filnum.blk'
|
|
include 'gj_xyzrot.blk'
|
|
DIMENSION A(*)
|
|
INTEGER IDNPS(*), NNNPS(*)
|
|
LOGICAL RENNP, CLOSE, MATMAT
|
|
|
|
CHARACTER*8 REPLY
|
|
INTEGER INTYP(MAXFLD+1)
|
|
CHARACTER*8 CFIELD(MAXFLD), WORD
|
|
INTEGER IFIELD(MAXFLD)
|
|
REAL RFIELD(MAXFLD)
|
|
CHARACTER*132 INPUT
|
|
|
|
LOGICAL ONSET, MATSTR, FFEXST
|
|
|
|
ROT3D = .FALSE.
|
|
CALL INIREA (3, 0.0, ROTCEN)
|
|
CALL INIREA (3*3, 0.0, ROTMAT)
|
|
DO 100 I = 1, 3
|
|
ROTMAT(I,I) = 1.0
|
|
100 continue
|
|
IEXPCT = 0
|
|
CLOSE = .TRUE.
|
|
MATMAT = .FALSE.
|
|
ONSET = .FALSE.
|
|
if (nnps1 + nnps2 .gt. 0) then
|
|
CALL MDRSRV ('ISTA', KISTA, NNPS1+NNPS2)
|
|
CALL MDRSRV ('ISCR', KISCR, NNPS1+NNPS2)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
GOTO 240
|
|
END IF
|
|
CALL INITIN (A(KISTA), NNPS1+NNPS2, 0)
|
|
end if
|
|
110 CONTINUE
|
|
WRITE (*, *)
|
|
CALL GETINP (0,0,'Equivalence or Command (Enter HELP for info)? ',
|
|
* INPUT, IOSTAT)
|
|
|
|
C ... Handle commented lines
|
|
IF (INPUT(1:1) .EQ. '$') goto 110
|
|
|
|
IDCONT = 0
|
|
CALL FFISTR(INPUT, MAXFLD, IDCONT,
|
|
* NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
|
|
CALL OUTLOG (KLOG, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
|
|
C -- Valid Commands:
|
|
C NO
|
|
C EQUIVALENCE
|
|
C COMBINE
|
|
C YES
|
|
C LIST
|
|
C MIRROR
|
|
C OFFSET
|
|
C SHIFT
|
|
|
|
REPLY = CFIELD(1)
|
|
IF (REPLY(1:1) .EQ. ' ') REPLY = 'NO'
|
|
CALL EXUPCS (REPLY)
|
|
|
|
IF (MATSTR(REPLY, 'HELP', 1)) THEN
|
|
write (*, 10000)
|
|
10000 FORMAT (/,' Valid Commands:',/,4X,
|
|
$ 'YES|NO',/,4X,
|
|
$ 'EQUIVALENCE [nset1] [nset2] [toler]',
|
|
$ ' [MATERIAL] ',/,4X,
|
|
$ 'COMBINE [nset1] [nset2] [toler]',
|
|
$ ' [MATERIAL]',/,4X,
|
|
$ 'EQUIVALENCE|COMBINE END|EXIT|NO',/,4X,
|
|
$ 'MIRROR X|Y|Z|ALL (sets scale to -1)',/,4X,
|
|
$ 'OFFSET X|Y|Z|ALL|ADD|RESET offset ...',/,4X,
|
|
$ 'SHIFT X|Y|Z|ALL|ADD|RESET offset ...',/,4X,
|
|
$ 'SCALE X|Y|Z|ALL|MULTIPLY|RESET scale ...',/,4X,
|
|
$ 'REVOLVE X|Y|Z|RESET angle ...',/,4x,
|
|
$ 'REVCEN xcen, ycen, zcen ',/,4x,
|
|
$ 'LIST (lists nodesets)',/,4X,
|
|
$ 'EXPECT num_matches',//,4X,
|
|
$ 'NOTE: Coords of 2nd database = scale*old_coord+offset',/)
|
|
go to 110
|
|
ELSE IF (MATSTR(REPLY, 'EQUIVALENCE', 3) .OR.
|
|
$ MATSTR(REPLY, 'COMBINE', 3)) THEN
|
|
IF (MATSTR(CFIELD(2), 'END', 3) .OR.
|
|
$ MATSTR(CFIELD(2), 'EXIT',3) .OR.
|
|
$ MATSTR(CFIELD(2), 'NO', 1)) THEN
|
|
RENNP = .FALSE.
|
|
ELSE
|
|
RENNP = .TRUE.
|
|
END IF
|
|
ELSE IF (MATSTR(REPLY, 'YES', 1)) THEN
|
|
RENNP = .TRUE.
|
|
ELSE IF (MATSTR(REPLY, 'NO', 1) .or. MATSTR(REPLY, 'END',3)) THEN
|
|
RENNP = .FALSE.
|
|
else if (matstr(reply, 'LIST', 1)) then
|
|
CALL PRTNPS (A(KISTA), NNPS1, NNPS2, IDNPS, NNNPS, A(KISCR))
|
|
go to 110
|
|
else if (matstr(reply, 'MIRROR', 1)) then
|
|
ifld = 2
|
|
120 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XSCL = 1.
|
|
YSCL = 1.
|
|
ZSCL = 1.
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
XSCL = -1.
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
YSCL = -1.
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
ZSCL = -1.
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
* 'Z not allowed for 2D database')
|
|
END IF
|
|
ELSE IF (WORD .EQ. 'ALL') THEN
|
|
XSCL = -1.
|
|
YSCL = -1.
|
|
ZSCL = -1.
|
|
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 130
|
|
END IF
|
|
GOTO 120
|
|
END IF
|
|
|
|
130 CONTINUE
|
|
go to 110
|
|
ELSE IF (matstr(reply, 'REVOLVE', 4)) THEN
|
|
ifld = 2
|
|
DEGANG = ATAN2(0.0, -1.0) / 180.0
|
|
|
|
140 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 150 I = 1, 3
|
|
ROTMAT(I,I) = 1.0
|
|
150 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, *160)
|
|
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, *160)
|
|
ROT3D = .TRUE.
|
|
CALL ROTXYZ (WORD, DEG * DEGANG, ROTMAT)
|
|
ELSE
|
|
IF (NDIM .EQ. 3) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "Z" or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "Z" or "RESET"')
|
|
GOTO 160
|
|
END IF
|
|
GOTO 140
|
|
END IF
|
|
|
|
160 CONTINUE
|
|
go to 110
|
|
ELSE IF (matstr(reply, 'REVCEN', 4)) THEN
|
|
ifld = 2
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X revolution center', 0.0, ROTCEN(1), *170)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y revolution center', 0.0, ROTCEN(2), *170)
|
|
IF (NDIM .EQ. 3) CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z revolution center', 0.0, ROTCEN(3), *170)
|
|
IF (NDIM .EQ. 2) ROTCEN(3) = 0.0
|
|
|
|
170 CONTINUE
|
|
go to 110
|
|
else IF (matstr(reply, 'OFFSET', 1) .OR.
|
|
$ matstr(reply, 'SHIFT', 2)) THEN
|
|
ifld = 2
|
|
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
|
|
C IF (INTYP(IFLD) .EQ. 0) THEN
|
|
C Check if character field has 'X','Y', or 'Z'
|
|
IF ((INTYP(IFLD) .EQ. 0) .OR. ((CFIELD(IFLD) .GE. 'A')
|
|
& .AND. (CFIELD(IFLD) .LE. 'Z'))) THEN
|
|
180 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XOFF = 0.0
|
|
YOFF = 0.0
|
|
ZOFF = 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, *190)
|
|
XOFF = RMULT * XOFF + TOFFS
|
|
YOFF = RMULT * YOFF + TOFFS
|
|
ZOFF = RMULT * ZOFF + TOFFS
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X coordinate offset', 0.0, TOFFS, *190)
|
|
XOFF = RMULT * XOFF + TOFFS
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y coordinate offset', 0.0, TOFFS, *190)
|
|
YOFF = RMULT * YOFF + TOFFS
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z coordinate offset', 0.0, TOFFS, *190)
|
|
ZOFF = RMULT * ZOFF + 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 190
|
|
END IF
|
|
GOTO 180
|
|
END IF
|
|
ELSE
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X coordinate offset', XOFF, XOFF, *190)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y coordinate offset', YOFF, YOFF, *190)
|
|
IF (NDIM .EQ. 3) CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z coordinate offset', ZOFF, ZOFF, *190)
|
|
END IF
|
|
190 CONTINUE
|
|
go to 110
|
|
C ------------------------------ SCALE -----------------------------
|
|
else IF (matstr(reply, 'SCALE', 2)) THEN
|
|
ifld = 2
|
|
|
|
IF (INTYP(IFLD) .EQ. 0) THEN
|
|
200 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (MATSTR (WORD, 'RESET', 1)) THEN
|
|
XSCL = 1.0
|
|
YSCL = 1.0
|
|
ZSCL = 1.0
|
|
ELSE IF (MATSTR (WORD, 'ALL', 2)) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'model scale', 1.0, TSCL, *210)
|
|
XSCL = TSCL
|
|
YSCL = TSCL
|
|
ZSCL = TSCL
|
|
ELSE IF (WORD .EQ. 'X') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X coordinate scale', 1.0, XSCL, *210)
|
|
ELSE IF (WORD .EQ. 'Y') THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y coordinate scale', 1.0, YSCL, *210)
|
|
ELSE IF (WORD .EQ. 'Z') THEN
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z coordinate scale', 1.0, ZSCL, *210)
|
|
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",'//
|
|
$ 'or "RESET"')
|
|
IF (NDIM .EQ. 2) CALL PRTERR ('CMDERR',
|
|
& 'Expected "X", "Y", "ALL", or "RESET"')
|
|
GOTO 210
|
|
END IF
|
|
GOTO 200
|
|
END IF
|
|
ELSE
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'X coordinate scale', XSCL, XSCL, *210)
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Y coordinate scale', YSCL, YSCL, *210)
|
|
IF (NDIM .EQ. 3) CALL FFREAL (IFLD, INTYP, RFIELD,
|
|
& 'Z coordinate scale', ZSCL, ZSCL, *210)
|
|
END IF
|
|
210 CONTINUE
|
|
go to 110
|
|
C ------------------------------ EXPECT -----------------------------
|
|
else IF (matstr(reply, 'EXPECT', 3)) THEN
|
|
ifld = 2
|
|
call ffintg (ifld, intyp, ifield,
|
|
$ 'number of expected matches', 0, IEXPCT, *215)
|
|
215 CONTINUE
|
|
go to 110
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
$ 'Unrecognized response, Please Reenter')
|
|
CALL PRTERR ('CMDSPEC',
|
|
$ 'Valid Response: Yes, No, COMbine, EQUivalence')
|
|
GO TO 110
|
|
END IF
|
|
|
|
IF (IOSTAT .LT. 0) GOTO 240
|
|
|
|
MATNS1 = 0
|
|
MATNS2 = 0
|
|
TOLER = -999.0
|
|
|
|
C ... Parse Command lines:
|
|
C EQUIVALENCE [NS1 NS2] TOLER [CLOSEST|MATERIAL]
|
|
|
|
IF (RENNP .AND. (NNPS1 .GT. 0) .AND. (NNPS2 .GT. 0)) THEN
|
|
IF (NUMFLD .EQ. 2) THEN
|
|
|
|
C ... 'EQUIV' TOLER
|
|
TOLER = RFIELD(2)
|
|
|
|
ELSE IF (NUMFLD .EQ. 3 .AND. INTYP(3) .NE. 0) THEN
|
|
|
|
C ... 'EQUIV' NS1 NS1
|
|
ONSET = .TRUE.
|
|
|
|
ELSE IF (NUMFLD .EQ. 3 .AND. INTYP(3) .EQ. 0) THEN
|
|
|
|
C ... 'EQUIV' TOLER 'CLOSEST' | 'MATERIAL'
|
|
TOLER = RFIELD(2)
|
|
IF (MATSTR(CFIELD(3),'CLOSEST',1)) THEN
|
|
CLOSE = .TRUE.
|
|
ELSE IF (MATSTR(CFIELD(3),'MATERIAL',1)) THEN
|
|
MATMAT = .TRUE.
|
|
ELSE
|
|
CALL PRTERR ('CMDWARN',
|
|
$ 'Unrecognized EQUIV Option: '//CFIELD(3))
|
|
END IF
|
|
|
|
ELSE IF (NUMFLD .EQ. 4 .and.
|
|
$ intyp(3) .eq. 0 .and. intyp(4) .eq. 0) THEN
|
|
|
|
C ... 'EQUIV' TOLER 'CLOSEST' 'MATERIAL'
|
|
onset = .FALSE.
|
|
TOLER = RFIELD(2)
|
|
IF (MATSTR(CFIELD(3),'CLOSEST',1)) CLOSE = .TRUE.
|
|
IF (MATSTR(CFIELD(3),'MATERIAL',1)) MATMAT = .TRUE.
|
|
IF (MATSTR(CFIELD(4),'CLOSEST',1)) CLOSE = .TRUE.
|
|
IF (MATSTR(CFIELD(4),'MATERIAL',1)) MATMAT = .TRUE.
|
|
|
|
ELSE IF (NUMFLD .EQ. 4 .and.
|
|
$ intyp(3) .ne. 0 .and. intyp(4) .ne. 0) THEN
|
|
C ... 'EQUIV' NS1 NS2 TOLER
|
|
ONSET = .TRUE.
|
|
TOLER = RFIELD(4)
|
|
|
|
ELSE IF (NUMFLD .GE. 5) THEN
|
|
|
|
C ... 'EQUIV' NS1 NS2 TOLER 'CLOSEST'|'MATERIAL'
|
|
ONSET = .TRUE.
|
|
TOLER = RFIELD(4)
|
|
IF (MATSTR(CFIELD(5),'CLOSEST',1)) CLOSE = .TRUE.
|
|
if (MATSTR(CFIELD(5),'MATERIAL',1)) MATMAT = .TRUE.
|
|
if (numfld .eq. 6) then
|
|
IF (MATSTR(CFIELD(6),'CLOSEST',1)) CLOSE = .TRUE.
|
|
if (MATSTR(CFIELD(6),'MATERIAL',1)) MATMAT = .TRUE.
|
|
end if
|
|
ELSE IF (NUMFLD .EQ. 1) THEN
|
|
CALL FREFLD (0, 0,
|
|
* 'Should a nodal point set match be done? ',
|
|
* MAXFLD, IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
CALL OUTLOG (KLOG, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
|
|
REPLY = CFIELD(1)
|
|
CALL EXUPCS (REPLY)
|
|
ONSET = (REPLY(1:1) .EQ. 'Y')
|
|
IF (IOSTAT .LT. 0) GOTO 240
|
|
else
|
|
call prterr ('PROGRAM',
|
|
$ 'Unrecognized command line format, try again.')
|
|
write (*,*)
|
|
$ 'EQUIV [nset1 nset2] toler [material]'
|
|
END IF
|
|
|
|
IF (ONSET) THEN
|
|
CALL PRTNPS (A(KISTA), NNPS1, NNPS2, IDNPS, NNNPS, A(KISCR))
|
|
|
|
220 CONTINUE
|
|
IF (NUMFLD .GE. 3) THEN
|
|
IFLD = 2
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
NUMFLD = 1
|
|
ELSE
|
|
WRITE (*, *)
|
|
CALL FREFLD (0, 0,
|
|
& 'Enter set ID of first set, second set> ', MAXFLD,
|
|
& IOSTAT, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
IF (IOSTAT .LT. 0) GOTO 240
|
|
IF (NUMFLD .EQ. 0) GOTO 220
|
|
CALL OUTLOG (KLOG, NUMFLD, INTYP, CFIELD, IFIELD, RFIELD)
|
|
|
|
INTYP(MIN(MAXFLD,NUMFLD)+1) = -999
|
|
IFLD = 1
|
|
END IF
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
& 'first set ID', 0, ID1, *220)
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
& 'second set ID', 0, ID2, *220)
|
|
IX1 = LOCINT (ID1, NNPS1, IDNPS)
|
|
IX2 = LOCINT (ID2, NNPS2, IDNPS(NNPS1+1))
|
|
IF ((IX1 .LE. 0) .AND. (IX2 .LE. 0)) THEN
|
|
CALL PRTERR ('CMDERR', 'Invalid set ID for both sets')
|
|
ELSE IF (IX1 .LE. 0) THEN
|
|
CALL PRTERR ('CMDERR', 'Invalid set ID for first set')
|
|
ELSE IF (IX2 .LE. 0) THEN
|
|
CALL PRTERR ('CMDERR', 'Invalid set ID for second set')
|
|
END IF
|
|
IF ((IX1 .LE. 0) .OR. (IX2 .LE. 0)) GOTO 110
|
|
IX2 = NNPS1 + IX2
|
|
MATNS1 = IX1
|
|
MATNS2 = IX2
|
|
|
|
END IF
|
|
ELSE IF (NUMFLD .GE. 2) THEN
|
|
C ... 'EQUIV' TOLER 'CLOSEST'|'MATERIAL'
|
|
TOLER = RFIELD(2)
|
|
DO 230 IFLD = 3, NUMFLD
|
|
if (intyp(ifld) .ne. 0) then
|
|
CALL PRTERR ('CMDWARN',
|
|
$ 'Unrecognized EQUIV Option: '//CFIELD(IFLD))
|
|
CALL PRTERR ('CMDWARN',
|
|
$ 'Expected `CLOSEST` and/or `MATERIAL`')
|
|
goto 110
|
|
end if
|
|
IF (MATSTR(CFIELD(IFLD),'CLOSEST',1)) THEN
|
|
CLOSE = .TRUE.
|
|
ELSE IF (MATSTR(CFIELD(IFLD),'MATERIAL',1)) THEN
|
|
MATMAT = .TRUE.
|
|
ELSE
|
|
CALL PRTERR ('CMDWARN',
|
|
$ 'Unrecognized EQUIV Option: '//CFIELD(IFLD))
|
|
goto 110
|
|
END IF
|
|
230 CONTINUE
|
|
END IF
|
|
240 CONTINUE
|
|
if (nnps1 + nnps2 .gt. 0) then
|
|
CALL MDDEL ('ISTA')
|
|
CALL MDDEL ('ISCR')
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) CALL MEMERR
|
|
end if
|
|
|
|
RETURN
|
|
END
|
|
|