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