OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24for3e.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!|| i24for3e ../engine/source/interfaces/int24/i24for3e.F
25!||====================================================================
26 SUBROUTINE i24for3e()
27 RETURN
28 END
29C
30!||====================================================================
31!|| i24forc_fic ../engine/source/interfaces/int24/i24for3e.F
32!||--- called by ------------------------------------------------------
33!|| i24ass0 ../engine/source/interfaces/int24/i24for3.F
34!|| i24ass2 ../engine/source/interfaces/int24/i24for3.F
35!|| i24sms2 ../engine/source/interfaces/int24/i24for3.F
36!||====================================================================
37 SUBROUTINE i24forc_fic(NPT ,IRTSE ,NSNE ,IS2SE ,IS2PT ,
38 + NS ,NFIC ,FICI ,FICS ,IXSS )
39C============================================================================
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER IRTSE(5,*) ,NS,NSNE,IS2SE(2,*),IS2PT(*),NPT,IXSS(4),NFIC
47 my_real
48 . fici(nfic),fics(4,nfic)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52! 4---------------3
53! | . . |
54! | . . |
55! | . . |
56! | . |
57! | . . |
58! | . . |
59! | . o3 . |
60! 1---o1------o2--2 NPT=3
61C----- NLS : Num. of element with active edge----
62 INTEGER I,J,K,NSN0,IP,NS1,NS2,IE,NP0
63 INTEGER IK1(4),IK2(4),IE1,IE2,IED
64 DATA ik1 /1,2,3,4/
65 DATA ik2 /2,3,4,1/
66 my_real
67 . fx,fy,fz,s,sti,fict(nfic)
68C=======================================================================
69C----IRTSE(5,*) -> id of edge
70C=======================================================================
71 IF (ns<=0) RETURN
72 fics(1:4,1:nfic) = zero
73 ip = is2pt(ns)
74 ie1 = is2se(1,ns)
75 ie2 = is2se(2,ns)
76 IF (ie1 > 0) THEN
77 ie = ie1
78 ied=irtse(5,ie)
79 ns1= ik1(ied)
80 ns2= ik2(ied)
81 ELSEIF(ie2 > 0) THEN
82 ie = ie2
83 ied=irtse(5,ie)
84 ns1= ik2(ied)
85 ns2= ik1(ied)
86 ELSE
87 print *,'probleme EDGES,IE1,IE2=',ns,ie1,ie2
88 END IF
89 ixss(1:4) = irtse(1:4,ie)
90 DO k = 1,nfic
91 fict(k) = fici(k)
92c FICT(K) = FICI(K)/NPT
93 END DO
94 IF (ip==npt) THEN
95C---equi_balance to NS1,NS2 and element center
96C-------seg center-------
97 IF (irtse(3,ie)/=irtse(4,ie)) THEN
98 DO j =1,4
99 DO k = 1,nfic
100 fics(j,k) = fourth*fict(k)
101 END DO
102 END DO
103 ELSE
104 DO j =1,3
105 DO k = 1,nfic
106 fics(j,k) = third*fict(k)
107 END DO
108 END DO
109 END IF
110C-------NPT should be unpair: 3,5,7....
111 ELSEIF (ip > 0 ) THEN
112 np0 = (npt-1)/2
113 IF (ip > np0) THEN
114C---------right side
115 s = (ip+1)*one/(npt+1)
116 DO k = 1,nfic
117 fics(ns2,k) = fics(ns2,k) + s*fict(k)
118 END DO
119 s = (npt-ip)*one/(npt+1)
120 DO k = 1,nfic
121 fics(ns1,k) = fics(ns1,k) + s*fict(k)
122 END DO
123 ELSE
124C---------left side
125 s = (npt-ip+1)*one/(npt+1)
126 DO k = 1,nfic
127 fics(ns1,k) = fics(ns1,k) + s*fict(k)
128 END DO
129 s = ip*one/(npt+1)
130 DO k = 1,nfic
131 fics(ns2,k) = fics(ns2,k) + s*fict(k)
132 END DO
133 END IF
134 END IF
135C-----------
136 RETURN
137 END
138!||====================================================================
139!|| i24for1_fic ../engine/source/interfaces/int24/i24for3e.F
140!||--- called by ------------------------------------------------------
141!|| i24for3 ../engine/source/interfaces/int24/i24for3.F
142!||--- uses -----------------------------------------------------
143!|| tri7box ../engine/share/modules/tri7box.F
144!||====================================================================
145 SUBROUTINE i24for1_fic(NPT ,IRTSE ,NSNE ,IS2SE ,IS2PT ,
146 + NS ,FXI ,FYI ,FZI ,FOR1 ,
147 + INEGA )
148 USE tri7box
149C============================================================================
150C I m p l i c i t T y p e s
151C-----------------------------------------------
152#include "implicit_f.inc"
153C-----------------------------------------------
154C D u m m y A r g u m e n t s
155C-----------------------------------------------
156 INTEGER IRTSE(5,*) ,NS,NSNE,IS2SE(2,*),IS2PT(*),NPT,INEGA
157 my_real
158 . FXI ,FYI ,FZI, FOR1(3,*)
159C-----------------------------------------------
160C L o c a l V a r i a b l e s
161C-----------------------------------------------
162! 4---------------3
163! | . . |
164! | . . |
165! | . . |
166! | . |
167! | . . |
168! | . . |
169! | . o3 . |
170! 1---o1------o2--2 NPT=3
171C----- NLS : Num. of element with active edge----
172 INTEGER I,J,K,NSN0,IP,NS1,NS2,IE,NP0,IX
173 INTEGER IK1(4),IK2(4),IE1,IE2,IED
174 DATA IK1 /1,2,3,4/
175 DATA ik2 /2,3,4,1/
176 my_real
177 . fx,fy,fz,s,fxs(4),fys(4),fzs(4)
178C=======================================================================
179C----IRTSE(5,*) -> id of edge, NS1,NS2 local edge nodes
180C=======================================================================
181 IF (ns<=0) RETURN
182 DO j = 1,4
183 fxs(j) = zero
184 fys(j) = zero
185 fzs(j) = zero
186 END DO
187 ip = is2pt(ns)
188 ie1 = is2se(1,ns)
189 ie2 = is2se(2,ns)
190 IF (ie1 > 0) THEN
191 ie = ie1
192 ied=irtse(5,ie)
193 ns1= ik1(ied)
194 ns2= ik2(ied)
195 ELSEIF(ie2 > 0) THEN
196 ie = ie2
197 ied=irtse(5,ie)
198 ns1= ik2(ied)
199 ns2= ik1(ied)
200 ELSE
201 print *,'probleme EDGENS,IE1,IE2=',ns,ie1,ie2
202 END IF
203 IF (ip==npt) THEN
204C---equi_balance to NS1,NS2 and element center
205 fx = fxi
206 fy = fyi
207 fz = fzi
208c FX = THIRD*FXI
209c FY = THIRD*FYI
210c FZ = THIRD*FZI
211C-------seg center-------
212 IF (irtse(3,ie)/=irtse(4,ie)) THEN
213 fxs(1) = fourth*fx
214 fys(1) = fourth*fy
215 fzs(1) = fourth*fz
216 DO j =2,4
217 fxs(j) = fxs(1)
218 fys(j) = fys(1)
219 fzs(j) = fzs(1)
220 END DO
221 ELSE
222 fxs(1) = third*fx
223 fys(1) = third*fy
224 fzs(1) = third*fz
225 DO j =2,3
226 fxs(j) = fxs(1)
227 fys(j) = fys(1)
228 fzs(j) = fzs(1)
229 END DO
230 END IF
231C-------NPT should be unpair: 3,5,7....
232 ELSEIF (ip > 0 ) THEN
233 np0 = (npt-1)/2
234 IF (ip > np0) THEN
235C---------right side
236 s = (ip+1)*one/(npt+1)
237 fxs(ns2) = fxs(ns2)+s*fxi
238 fys(ns2) = fys(ns2)+s*fyi
239 fzs(ns2) = fzs(ns2)+s*fzi
240 s = (npt-ip)*one/(npt+1)
241 fxs(ns1) = fxs(ns1)+s*fxi
242 fys(ns1) = fys(ns1)+s*fyi
243 fzs(ns1) = fzs(ns1)+s*fzi
244 ELSE
245C---------left side
246 s = (npt-ip+1)*one/(npt+1)
247 fxs(ns1) = fxs(ns1)+s*fxi
248 fys(ns1) = fys(ns1)+s*fyi
249 fzs(ns1) = fzs(ns1)+s*fzi
250 s = ip*one/(npt+1)
251 fxs(ns2) = fxs(ns2)+s*fxi
252 fys(ns2) = fys(ns2)+s*fyi
253 fzs(ns2) = fzs(ns2)+s*fzi
254 END IF
255 END IF
256 IF (inega==-1) THEN
257 DO j =1,4
258 ix = irtse(j,ie)
259 for1(1,ix) = for1(1,ix) - fxs(j)
260 for1(2,ix) = for1(2,ix) - fys(j)
261 for1(3,ix) = for1(3,ix) - fzs(j)
262 END DO
263 ELSE
264 DO j =1,4
265 ix = irtse(j,ie)
266 for1(1,ix) = for1(1,ix) + fxs(j)
267 for1(2,ix) = for1(2,ix) + fys(j)
268 for1(3,ix) = for1(3,ix) + fzs(j)
269 END DO
270 END IF
271C-----------
272 RETURN
273 END
274
275!||====================================================================
276!|| i24for1_ficr ../engine/source/interfaces/int24/i24for3e.F
277!||--- called by ------------------------------------------------------
278!|| i24for3 ../engine/source/interfaces/int24/i24for3.F
279!||--- uses -----------------------------------------------------
280!|| tri7box ../engine/share/modules/tri7box.F
281!||====================================================================
282 SUBROUTINE i24for1_ficr(NPT ,IRTSE ,NSNE ,IS2SE ,IS2PT ,
283 + NS ,FXI ,FYI ,FZI ,FOR1 ,
284 + INEGA ,NI )
285 USE tri7box
286C============================================================================
287C I m p l i c i t T y p e s
288C-----------------------------------------------
289#include "implicit_f.inc"
290C-----------------------------------------------
291C D u m m y A r g u m e n t s
292C-----------------------------------------------
293 INTEGER IRTSE(5,*) ,NS,NSNE,IS2SE(2,*),IS2PT(*),NPT,INEGA,NI
294 my_real
295 . FXI ,FYI ,FZI, FOR1(3,*)
296C-----------------------------------------------
297C L o c a l V a r i a b l e s
298C-----------------------------------------------
299! 4---------------3
300! | . . |
301! | . . |
302! | . . |
303! | . |
304! | . . |
305! | . . |
306! | . o3 . |
307! 1---o1------o2--2 NPT=3
308C----- NLS : Num. of element with active edge----
309 INTEGER I,J,K,NSN0,IP,NS1,NS2,IE,NP0,IX
310 INTEGER IK1(4),IK2(4),IE1,IE2,IED
311 DATA IK1 /1,2,3,4/
312 DATA IK2 /2,3,4,1/
313 my_real
314 . fx,fy,fz,s,fxs(4),fys(4),fzs(4)
315C=======================================================================
316C----IRTSE(5,*) -> id of edge, NS1,NS2 local edge nodes
317C=======================================================================
318 IF (ns<=0) RETURN
319 DO j = 1,4
320 fxs(j) = zero
321 fys(j) = zero
322 fzs(j) = zero
323 END DO
324 ip = is2pt(ns)
325 ie1 = is2se(1,ns)
326 ie2 = is2se(2,ns)
327 IF (ie1 > 0) THEN
328 ie = ie1
329 ied=irtse(5,ie)
330 ns1= ik1(ied)
331 ns2= ik2(ied)
332 ELSEIF(ie2 > 0) THEN
333 ie = ie2
334 ied=irtse(5,ie)
335 ns1= ik2(ied)
336 ns2= ik1(ied)
337 ELSE
338 print *,'probleme EDGENS,IE1,IE2=',ns,ie1,ie2
339 END IF
340 IF (ip==npt) THEN
341C---equi_balance to NS1,NS2 and element center
342 fx = fxi
343 fy = fyi
344 fz = fzi
345c FX = THIRD*FXI
346c FY = THIRD*FYI
347c FZ = THIRD*FZI
348C-------seg center-------
349 IF (irtse(3,ie)/=irtse(4,ie)) THEN
350 fxs(1) = fourth*fx
351 fys(1) = fourth*fy
352 fzs(1) = fourth*fz
353 DO j =2,4
354 fxs(j) = fxs(1)
355 fys(j) = fys(1)
356 fzs(j) = fzs(1)
357 END DO
358 ELSE
359 fxs(1) = third*fx
360 fys(1) = third*fy
361 fzs(1) = third*fz
362 DO j =2,3
363 fxs(j) = fxs(1)
364 fys(j) = fys(1)
365 fzs(j) = fzs(1)
366 END DO
367 END IF
368C-------NPT should be unpair: 3,5,7....
369 ELSEIF (ip > 0 ) THEN
370 np0 = (npt-1)/2
371 IF (ip > np0) THEN
372C---------right side
373 s = (ip+1)*one/(npt+1)
374 fxs(ns2) = fxs(ns2)+s*fxi
375 fys(ns2) = fys(ns2)+s*fyi
376 fzs(ns2) = fzs(ns2)+s*fzi
377 s = (npt-ip)*one/(npt+1)
378 fxs(ns1) = fxs(ns1)+s*fxi
379 fys(ns1) = fys(ns1)+s*fyi
380 fzs(ns1) = fzs(ns1)+s*fzi
381 ELSE
382C---------left side
383 s = (npt-ip+1)*one/(npt+1)
384 fxs(ns1) = fxs(ns1)+s*fxi
385 fys(ns1) = fys(ns1)+s*fyi
386 fzs(ns1) = fzs(ns1)+s*fzi
387 s = ip*one/(npt+1)
388 fxs(ns2) = fxs(ns2)+s*fxi
389 fys(ns2) = fys(ns2)+s*fyi
390 fzs(ns2) = fzs(ns2)+s*fzi
391 END IF
392 END IF
393 IF (inega==-1) THEN
394 DO j =1,4
395 ix = irtse(j,ie)
396c IF(IX >NLSKYFI(NI))print*,ispmd,NI,'ERROR:',IX,NLSKYFI(NI)
397 for1(1,ix) = for1(1,ix) - fxs(j)
398 for1(2,ix) = for1(2,ix) - fys(j)
399 for1(3,ix) = for1(3,ix) - fzs(j)
400 END DO
401 ELSE
402 DO j =1,4
403 ix = irtse(j,ie)
404 for1(1,ix) = for1(1,ix) + fxs(j)
405 for1(2,ix) = for1(2,ix) + fys(j)
406 for1(3,ix) = for1(3,ix) + fzs(j)
407 END DO
408 END IF
409C-----------
410 RETURN
411 END
412
413!||====================================================================
414!|| i24xvfic_upd ../engine/source/interfaces/int24/i24for3e.f
415!||--- called by ------------------------------------------------------
416!|| i24e2e_fictive_nodes_update ../engine/source/interfaces/int24/i24for3e.F
417!||--- calls -----------------------------------------------------
418!|| i24xfic_ini ../engine/source/interfaces/int24/i24for3e.f
419!||--- uses -----------------------------------------------------
420!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
421!||====================================================================
422 SUBROUTINE i24xvfic_upd(IPARI ,INTBUF_TAB ,X ,V ,NPT ,ITAB )
423C-----------------------------------------------
424C M o d u l e s
425C-----------------------------------------------
426 USE intbufdef_mod
427C============================================================================
428C I m p l i c i t T y p e s
429C-----------------------------------------------
430#include "implicit_f.inc"
431C-----------------------------------------------
432C D u m m y A r g u m e n t s
433C-----------------------------------------------
434 INTEGER IPARI(*) ,NPT,ITAB(*)
435 TYPE(INTBUF_STRUCT_) INTBUF_TAB
436 my_real
437 . X(3,*),V(3,*)
438C-----------------------------------------------
439C L o c a l V a r i a b l e s
440C-----------------------------------------------
441 INTEGER I,J,K,NRTSE,NSNE,NSN
442C=======================================================================
443 NRTSE = ipari(52)
444 nsne = ipari(55)
445 nsn = ipari(5)
446 CALL i24xfic_ini(nrtse ,intbuf_tab%IRTSE ,nsne ,intbuf_tab%IS2SE ,
447 + intbuf_tab%IS2PT ,nsn ,intbuf_tab%NSV ,x ,
448 + intbuf_tab%XFIC ,npt , itab ,1)
449 CALL i24xfic_ini(nrtse ,intbuf_tab%IRTSE ,nsne ,intbuf_tab%IS2SE ,
450 + intbuf_tab%IS2PT ,nsn ,intbuf_tab%NSV ,v ,
451 + intbuf_tab%VFIC ,npt , itab ,2 )
452C-----------
453 RETURN
454 END
455!||====================================================================
456!|| i24xfic_ini ../engine/source/interfaces/int24/i24for3e.F
457!||--- called by ------------------------------------------------------
458!|| i24xvfic_upd ../engine/source/interfaces/int24/i24for3e.F
459!||--- calls -----------------------------------------------------
460!|| i24fic_getn ../engine/source/interfaces/int24/i24for3e.F
461!||====================================================================
462 SUBROUTINE i24xfic_ini(NRTSE ,IRTSE ,NSNE ,IS2SE ,IS2PT ,
463 4 NSN ,NSV ,X ,XFIC ,NPT , ITAB ,FLG)
464C============================================================================
465C I m p l i c i t T y p e s
466C-----------------------------------------------
467#include "implicit_f.inc"
468C-----------------------------------------------
469C C o m m o n B l o c k s
470C-----------------------------------------------
471#include "com04_c.inc"
472
473C-----------------------------------------------
474C D u m m y A r g u m e n t s
475C-----------------------------------------------
476 INTEGER IRTSE(5,*) ,NSV(*),NRTSE,NSNE,IS2SE(2,*),IS2PT(*),NSN,NPT,
477 . ITAB(*),FLG
478 my_real
479 . X(3,*),XFIC(3,*)
480C-----------------------------------------------
481C L o c a l V a r i a b l e s
482C-----------------------------------------------
483! 4---------------3
484! | . . |
485! | . . |
486! | . . |
487! | . |
488! | . . |
489! | . . |
490! | . o3 . |
491! 1---o1------o2--2 NPT=3
492C----- NLS : Num. of element with active edge----
493 INTEGER I,J,K,NSN0,NS,IP,NS1,NS2,IE,NP0,ipr
494 my_real
495 . X0,Y0,Z0,XE0,YE0,ZE0,S
496C=======================================================================
497C----IRTSE(5,*) -> id of edge
498C=======================================================================
499 ipr=0
500c if (ncycle==0) ipr=1
501 nsn0 = nsn-nsne
502c if (ipr==1) write(6,*),'NSN,NSNE=',NSN,NSNE
503 DO i=nsn0+1,nsn
504 ns=nsv(i)-numnod
505C IF (NS<=0) write(iout,*) '!!!!error, NSV(I),I=',NSV(I),I
506 ip = is2pt(ns)
507c if (ipr==1) write(6,*),'IP,NS,I=',IP,NS,I
508 CALL i24fic_getn(ns ,irtse ,is2se ,ie ,ns1 ,
509 + ns2 )
510c if (ipr==1) write(6,*),'IE,IRTSE(j,IE)=',IE,(itab(IRTSE(j,IE)),j=1,5)
511 IF (ip==npt) THEN
512C-------seg center-------
513 IF (irtse(3,ie)==irtse(4,ie)) THEN
514 x0=third*(x(1,irtse(1,ie))+x(1,irtse(2,ie))+x(1,irtse(3,ie)))
515 y0=third*(x(2,irtse(1,ie))+x(2,irtse(2,ie))+x(2,irtse(3,ie)))
516 z0=third*(x(3,irtse(1,ie))+x(3,irtse(2,ie))+x(3,irtse(3,ie)))
517 ELSE
518 x0=fourth*(x(1,irtse(1,ie))+x(1,irtse(2,ie))+x(1,irtse(3,ie))+
519 + x(1,irtse(4,ie)))
520 y0=fourth*(x(2,irtse(1,ie))+x(2,irtse(2,ie))+x(2,irtse(3,ie))+
521 + x(2,irtse(4,ie)))
522 z0=fourth*(x(3,irtse(1,ie))+x(3,irtse(2,ie))+x(3,irtse(3,ie))+
523 + x(3,irtse(4,ie)))
524 END IF
525C-------edge center-------
526c XE0=HALF*(X(1,NS1)+X(1,NS2))
527c YE0=HALF*(X(2,NS1)+X(2,NS2))
528c ZE0=HALF*(X(3,NS1)+X(3,NS2))
529C
530 xfic(1,ns) = third*(x0+x(1,ns1)+x(1,ns2))
531 xfic(2,ns) = third*(y0+x(2,ns1)+x(2,ns2))
532 xfic(3,ns) = third*(z0+x(3,ns1)+x(3,ns2))
533
534c if (ipr==1) then
535c write(iout,*),'NS1,NS2,IE,=',itab(NS1),itab(NS2),IE
536c write(iout,*),'NS1,NS2,Xs1,Xs2,xns=',itab(NS1),itab(NS2)
537cc print *,X(3,IRTSE(1,IE)),X(3,IRTSE(2,IE)),X(3,IRTSE(3,IE))
538c write(iout,*)X(1,NS1),X(2,NS1),X(3,NS1)
539c write(iout,*)X(1,NS2),X(2,NS2),X(3,NS2)
540c write(iout,*)XFIC(1,NS),XFIC(2,NS),XFIC(3,NS)
541c end if
542C-------NPT should be unpair: 3,5,7
543 ELSEIF (ip > 0 ) THEN
544C-------edge center-------
545 xe0=half*(x(1,ns1)+x(1,ns2))
546 ye0=half*(x(2,ns1)+x(2,ns2))
547 ze0=half*(x(3,ns1)+x(3,ns2))
548 np0 = (npt-1)/2
549 IF (ip > np0) THEN
550C---------right side
551 s = (ip-np0)*one/(npt-1)
552 xfic(1,ns) = xe0 +s*(x(1,ns2)-xe0)
553 xfic(2,ns) = ye0 +s*(x(2,ns2)-ye0)
554 xfic(3,ns) = ze0 +s*(x(3,ns2)-ze0)
555 ELSE
556C---------left side
557 s = ip*one/(npt-1)
558 xfic(1,ns) = x(1,ns1) +s*(xe0 -x(1,ns1))
559 xfic(2,ns) = x(2,ns1) +s*(ye0 -x(2,ns1))
560 xfic(3,ns) = x(3,ns1) +s*(ze0 -x(3,ns1))
561 END IF
562 END IF
563 END DO
564C-----------
565 RETURN
566 END
567!||====================================================================
568!|| i24fics_ini ../engine/source/interfaces/int24/i24for3e.F
569!||--- called by ------------------------------------------------------
570!|| i24e2e_fictive_nodes_update ../engine/source/interfaces/int24/i24for3e.F
571!||--- calls -----------------------------------------------------
572!|| i24fic_getn ../engine/source/interfaces/int24/i24for3e.F
573!||====================================================================
574 SUBROUTINE i24fics_ini(IRTSE ,NSNE ,IS2SE ,IS2PT ,NSN ,
575 4 NSV ,S ,FICS ,NPT ,ITAB )
576C============================================================================
577C I m p l i c i t T y p e s
578C-----------------------------------------------
579#include "implicit_f.inc"
580C-----------------------------------------------
581C C o m m o n B l o c k s
582C-----------------------------------------------
583#include "com04_c.inc"
584C-----------------------------------------------
585C D u m m y A r g u m e n t s
586C-----------------------------------------------
587 INTEGER IRTSE(5,*) ,NSV(*),NSNE,IS2SE(2,*),IS2PT(*),NSN,NPT ,ITAB(*)
588 my_real
589 . S(*),FICS(NSNE)
590C-----------------------------------------------
591C L o c a l V a r i a b l e s
592C-----------------------------------------------
593! 4---------------3
594! | . . |
595! | . . |
596! | . . |
597! | . |
598! | . . |
599! | . . |
600! | . o3 . |
601! 1---o1------o2--2 NPT=3
602C----- NLS : Num. of element with active edge----
603 INTEGER I,J,K,NSN0,NS,IP,NS1,NS2,IE,NP0
604 my_real
605 . S0,SE0,FAC
606C=======================================================================
607C----IRTSE(5,*) -> id of edge
608C=======================================================================
609 NSN0 = nsn-nsne
610 DO i=nsn0+1,nsn
611 ns=nsv(i)-numnod
612 IF (ns<=0) print *,'!!!!error, NSV(I),I=',nsv(i),i
613 ip = is2pt(ns)
614 CALL i24fic_getn(ns ,irtse ,is2se ,ie ,ns1 ,
615 + ns2 )
616 IF (ip==npt) THEN
617C-------seg center-------
618 IF (irtse(3,ie)==irtse(4,ie)) THEN
619 s0=third*(s(irtse(1,ie))+s(irtse(2,ie))+s(irtse(3,ie)))
620 ELSE
621 s0=fourth*(s(irtse(1,ie))+s(irtse(2,ie))+s(irtse(3,ie))+
622 + s(irtse(4,ie)))
623 END IF
624C-------edge center-------
625C
626 fics(ns) = third*(s0+s(ns1)+s(ns2))
627C-------NPT should be unpair: 3,5,7
628 ELSEIF (ip > 0 ) THEN
629C-------edge center-------
630 se0=half*(s(ns1)+s(ns2))
631 np0 = (npt-1)/2
632 IF (ip > np0) THEN
633C---------right side
634 fac = (ip-np0)/(npt-1)
635 fics(ns) = se0 +fac*(s(ns2)-se0)
636 ELSE
637C---------left side
638 fac = ip/(npt-1)
639 fics(ns) = s(ns1) +fac*(se0 -s(ns1))
640 END IF
641 END IF
642 END DO
643C-----------
644 RETURN
645 END
646!||====================================================================
647!|| i24fic_getn ../engine/source/interfaces/int24/i24for3e.F
648!||--- called by ------------------------------------------------------
649!|| i24cor3 ../engine/source/interfaces/int24/i24cor3.F
650!|| i24fics_ini ../engine/source/interfaces/int24/i24for3e.F
651!|| i24trivox ../engine/source/interfaces/intsort/i24trivox.F
652!|| i24xfic_ini ../engine/source/interfaces/int24/i24for3e.F
653!||--- calls -----------------------------------------------------
654!|| arret ../engine/source/system/arret.F
655!||====================================================================
656 SUBROUTINE i24fic_getn(NS ,IRTSE ,IS2SE ,IE ,NS1 ,
657 4 NS2 )
658C============================================================================
659C I m p l i c i t T y p e s
660C-----------------------------------------------
661#include "implicit_f.inc"
662C-----------------------------------------------
663C D u m m y A r g u m e n t s
664C-----------------------------------------------
665 INTEGER IRTSE(5,*) ,NS,IS2SE(2,*),NS1,NS2,IE
666C-----------------------------------------------
667C L o c a l V a r i a b l e s
668C-----------------------------------------------
669C----- get edge NS1,NS2 and--Secnd seg id :IE-
670 INTEGER IK1(4),IK2(4),IE1,IE2,IED
671 DATA IK1 /1,2,3,4/
672 DATA IK2 /2,3,4,1/
673C=======================================================================
674C----IRTSE(5,*) -> id of edge
675C=======================================================================
676 ie1 = is2se(1,ns)
677 ie2 = is2se(2,ns)
678 IF (ie1 > 0) THEN
679 ie = ie1
680 ied=irtse(5,ie)
681 ns1= irtse(ik1(ied),ie)
682 ns2= irtse(ik2(ied),ie)
683 ELSEIF(ie2 > 0) THEN
684 ie = ie2
685 ied=irtse(5,ie)
686 ns1= irtse(ik2(ied),ie)
687 ns2= irtse(ik1(ied),ie)
688 ELSE
689 print *,'probleme EDGE NS,IE1,IE2=',ns,ie1,ie2
690 call arret(2)
691 END IF
692C-----------
693 RETURN
694 END
695
696!||====================================================================
697!|| i24e2e_fictive_nodes_update ../engine/source/interfaces/int24/i24for3e.F
698!||--- called by ------------------------------------------------------
699!|| resol ../engine/source/engine/resol.F
700!||--- calls -----------------------------------------------------
701!|| i24fics_ini ../engine/source/interfaces/int24/i24for3e.F
702!|| i24xvfic_upd ../engine/source/interfaces/int24/i24for3e.F
703!||--- uses -----------------------------------------------------
704!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
705!||====================================================================
706 SUBROUTINE i24e2e_fictive_nodes_update(INTLIST,NBINTC,IPARI,INTBUF_TAB,
707 * X,V,MS,ITAB,XYZ,NUMNOD,NSH_OFFSET)
708C-----------------------------------------------
709C M o d u l e s
710C-----------------------------------------------
711 USE intbufdef_mod
712C-----------------------------------------------
713C I m p l i c i t T y p e s
714C-----------------------------------------------
715#include "implicit_f.inc"
716C-----------------------------------------------
717C C o m m o n B l o c k s
718C-----------------------------------------------
719#include "com08_c.inc"
720#include "param_c.inc"
721
722C-----------------------------------------------
723C D u m m y A r g u m e n t s
724C-----------------------------------------------
725 TYPE(intbuf_struct_) INTBUF_TAB(*)
726 INTEGER INTLIST(*),NBINTC
727 INTEGER, INTENT(IN) :: NUMNOD,NSH_OFFSET
728 INTEGER IPARI(NPARI,*),ITAB(*)
729 my_real
730 * X(3,*),V(3,*),MS(3,*),XYZ(3,NUMNOD)
731C-----------------------------------------------
732C L o c a l V a r i a b l e s
733C-----------------------------------------------
734 INTEGER KK,N,NPT,NTY,NFIC,NSN,NSNE,IEDGE4
735 my_real
736 * ts
737C-----------------------------------------------
738 DO kk=1,nbintc
739 n = intlist(kk)
740 nsn = ipari(5,n)
741 nty = ipari(7,n)
742 nsne = ipari(55,n)
743 iedge4 = ipari(59,n)
744 ts = intbuf_tab(n)%VARIABLES(3)
745
746 IF(nty == 24.AND.iedge4>0.AND.tt>=ts)THEN
747
748C Move XFIC & VFIC to another place for SPMD coherency
749 nfic = 3
750 IF (nsh_offset>0) THEN
751 CALL i24xvfic_upd(ipari(1,n),intbuf_tab(n),xyz ,v ,nfic ,itab)
752 ELSE
753 CALL i24xvfic_upd(ipari(1,n),intbuf_tab(n),x ,v ,nfic ,itab)
754 END IF
755
756C Move fictive Mass node computation to another place for SPMD coherency
757
758 npt = 3
759 CALL i24fics_ini(intbuf_tab(n)%IRTSE ,nsne ,intbuf_tab(n)%IS2SE ,
760 1 intbuf_tab(n)%IS2PT ,nsn ,intbuf_tab(n)%NSV ,
761 2 ms ,intbuf_tab(n)%MSFIC ,npt ,itab )
762 ENDIF
763 ENDDO
764
765 END
766
767
my_real
#define my_real
Definition cppsort.cpp:32
i24for3e
subroutine i24for3e()
Definition i24for3e.F:27
i24xfic_ini
subroutine i24xfic_ini(nrtse, irtse, nsne, is2se, is2pt, nsn, nsv, x, xfic, npt, itab, flg)
Definition i24for3e.F:464
i24for1_fic
subroutine i24for1_fic(npt, irtse, nsne, is2se, is2pt, ns, fxi, fyi, fzi, for1, inega)
Definition i24for3e.F:148
i24forc_fic
subroutine i24forc_fic(npt, irtse, nsne, is2se, is2pt, ns, nfic, fici, fics, ixss)
Definition i24for3e.F:39
i24fic_getn
subroutine i24fic_getn(ns, irtse, is2se, ie, ns1, ns2)
Definition i24for3e.F:658
i24for1_ficr
subroutine i24for1_ficr(npt, irtse, nsne, is2se, is2pt, ns, fxi, fyi, fzi, for1, inega, ni)
Definition i24for3e.F:285
i24xvfic_upd
subroutine i24xvfic_upd(ipari, intbuf_tab, x, v, npt, itab)
Definition i24for3e.F:423
i24e2e_fictive_nodes_update
subroutine i24e2e_fictive_nodes_update(intlist, nbintc, ipari, intbuf_tab, x, v, ms, itab, xyz, numnod, nsh_offset)
Definition i24for3e.F:708
i24fics_ini
subroutine i24fics_ini(irtse, nsne, is2se, is2pt, nsn, nsv, s, fics, npt, itab)
Definition i24for3e.F:576
arret
subroutine arret(nn)
Definition arret.F:87