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.

204 lines
6.9 KiB

2 years ago
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 DOIF (TEST, PARTYP, LENARY, NELBLK, IXELB, ISEVOK,
& NUMIX, IXNODE, IXELEM, PARMC, PARMT, PARMF, RESULT)
C=======================================================================
C --*** DOIF *** (ALGEBRA) Perform operation (2 parameters)
C -- Written by Amy Gilkey - revised 05/17/88
C --
C --DOIF performs an operation with up to two parameters on each array
C --value.
C --
C --Parameters:
C -- TEST - IN - the operator character
C -- PARTYP - IN - the parameter type (element must be handled differently)
C -- LENARY - IN - the length of the parameter arrays
C -- NELBLK - IN - the number of element blocks
C -- IXELB - IN - the cumulative element counts for each element block
C -- ISEVOK - IN - the element variable truth table for each element block
C -- NUMIX - IN - the number of selected values; <0 if all
C -- IXNODE - IN - the indices of the selected nodes (only if NUMIX>=0)
C -- IXELEM - IN - the indices of the selected elements (only if NUMIX>=0)
C -- PARMC - IN - the condition arrays
C -- PARMT, PARMF - IN - the true and false result arrays
C -- RESULT - OUT - the returned result array
CHARACTER*(*) TEST
CHARACTER PARTYP
INTEGER IXELB(0:NELBLK)
LOGICAL ISEVOK(*)
INTEGER IXNODE(*)
INTEGER IXELEM(*)
REAL PARMC(*)
REAL PARMT(*), PARMF(*)
REAL RESULT(*)
IF (TEST .EQ. 'IFLZ') THEN
IF (NUMIX .GE. 0) THEN
IF (PARTYP .NE. 'E') THEN
DO 100 I = 1, NUMIX
J = IXNODE(I)
IF (PARMC(J) .LT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
100 CONTINUE
ELSE
DO 120 IELB = 1, NELBLK
IF (ISEVOK(IELB)) THEN
DO 110 I = IXELB(IELB-1)+1, IXELB(IELB)
J = IXELEM(I)
IF (PARMC(J) .LT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
110 CONTINUE
END IF
120 CONTINUE
END IF
ELSE
C NUMIX < 0; ALL VALUES SELECTED
C NUMEL=NUMELO; NUMNP=NUMNPO; IXELB(J)=IXELBO(J), J=1,NELBLK
IF (PARTYP .NE. 'E') THEN
DO 130 J = 1, LENARY
IF (PARMC(J) .LT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
130 CONTINUE
ELSE
DO 150 IELB = 1, NELBLK
IF (ISEVOK(IELB)) THEN
DO 140 J = IXELB(IELB-1)+1, IXELB(IELB)
IF (PARMC(J) .LT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
140 CONTINUE
END IF
150 CONTINUE
END IF
END IF
ELSE IF (TEST .EQ. 'IFEZ') THEN
IF (NUMIX .GE. 0) THEN
IF (PARTYP .NE. 'E') THEN
DO 160 I = 1, NUMIX
J = IXNODE(I)
IF (PARMC(J) .EQ. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
160 CONTINUE
ELSE
DO 180 IELB = 1, NELBLK
IF (ISEVOK(IELB)) THEN
DO 170 I = IXELB(IELB-1)+1, IXELB(IELB)
J = IXELEM(I)
IF (PARMC(J) .EQ. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
170 CONTINUE
END IF
180 CONTINUE
END IF
ELSE
C NUMIX < 0; ALL VALUES SELECTED
C NUMEL=NUMELO; NUMNP=NUMNPO; IXELB(J)=IXELBO(J), J=1,NELBLK
IF (PARTYP .NE. 'E') THEN
DO 190 J = 1, LENARY
IF (PARMC(J) .EQ. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
190 CONTINUE
ELSE
DO 210 IELB = 1, NELBLK
IF (ISEVOK(IELB)) THEN
DO 200 J = IXELB(IELB-1)+1, IXELB(IELB)
IF (PARMC(J) .EQ. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
200 CONTINUE
END IF
210 CONTINUE
END IF
END IF
ELSE IF (TEST .EQ. 'IFGZ') THEN
IF (NUMIX .GE. 0) THEN
IF (PARTYP .NE. 'E') THEN
DO 220 I = 1, NUMIX
J = IXNODE(I)
IF (PARMC(J) .GT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
220 CONTINUE
ELSE
DO 240 IELB = 1, NELBLK
IF (ISEVOK(IELB)) THEN
DO 230 I = IXELB(IELB-1)+1, IXELB(IELB)
J = IXELEM(I)
IF (PARMC(J) .GT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
230 CONTINUE
END IF
240 CONTINUE
END IF
ELSE
C NUMIX < 0; ALL VALUES SELECTED
C NUMEL=NUMELO; NUMNP=NUMNPO; IXELB(J)=IXELBO(J), J=1,NELBLK
IF (PARTYP .NE. 'E') THEN
DO 250 J = 1, LENARY
IF (PARMC(J) .GT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
250 CONTINUE
ELSE
DO 270 IELB = 1, NELBLK
IF (ISEVOK(IELB)) THEN
DO 260 J = IXELB(IELB-1)+1, IXELB(IELB)
IF (PARMC(J) .GT. 0.0) THEN
RESULT(J) = PARMT(J)
ELSE
RESULT(J) = PARMF(J)
END IF
260 CONTINUE
END IF
270 CONTINUE
END IF
END IF
END IF
RETURN
END