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
|
SUBROUTINE TRPLMD (GMAT,DMAT,BMAT,BMAT1,BMAT2,MATTYP,JCOR,WTK)
C
C ROUTINE TO PERFORM THE TRIPLE MULTIPLY AT EACH INTEGRATION
C POINT FOR THE QUAD4 ELEMENT.
C DIFFERENT PATHS ARE TAKEN BASED ON THE FOLLOWING CRITERIA -
C 1- ELEMENT BEING A MEMBRANE ONLY, OR BENDING ONLY, OR BOTH
C MEMBRANE AND BENDING ELEMENT.
C 2- THE MATERIAL PROPERTIES BEING ISOTROPIC OR NOT.
C 3- THE MACHINE THIS CODE IS RUNNING ON. (TENTATIVE)
C
DOUBLE PRECISION WTK,AKGG,GMAT(10,10),DMAT(7,7)
DOUBLE PRECISION BMAT(240),BMAT1(1),BMAT2(1)
DOUBLE PRECISION DBM(240),DMAT1(3,3),DMAT2(4,4)
C
LOGICAL MEMBRN,BENDNG,SHRFLX,MBCOUP,NORPTH
C
COMMON /TERMS / MEMBRN,BENDNG,SHRFLX,MBCOUP,NORPTH
COMMON /ZZZZZZ/ AKGG(1)
COMMON /TRPLM / NDOF,IBOT,IPTX1,IPTX2,IPTY1,IPTY2
C
C*****
C INITIALIZE
C*****
ND1 = NDOF
ND2 = ND1 * 2
ND3 = ND1 * 3
ND4 = ND1 * 4
ND5 = ND1 * 5
ND6 = ND1 * 6
ND7 = ND1 * 7
ND8 = ND1 * 8
ND9 = ND1 * 9
NDA = ND1 * 10
IF (.NOT.NORPTH) GO TO 500
C*****
C ALL MIDS ARE THE SAME AND THERE IS NO COUPLING.
C IF THE MATERIAL IS ISOTROPIC, PERFORM THE 1ST MUTIPLY EXPLICITLY.
C IF NOT, USE GMMATD. IN EITHER CASE, THE 2ND MULTIPLY USES GMMATD.
C*****
DO 100 I=1,ND1
BMAT(I+ND2) = BMAT2(I+IBOT )
BMAT(I+ND3) = BMAT1(I+IPTY1 )
BMAT(I+ND4) = BMAT1(I+IPTY2 )
BMAT(I+ND5) = BMAT1(I+IPTX1+ND1)
100 BMAT(I+ND6) = BMAT1(I+IPTX2+ND1)
C
IF (MATTYP .NE. 1) GO TO 300
DO 200 I=1,ND1
DBM (I ) = DMAT(1,1)*BMAT(I ) + DMAT(1,2)*BMAT(I+ND1)
DBM (I+ND1) = DMAT(2,1)*BMAT(I ) + DMAT(2,2)*BMAT(I+ND1)
DBM (I+ND2) = DMAT(3,3)*BMAT(I+ND2)
DBM (I+ND3) = DMAT(4,4)*BMAT(I+ND3) + DMAT(4,5)*BMAT(I+ND4)
DBM (I+ND4) = DMAT(5,4)*BMAT(I+ND3) + DMAT(5,5)*BMAT(I+ND4)
DBM (I+ND5) = DMAT(6,6)*BMAT(I+ND5) + DMAT(6,7)*BMAT(I+ND6)
200 DBM (I+ND6) = DMAT(7,6)*BMAT(I+ND5) + DMAT(7,7)*BMAT(I+ND6)
GO TO 400
C
300 CALL GMMATD (DMAT,7,7,0,BMAT,7,ND1,0,DBM)
C
400 DO 420 I=1,ND7
420 BMAT(I) = BMAT(I)*WTK
CALL GMMATD (BMAT,7,ND1,-1,DBM,7,ND1,0,AKGG(JCOR))
RETURN
C*****
C MIDS ARE NOT THE SAME. CHECK FOR MEMBRANE ONLY AND BENDING ONLY
C CASES AND BRANCH APPROPRIATELY. IF BOTH ARE THERE, CONTINUE.
C*****
500 IF (.NOT.BENDNG) GO TO 800
IF (.NOT.MEMBRN) GO TO 1200
DO 600 I=1,ND1
BMAT(I+ND2) = BMAT2(I+IBOT )
BMAT(I+ND5) = BMAT2(I+IBOT+ND1 )
BMAT(I+ND6) = BMAT1(I+IPTY1 )
BMAT(I+ND7) = BMAT1(I+IPTY2 )
BMAT(I+ND8) = BMAT1(I+IPTX1+ND1)
600 BMAT(I+ND9) = BMAT1(I+IPTX2+ND1)
C
CALL GMMATD (GMAT,10,10,0,BMAT,10,ND1,0,DBM)
C
DO 750 I=1,NDA
750 BMAT(I) = BMAT(I)*WTK
CALL GMMATD (BMAT,10,ND1,-1,DBM,10,ND1,0,AKGG(JCOR))
RETURN
C*****
C MEMBRANE ONLY ELEMENT. ONLY THE FIRST 3X3 OF GMAT AND THE FIRST
C 3 ROWS OF BMAT ARE MULTIPLIED.
C*****
800 DO 900 I=1,ND1
900 BMAT(I+ND2) = BMAT2(I+IBOT)
C
IF (MATTYP .NE. 1) GO TO 950
DO 920 I=1,ND1
DBM (I ) = GMAT(1,1)*BMAT(I ) + GMAT(1,2)*BMAT(I+ND1)
DBM (I+ND1) = GMAT(2,1)*BMAT(I ) + GMAT(2,2)*BMAT(I+ND1)
920 DBM (I+ND2) = GMAT(3,3)*BMAT(I+ND2)
GO TO 1050
C
950 DO 1000 I=1,3
DO 1000 J=1,3
1000 DMAT1(I,J) = GMAT(I,J)
CALL GMMATD (DMAT1,3,3,0,BMAT(1),3,ND1,0,DBM(1))
C
1050 DO 1100 I=1,ND3
1100 BMAT(I) = BMAT(I)*WTK
CALL GMMATD (BMAT,3,ND1,-1,DBM,3,ND1,0,AKGG(JCOR))
RETURN
C*****
C BENDING ONLY ELEMENT. THE FIRST 3 ROWS AND COLUMNS OF GMAT AND
C THE FIRST 3 ROWS OF BMAT WILL BE EXCLUDED FROM MULTIPLICATIONS.
C*****
1200 DO 1300 I=1,ND1
BMAT(I+ND6) = BMAT1(I+IPTY1 )
BMAT(I+ND7) = BMAT1(I+IPTY2 )
BMAT(I+ND8) = BMAT1(I+IPTX1+ND1)
1300 BMAT(I+ND9) = BMAT1(I+IPTX2+ND1)
C
DO 1400 I=1,3
DO 1400 J=1,3
1400 DMAT1(I,J) = GMAT(I+3,J+3)
DO 1500 I=1,4
DO 1500 J=1,4
1500 DMAT2(I,J) = GMAT(I+6,J+6)
C
CALL GMMATD (DMAT1,3,3,0,BMAT(ND3+1),3,ND1,0,DBM(1 ))
CALL GMMATD (DMAT2,4,4,0,BMAT(ND6+1),4,ND1,0,DBM(ND3+1))
C
DO 1600 I=ND3+1,NDA
1600 BMAT(I) = BMAT(I)*WTK
CALL GMMATD (BMAT(ND3+1),7,ND1,-1,DBM,7,ND1,0,AKGG(JCOR))
RETURN
C
END
|
