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 CMDMVW (VERB, INLINE, & IFLD, INTYP, CFIELD, IFIELD, RFIELD, & UNMESH, NEWMOD, ISSNPS, ISSESS, *) C======================================================================= C --*** CMDMVW *** (MESH) Process multiple view commands C -- Written by Amy Gilkey - revised 05/26/88 C -- C --Parameters: C -- VERB - IN/OUT - the verbs for the SHOW command C -- INLINE - IN/OUT - the parsed input line for the log file C -- IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field C -- reader index and fields C -- UNMESH - IN - the mesh limits C -- NEWMOD - OUT - the mode status of each view: C -- -1 = unchanged C -- 0 = changed to default C -- n = changed to be like view n C -- ISSNPS - IN/OUT - the indices of the selected node sets C -- ISSESS - IN/OUT - the indices of the selected side sets C -- C --Common Variables: C -- Uses NDIM of /DBNUMS/ C -- Uses IS3DIM of /D3NUMS/ C -- Sets and uses MSHDEF, MSHNUM, MSHLIN, MLNTYP, NNPSET, NESSET C -- of /MSHOPT/ PARAMETER (MSHNON=0, MSHBOR=1, MSHDIV=2, MSHSEL=3, MSHALL=4) PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4, KNEA=5, KFAR=6) include 'params.blk' include 'dbnums.blk' include 'dbnumgq.blk' include 'd3nums.blk' include 'mshopt.blk' include 'views.blk' CHARACTER*(*) VERB CHARACTER*(*) INLINE INTEGER INTYP(*) CHARACTER*(*) CFIELD(*) INTEGER IFIELD(*) REAL RFIELD(*) REAL UNMESH(KFAR) INTEGER NEWMOD(4) INTEGER ISSNPS(NUMNPS,4) INTEGER ISSESS(NUMESS,4) CHARACTER*(MXSTLN) WORD LOGICAL SYMCMD LOGICAL NEWSYM LOGICAL FFMATC, MATSTR IF ((VERB .EQ. 'XSYM') .OR. (VERB .EQ. 'XVIEW')) THEN CALL FFADDC (VERB, INLINE) SYMCMD = VERB(2:4) .EQ. 'SYM' IF (IS3DIM) THEN IF (SYMCMD) THEN CALL PRTERR ('CMDERR', 'Command allowed in 2D only') GOTO 100 END IF END IF IF (FFMATC (IFLD, INTYP, CFIELD, 'OFF', 3)) THEN CALL FFADDC ('OFF', INLINE) IF (MSHDEF(1) .EQ. 'NONE') THEN CALL PRTERR ('CMDERR', & 'Vertically divided views are not defined') GOTO 100 END IF C --Move main views from left to right, if needed IF (XISSYM .AND. (.NOT. LFTSYM)) THEN CALL CPYMSH (2, 1, ISSNPS, ISSESS) IF (MSHDEF(3) .NE. 'NONE') & CALL CPYMSH (4, 3, ISSNPS, ISSESS) END IF C --Delete left views CALL CPYMSH (1, 0, ISSNPS, ISSESS) IF (MSHDEF(3) .NE. 'NONE') & CALL CPYMSH (3, 0, ISSNPS, ISSESS) C --Reset symmetric views if one view XISSYM = .FALSE. IF (MSHDEF(4) .EQ. 'NONE') MULTIM = .FALSE. ELSE IF (SYMCMD) THEN C --Get symmetry axis IF (LFTSYM) THEN CALL FFCHAR (IFLD, INTYP, CFIELD, 'LEFT', WORD) ELSE CALL FFCHAR (IFLD, INTYP, CFIELD, 'RIGHT', WORD) END IF IF (MATSTR (WORD, 'LEFT', 1)) THEN CALL FFADDC ('LEFT', INLINE) NEWSYM = .TRUE. ELSE IF (MATSTR (WORD, 'RIGHT', 1)) THEN CALL FFADDC ('RIGHT', INLINE) NEWSYM = .FALSE. ELSE CALL PRTERR ('CMDERR', & 'Expected "LEFT", "RIGHT" or "OFF"') GOTO 100 END IF IF (FFMATC (IFLD, INTYP, CFIELD, 'CURSOR', 1)) THEN CALL PICK2D ('point on symmetry axis', .TRUE., & .TRUE., IFLD, INTYP, RFIELD, & XAXSYM, RDUM, *100) ELSE IF (NEWSYM .EQV. LFTSYM) THEN XS = XAXSYM ELSE IF (NEWSYM) THEN XS = UNMESH(KLFT) ELSE IF (.NOT. NEWSYM) THEN XS = UNMESH(KRGT) END IF CALL FFREAL (IFLD, INTYP, RFIELD, & 'symmetry axis', XS, XAXSYM, *100) END IF CALL FFADDR (XAXSYM, INLINE) XISSYM = .TRUE. LFTSYM = NEWSYM ELSE CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD) CALL FFADDC (WORD, INLINE) IF (WORD .NE. 'ON') THEN CALL PRTERR ('CMDERR', 'Expected "ON" or "OFF"') GOTO 100 END IF XISSYM = .FALSE. END IF C --Copy right views to left views, if not defined IF (MSHDEF(1) .EQ. 'NONE') THEN CALL CPYMSH (1, 2, ISSNPS, ISSESS) IF (MSHDEF(4) .NE. 'NONE') & CALL CPYMSH (3, 4, ISSNPS, ISSESS) END IF END IF ELSE IF ((VERB .EQ. 'YSYM') .OR. (VERB .EQ. 'YVIEW')) THEN CALL FFADDC (VERB, INLINE) SYMCMD = VERB(2:4) .EQ. 'SYM' IF (IS3DIM) THEN IF (SYMCMD) THEN CALL PRTERR ('CMDERR', 'Command allowed in 2D only') GOTO 100 END IF END IF IF (FFMATC (IFLD, INTYP, CFIELD, 'OFF', 3)) THEN CALL FFADDC ('OFF', INLINE) IF (MSHDEF(4) .EQ. 'NONE') THEN CALL PRTERR ('CMDERR', & 'Horizontally divided views are not defined') GOTO 100 END IF C --Move main views from bottom to top, if needed IF (YISSYM .AND. (.NOT. BOTSYM)) THEN CALL CPYMSH (2, 4, ISSNPS, ISSESS) IF (MSHDEF(3) .NE. 'NONE') & CALL CPYMSH (1, 3, ISSNPS, ISSESS) END IF C --Delete bottom views CALL CPYMSH (4, 0, ISSNPS, ISSESS) IF (MSHDEF(3) .NE. 'NONE') & CALL CPYMSH (3, 0, ISSNPS, ISSESS) C --Reset symmetric views if one view YISSYM = .FALSE. IF (MSHDEF(1) .EQ. 'NONE') MULTIM = .FALSE. ELSE IF (SYMCMD) THEN C --Get symmetry axis IF (BOTSYM) THEN CALL FFCHAR (IFLD, INTYP, CFIELD, 'BOTTOM', WORD) ELSE CALL FFCHAR (IFLD, INTYP, CFIELD, 'TOP', WORD) END IF IF (MATSTR (WORD, 'BOTTOM', 1)) THEN CALL FFADDC ('BOTTOM', INLINE) NEWSYM = .TRUE. ELSE IF (MATSTR (WORD, 'TOP', 1)) THEN CALL FFADDC ('TOP', INLINE) NEWSYM = .FALSE. ELSE CALL PRTERR ('CMDERR', & 'Expected "BOTTOM", "TOP" or "OFF"') GOTO 100 END IF IF (FFMATC (IFLD, INTYP, CFIELD, 'CURSOR', 1)) THEN CALL PICK2D ('point on symmetry axis', .TRUE., & .TRUE., IFLD, INTYP, RFIELD, & RDUM, YAXSYM, *100) ELSE IF (NEWSYM .EQV. BOTSYM) THEN YS = YAXSYM ELSE IF (NEWSYM) THEN YS = UNMESH(KBOT) ELSE IF (.NOT. NEWSYM) THEN YS = UNMESH(KTOP) END IF CALL FFREAL (IFLD, INTYP, RFIELD, & 'symmetry axis', YS, YAXSYM, *100) END IF CALL FFADDR (YAXSYM, INLINE) YISSYM = .TRUE. BOTSYM = NEWSYM ELSE CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD) CALL FFADDC (WORD, INLINE) IF (WORD .NE. 'ON') THEN CALL PRTERR ('CMDERR', 'Expected "ON" or "OFF"') GOTO 100 END IF YISSYM = .FALSE. END IF C --Copy top views to bottom views, if not defined IF (MSHDEF(4) .EQ. 'NONE') THEN CALL CPYMSH (4, 2, ISSNPS, ISSESS) IF (MSHDEF(1) .NE. 'NONE') & CALL CPYMSH (3, 1, ISSNPS, ISSESS) END IF END IF END IF RETURN 100 CONTINUE RETURN 1 END