OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admfor0.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine admfor0 (ixc, ipartc, ixtg, iparttg, ipart, a, stifn, ar, stifr, x, sh4tree, sh3tree, stcont, fthe, condn, nodadt_therm, itherm_fe)

Function/Subroutine Documentation

◆ admfor0()

subroutine admfor0 ( integer, dimension(nixc,*) ixc,
integer, dimension(*) ipartc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) iparttg,
integer, dimension(lipart1,*) ipart,
a,
stifn,
ar,
stifr,
x,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
stcont,
fthe,
condn,
integer, intent(in) nodadt_therm,
integer, intent(in) itherm_fe )

Definition at line 33 of file admfor0.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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