OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fr_rlink1.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "warn_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fr_rlink1 (nod, itabm1, fr_rl, nsn)
subroutine fr_rlale (m1, m2, nod, itabm1, itag)

Function/Subroutine Documentation

◆ fr_rlale()

subroutine fr_rlale ( integer m1,
integer m2,
integer, dimension(*) nod,
integer, dimension(*) itabm1,
integer itag )

Definition at line 130 of file fr_rlink1.F.

131C-----------------------------------------------
132C M o d u l e s
133C-----------------------------------------------
134 USE message_mod
135C-----------------------------------------------
136C I m p l i c i t T y p e s
137C-----------------------------------------------
138#include "implicit_f.inc"
139C-----------------------------------------------
140C C o m m o n B l o c k s
141C-----------------------------------------------
142#include "com01_c.inc"
143#include "com04_c.inc"
144#include "warn_c.inc"
145#include "task_c.inc"
146C-----------------------------------------------
147C D u m m y A r g u m e n t s
148C-----------------------------------------------
149 INTEGER M1, M2, NOD(*),ITABM1(*),ITAG
150C-----------------------------------------------
151C L o c a l V a r i a b l e s
152C-----------------------------------------------
153 INTEGER I, N,NSN,
154 . NODTMP(ABS(ITAG)+2),NODU(ABS(ITAG)+2)
155C-----------------------------------------------
156C E x t e r n a l F u n c t i o n s
157C-----------------------------------------------
158 INTEGER SYSFUS2
159C-----------------------------------------------
160C D e s c r i p t i o n
161C-----------------------------------------------
162C NOD(1:NSN) is the array containing user ids from
163C /VEL/ALE card (ale links) if the node is present on
164C local domain then it is replaced by its internal id
165C otherwise its sign is changed.
166C / internal_id, if present in local domain
167C OUTPUT: NOD(id) = -
168C \ -user id, otherwise
169C-----------------------------------------------
170C S o u r c e L i n e s
171C-----------------------------------------------
172C
173C Recherche du no de noeuds internes
174C
175 IF(itag>0)THEN !ALE LINK DEFINED BY A NODE LIST
176 nsn=itag
177 nodu(nsn+1)=m1
178 nodu(nsn+2)=m2
179 nodtmp(nsn+1) = sysfus2(m1,itabm1,numnod)
180 nodtmp(nsn+2) = sysfus2(m2,itabm1,numnod)
181 DO i=1,nsn
182 nodu(i) = nod(i)
183 ! SYSFUS2 retourne 0 si noeud non trouve, local id otherwise
184 nodtmp(i) = sysfus2(nod(i),itabm1,numnod)
185 END DO
186 !Denombrement nb de noeuds locaux (ie nb de noeuds N<>0)
187 DO i=1,nsn
188 IF(nodtmp(i)/=0) THEN
189 nod(i) = nodtmp(i)
190 ELSE
191 nod(i) = -nodu(i)
192 END IF
193 END DO
194 ! si noeuds non present alors tag en - pour M1 et M2
195 IF(nodtmp(nsn+1)==0)THEN
196 m1=-m1
197 ELSE
198 m1=nodtmp(nsn+1)
199 END IF
200 IF(nodtmp(nsn+2)==0)THEN
201 m2=-m2
202 ELSE
203 m2=nodtmp(nsn+2)
204 END IF
205 ! Verification des ID user avec comm globale
206 IF(nspmd > 1) CALL spmd_glob_isum9(nodtmp,nsn+2)
207 IF(ispmd==0) THEN
208 !stop if main nodes not found
209 DO i = nsn+1, nsn+2
210 IF(nodtmp(i)==0) THEN
211 CALL ancmsg(msgid=186,anmode=aninfo_blind,
212 . i1=nodu(i),c1='ALE LINK')
213 ierr=ierr+1
214 RETURN
215 END IF
216 END DO
217 !stop if a SECONDARY node is not found
218 DO i = 1, nsn
219 IF(nodtmp(i)==0) THEN
220 CALL ancmsg(msgid=186,anmode=aninfo_blind,
221 . i1=nodu(i),c1='ALE LINK')
222 ierr=ierr+1
223 RETURN
224 END IF
225 END DO
226 ENDIF
227
228 ELSE ! ALE LINK DEFINED FROM A GRNOD
229 nsn=0
230 nodu(nsn+1)=m1
231 nodu(nsn+2)=m2
232 nodtmp(nsn+1) = sysfus2(m1,itabm1,numnod)
233 nodtmp(nsn+2) = sysfus2(m2,itabm1,numnod)
234 ! si noeuds non present alors tag en - pour M1 et M2
235 IF(nodtmp(nsn+1)==0)THEN
236 m1=-m1
237 ELSE
238 m1=nodtmp(nsn+1)
239 END IF
240 IF(nodtmp(nsn+2)==0)THEN
241 m2=-m2
242 ELSE
243 m2=nodtmp(nsn+2)
244 END IF
245 ! Verification des ID user avec comm globale
246 IF(nspmd > 1) CALL spmd_glob_isum9(nodtmp,nsn+2)
247 IF(ispmd==0) THEN
248 !stop if main nodes not found
249 DO i = nsn+1, nsn+2
250 IF(nodtmp(i)==0) THEN
251 CALL ancmsg(msgid=186,anmode=aninfo_blind,
252 . i1=nodu(i),c1='ALE LINK')
253 ierr=ierr+1
254 RETURN
255 END IF
256 END DO
257 ENDIF
258
259 !CHECK EXISTENS OF GRNOD_ID
260
261 ENDIF !(ITAG>0)
262
263 RETURN
sysfus2
integer function sysfus2(iu, itabm1, numnod)
Definition sysfus.F:99
message_mod
Definition message_mod.F:1249
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ fr_rlink1()

