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.
78 lines
2.6 KiB
78 lines
2.6 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 SHWINT (ITRANT, NEREPL, DIM3, NRTRAN, D3TRAN, ZGRAD)
|
|
C=======================================================================
|
|
|
|
INTEGER NRTRAN(*)
|
|
REAL D3TRAN(*), ZGRAD(*)
|
|
|
|
CHARACTER*20 RSTR(9)
|
|
CHARACTER*20 STRA, TYPE
|
|
|
|
CALL INTSTR (1, 0, NEREPL, STRA, LSTRA)
|
|
CALL NUMSTR (1, 4, DIM3, RSTR(1), LR)
|
|
|
|
IF (ITRANT .EQ. 0) THEN
|
|
TYPE = 'Transform'
|
|
ELSE IF (ITRANT .EQ. 1) THEN
|
|
TYPE = 'Translate'
|
|
ELSE IF (ITRANT .EQ. 2) THEN
|
|
TYPE = 'Rotate'
|
|
ELSE IF (ITRANT .EQ. 4) THEN
|
|
TYPE = 'Warp'
|
|
ELSE IF (ITRANT .EQ. 8) THEN
|
|
TYPE = 'Twist'
|
|
ELSE IF (ITRANT .EQ. 16) THEN
|
|
TYPE = 'Project'
|
|
ELSE IF (ITRANT .EQ. 32) THEN
|
|
TYPE = 'ExpRotate'
|
|
ELSE IF (ITRANT .EQ. 64) THEN
|
|
TYPE = 'Spline'
|
|
ELSE
|
|
CALL PRTERR ('PROGRAM', 'Unknown transformation option')
|
|
RETURN
|
|
END IF
|
|
|
|
LT = LENSTR(TYPE)
|
|
|
|
IF (NEREPL .EQ. NRTRAN(1)) THEN
|
|
IF (ABS (ZGRAD(1) - 1.0) .LE. 1.0E-6) THEN
|
|
WRITE (*, 20) TYPE(:LT), ' mesh ', STRA(:LSTRA),
|
|
& ' times for a total of ', RSTR(1)(:LR)
|
|
ELSE
|
|
CALL NUMSTR (1, 3, ZGRAD(1), RSTR(2), LR2)
|
|
WRITE (*, 20) TYPE(:LT), ' mesh ', STRA(:LSTRA),
|
|
& ' times for a total of ', RSTR(1)(:LR),
|
|
& ' with a gradient of ', RSTR(2)(:LR2)
|
|
END IF
|
|
ELSE
|
|
IBLK = 0
|
|
NR = 0
|
|
10 CONTINUE
|
|
IF (.TRUE.) THEN
|
|
IBLK = IBLK + 1
|
|
NR = NR + NRTRAN(IBLK)
|
|
CALL INTSTR (1, 0, NRTRAN(IBLK), STRA, LSTRA)
|
|
CALL NUMSTR (1, 4, D3TRAN(IBLK), RSTR(1), LR)
|
|
IF (ABS (ZGRAD(IBLK) - 1.0) .LE. 0.001) THEN
|
|
WRITE (*, 20) TYPE(:LT), ' mesh ',
|
|
& STRA(:LSTRA), ' times for a subtotal of ',
|
|
& RSTR(1)(:LR)
|
|
ELSE
|
|
CALL NUMSTR (1, 3, ZGRAD(IBLK), RSTR(2), LR2)
|
|
WRITE (*, 20) TYPE(:LT), ' mesh ',
|
|
& STRA(:LSTRA), ' times for a subtotal of ',
|
|
& RSTR(1)(:LR), ' with a gradient of ',
|
|
& RSTR(2)(:LR2)
|
|
END IF
|
|
IF (NR .LT. NEREPL) GOTO 10
|
|
END IF
|
|
END IF
|
|
20 FORMAT (1X, 10A)
|
|
RETURN
|
|
END
|
|
|