OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
assem_s10.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| assem_s10 ../engine/source/implicit/assem_s10.F
25!||--- called by ------------------------------------------------------
26!|| s10ke3 ../engine/source/elements/solid/solide10/s10ke3.F
27!||--- calls -----------------------------------------------------
28!|| ass10_kkii ../engine/source/implicit/assem_s10.F
29!|| ass10_kkij ../engine/source/implicit/assem_s10.F
30!|| ass10_kkji ../engine/source/implicit/assem_s10.F
31!|| assem_kii ../engine/source/implicit/imp_glob_k.F
32!|| assem_kij ../engine/source/implicit/imp_glob_k.F
33!||--- uses -----------------------------------------------------
34!|| element_mod ../common_source/modules/elements/element_mod.f90
35!||====================================================================
36 SUBROUTINE assem_s10(
37 1 IXS ,IXS10 ,NEL ,IDDL ,NDOF ,
38 2 K_DIAG,K_LT ,IADK ,JDIK ,K11 ,
39 3 K12 ,K13 ,K14 ,K15 ,K16 ,
40 4 K17 ,K18 ,K19 ,K10 ,K22 ,
41 5 K23 ,K24 ,K25 ,K26 ,K27 ,
42 6 K28 ,K29 ,K20 ,K33 ,K34 ,
43 7 K35 ,K36 ,K37 ,K38 ,K39 ,
44 8 K30 ,K44 ,K45 ,K46 ,K47 ,
45 9 K48 ,K49 ,K40 ,K55 ,K56 ,
46 A K57 ,K58 ,K59 ,K50 ,K66 ,
47 B K67 ,K68 ,K69 ,K60 ,K77 ,
48 C K78 ,K79 ,K70 ,K88 ,K89 ,
49 D K80 ,K99 ,K90 ,K00 ,OFF )
50 use element_mod , only : nixs
51C----6---------------------------------------------------------------7---------8
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62C-----------------------------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER IXS(NIXS,*),IXS10(6,*),NEL ,IDDL(*) ,NDOF(*) ,
66 . IADK(*) ,JDIK(*)
67C REAL
68 my_real
69 . K_DIAG(*) ,K_LT(*) ,OFF(*),
70 . K11(9,*) ,K12(9,*) ,K13(9,*) ,K14(9,*) ,K15(9,*) ,
71 . K16(9,*) ,K17(9,*) ,K18(9,*) ,K19(9,*) ,K10(9,*) ,
72 . K22(9,*) ,K23(9,*) ,K24(9,*) ,K25(9,*) ,K26(9,*) ,
73 . K27(9,*) ,K28(9,*) ,K29(9,*) ,K20(9,*) ,K33(9,*) ,
74 . K34(9,*) ,K35(9,*) ,K36(9,*) ,K37(9,*) ,K38(9,*) ,
75 . K39(9,*) ,K30(9,*) ,K44(9,*) ,K45(9,*) ,K46(9,*) ,
76 . K47(9,*) ,K48(9,*) ,K49(9,*) ,K40(9,*) ,K55(9,*) ,
77 . K56(9,*) ,K57(9,*) ,K58(9,*) ,K59(9,*) ,K50(9,*) ,
78 . k66(9,*) ,k67(9,*) ,k68(9,*) ,k69(9,*) ,k60(9,*) ,
79 . k77(9,*) ,k78(9,*) ,k79(9,*) ,k70(9,*) ,k88(9,*) ,
80 . k89(9,*) ,k80(9,*) ,k99(9,*) ,k90(9,*) ,k00(9,*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER EP,NN(MVSIZ,10),IPERM1(10),IPERM2(10),N,N1,N2,I
85 INTEGER NI,NJ,N10
86 DATA IPERM1/0,0,0,0,1,2,3,1,2,3/
87 DATA IPERM2/0,0,0,0,2,3,1,4,4,4/
88C----6---------------------------------------------------------------7---------8
89 N10= 0
90 do ep = 1,nel
91 nn(ep,1)=ixs(2,ep)
92 nn(ep,2)=ixs(4,ep)
93 nn(ep,3)=ixs(7,ep)
94 nn(ep,4)=ixs(6,ep)
95 nn(ep,5) =ixs10(1,ep)
96 nn(ep,6) =ixs10(2,ep)
97 nn(ep,7) =ixs10(3,ep)
98 nn(ep,8) =ixs10(4,ep)
99 nn(ep,9) =ixs10(5,ep)
100 nn(ep,10)=ixs10(6,ep)
101 IF (nn(ep,5)>0.AND.nn(ep,6)>0.AND.nn(ep,7)>0.AND.
102 . nn(ep,8)>0.AND.nn(ep,9)>0.AND.nn(ep,10)>0)
103 . n10 = n10 + 1
104 ENDDO
105C---------condense first in KIJ--for degenerated element------------
106 IF (n10<nel) THEN
107C-------block k00,k10,k20,k30,k40,k50,k60,k70,k80,k90-----
108 n=10
109C---------N1=3,N2=4--------------
110 n1=iperm1(n)
111 n2=iperm2(n)
112 DO ep = 1,nel
113 IF (nn(ep,n)==0.AND.off(ep)>zero) THEN
114 CALL ass10_kkii(n1 ,n2 ,k33(1,ep),k44(1,ep),k34(1,ep),
115 1 k00(1,ep),3 )
116C------- k10,k20,k30,k40,50,60,70,80,90-----
117 CALL ass10_kkij(1 ,n1 ,n2 ,3 ,
118 1 k33(1,ep),k44(1,ep),k13(1,ep),k14(1,ep),
119 2 k10(1,ep))
120 CALL ass10_kkij(2 ,n1 ,n2 ,3 ,
121 1 k33(1,ep),k44(1,ep),k23(1,ep),k24(1,ep),
122 2 k20(1,ep))
123 CALL ass10_kkij(3 ,n1 ,n2 ,3 ,
124 1 k33(1,ep),k44(1,ep),k33(1,ep),k34(1,ep),
125 2 k30(1,ep))
126 CALL ass10_kkij(4 ,n1 ,n2 ,3 ,
127 1 k33(1,ep),k44(1,ep),k34(1,ep),k44(1,ep),
128 2 k40(1,ep))
129 CALL ass10_kkij(5 ,n1 ,n2 ,3 ,
130 1 k33(1,ep),k44(1,ep),k35(1,ep),k45(1,ep),
131 2 k50(1,ep))
132 CALL ass10_kkij(6 ,n1 ,n2 ,3 ,
133 1 k33(1,ep),k44(1,ep),k36(1,ep),k46(1,ep),
134 2 k60(1,ep))
135 CALL ass10_kkij(7 ,n1 ,n2 ,3 ,
136 1 k33(1,ep),k44(1,ep),k37(1,ep),k47(1,ep),
137 2 k70(1,ep))
138 CALL ass10_kkij(8 ,n1 ,n2 ,3 ,
139 1 k33(1,ep),k44(1,ep),k38(1,ep),k48(1,ep),
140 2 k80(1,ep))
141 CALL ass10_kkij(9 ,n1 ,n2 ,3 ,
142 1 k33(1,ep),k44(1,ep),k39(1,ep),k49(1,ep),
143 2 k90(1,ep))
144 ENDIF
145 ENDDO
146C-------block k99,k19,k29,k39,k49,k59,k69,k79,k89-----
147 n=9
148C---------N1=2,N2=4--------------
149 n1=iperm1(n)
150 n2=iperm2(n)
151 DO ep = 1,nel
152 IF (nn(ep,n)==0.AND.off(ep)>zero) THEN
153 CALL ass10_kkii(n1 ,n2 ,k22(1,ep),k44(1,ep),k24(1,ep),
154 1 k99(1,ep),3 )
155C------- k19,k29,k39,k49,59,69,79,89-----
156 CALL ass10_kkij(1 ,n1 ,n2 ,3 ,
157 1 k22(1,ep),k44(1,ep),k12(1,ep),k14(1,ep),
158 2 k19(1,ep))
159 CALL ass10_kkij(2 ,n1 ,n2 ,3 ,
160 1 k22(1,ep),k44(1,ep),k22(1,ep),k24(1,ep),
161 2 k29(1,ep))
162 CALL ass10_kkij(3 ,n1 ,n2 ,3 ,
163 1 k22(1,ep),k44(1,ep),k23(1,ep),k34(1,ep),
164 2 k39(1,ep))
165 CALL ass10_kkij(4 ,n1 ,n2 ,3 ,
166 1 k22(1,ep),k44(1,ep),k24(1,ep),k44(1,ep),
167 2 k49(1,ep))
168 CALL ass10_kkij(5 ,n1 ,n2 ,3 ,
169 1 k22(1,ep),k44(1,ep),k25(1,ep),k45(1,ep),
170 2 k59(1,ep))
171 CALL ass10_kkij(6 ,n1 ,n2 ,3 ,
172 1 k22(1,ep),k44(1,ep),k26(1,ep),k46(1,ep),
173 2 k69(1,ep))
174 CALL ass10_kkij(7 ,n1 ,n2 ,3 ,
175 1 k22(1,ep),k44(1,ep),k27(1,ep),k47(1,ep),
176 2 k79(1,ep))
177 CALL ass10_kkij(8 ,n1 ,n2 ,3 ,
178 1 k22(1,ep),k44(1,ep),k28(1,ep),k48(1,ep),
179 2 k89(1,ep))
180 CALL ass10_kkji(10 ,n1 ,n2 ,3 ,
181 1 k22(1,ep),k44(1,ep),k20(1,ep),k40(1,ep),
182 2 k90(1,ep))
183 ENDIF
184 ENDDO
185C-------block k88,k18,k28,k38,k48,k58,k68,k78-----
186 n=8
187C---------N1=1,N2=4--------------
188 n1=iperm1(n)
189 n2=iperm2(n)
190 DO ep = 1,nel
191 IF (nn(ep,n)==0.AND.off(ep)>zero) THEN
192 CALL ass10_kkii(n1 ,n2 ,k11(1,ep),k44(1,ep),k14(1,ep),
193 1 k88(1,ep),3 )
194C------- k18,k28,k38,k48,58,68,78-----
195 CALL ass10_kkij(1 ,n1 ,n2 ,3 ,
196 1 k11(1,ep),k44(1,ep),k11(1,ep),k14(1,ep),
197 2 k18(1,ep))
198 CALL ass10_kkij(2 ,n1 ,n2 ,3 ,
199 1 k11(1,ep),k44(1,ep),k12(1,ep),k24(1,ep),
200 2 k28(1,ep))
201 CALL ass10_kkij(3 ,n1 ,n2 ,3 ,
202 1 k11(1,ep),k44(1,ep),k13(1,ep),k34(1,ep),
203 2 k38(1,ep))
204 CALL ass10_kkij(4 ,n1 ,n2 ,3 ,
205 1 k11(1,ep),k44(1,ep),k14(1,ep),k44(1,ep),
206 2 k48(1,ep))
207 CALL ass10_kkij(5 ,n1 ,n2 ,3 ,
208 1 k11(1,ep),k44(1,ep),k15(1,ep),k45(1,ep),
209 2 k58(1,ep))
210 CALL ass10_kkij(6 ,n1 ,n2 ,3 ,
211 1 k11(1,ep),k44(1,ep),k16(1,ep),k46(1,ep),
212 2 k68(1,ep))
213 CALL ass10_kkij(7 ,n1 ,n2 ,3 ,
214 1 k11(1,ep),k44(1,ep),k17(1,ep),k47(1,ep),
215 2 k78(1,ep))
216 CALL ass10_kkji(9 ,n1 ,n2 ,3 ,
217 1 k11(1,ep),k44(1,ep),k19(1,ep),k49(1,ep),
218 2 k89(1,ep))
219 CALL ass10_kkji(10 ,n1 ,n2 ,3 ,
220 1 k11(1,ep),k44(1,ep),k10(1,ep),k40(1,ep),
221 2 k80(1,ep))
222 ENDIF
223 ENDDO
224C-------block k77,k17,k27,k37,k47,k57,k67-----
225 n=7
226C---------N1=3,N2=1--------------
227 n1=iperm1(n)
228 n2=iperm2(n)
229 DO ep = 1,nel
230 IF (nn(ep,n)==0.AND.off(ep)>zero) THEN
231 CALL ass10_kkii(n1 ,n2 ,k33(1,ep),k11(1,ep),k13(1,ep),
232 1 k77(1,ep),3 )
233C------- k17,k27,k37,k47,57,67-----
234 CALL ass10_kkij(1 ,n1 ,n2 ,3 ,
235 1 k33(1,ep),k11(1,ep),k13(1,ep),k11(1,ep),
236 2 k17(1,ep))
237 CALL ass10_kkij(2 ,n1 ,n2 ,3 ,
238 1 k33(1,ep),k11(1,ep),k23(1,ep),k12(1,ep),
239 2 k27(1,ep))
240 CALL ass10_kkij(3 ,n1 ,n2 ,3 ,
241 1 k33(1,ep),k11(1,ep),k33(1,ep),k13(1,ep),
242 2 k37(1,ep))
243 CALL ass10_kkij(4 ,n1 ,n2 ,3 ,
244 1 k33(1,ep),k11(1,ep),k34(1,ep),k14(1,ep),
245 2 k47(1,ep))
246 CALL ass10_kkij(5 ,n1 ,n2 ,3 ,
247 1 k33(1,ep),k11(1,ep),k35(1,ep),k15(1,ep),
248 2 k57(1,ep))
249 CALL ass10_kkij(6 ,n1 ,n2 ,3 ,
250 1 k33(1,ep),k11(1,ep),k36(1,ep),k16(1,ep),
251 2 k67(1,ep))
252 CALL ass10_kkji(8 ,n1 ,n2 ,3 ,
253 1 k11(1,ep),k44(1,ep),k38(1,ep),k18(1,ep),
254 2 k78(1,ep))
255 CALL ass10_kkji(9 ,n1 ,n2 ,3 ,
256 1 k11(1,ep),k44(1,ep),k39(1,ep),k19(1,ep),
257 2 k79(1,ep))
258 CALL ass10_kkji(10 ,n1 ,n2 ,3 ,
259 1 k11(1,ep),k44(1,ep),k30(1,ep),k10(1,ep),
260 2 k70(1,ep))
261 ENDIF
262 ENDDO
263C-------block k66,k16,k26,k36,k46,k56-----
264 n=6
265C---------N1=2,N2=3--------------
266 n1=iperm1(n)
267 n2=iperm2(n)
268 DO ep = 1,nel
269 IF (nn(ep,n)==0.AND.off(ep)>zero) THEN
270 CALL ass10_kkii(n1 ,n2 ,k22(1,ep),k33(1,ep),k23(1,ep),
271 1 k66(1,ep),3 )
272C------- k16,k26,k36,k46,56-----
273 CALL ass10_kkij(1 ,n1 ,n2 ,3 ,
274 1 k22(1,ep),k33(1,ep),k12(1,ep),k13(1,ep),
275 2 k16(1,ep))
276 CALL ass10_kkij(2 ,n1 ,n2 ,3 ,
277 1 k22(1,ep),k33(1,ep),k22(1,ep),k23(1,ep),
278 2 k26(1,ep))
279 CALL ass10_kkij(3 ,n1 ,n2 ,3 ,
280 1 k22(1,ep),k33(1,ep),k23(1,ep),k33(1,ep),
281 2 k36(1,ep))
282 CALL ass10_kkij(4 ,n1 ,n2 ,3 ,
283 1 k22(1,ep),k33(1,ep),k24(1,ep),k34(1,ep),
284 2 k46(1,ep))
285 CALL ass10_kkij(5 ,n1 ,n2 ,3 ,
286 1 k22(1,ep),k33(1,ep),k25(1,ep),k35(1,ep),
287 2 k56(1,ep))
288 CALL ass10_kkji(7 ,n1 ,n2 ,3 ,
289 1 k22(1,ep),k33(1,ep),k27(1,ep),k37(1,ep),
290 2 k67(1,ep))
291 CALL ass10_kkji(8 ,n1 ,n2 ,3 ,
292 1 k22(1,ep),k33(1,ep),k28(1,ep),k38(1,ep),
293 2 k68(1,ep))
294 CALL ass10_kkji(9 ,n1 ,n2 ,3 ,
295 1 k22(1,ep),k33(1,ep),k29(1,ep),k39(1,ep),
296 2 k69(1,ep))
297 CALL ass10_kkji(10 ,n1 ,n2 ,3 ,
298 1 k22(1,ep),k33(1,ep),k20(1,ep),k30(1,ep),
299 2 k60(1,ep))
300 ENDIF
301 ENDDO
302C-------block k55,k15,k25,k35,k45-----
303 n=5
304C---------N1=1,N2=2--------------
305 n1=iperm1(n)
306 n2=iperm2(n)
307 DO ep = 1,nel
308 IF (nn(ep,n)==0.AND.off(ep)>zero) THEN
309 CALL ass10_kkii(n1 ,n2 ,k11(1,ep),k22(1,ep),k12(1,ep),
310 1 k55(1,ep),3 )
311C------- k15,k25,k35,k45-----
312 CALL ass10_kkij(1 ,n1 ,n2 ,3 ,
313 1 k11(1,ep),k22(1,ep),k11(1,ep),k12(1,ep),
314 2 k15(1,ep))
315 CALL ass10_kkij(2 ,n1 ,n2 ,3 ,
316 1 k11(1,ep),k22(1,ep),k12(1,ep),k22(1,ep),
317 2 k25(1,ep))
318 CALL ass10_kkij(3 ,n1 ,n2 ,3 ,
319 1 k11(1,ep),k22(1,ep),k13(1,ep),k23(1,ep),
320 2 k35(1,ep))
321 CALL ass10_kkij(4 ,n1 ,n2 ,3 ,
322 1 k11(1,ep),k22(1,ep),k14(1,ep),k24(1,ep),
323 2 k45(1,ep))
324 CALL ass10_kkji(6 ,n1 ,n2 ,3 ,
325 1 k11(1,ep),k22(1,ep),k16(1,ep),k26(1,ep),
326 2 k56(1,ep))
327 CALL ass10_kkji(7 ,n1 ,n2 ,3 ,
328 1 k11(1,ep),k22(1,ep),k17(1,ep),k27(1,ep),
329 2 k57(1,ep))
330 CALL ass10_kkji(8 ,n1 ,n2 ,3 ,
331 1 k11(1,ep),k22(1,ep),k18(1,ep),k28(1,ep),
332 2 k58(1,ep))
333 CALL ass10_kkji(9 ,n1 ,n2 ,3 ,
334 1 k11(1,ep),k22(1,ep),k19(1,ep),k29(1,ep),
335 2 k59(1,ep))
336 CALL ass10_kkji(10 ,n1 ,n2 ,3 ,
337 1 k11(1,ep),k22(1,ep),k10(1,ep),k20(1,ep),
338 2 k50(1,ep))
339 ENDIF
340 ENDDO
341 END IF !(N10<NEL) THEN
342C-------block diagonal k11,k22...k44-----
343 CALL assem_kii(nn(1,1),nel,iddl,iadk,k_diag,k_lt ,k11,3,off)
344 CALL assem_kii(nn(1,2),nel,iddl,iadk,k_diag,k_lt ,k22,3,off)
345 CALL assem_kii(nn(1,3),nel,iddl,iadk,k_diag,k_lt ,k33,3,off)
346 CALL assem_kii(nn(1,4),nel,iddl,iadk,k_diag,k_lt ,k44,3,off)
347C-------non diag kij-----
348 CALL assem_kij(nn(1,1),nn(1,2),nel,iddl,iadk,jdik,
349 . k_diag,k_lt,k12,3,off)
350 CALL assem_kij(nn(1,1),nn(1,3),nel,iddl,iadk,jdik,
351 . k_diag,k_lt,k13,3,off)
352 CALL assem_kij(nn(1,1),nn(1,4),nel,iddl,iadk,jdik,
353 . k_diag,k_lt,k14,3,off)
354 CALL assem_kij(nn(1,2),nn(1,3),nel,iddl,iadk,jdik,
355 . k_diag,k_lt,k23,3,off)
356 CALL assem_kij(nn(1,2),nn(1,4),nel,iddl,iadk,jdik,
357 . k_diag,k_lt,k24,3,off)
358 CALL assem_kij(nn(1,3),nn(1,4),nel,iddl,iadk,jdik,
359 . k_diag,k_lt,k34,3,off)
360C--------
361 CALL assem_kii(nn(1,5),nel,iddl,iadk,k_diag,k_lt ,k55,3,off)
362 CALL assem_kii(nn(1,6),nel,iddl,iadk,k_diag,k_lt ,k66,3,off)
363 CALL assem_kii(nn(1,7),nel,iddl,iadk,k_diag,k_lt ,k77,3,off)
364 CALL assem_kii(nn(1,8),nel,iddl,iadk,k_diag,k_lt ,k88,3,off)
365 CALL assem_kii(nn(1,9),nel,iddl,iadk,k_diag,k_lt ,k99,3,off)
366 CALL assem_kii(nn(1,10),nel,iddl,iadk,k_diag,k_lt ,k00,3,off)
367C-------non diag kij-----
368 CALL assem_kij(nn(1,1),nn(1,5),nel,iddl,iadk,jdik,
369 . k_diag,k_lt,k15,3,off)
370 CALL assem_kij(nn(1,1),nn(1,6),nel,iddl,iadk,jdik,
371 . k_diag,k_lt,k16,3,off)
372 CALL assem_kij(nn(1,1),nn(1,7),nel,iddl,iadk,jdik,
373 . k_diag,k_lt,k17,3,off)
374 CALL assem_kij(nn(1,1),nn(1,8),nel,iddl,iadk,jdik,
375 . k_diag,k_lt,k18,3,off)
376 CALL assem_kij(nn(1,1),nn(1,9),nel,iddl,iadk,jdik,
377 . k_diag,k_lt,k19,3,off)
378 CALL assem_kij(nn(1,1),nn(1,10),nel,iddl,iadk,jdik,
379 . k_diag,k_lt,k10,3,off)
380 CALL assem_kij(nn(1,2),nn(1,5),nel,iddl,iadk,jdik,
381 . k_diag,k_lt,k25,3,off)
382 CALL assem_kij(nn(1,2),nn(1,6),nel,iddl,iadk,jdik,
383 . k_diag,k_lt,k26,3,off)
384 CALL assem_kij(nn(1,2),nn(1,7),nel,iddl,iadk,jdik,
385 . k_diag,k_lt,k27,3,off)
386 CALL assem_kij(nn(1,2),nn(1,8),nel,iddl,iadk,jdik,
387 . k_diag,k_lt,k28,3,off)
388 CALL assem_kij(nn(1,2),nn(1,9),nel,iddl,iadk,jdik,
389 . k_diag,k_lt,k29,3,off)
390 CALL assem_kij(nn(1,2),nn(1,10),nel,iddl,iadk,jdik,
391 . k_diag,k_lt,k20,3,off)
392 CALL assem_kij(nn(1,3),nn(1,5),nel,iddl,iadk,jdik,
393 . k_diag,k_lt,k35,3,off)
394 CALL assem_kij(nn(1,3),nn(1,6),nel,iddl,iadk,jdik,
395 . k_diag,k_lt,k36,3,off)
396 CALL assem_kij(nn(1,3),nn(1,7),nel,iddl,iadk,jdik,
397 . k_diag,k_lt,k37,3,off)
398 CALL assem_kij(nn(1,3),nn(1,8),nel,iddl,iadk,jdik,
399 . k_diag,k_lt,k38,3,off)
400 CALL assem_kij(nn(1,3),nn(1,9),nel,iddl,iadk,jdik,
401 . k_diag,k_lt,k39,3,off)
402 CALL assem_kij(nn(1,3),nn(1,10),nel,iddl,iadk,jdik,
403 . k_diag,k_lt,k30,3,off)
404 CALL assem_kij(nn(1,4),nn(1,5),nel,iddl,iadk,jdik,
405 . k_diag,k_lt,k45,3,off)
406 CALL assem_kij(nn(1,4),nn(1,6),nel,iddl,iadk,jdik,
407 . k_diag,k_lt,k46,3,off)
408 CALL assem_kij(nn(1,4),nn(1,7),nel,iddl,iadk,jdik,
409 . k_diag,k_lt,k47,3,off)
410 CALL assem_kij(nn(1,4),nn(1,8),nel,iddl,iadk,jdik,
411 . k_diag,k_lt,k48,3,off)
412 CALL assem_kij(nn(1,4),nn(1,9),nel,iddl,iadk,jdik,
413 . k_diag,k_lt,k49,3,off)
414 CALL assem_kij(nn(1,4),nn(1,10),nel,iddl,iadk,jdik,
415 . k_diag,k_lt,k40,3,off)
416 CALL assem_kij(nn(1,5),nn(1,6),nel,iddl,iadk,jdik,
417 . k_diag,k_lt,k56,3,off)
418 CALL assem_kij(nn(1,5),nn(1,7),nel,iddl,iadk,jdik,
419 . k_diag,k_lt,k57,3,off)
420 CALL assem_kij(nn(1,5),nn(1,8),nel,iddl,iadk,jdik,
421 . k_diag,k_lt,k58,3,off)
422 CALL assem_kij(nn(1,5),nn(1,9),nel,iddl,iadk,jdik,
423 . k_diag,k_lt,k59,3,off)
424 CALL assem_kij(nn(1,5),nn(1,10),nel,iddl,iadk,jdik,
425 . k_diag,k_lt,k50,3,off)
426 CALL assem_kij(nn(1,6),nn(1,7),nel,iddl,iadk,jdik,
427 . k_diag,k_lt,k67,3,off)
428 CALL assem_kij(nn(1,6),nn(1,8),nel,iddl,iadk,jdik,
429 . k_diag,k_lt,k68,3,off)
430 CALL assem_kij(nn(1,6),nn(1,9),nel,iddl,iadk,jdik,
431 . k_diag,k_lt,k69,3,off)
432 CALL assem_kij(nn(1,6),nn(1,10),nel,iddl,iadk,jdik,
433 . k_diag,k_lt,k60,3,off)
434 CALL assem_kij(nn(1,7),nn(1,8),nel,iddl,iadk,jdik,
435 . k_diag,k_lt,k78,3,off)
436 CALL assem_kij(nn(1,7),nn(1,9),nel,iddl,iadk,jdik,
437 . k_diag,k_lt,k79,3,off)
438 CALL assem_kij(nn(1,7),nn(1,10),nel,iddl,iadk,jdik,
439 . k_diag,k_lt,k70,3,off)
440 CALL assem_kij(nn(1,8),nn(1,9),nel,iddl,iadk,jdik,
441 . k_diag,k_lt,k89,3,off)
442 CALL assem_kij(nn(1,8),nn(1,10),nel,iddl,iadk,jdik,
443 . k_diag,k_lt,k80,3,off)
444 CALL assem_kij(nn(1,9),nn(1,10),nel,iddl,iadk,jdik,
445 . k_diag,k_lt,k90,3,off)
446C----6---------------------------------------------------------------7---------8
447 RETURN
448 END
449!||====================================================================
450!|| ass10_kii ../engine/source/implicit/assem_s10.F
451!||--- calls -----------------------------------------------------
452!|| assem_kii1 ../engine/source/implicit/assem_s10.F
453!|| assem_kij1 ../engine/source/implicit/assem_s10.F
454!||====================================================================
455 SUBROUTINE ass10_kii(NC ,N1 ,N2 ,
456 1 IDDL ,IADK ,JDIK ,K_DIAG,K_LT ,
457 2 KJJ ,ND )
458C-----------------------------------------------
459C I m p l i c i t T y p e s
460C-----------------------------------------------
461#include "implicit_f.inc"
462C-----------------------------------------------
463C D u m m y A r g u m e n t s
464C-----------------------------------------------
465 INTEGER ND,NC(10),N1,N2,IDDL(*) , IADK(*) ,JDIK(*)
466 my_real
467 . K_DIAG(*) ,K_LT(*) ,KJJ(ND,ND)
468C-----------------------------------------------
469C L o c a l V a r i a b l e s
470C-----------------------------------------------
471 INTEGER I,J
472 my_real
473 . KII(ND,ND)
474C------------------------------
475 DO I =1,nd
476 DO j =i,nd
477 kii(i,j) = fourth*kjj(i,j)
478 ENDDO
479 ENDDO
480 DO i =1,nd
481 DO j =i+1,nd
482 kii(j,i) = kii(i,j)
483 ENDDO
484 ENDDO
485C
486 CALL assem_kii1(nc(n1),iddl ,iadk ,k_diag,
487 1 k_lt ,kii ,nd )
488 CALL assem_kii1(nc(n2),iddl ,iadk ,k_diag,
489 1 k_lt ,kii ,nd )
490 CALL assem_kij1(nc(n1),nc(n2),iddl ,iadk,jdik,
491 1 k_diag,k_lt ,kii ,nd )
492C
493 RETURN
494 END
495!||====================================================================
496!|| ass10_kij ../engine/source/implicit/assem_s10.F
497!||--- calls -----------------------------------------------------
498!|| assem_kii1 ../engine/source/implicit/assem_s10.F
499!|| assem_kij1 ../engine/source/implicit/assem_s10.F
500!||====================================================================
501 SUBROUTINE ass10_kij(NC ,NI ,NJ1 ,NJ2 ,ND ,
502 1 IDDL ,IADK ,JDIK ,K_DIAG,K_LT ,
503 2 KIJ0 )
504C-----------------------------------------------
505C I m p l i c i t T y p e s
506C-----------------------------------------------
507#include "implicit_f.inc"
508C-----------------------------------------------
509C D u m m y A r g u m e n t s
510C-----------------------------------------------
511 INTEGER ND,NC(10),NI,NJ1,NJ2,IDDL(*) , IADK(*) ,JDIK(*)
512 my_real
513 . K_DIAG(*) ,K_LT(*) ,KIJ0(ND,ND)
514C-----------------------------------------------
515C L o c a l V a r i a b l e s
516C-----------------------------------------------
517 INTEGER I,J,NJ
518 my_real
519 . kii(nd,nd),kij(nd,nd)
520C------------------------------
521 DO i =1,nd
522 DO j =1,nd
523 kij(i,j) = half*kij0(i,j)
524 ENDDO
525 ENDDO
526C
527 nj=nj1
528 IF (ni==nj) THEN
529 DO i =1,nd
530 DO j =i,nd
531 kii(i,j) = kij(i,j)+ kij(j,i)
532 ENDDO
533 ENDDO
534 CALL assem_kii1(nc(ni),iddl ,iadk ,k_diag,
535 1 k_lt ,kii ,nd )
536 ELSEIF (ni>nj) THEN
537 CALL assem_kij1(nc(nj),nc(ni),iddl ,iadk,jdik,
538 1 k_diag,k_lt ,kij ,nd )
539 ELSE
540 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
541 1 k_diag,k_lt ,kij ,nd )
542 ENDIF
543 nj=nj2
544 IF (ni==nj) THEN
545 DO i =1,nd
546 DO j =i,nd
547 kii(i,j) = kij(i,j)+ kij(j,i)
548 ENDDO
549 ENDDO
550 CALL assem_kii1(nc(ni),iddl ,iadk ,k_diag,
551 1 k_lt ,kii ,nd )
552 ELSEIF (ni>nj) THEN
553 CALL assem_kij1(nc(nj),nc(ni),iddl ,iadk,jdik,
554 1 k_diag,k_lt ,kij ,nd )
555 ELSE
556 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
557 1 k_diag,k_lt ,kij ,nd )
558 ENDIF
559C
560 RETURN
561 END
562!||====================================================================
563!|| ass10_kij1 ../engine/source/implicit/assem_s10.F
564!||--- calls -----------------------------------------------------
565!|| assem_kii1 ../engine/source/implicit/assem_s10.F
566!|| assem_kij1 ../engine/source/implicit/assem_s10.F
567!||====================================================================
568 SUBROUTINE ass10_kij1(NC ,NI1 ,NI2 ,NJ1 ,NJ2 ,
569 1 IDDL ,IADK ,JDIK ,K_DIAG,K_LT ,
570 2 KIJ0 ,ND )
571C-----------------------------------------------
572C I m p l i c i t T y p e s
573C-----------------------------------------------
574#include "implicit_f.inc"
575C-----------------------------------------------
576C D u m m y A r g u m e n t s
577C-----------------------------------------------
578 INTEGER ND,NC(10),NI1,NI2,NJ1,NJ2,IDDL(*) , IADK(*) ,JDIK(*)
579 my_real
580 . k_diag(*) ,k_lt(*) ,kij0(nd,nd)
581C-----------------------------------------------
582C L o c a l V a r i a b l e s
583C-----------------------------------------------
584 INTEGER I,J,NI,NJ
585 my_real
586 . KII(ND,ND),KIJ(ND,ND)
587C------------------------------
588 DO i =1,nd
589 DO j =1,nd
590 kij(i,j) = fourth*kij0(i,j)
591 ENDDO
592 ENDDO
593C
594 ni=ni1
595 nj=nj1
596 IF (ni==nj) THEN
597 DO i =1,nd
598 DO j =i,nd
599 kii(i,j) = kij(i,j)+ kij(j,i)
600 ENDDO
601 ENDDO
602 CALL assem_kii1(nc(ni),iddl ,iadk ,k_diag,
603 1 k_lt ,kii ,nd )
604 ELSEIF (ni>nj) THEN
605 CALL assem_kij1(nc(nj),nc(ni),iddl ,iadk,jdik,
606 1 k_diag,k_lt ,kij ,nd )
607 ELSE
608 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
609 1 k_diag,k_lt ,kij ,nd )
610 ENDIF
611C
612 nj=nj2
613 IF (ni==nj) THEN
614 DO i =1,nd
615 DO j =i,nd
616 kii(i,j) = kij(i,j)+ kij(j,i)
617 ENDDO
618 ENDDO
619 CALL assem_kii1(nc(ni),iddl ,iadk ,k_diag,
620 1 k_lt ,kii ,nd )
621 ELSEIF (ni>nj) THEN
622 CALL assem_kij1(nc(nj),nc(ni),iddl ,iadk,jdik,
623 1 k_diag,k_lt ,kij ,nd )
624 ELSE
625 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
626 1 k_diag,k_lt ,kij ,nd )
627 ENDIF
628C
629 ni=ni2
630 nj=nj1
631 IF (ni==nj) THEN
632 DO i =1,nd
633 DO j =i,nd
634 kii(i,j) = kij(i,j)+ kij(j,i)
635 ENDDO
636 ENDDO
637 CALL assem_kii1(nc(ni),iddl ,iadk ,k_diag,
638 1 k_lt ,kii ,nd )
639 ELSEIF (ni>nj) THEN
640 CALL assem_kij1(nc(nj),nc(ni),iddl ,iadk,jdik,
641 1 k_diag,k_lt ,kij ,nd )
642 ELSE
643 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
644 1 k_diag,k_lt ,kij ,nd )
645 ENDIF
646C
647 nj=nj2
648 IF (ni==nj) THEN
649 DO i =1,nd
650 DO j =i,nd
651 kii(i,j) = kij(i,j)+ kij(j,i)
652 ENDDO
653 ENDDO
654 CALL assem_kii1(nc(ni),iddl ,iadk ,k_diag,
655 1 k_lt ,kii ,nd )
656 ELSEIF (ni>nj) THEN
657 CALL assem_kij1(nc(nj),nc(ni),iddl ,iadk,jdik,
658 1 k_diag,k_lt ,kij ,nd )
659 ELSE
660 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
661 1 k_diag,k_lt ,kij ,nd )
662 ENDIF
663C
664 RETURN
665 END
666!||====================================================================
667!|| assem_kii1 ../engine/source/implicit/assem_s10.F
668!||--- called by ------------------------------------------------------
669!|| ass10_kii ../engine/source/implicit/assem_s10.F
670!|| ass10_kij ../engine/source/implicit/assem_s10.F
671!|| ass10_kij1 ../engine/source/implicit/assem_s10.F
672!||====================================================================
673 SUBROUTINE assem_kii1(NI ,IDDL ,IADK ,K_DIAG,K_LT ,
674 1 KII ,ND )
675C-----------------------------------------------
676C I m p l i c i t T y p e s
677C-----------------------------------------------
678#include "implicit_f.inc"
679C-----------------------------------------------
680C C o m m o n B l o c k s
681C-----------------------------------------------
682#include "impl1_c.inc"
683#include "comlock.inc"
684C-----------------------------------------------
685C D u m m y A r g u m e n t s
686C-----------------------------------------------
687 INTEGER ND
688 INTEGER NI,IDDL(*) , IADK(*)
689C REAL
690 my_real
691 . K_DIAG(*) ,K_LT(*) ,KII(ND,ND)
692C-----------------------------------------------
693C L o c a l V a r i a b l e s
694C-----------------------------------------------
695 INTEGER N,K,IK,ID,JD,L
696C----6----------KII is always triag_sup whatever IKPAT---------------7--------
697 N = ni
698 id = iddl(n)
699 IF (ikpat==0) THEN
700C minimize lockon/lockoff
701#include "lockon.inc"
702 DO k=1,nd
703c#include "lockon.inc"
704 k_diag(id+k) = k_diag(id+k) + kii(k,k)
705c#include "lockoff.inc"
706 jd = iadk(id+k)-1
707 DO l=k+1,nd
708 ik = jd+l-k
709c#include "lockon.inc"
710 k_lt(ik) = k_lt(ik) + kii(k,l)
711c#include "lockoff.inc"
712 ENDDO
713 ENDDO
714#include "lockoff.inc"
715 ELSE
716#include "lockon.inc"
717 DO k=1,nd
718c#include "lockon.inc"
719 k_diag(id+k) = k_diag(id+k) + kii(k,k)
720c#include "lockoff.inc"
721 jd = iadk(id+k+1)-k
722 DO l=1,k-1
723 ik = jd+l
724c#include "lockon.inc"
725 k_lt(ik) = k_lt(ik) + kii(l,k)
726c#include "lockoff.inc"
727 ENDDO
728 ENDDO
729#include "lockoff.inc"
730 ENDIF
731C
732 RETURN
733 END
734!||====================================================================
735!|| assem_kij1 ../engine/source/implicit/assem_s10.F
736!||--- called by ------------------------------------------------------
737!|| ass10_kii ../engine/source/implicit/assem_s10.F
738!|| ass10_kij ../engine/source/implicit/assem_s10.F
739!|| ass10_kij1 ../engine/source/implicit/assem_s10.F
740!|| ass10_kij2 ../engine/source/implicit/assem_s10.F
741!||====================================================================
742 SUBROUTINE assem_kij1(NI ,NJ ,IDDL ,IADK,JDIK,
743 1 K_DIAG,K_LT ,KIJ ,ND )
744C-----------------------------------------------
745C I m p l i c i t T y p e s
746C-----------------------------------------------
747#include "implicit_f.inc"
748C-----------------------------------------------
749C C o m m o n B l o c k s
750C-----------------------------------------------
751#include "comlock.inc"
752#include "impl1_c.inc"
753C-----------------------------------------------
754C D u m m y A r g u m e n t s
755C-----------------------------------------------
756 INTEGER ND,NI,NJ,IDDL(*) ,IADK(*),JDIK(*)
757 my_real
758 . K_DIAG(*),K_LT(*) ,KIJ(ND,ND)
759C-----------------------------------------------
760C L o c a l V a r i a b l e s
761C-----------------------------------------------
762 INTEGER I,J,K,ID,JD,JDL,L,JJ
763C----6---------------------------------------------------------------7---------8
764 IF (ikpat==0) THEN
765 i = iddl(ni)
766 j = iddl(nj)
767 id = min(i,j)
768 jd = max(i,j)+1
769 IF (i==id) THEN
770 DO k=1,nd
771 DO jj = iadk(id+k),iadk(id+1+k)-1
772C-------- Find l'Address in LT -----
773 IF (jdik(jj)==jd) THEN
774 jdl = jj-1
775 GOTO 100
776 ENDIF
777 ENDDO
778 100 CONTINUE
779C minimize lockon/lockoff
780#include "lockon.inc"
781 DO l=1,nd
782c#include "lockon.inc"
783 k_lt(jdl+l) = k_lt(jdl+l) + kij(k,l)
784c#include "lockoff.inc"
785 ENDDO
786#include "lockoff.inc"
787 ENDDO
788 ELSE
789 DO k=1,nd
790 DO jj = iadk(id+k),iadk(id+1+k)-1
791 IF (jdik(jj)==jd) THEN
792 jdl = jj-1
793 GOTO 200
794 ENDIF
795 ENDDO
796 200 CONTINUE
797#include "lockon.inc"
798 DO l=1,nd
799c#include "lockon.inc"
800 k_lt(jdl+l) = k_lt(jdl+l) + kij(l,k)
801c#include "lockoff.inc"
802 ENDDO
803#include "lockoff.inc"
804 ENDDO
805 ENDIF
806 ELSE
807 i = iddl(ni)
808 j = iddl(nj)
809 id = max(i,j)
810 jd = min(i,j)+1
811 IF (i==id) THEN
812 DO k=1,nd
813 DO jj = iadk(id+k),iadk(id+1+k)-1
814C-------- Find l'Address in LT -----
815 IF (jdik(jj)==jd) THEN
816 jdl = jj-1
817 GOTO 300
818 ENDIF
819 ENDDO
820 300 CONTINUE
821#include "lockon.inc"
822 DO l=1,nd
823c#include "lockon.inc"
824 k_lt(jdl+l) = k_lt(jdl+l) + kij(k,l)
825c#include "lockoff.inc"
826 ENDDO
827#include "lockoff.inc"
828 ENDDO
829 ELSE
830 DO k=1,nd
831 DO jj = iadk(id+k),iadk(id+1+k)-1
832 IF (jdik(jj)==jd) THEN
833 jdl = jj-1
834 GOTO 400
835 ENDIF
836 ENDDO
837 400 CONTINUE
838#include "lockon.inc"
839 DO l=1,nd
840c#include "lockon.inc"
841 k_lt(jdl+l) = k_lt(jdl+l) + kij(l,k)
842c#include "lockoff.inc"
843 ENDDO
844#include "lockoff.inc"
845 ENDDO
846 ENDIF
847 ENDIF
848C----6---------------------------------------------------------------7---------8
849 RETURN
850 END
851!||====================================================================
852!|| ass10_kij2 ../engine/source/implicit/assem_s10.F
853!||--- calls -----------------------------------------------------
854!|| assem_kij1 ../engine/source/implicit/assem_s10.F
855!||====================================================================
856 SUBROUTINE ass10_kij2(NC ,NI ,NJ1 ,NJ2 ,ND ,
857 1 IDDL ,IADK ,JDIK ,K_DIAG,K_LT ,
858 2 KIJ0 )
859C-----------------------------------------------
860C I m p l i c i t T y p e s
861C-----------------------------------------------
862#include "implicit_f.inc"
863C-----------------------------------------------
864C D u m m y A r g u m e n t s
865C-----------------------------------------------
866 INTEGER ND,NC(10),NI,NJ1,NJ2,IDDL(*) , IADK(*) ,JDIK(*)
867 my_real
868 . k_diag(*) ,k_lt(*) ,kij0(nd,nd)
869C-----------------------------------------------
870C L o c a l V a r i a b l e s
871C-----------------------------------------------
872 INTEGER I,J,NJ
873 my_real
874 . kii(nd,nd),kij(nd,nd)
875C------------------------------
876 DO i =1,nd
877 DO j =1,nd
878 kij(i,j) = half*kij0(i,j)
879 ENDDO
880 ENDDO
881C
882 nj=nj1
883
884 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
885 1 k_diag,k_lt ,kij ,nd )
886 nj=nj2
887
888 CALL assem_kij1(nc(ni),nc(nj),iddl ,iadk,jdik,
889 1 k_diag,k_lt ,kij ,nd )
890C
891 RETURN
892 END
893!||====================================================================
894!|| ass10_kkii ../engine/source/implicit/assem_s10.F
895!||--- called by ------------------------------------------------------
896!|| assem_s10 ../engine/source/implicit/assem_s10.F
897!||====================================================================
898 SUBROUTINE ass10_kkii(N1 ,N2 ,K11 ,K22 ,K12 ,
899 1 KJJ ,ND )
900C-----------------------------------------------
901C I m p l i c i t T y p e s
902C-----------------------------------------------
903#include "implicit_f.inc"
904C-----------------------------------------------
905C D u m m y A r g u m e n t s
906C-----------------------------------------------
907 INTEGER ND,N1,N2
908 my_real
909 . k11(nd,nd) ,k22(nd,nd),k12(nd,nd),kjj(nd,nd)
910C-----------------------------------------------
911C L o c a l V a r i a b l e s
912C-----------------------------------------------
913 INTEGER I,J
914 my_real
915 . kii(nd,nd)
916C------------------------------
917 DO i =1,nd
918 DO j =i,nd
919 kii(i,j) = fourth*kjj(i,j)
920 ENDDO
921 ENDDO
922 DO i =1,nd
923 DO j =i+1,nd
924 kii(j,i) = kii(i,j)
925 ENDDO
926 ENDDO
927C
928 DO i =1,nd
929 DO j =i,nd
930 k11(i,j) = k11(i,j)+ kii(i,j)
931 k22(i,j) = k22(i,j)+ kii(i,j)
932 ENDDO
933 ENDDO
934C
935 DO i =1,nd
936 DO j =1,nd
937 k12(i,j) = k12(i,j)+ kii(i,j)
938 ENDDO
939 ENDDO
940C
941 RETURN
942 END
943!||====================================================================
944!|| ass10_kkij ../engine/source/implicit/assem_s10.F
945!||--- called by ------------------------------------------------------
946!|| assem_s10 ../engine/source/implicit/assem_s10.F
947!||====================================================================
948 SUBROUTINE ass10_kkij(NI ,NJ1 ,NJ2 ,ND ,
949 1 K11 ,K22 ,KI1 ,KI2 ,KIJ0 )
950C-----------------------------------------------
951C I m p l i c i t T y p e s
952C-----------------------------------------------
953#include "implicit_f.inc"
954C-----------------------------------------------
955C D u m m y A r g u m e n t s
956C-----------------------------------------------
957 INTEGER ND,NI,NJ1,NJ2
958 my_real
959 . k11(nd,nd),k22(nd,nd),ki1(nd,nd),ki2(nd,nd),kij0(nd,nd)
960C-----------------------------------------------
961C L o c a l V a r i a b l e s
962C-----------------------------------------------
963 INTEGER I,J,NJ
964 my_real
965 . kij(nd,nd)
966C------------------------------
967 DO i =1,nd
968 DO j =1,nd
969 kij(i,j) = half*kij0(i,j)
970 ENDDO
971 ENDDO
972C
973 nj=nj1
974 IF (ni==nj) THEN
975 DO i =1,nd
976 DO j =i,nd
977 k11(i,j) = k11(i,j)+kij(i,j)+ kij(j,i)
978 ENDDO
979 ENDDO
980 ELSEIF (ni>nj) THEN
981 DO i =1,nd
982 DO j =1,nd
983 ki1(i,j) = ki1(i,j)+kij(j,i)
984 ENDDO
985 ENDDO
986 ELSE
987 DO i =1,nd
988 DO j =1,nd
989 ki1(i,j) = ki1(i,j)+kij(i,j)
990 ENDDO
991 ENDDO
992 END IF
993 nj=nj2
994 IF (ni==nj) THEN
995 DO i =1,nd
996 DO j =i,nd
997 k22(i,j) = k22(i,j)+kij(i,j)+ kij(j,i)
998 ENDDO
999 ENDDO
1000 ELSEIF (ni>nj) THEN
1001 DO i =1,nd
1002 DO j =1,nd
1003 ki2(i,j) = ki2(i,j)+kij(j,i)
1004 ENDDO
1005 ENDDO
1006 ELSE
1007 DO i =1,nd
1008 DO j =1,nd
1009 ki2(i,j) = ki2(i,j)+kij(i,j)
1010 ENDDO
1011 ENDDO
1012 END IF
1013C
1014 RETURN
1015 END
1016!||====================================================================
1017!|| ass10_kkji ../engine/source/implicit/assem_s10.F
1018!||--- called by ------------------------------------------------------
1019!|| assem_s10 ../engine/source/implicit/assem_s10.F
1020!||====================================================================
1021 SUBROUTINE ass10_kkji(NI ,NJ1 ,NJ2 ,ND ,
1022 1 K11 ,K22 ,KI1 ,KI2 ,KIJ0 )
1023C-----------------------------------------------
1024C I m p l i c i t T y p e s
1025C-----------------------------------------------
1026#include "implicit_f.inc"
1027C-----------------------------------------------
1028C D u m m y A r g u m e n t s
1029C-----------------------------------------------
1030 INTEGER ND,NI,NJ1,NJ2
1031C REAL
1032 my_real
1033 . k11(nd,nd),k22(nd,nd),ki1(nd,nd),ki2(nd,nd),kij0(nd,nd)
1034C-----------------------------------------------
1035C L o c a l V a r i a b l e s
1036C-----------------------------------------------
1037 INTEGER I,J,NJ
1038 my_real
1039 . kij(nd,nd)
1040C------------------------------
1041 DO i =1,nd
1042 DO j =1,nd
1043 kij(i,j) = half*kij0(j,i)
1044 ENDDO
1045 ENDDO
1046C
1047 nj=nj1
1048 IF (ni==nj) THEN
1049 DO i =1,nd
1050 DO j =i,nd
1051 k11(i,j) = k11(i,j)+kij(i,j)+ kij(j,i)
1052 ENDDO
1053 ENDDO
1054 ELSEIF (ni>nj) THEN
1055 DO i =1,nd
1056 DO j =1,nd
1057 ki1(i,j) = ki1(i,j)+kij(j,i)
1058 ENDDO
1059 ENDDO
1060 ELSE
1061 DO i =1,nd
1062 DO j =1,nd
1063 ki1(i,j) = ki1(i,j)+kij(i,j)
1064 ENDDO
1065 ENDDO
1066 END IF
1067 nj=nj2
1068 IF (ni==nj) THEN
1069 DO i =1,nd
1070 DO j =i,nd
1071 k22(i,j) = k22(i,j)+kij(i,j)+ kij(j,i)
1072 ENDDO
1073 ENDDO
1074 ELSEIF (ni>nj) THEN
1075 DO i =1,nd
1076 DO j =1,nd
1077 ki2(i,j) = ki2(i,j)+kij(j,i)
1078 ENDDO
1079 ENDDO
1080 ELSE
1081 DO i =1,nd
1082 DO j =1,nd
1083 ki2(i,j) = ki2(i,j)+kij(i,j)
1084 ENDDO
1085 ENDDO
1086 END IF
1087C
1088 RETURN
1089 END
assem_s10
subroutine assem_s10(ixs, ixs10, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, k11, k12, k13, k14, k15, k16, k17, k18, k19, k10, k22, k23, k24, k25, k26, k27, k28, k29, k20, k33, k34, k35, k36, k37, k38, k39, k30, k44, k45, k46, k47, k48, k49, k40, k55, k56, k57, k58, k59, k50, k66, k67, k68, k69, k60, k77, k78, k79, k70, k88, k89, k80, k99, k90, k00, off)
Definition assem_s10.F:50
ass10_kii
subroutine ass10_kii(nc, n1, n2, iddl, iadk, jdik, k_diag, k_lt, kjj, nd)
Definition assem_s10.F:458
ass10_kkij
subroutine ass10_kkij(ni, nj1, nj2, nd, k11, k22, ki1, ki2, kij0)
Definition assem_s10.F:950
ass10_kkii
subroutine ass10_kkii(n1, n2, k11, k22, k12, kjj, nd)
Definition assem_s10.F:900
assem_kii1
subroutine assem_kii1(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition assem_s10.F:675
assem_kij1
subroutine assem_kij1(ni, nj, iddl, iadk, jdik, k_diag, k_lt, kij, nd)
Definition assem_s10.F:744
ass10_kkji
subroutine ass10_kkji(ni, nj1, nj2, nd, k11, k22, ki1, ki2, kij0)
Definition assem_s10.F:1023
ass10_kij
subroutine ass10_kij(nc, ni, nj1, nj2, nd, iddl, iadk, jdik, k_diag, k_lt, kij0)
Definition assem_s10.F:504
ass10_kij1
subroutine ass10_kij1(nc, ni1, ni2, nj1, nj2, iddl, iadk, jdik, k_diag, k_lt, kij0, nd)
Definition assem_s10.F:571
ass10_kij2
subroutine ass10_kij2(nc, ni, nj1, nj2, nd, iddl, iadk, jdik, k_diag, k_lt, kij0)
Definition assem_s10.F:859
my_real
#define my_real
Definition cppsort.cpp:32
assem_kii
subroutine assem_kii(ni, nel, iddl, iadk, k_diag, k_lt, kii, nd, off)
Definition imp_glob_k.F:964
assem_kij
subroutine assem_kij(ni, nj, nel, iddl, iadk, jdik, k_diag, k_lt, kij, nd, off)
Definition imp_glob_k.F:1043
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21