OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admfor0.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!|| admfor0 ../engine/source/model/remesh/admfor0.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| element_mod ../common_source/modules/elements/element_mod.F90
30!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
31!|| remesh_mod ../engine/share/modules/remesh_mod.F
32!||====================================================================
33 SUBROUTINE admfor0(IXC ,IPARTC,IXTG ,IPARTTG,IPART ,
34 . A ,STIFN ,AR ,STIFR ,X ,
35 . SH4TREE,SH3TREE,STCONT,FTHE ,CONDN ,
36 . NODADT_THERM,ITHERM_FE)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE remesh_mod
41 USE my_alloc_mod
42 use element_mod , only : nixc,nixtg
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "remesh_c.inc"
55#include "scr17_c.inc"
56#include "scr18_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER IXC(NIXC,*), IPARTC(*), IXTG(NIXTG,*), IPARTTG(*),
61 . IPART(LIPART1,*), SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
62 INTEGER ,INTENT(IN) :: NODADT_THERM
63 INTEGER ,INTENT(IN) :: ITHERM_FE
64 my_real A(3,*), STIFN(*), AR(3,*), STIFR(*), X(3,*),
65 . stcont(*), fthe(*),condn(*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER KN, KN1, KN2, KN3, KN4
70 INTEGER N, NN, LEVEL, IP, NLEV
71 INTEGER SON,M1,M2,M3,M4,MC,N1,N2,N3,N4,J,K
72 INTEGER I,LLNOD,
73 . le,lelt,lev,ne,lelt1,lelt2,
74 . ni,ll
75 INTEGER, DIMENSION(:), ALLOCATABLE :: LNOD
76 INTEGER, DIMENSION(:), ALLOCATABLE :: NELT
77 INTEGER, DIMENSION(:), ALLOCATABLE :: LKINNOD
78 my_real
79 . a1,a2,a3,a4,ac,
80 . phi,facm,faci,r,s
81 my_real, DIMENSION(:), ALLOCATABLE :: rnod
82 my_real, DIMENSION(:), ALLOCATABLE :: snod
83C-----------------------------------------------
84 CALL my_alloc(lnod,numnod)
85 CALL my_alloc(nelt,2*(4**levelmax))
86 CALL my_alloc(lkinnod,numnod)
87 CALL my_alloc(rnod,numnod)
88 CALL my_alloc(snod,numnod)
89C-----------------------------------------------
90 lkinnod=0
91 DO level=levelmax-1,0,-1
92
93 DO nn=psh4kin(level)+1,psh4kin(level+1)
94 n =lsh4kin(nn)
95
96 son=sh4tree(2,n)
97
98 n1=ixc(2,n)
99 n2=ixc(3,n)
100 n3=ixc(4,n)
101 n4=ixc(5,n)
102C
103 mc=ixc(4,son)
104 DO j=1,3
105 ac= fourth*a(j,mc)
106 a(j,n1)=a(j,n1)+ac
107 a(j,n2)=a(j,n2)+ac
108 a(j,n3)=a(j,n3)+ac
109 a(j,n4)=a(j,n4)+ac
110 END DO
111 ac=fourth*stifn(mc)
112 stifn(n1)=stifn(n1)+ac
113 stifn(n2)=stifn(n2)+ac
114 stifn(n3)=stifn(n3)+ac
115 stifn(n4)=stifn(n4)+ac
116 IF(istatcnd/=0)THEN
117 ac=fourth*stcont(mc)
118 stcont(n1)=stcont(n1)+ac
119 stcont(n2)=stcont(n2)+ac
120 stcont(n3)=stcont(n3)+ac
121 stcont(n4)=stcont(n4)+ac
122 END IF
123
124 DO j=1,3
125 ac= fourth*ar(j,mc)
126 ar(j,n1)=ar(j,n1)+ac
127 ar(j,n2)=ar(j,n2)+ac
128 ar(j,n3)=ar(j,n3)+ac
129 ar(j,n4)=ar(j,n4)+ac
130 END DO
131 ac=fourth*stifr(mc)
132 stifr(n1)=stifr(n1)+ac
133 stifr(n2)=stifr(n2)+ac
134 stifr(n3)=stifr(n3)+ac
135 stifr(n4)=stifr(n4)+ac
136
137 IF(itherm_fe > 0)THEN
138 ac= fourth*fthe(mc)
139 fthe(n1)=fthe(n1)+ac
140 fthe(n2)=fthe(n2)+ac
141 fthe(n3)=fthe(n3)+ac
142 fthe(n4)=fthe(n4)+ac
143 END IF
144
145 IF(nodadt_therm > 0)THEN
146 ac= fourth*condn(mc)
147 condn(n1)=condn(n1)+ac
148 condn(n2)=condn(n2)+ac
149 condn(n3)=condn(n3)+ac
150 condn(n4)=condn(n4)+ac
151 END IF
152
153 lkinnod(mc)=1
154 stifn(mc)=em20
155 stifr(mc)=em20
156C
157 m1=ixc(3,son )
158 IF(lkinnod(m1)==0)THEN
159 lkinnod(m1)=1
160 DO j=1,3
161 a1=half*a(j,m1)
162 a(j,n1)=a(j,n1)+a1
163 a(j,n2)=a(j,n2)+a1
164 END DO
165 a1=half*stifn(m1)
166 stifn(n1)=stifn(n1)+a1
167 stifn(n2)=stifn(n2)+a1
168
169 IF(istatcnd/=0)THEN
170 a1=half*stcont(m1)
171 stcont(n1)=stcont(n1)+a1
172 stcont(n2)=stcont(n2)+a1
173 END IF
174
175 DO j=1,3
176 a1=half*ar(j,m1)
177 ar(j,n1)=ar(j,n1)+a1
178 ar(j,n2)=ar(j,n2)+a1
179 END DO
180 a1=half*stifr(m1)
181 stifr(n1)=stifr(n1)+a1
182 stifr(n2)=stifr(n2)+a1
183
184 IF(itherm_fe > 0)THEN
185 a1= half*fthe(m1)
186 fthe(n1)=fthe(n1)+a1
187 fthe(n2)=fthe(n2)+a1
188 END IF
189
190 IF(nodadt_therm > 0)THEN
191 a1= half*condn(m1)
192 condn(n1)=condn(n1)+a1
193 condn(n2)=condn(n2)+a1
194 END IF
195
196 stifn(m1)=em20
197 stifr(m1)=em20
198 END IF
199C
200 m2=ixc(4,son+1)
201 IF(lkinnod(m2)==0)THEN
202 lkinnod(m2)=1
203 DO j=1,3
204 a2=half*a(j,m2)
205 a(j,n2)=a(j,n2)+a2
206 a(j,n3)=a(j,n3)+a2
207 END DO
208 a2=half*stifn(m2)
209 stifn(n2)=stifn(n2)+a2
210 stifn(n3)=stifn(n3)+a2
211
212 IF(istatcnd/=0)THEN
213 a2=half*stcont(m2)
214 stcont(n2)=stcont(n2)+a2
215 stcont(n3)=stcont(n3)+a2
216 END IF
217
218 DO j=1,3
219 a2=half*ar(j,m2)
220 ar(j,n2)=ar(j,n2)+a2
221 ar(j,n3)=ar(j,n3)+a2
222 END DO
223 a2=half*stifr(m2)
224 stifr(n2)=stifr(n2)+a2
225 stifr(n3)=stifr(n3)+a2
226
227 IF(itherm_fe > 0)THEN
228 a2= half*fthe(m2)
229 fthe(n2)=fthe(n2)+a2
230 fthe(n3)=fthe(n3)+a2
231 END IF
232
233 IF(nodadt_therm > 0)THEN
234 a2= half*condn(m2)
235 condn(n2)=condn(n2)+a2
236 condn(n3)=condn(n3)+a2
237 END IF
238
239 stifn(m2)=em20
240 stifr(m2)=em20
241 END IF
242
243 m3=ixc(5,son+2)
244 IF(lkinnod(m3)==0)THEN
245 lkinnod(m3)=1
246 DO j=1,3
247 a3=half*a(j,m3)
248 a(j,n3)=a(j,n3)+a3
249 a(j,n4)=a(j,n4)+a3
250 END DO
251 a3=half*stifn(m3)
252 stifn(n3)=stifn(n3)+a3
253 stifn(n4)=stifn(n4)+a3
254
255 IF(istatcnd/=0)THEN
256 a3=half*stcont(m3)
257 stcont(n3)=stcont(n3)+a3
258 stcont(n4)=stcont(n4)+a3
259 END IF
260
261 DO j=1,3
262 a3=half*ar(j,m3)
263 ar(j,n3)=ar(j,n3)+a3
264 ar(j,n4)=ar(j,n4)+a3
265 END DO
266 a3=half*stifr(m3)
267 stifr(n3)=stifr(n3)+a3
268 stifr(n4)=stifr(n4)+a3
269
270 IF(itherm_fe > 0)THEN
271 a3= half*fthe(m3)
272 fthe(n3)=fthe(n3)+a3
273 fthe(n4)=fthe(n4)+a3
274 END IF
275
276 IF(nodadt_therm > 0)THEN
277 a3= half*condn(m3)
278 condn(n3)=condn(n3)+a3
279 condn(n4)=condn(n4)+a3
280 END IF
281
282 stifn(m3)=em20
283 stifr(m3)=em20
284 END IF
285C
286 m4=ixc(2,son+3)
287 IF(lkinnod(m4)==0)THEN
288 lkinnod(m4)=1
289 DO j=1,3
290 a4=half*a(j,m4)
291 a(j,n1)=a(j,n1)+a4
292 a(j,n4)=a(j,n4)+a4
293 END DO
294 a4=half*stifn(m4)
295 stifn(n1)=stifn(n1)+a4
296 stifn(n4)=stifn(n4)+a4
297
298 IF(istatcnd/=0)THEN
299 a4=half*stcont(m4)
300 stcont(n1)=stcont(n1)+a4
301 stcont(n4)=stcont(n4)+a4
302 END IF
303
304 DO j=1,3
305 a4=half*ar(j,m4)
306 ar(j,n1)=ar(j,n1)+a4
307 ar(j,n4)=ar(j,n4)+a4
308 END DO
309 a4=half*stifr(m4)
310 stifr(n1)=stifr(n1)+a4
311 stifr(n4)=stifr(n4)+a4
312
313 IF(itherm_fe > 0)THEN
314 a4= half*fthe(m4)
315 fthe(n1)=fthe(n1)+a4
316 fthe(n4)=fthe(n4)+a4
317 END IF
318
319 IF(nodadt_therm > 0)THEN
320 a4= half*condn(m4)
321 condn(n1)=condn(n1)+a4
322 condn(n4)=condn(n4)+a4
323 END IF
324
325 stifn(m4)=em20
326 stifr(m4)=em20
327 END IF
328
329 END DO
330
331
332 DO nn=psh3kin(level)+1,psh3kin(level+1)
333 n =lsh3kin(nn)
334
335 son=sh3tree(2,n)
336
337 n1=ixtg(2,n)
338 n2=ixtg(3,n)
339 n3=ixtg(4,n)
340C
341 m1=ixtg(4,son+3)
342 IF(lkinnod(m1)==0)THEN
343 lkinnod(m1)=1
344 DO j=1,3
345 a1=half*a(j,m1)
346 a(j,n1)=a(j,n1)+a1
347 a(j,n2)=a(j,n2)+a1
348 END DO
349 a1=half*stifn(m1)
350 stifn(n1)=stifn(n1)+a1
351 stifn(n2)=stifn(n2)+a1
352
353 IF(istatcnd/=0)THEN
354 a1=half*stcont(m1)
355 stcont(n1)=stcont(n1)+a1
356 stcont(n2)=stcont(n2)+a1
357 END IF
358
359 DO j=1,3
360 a1=half*ar(j,m1)
361 ar(j,n1)=ar(j,n1)+a1
362 ar(j,n2)=ar(j,n2)+a1
363 END DO
364 a1=half*stifr(m1)
365 stifr(n1)=stifr(n1)+a1
366 stifr(n2)=stifr(n2)+a1
367
368 IF(itherm_fe > 0)THEN
369 a1= half*fthe(m1)
370 fthe(n1)=fthe(n1)+a1
371 fthe(n2)=fthe(n2)+a1
372 END IF
373
374 IF(nodadt_therm > 0)THEN
375 a1= half*condn(m1)
376 condn(n1)=condn(n1)+a1
377 condn(n2)=condn(n2)+a1
378 END IF
379
380 stifn(m1)=em20
381 stifr(m1)=em20
382 END IF
383C
384 m2=ixtg(2,son+3)
385 IF(lkinnod(m2)==0)THEN
386 lkinnod(m2)=1
387 DO j=1,3
388 a2=half*a(j,m2)
389 a(j,n2)=a(j,n2)+a2
390 a(j,n3)=a(j,n3)+a2
391 END DO
392 a2=half*stifn(m2)
393 stifn(n2)=stifn(n2)+a2
394 stifn(n3)=stifn(n3)+a2
395
396 IF(istatcnd/=0)THEN
397 a2=half*stcont(m2)
398 stcont(n2)=stcont(n2)+a2
399 stcont(n3)=stcont(n3)+a2
400 END IF
401
402 DO j=1,3
403 a2=half*ar(j,m2)
404 ar(j,n2)=ar(j,n2)+a2
405 ar(j,n3)=ar(j,n3)+a2
406 END DO
407 a2=half*stifr(m2)
408 stifr(n2)=stifr(n2)+a2
409 stifr(n3)=stifr(n3)+a2
410
411 IF(itherm_fe > 0)THEN
412 a2= half*fthe(m2)
413 fthe(n2)=fthe(n2)+a2
414 fthe(n3)=fthe(n3)+a2
415 END IF
416
417 IF(nodadt_therm > 0)THEN
418 a2= half*condn(m2)
419 condn(n2)=condn(n2)+a2
420 condn(n3)=condn(n3)+a2
421 END IF
422
423 stifn(m2)=em20
424 stifr(m2)=em20
425 END IF
426
427 m3=ixtg(3,son+3)
428 IF(lkinnod(m3)==0)THEN
429 lkinnod(m3)=1
430 DO j=1,3
431 a3=half*a(j,m3)
432 a(j,n3)=a(j,n3)+a3
433 a(j,n1)=a(j,n1)+a3
434 END DO
435 a3=half*stifn(m3)
436 stifn(n3)=stifn(n3)+a3
437 stifn(n1)=stifn(n1)+a3
438
439 IF(istatcnd/=0)THEN
440 a3=half*stcont(m3)
441 stcont(n3)=stcont(n3)+a3
442 stcont(n1)=stcont(n1)+a3
443 END IF
444
445 DO j=1,3
446 a3=half*ar(j,m3)
447 ar(j,n3)=ar(j,n3)+a3
448 ar(j,n1)=ar(j,n1)+a3
449 END DO
450 a3=half*stifr(m3)
451 stifr(n3)=stifr(n3)+a3
452 stifr(n1)=stifr(n1)+a3
453
454 IF(itherm_fe > 0)THEN
455 a3= half*fthe(m3)
456 fthe(n3)=fthe(n3)+a3
457 fthe(n1)=fthe(n1)+a3
458 END IF
459
460 IF(nodadt_therm > 0)THEN
461 a3= half*condn(m3)
462 condn(n3)=condn(n3)+a3
463 condn(n1)=condn(n1)+a3
464 END IF
465
466 stifn(m3)=em20
467 stifr(m3)=em20
468 END IF
469
470 END DO
471
472 END DO
473C-----
474 IF(istatcnd==0) RETURN
475
476 tagnod=0
477C Store forces.
478 acnd(1:3,1:numnod)=a (1:3,1:numnod)
479 arcnd(1:3,1:numnod)=ar(1:3,1:numnod)
480
481 ll=psh4upl(1)
482 DO nn=1,ll
483 n =lsh4upl(nn)
484C
485 n1=ixc(2,n)
486 n2=ixc(3,n)
487 n3=ixc(4,n)
488 n4=ixc(5,n)
489C
490C-------
491 rnod(n1)=-one
492 snod(n1)=-one
493 rnod(n2)= one
494 snod(n2)=-one
495 rnod(n3)= one
496 snod(n3)= one
497 rnod(n4)=-one
498 snod(n4)= one
499C
500C-------
501 lelt =1
502 nelt(1)=n
503
504 lelt1 =0
505 lelt2 =1
506
507 lev=0
508
509 llnod=0
510 DO WHILE (lev < levelmax)
511 DO le=lelt1+1,lelt2
512
513 ne =nelt(le)
514 IF(sh4tree(3,ne) >= 0) cycle
515
516 m1=ixc(2,ne)
517 m2=ixc(3,ne)
518 m3=ixc(4,ne)
519 m4=ixc(5,ne)
520
521 son=sh4tree(2,ne)
522
523 lelt=lelt+1
524 nelt(lelt)=son
525
526 lelt=lelt+1
527 nelt(lelt)=son+1
528
529 lelt=lelt+1
530 nelt(lelt)=son+2
531
532 lelt=lelt+1
533 nelt(lelt)=son+3
534
535 ni=ixc(3,son)
536 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
537C
538C nodes w/kinematic condition are not condensed
539 tagnod(ni)=1
540 llnod=llnod+1
541 lnod(llnod)=ni
542 END IF
543 rnod(ni)=half*(rnod(m1)+rnod(m2))
544 snod(ni)=half*(snod(m1)+snod(m2))
545
546 ni=ixc(4,son+1)
547 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
548 tagnod(ni)=1
549 llnod=llnod+1
550 lnod(llnod)=ni
551 END IF
552 rnod(ni)=half*(rnod(m2)+rnod(m3))
553 snod(ni)=half*(snod(m2)+snod(m3))
554
555 ni=ixc(5,son+2)
556 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
557 tagnod(ni)=1
558 llnod=llnod+1
559 lnod(llnod)=ni
560 END IF
561 rnod(ni)=half*(rnod(m3)+rnod(m4))
562 snod(ni)=half*(snod(m3)+snod(m4))
563
564 ni=ixc(2,son+3)
565 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
566 tagnod(ni)=1
567 llnod=llnod+1
568 lnod(llnod)=ni
569 END IF
570 rnod(ni)=half*(rnod(m4)+rnod(m1))
571 snod(ni)=half*(snod(m4)+snod(m1))
572
573 ni=ixc(4,son)
574 IF(lkinnod(ni)==0)THEN
575 tagnod(ni)=1
576 llnod=llnod+1
577 lnod(llnod)=ni
578 END IF
579 rnod(ni)=fourth*(rnod(m1)+rnod(m2)+rnod(m3)+rnod(m4))
580 snod(ni)=fourth*(snod(m1)+snod(m2)+snod(m3)+snod(m4))
581
582 END DO
583
584 lev =lev+1
585 lelt1 =lelt2
586 lelt2 =lelt
587
588 END DO
589C
590C-------
591 DO i=1,llnod
592 ni=lnod(i)
593 r =rnod(ni)
594 s =snod(ni)
595 phi =fourth*(one-r)*(one-s)
596 DO j=1,3
597 ac= phi*a(j,ni)
598 a(j,n1)=a(j,n1)+ac
599 END DO
600 stifn(n1)=stifn(n1)+phi*stcont(ni)
601 DO j=1,3
602 ac= phi*ar(j,ni)
603 ar(j,n1)=ar(j,n1)+ac
604 END DO
605 phi=fourth*(one+r)*(one-s)
606 DO j=1,3
607 ac= phi*a(j,ni)
608 a(j,n2)=a(j,n2)+ac
609 END DO
610 stifn(n2)=stifn(n2)+phi*stcont(ni)
611 DO j=1,3
612 ac= phi*ar(j,ni)
613 ar(j,n2)=ar(j,n2)+ac
614 END DO
615 phi=fourth*(one+r)*(one+s)
616 DO j=1,3
617 ac= phi*a(j,ni)
618 a(j,n3)=a(j,n3)+ac
619 END DO
620 stifn(n3)=stifn(n3)+phi*stcont(ni)
621 DO j=1,3
622 ac= phi*ar(j,ni)
623 ar(j,n3)=ar(j,n3)+ac
624 END DO
625 phi=fourth*(one-r)*(one+s)
626 DO j=1,3
627 ac= phi*a(j,ni)
628 a(j,n4)=a(j,n4)+ac
629 END DO
630 stifn(n4)=stifn(n4)+phi*stcont(ni)
631 DO j=1,3
632 ac= phi*ar(j,ni)
633 ar(j,n4)=ar(j,n4)+ac
634 END DO
635 END DO
636
637
638 END DO
639C
640C-----
641
642 ll=psh3upl(1)
643 DO nn=1,ll
644 n =lsh3upl(nn)
645C
646 n1=ixtg(2,n)
647 n2=ixtg(3,n)
648 n3=ixtg(4,n)
649C
650C-------
651 rnod(n1)= zero
652 snod(n1)= zero
653 rnod(n2)= one
654 snod(n2)= zero
655 rnod(n3)= zero
656 snod(n3)= one
657C
658C-------
659 lelt =1
660 nelt(1)=n
661
662 lelt1 =0
663 lelt2 =1
664
665 lev=0
666
667 llnod=0
668 DO WHILE (lev < levelmax)
669 DO le=lelt1+1,lelt2
670
671 ne =nelt(le)
672 IF(sh3tree(3,ne) >= 0) cycle
673
674 m1=ixtg(2,ne)
675 m2=ixtg(3,ne)
676 m3=ixtg(4,ne)
677
678 son=sh3tree(2,ne)
679
680 lelt=lelt+1
681 nelt(lelt)=son
682
683 lelt=lelt+1
684 nelt(lelt)=son+1
685
686 lelt=lelt+1
687 nelt(lelt)=son+2
688
689 lelt=lelt+1
690 nelt(lelt)=son+3
691
692 ni=ixtg(4,son+3)
693 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
694 tagnod(ni)=1
695 llnod=llnod+1
696 lnod(llnod)=ni
697 END IF
698 rnod(ni)=half*(rnod(m1)+rnod(m2))
699 snod(ni)=half*(snod(m1)+snod(m2))
700
701 ni=ixtg(2,son+3)
702 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
703 tagnod(ni)=1
704 llnod=llnod+1
705 lnod(llnod)=ni
706 END IF
707 rnod(ni)=half*(rnod(m2)+rnod(m3))
708 snod(ni)=half*(snod(m2)+snod(m3))
709
710 ni=ixtg(3,son+3)
711 IF(lkinnod(ni)==0.AND.tagnod(ni)==0)THEN
712 tagnod(ni)=1
713 llnod=llnod+1
714 lnod(llnod)=ni
715 END IF
716 rnod(ni)=half*(rnod(m3)+rnod(m1))
717 snod(ni)=half*(snod(m3)+snod(m1))
718
719 END DO
720
721 lev =lev+1
722 lelt1 =lelt2
723 lelt2 =lelt
724
725 END DO
726C
727C-------
728 DO i=1,llnod
729 ni=lnod(i)
730 r =rnod(ni)
731 s =snod(ni)
732 phi =one-r-s
733 DO j=1,3
734 ac= phi*a(j,ni)
735 a(j,n1)=a(j,n1)+ac
736 END DO
737 stifn(n1)=stifn(n1)+phi*stcont(ni)
738 DO j=1,3
739 ac= phi*ar(j,ni)
740 ar(j,n1)=ar(j,n1)+ac
741 END DO
742 phi=r
743 DO j=1,3
744 ac= phi*a(j,ni)
745 a(j,n2)=a(j,n2)+ac
746 END DO
747 stifn(n2)=stifn(n2)+phi*stcont(ni)
748 DO j=1,3
749 ac= phi*ar(j,ni)
750 ar(j,n2)=ar(j,n2)+ac
751 END DO
752 phi=s
753 DO j=1,3
754 ac= phi*a(j,ni)
755 a(j,n3)=a(j,n3)+ac
756 END DO
757 stifn(n3)=stifn(n3)+phi*stcont(ni)
758 DO j=1,3
759 ac= phi*ar(j,ni)
760 ar(j,n3)=ar(j,n3)+ac
761 END DO
762 END DO
763
764
765 END DO
766C
767C-----
768 DEALLOCATE(lnod)
769 DEALLOCATE(nelt)
770 DEALLOCATE(lkinnod)
771 DEALLOCATE(rnod)
772 DEALLOCATE(snod)
773 RETURN
774 END
admfor0
subroutine admfor0(ixc, ipartc, ixtg, iparttg, ipart, a, stifn, ar, stifr, x, sh4tree, sh3tree, stcont, fthe, condn, nodadt_therm, itherm_fe)
Definition admfor0.F:37
remesh_mod
Definition remesh_mod.F:50
remesh_mod::lsh4upl
integer, dimension(:), allocatable lsh4upl
Definition remesh_mod.F:71
remesh_mod::lsh4kin
integer, dimension(:), allocatable lsh4kin
Definition remesh_mod.F:62
remesh_mod::lsh3upl
integer, dimension(:), allocatable lsh3upl
Definition remesh_mod.F:71
remesh_mod::lsh3kin
integer, dimension(:), allocatable lsh3kin
Definition remesh_mod.F:62
remesh_mod::psh4kin
integer, dimension(:), allocatable psh4kin
Definition remesh_mod.F:62
remesh_mod::psh3kin
integer, dimension(:), allocatable psh3kin
Definition remesh_mod.F:62
remesh_mod::psh3upl
integer, dimension(:), allocatable psh3upl
Definition remesh_mod.F:71
remesh_mod::psh4upl
integer, dimension(:), allocatable psh4upl
Definition remesh_mod.F:71
remesh_mod::tagnod
integer, dimension(:), allocatable tagnod
Definition remesh_mod.F:77