Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
 
 
 
 
 
 

76 lines
2.4 KiB

C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details
SUBROUTINE COMSRT (MXND, MXCORN, MXPICK, MLN, LNODES, LCORN,
& NCORN, ICOMB, ITYPE, NPICK)
C***********************************************************************
C SUBROUTINE COMSRT = THIS SUBROUTINE GETS ALL THE COMBINATIONS
C POSSIBLE OF CORNERS, SIDES, AND DISSECION
C NODES
C***********************************************************************
C VARIABLES USED:
C ICOMB = THE DIFFERENT VALID PRIMITIVE COMBINATIONS
C ICOMB (I, J) WHERE I IS THE COMBINATION NUMBER
C AND J IS THE CORNER NUMBER.
C THE VALUE OF ICOMB (I,J) IS 1 FOR CORNER AND 0 FOR
C FOR A SIDE INTERPRETATION
C ITYPE = THE TYPE OF PRIMITIVE OR NUMBER OF CORNERS IN THIS
C COMBINATION.
C = 0 FOR A CIRCLE
C = 1 FOR A TEARDROP
C = 2 FOR A SEMICIRCLE
C = 3 FOR A TRIANGLE
C = 4 FOR A RECTANGLE
C = >4 OTHERWISE
C***********************************************************************
DIMENSION LNODES (MLN, MXND), ICOMB (MXCORN, MXPICK)
DIMENSION ITYPE (MXPICK), LCORN (MXCORN)
NPICK = 1
DO 100 I = 1, MXPICK
ITYPE (I) = 0
100 CONTINUE
DO 150 I = 1, NCORN
C PUT PURE CORNER AND CORNER/SIDE DESIGNATIONS IN ORDER
ITEST = LNODES (6, LCORN (I))
IF (ITEST .LE. 2) THEN
DO 110 J = 1, NPICK
ICOMB (I, J) = 1
ITYPE (J) = ITYPE (J) + 1
110 CONTINUE
IF (ITEST .EQ. 2) THEN
DO 130 J = NPICK + 1, NPICK * 2
DO 120 K = 1, I - 1
ICOMB (K, J) = ICOMB (K, J - NPICK)
120 CONTINUE
ITYPE (J) = ITYPE (J - NPICK) - 1
ICOMB (I, J) = 0
130 CONTINUE
NPICK = NPICK * 2
ENDIF
C PUT PURE SIDE AND SIDE/DISSECTIONS DESIGNATIONS IN ORDER
ELSEIF (ITEST .LE. 4) THEN
DO 140 J = 1, NPICK
ICOMB (I, J) = 0
140 CONTINUE
ENDIF
150 CONTINUE
RETURN
END