1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
SUBROUTINE TRMEMD
C
C THIS SUBROUTINE CALCULATES THE STIFFNESS AND MASS MATRICES FOR
C THE TRIANGULAR MEMBRANE ELEMENT. CALCULATIONS ARE PERFORMED
C PRIMARILY BY SUBROUTINES EKTRMS AND EMASTQ.
C DOUBLE PRECISION VERSION
C
C ECPT FOR THE TRMEM ELEMENT
C***********************************************************************
C INDEX DESCRIPTION TYPE
C ***** *********** ****
C 1 ELEMENT ID I
C 2-4 GRID POINTS A,B,AND C I
C 5 THETA = ANGLE OF MATERIAL R
C 6 MATERIAL ID I
C 7 T R
C 8 NON-STRUCTURAL MASS R
C 9 COORDINATE SYSTEM ID 1 I
C 10-12 X1,Y1,Z1 R
C 13 COORDINATE SYSTEM ID 2 I
C 14-16 X2,Y2,Z2 R
C 17 COORDINATE SYSTEM ID 3 I
C 18-20 X3,Y3,Z3 R
C 21 ELEMENT TEMPERATURE R
C***********************************************************************
DOUBLE PRECISION K,KOUT,M(9),MOUT(9),KSAVE
1, A,PROD9,TEMP9,XSUB,BFACT,E
LOGICAL NOGO,HEAT
INTEGER ELID,ESTID, DICT(10), IPART(3), NECPT(50), NGRID(3)
C
COMMON /SYSTEM / KSYSTM (60)
COMMON /EMGPRM / DM(15),ISMB(3),IPREC,NOGO,HEAT,ICMBAR
COMMON /EMGDIC / QQ(3), ELID, ESTID
COMMON /EMGEST / ECPT(50)
COMMON /EMGTRX / A(225),PROD9(9),TEMP9(9),XSUB(3),BFACT,
X E(18), K(324), KOUT(324),KSAVE(81)
C
EQUIVALENCE (ECPT(1),NECPT(1),IELID), (DICT5,DICT(5))
EQUIVALENCE (K(1),M(1)),(KOUT(1),MOUT(1)),(KSYSTM(2),IOUTPT)
EQUIVALENCE (KSYSTM(56), IHEAT), (ECPT(2), NGRID(1))
C
DATA IPART / 1,2, 3/
C
C
C
IP = IPREC
DICT(1) = ESTID
C
C CREATE AN ARRAY POINTING TO GRID POINTS IN INCREASING ORDER
C
100 DO 140 I=1,2
IP1 = I+1
II = IPART(I)
DO 120 J=IP1,3
JJ = IPART(J)
IF (NGRID(II).LE. NGRID(JJ)) GOTO 120
IPART(I) =JJ
IPART(J) =II
II = JJ
GO TO 100
120 CONTINUE
140 CONTINUE
C
C IF STIFFNESS MATRIX IS REQUESTED CALL EKTRMS. OTHERWISE GO TO
C MASS MATRIX CALCULATION SECTION
C
IF (ISMB(1) .EQ. 0 ) GO TO 300
C
CALL EKTRMD (0)
C
IF (NOGO) RETURN
C
C RE-ORDER THE STIFFNESS MATRIX BY INCREASING SIL VALUE
C
IF (HEAT) GO TO 200
DO 190 I=1,3
II = IPART(I)
DO 180 J=1,3
JJ = IPART(J)
DO 170 KA=1,3
DO 160 L=1,3
ISAVE = (II-1)*27 + (JJ-1) *9 + (KA-1)*3 + L
IOUT = (I-1)*27 + (J-1)*3 + (KA-1)*9 + L
160 K(IOUT)=KSAVE(ISAVE)
170 CONTINUE
180 CONTINUE
190 CONTINUE
C OUTPUT THE MATRIX
DICT(2)=1
DICT(3)=9
DICT(4)=7
C
CALL EMGOUT(K,K,81,1,DICT,1,IP)
GO TO 300
C
C OUTPUT HEAT MATRIX HERE
C
200 DO 260 I=1,3
DO 240 J=1,3
IOUT = (I-1)* 3+ J
IK = (IPART(I)-1)* 3 + IPART(J)
240 K(IOUT)=KSAVE(IK)
260 CONTINUE
C OUTPUT HEAT K
DICT(2) = 1
DICT(3) = 3
DICT(4) = 1
C
CALL EMGOUT (K,K,9,1,DICT,1,IP)
C
C PERFORM MASS MATRIX CALCULATIONS HERE
C
300 IF (ISMB(2) .EQ.0) RETURN
C
C CONVENTIONAL MASS MATRIX
C
CALL EMADTQ (4,M)
C REORDER THE MASS MATRIX
IF (HEAT) GO TO 350
DO 340 I=1,3
II = (I-1)*3
IJ = IPART(I)
JJ = (IJ-1)*3
DO 320 J=1,3
IOUT = II + J
IK = JJ + J
320 MOUT(IOUT) = M(IK)
340 CONTINUE
C
DICT(2) =2
DICT(3) = 9
DICT(4) = 7
C
CALL EMGOUT (MOUT, MOUT, 9,1,DICT,2,IP)
RETURN
C
C HEAT FORMULATION
C
350 DO 360 I=1,3
J=IPART(I)
360 MOUT(I)=M(J)
DICT(2)=2
DICT(3)=3
DICT(4)=1
C
CALL EMGOUT(MOUT,MOUT,3,1,DICT,2,IP)
RETURN
C
END
|