subroutine fr_rlink1 ( integer, dimension(*) nod,
integer, dimension(*) itabm1,
integer, dimension(*) fr_rl,
integer nsn )

Definition at line 35 of file fr_rlink1.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "warn_c.inc"
50#include "task_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NSN, NOD(*),ITABM1(*), FR_RL(*)
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I, N, NSN_L, P, PMAIN, IMAX,
59 . NODTMP(NSN),NODU(NSN)
60C-----------------------------------------------
61C E x t e r n a l F u n c t i o n s
62C-----------------------------------------------
63 INTEGER SYSFUS2
64C-----------------------------------------------
65C S o u r c e L i n e s
66C-----------------------------------------------
67C
68C Recherche du no de noeud interne
69C
70 DO i=1,nsn
71 nodu(i) = nod(i)
72C SYSFUS2 retourne 0 si noeud non trouve
73 nodtmp(i) = sysfus2(nod(i),itabm1,numnod)
74 END DO
75C Denombrement nb de noeuds locaux (ie nb de noeuds N<>0
76 nsn_l=0
77 DO i=1,nsn
78 IF(nodtmp(i)/=0) THEN
79 nsn_l = nsn_l+1
80 nod(nsn_l) = nodtmp(i)
81 END IF
82 END DO
83 fr_rl(ispmd+1)=nsn_l
84C sauvegarde nb de noeuds totaux
85 fr_rl(nspmd+1)=nsn
86C Verification des ID user avec comm globale
87 IF(nspmd > 1) CALL spmd_glob_isum9(nodtmp,nsn)
88 IF(ispmd==0) THEN
89 DO i = 1, nsn
90 IF(nodtmp(i)==0) THEN
91 CALL ancmsg(msgid=186,anmode=aninfo_blind,
92 . i1=nodu(i),c1='RIGID LINK')
93 ierr=ierr+1
94 END IF
95 END DO
96 ENDIF
97C affectation du nb de noeud local
98 nsn = nsn_l
99C echange valeur fr_rl
100 IF(nspmd > 1) THEN
101 DO p = 1, nspmd
102 CALL spmd_ibcast(fr_rl(p),fr_rl(p),1,1,it_spmd(p),0)
103 ENDDO
104 END IF
105C determination du pmain
106 imax = 0
107 pmain = 1
108 DO p = 1, nspmd
109 IF(fr_rl(p)>imax)THEN
110 pmain = p
111 imax = fr_rl(p)
112 END IF
113 END DO
114 fr_rl(nspmd+2) = pmain
115C
116 RETURN
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57