OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fr_rlink1.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!|| fr_rlink1 ../engine/source/mpi/kinematic_conditions/fr_rlink1.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.f
29!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
30!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
31!|| sysfus2 ../engine/source/system/sysfus.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../engine/share/message_module/message_mod.F
34!||====================================================================
35 SUBROUTINE fr_rlink1(NOD,ITABM1,FR_RL,NSN)
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
117 END
118C
119!||====================================================================
120!|| fr_rlale ../engine/source/mpi/kinematic_conditions/fr_rlink1.F
121!||--- called by ------------------------------------------------------
122!|| lectur ../engine/source/input/lectur.F
123!||--- calls -----------------------------------------------------
124!|| ancmsg ../engine/source/output/message/message.F
125!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.f
126!|| sysfus2 ../engine/source/system/sysfus.F
127!||--- uses -----------------------------------------------------
128!|| message_mod ../engine/share/message_module/message_mod.f
129!||====================================================================
130 SUBROUTINE fr_rlale(M1,M2,NOD,ITABM1,ITAG)
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
264 END
265
fr_rlink1
subroutine fr_rlink1(nod, itabm1, fr_rl, nsn)
Definition fr_rlink1.F:36
fr_rlale
subroutine fr_rlale(m1, m2, nod, itabm1, itag)
Definition fr_rlink1.F:131
message_mod
Definition message_mod.F:1249
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
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