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.
 
 
 
 
 
 

95 lines
1.9 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
C=======================================================================
SUBROUTINE PLTNIC(X,TYPE,FN,NE,INTER,NMIN)
CHARACTER*(*) TYPE
CHARACTER*1 TTYPE
REAL FNICE(11),INTERA(11),INTER
INTEGER NMINA(11)
DATA FNICE/0.,1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
DATA INTERA/1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1./
DATA NMINA/10,10,10,10,5,5,5,5,5,5,5/
TTYPE = TYPE
CALL CHRUP(TTYPE,TTYPE)
IF (X.EQ.0.) THEN
FN = 0.
NE = 0
RETURN
END IF
XTEMP = ABS(X)
IF (X.LT.0. .AND. TTYPE.EQ.'O') THEN
TTYPE = 'U'
ELSE IF (X.LT.0. .AND. TTYPE.EQ.'U') THEN
TTYPE = 'O'
END IF
E1 = LOG10(XTEMP)
JE = INT(E1)
IF (JE.LE.0. .AND. XTEMP.LT.1.) THEN
JE = JE - 1
END IF
IF (JE.LT.0) THEN
E2 = 1./10.** (-JE)
ELSE IF (JE.EQ.0) THEN
E2 = 1.
ELSE IF (JE.GT.0) THEN
E2 = 10.**JE
END IF
F1 = XTEMP/E2
IF (TTYPE.EQ.'O') THEN
DO 2910 I = 1,11
IF (F1/1.007.LE.FNICE(I)) THEN
GO TO 2920
END IF
2910 CONTINUE
2920 CONTINUE
END IF
IF (TTYPE.EQ.'U') THEN
DO 2930 I = 11,1,-1
IF (F1*1.007.GE.FNICE(I)) THEN
GO TO 2940
END IF
2930 CONTINUE
2940 CONTINUE
END IF
IF (I.GT.11) THEN
I = 11
END IF
IF (I.LT.1) THEN
I = 1
END IF
FN = FNICE(I)
INTER = INTERA(I)
NMIN = NMINA(I)
NE = JE
IF (X.LT.0.) THEN
FN = -FN
END IF
IF (FN.EQ.0.) THEN
NE = 0
END IF
RETURN
END