OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_seatbelts.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine c_seatbelts (n_slipring_l, n_retractor_l, p, nodlocal, elbuf_tab, iparg, n_anchor_remote_l, n_anchor_remote_send_l, anchor_remote_l, anchor_remote_send_l, n_seatbelt_l, n_seatbelt_2d_l, cep, off)

Function/Subroutine Documentation

◆ c_seatbelts()

subroutine c_seatbelts ( integer n_slipring_l,
integer n_retractor_l,
integer p,
integer, dimension(*) nodlocal,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer n_anchor_remote_l,
integer n_anchor_remote_send_l,
type(seatbelt_remote_nodes_struct) anchor_remote_l,
type(seatbelt_remote_nodes_struct) anchor_remote_send_l,
integer n_seatbelt_l,
integer n_seatbelt_2d_l,
integer, dimension(*) cep,
integer off )

Definition at line 31 of file c_seatbelts.F.

34C---------------------------------------------
35 USE seatbelt_mod
36 USE elbufdef_mod
37C---------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41#include "param_c.inc"
42#include "com01_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER N_SLIPRING_L,N_RETRACTOR_L,P,IPARG(NPARG,*),NODLOCAL(*),N_ANCHOR_REMOTE_L,
47 . N_ANCHOR_REMOTE_SEND_L,N_SEATBELT_L,N_SEATBELT_2D_L,CEP(*),OFF
48 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
49 TYPE(SEATBELT_REMOTE_NODES_STRUCT) ANCHOR_REMOTE_L,ANCHOR_REMOTE_SEND_L
50C-----------------------------------------------
51C E x t e r n a l F u n c t i o n s
52C-----------------------------------------------
53 INTEGER NLOCAL
54 EXTERNAL nlocal
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I,J,K,NN,PROC,ITY,MTN,NEL,NG,LOCAL_SLIP(NSLIPRING),LOCAL_RETR(NRETRACTOR),PP
59 . N_ANCHOR_REMOTE_SEND,PP,N_REC_PROC(NSPMD),N_SEND_PROC(NSPMD),COMPT,TAG_PROC(2,NSPMD),
60 . ISEATBELT
61 TYPE(G_BUFEL_) , POINTER :: GBUF
62C-----------------------------------------------
63C
64 local_slip = 0
65 local_retr = 0
66 n_rec_proc = 0
67 n_send_proc = 0
68C
69C--- Pass 1 counting ----------------------------------------------------------
70C
71 DO i = 1, n_seatbelt
72 IF (seatbelt_tab(i)%NSPRING > 0) THEN
73 IF (cep(off + seatbelt_tab(i)%SPRING(1)) == p - 1) THEN
74 n_seatbelt_l = n_seatbelt_l + 1
75 IF (seatbelt_tab(i)%NFRAM > 1) n_seatbelt_2d_l = n_seatbelt_2d_l + 1
76 ENDIF
77 ENDIF
78 ENDDO
79C
80 DO i = 1, nslipring
81 slipring(i)%IDG = i
82C
83 IF (nlocal(slipring(i)%FRAM(1)%NODE(2),p)==1) THEN
84C-- Proc main of slipring
85 n_slipring_l = n_slipring_l + 1
86 local_slip(i) = n_slipring_l
87 ENDIF
88C
89 DO j=1,slipring(i)%NFRAM
90 IF (nlocal(slipring(i)%FRAM(j)%NODE(2),p)==1) THEN
91 DO pp=1,nspmd
92 IF ((pp /= p).AND.(nlocal(slipring(i)%FRAM(j)%ANCHOR_NODE,pp)==1)) THEN
93C-- Count of remote anchor node (send)
94 n_anchor_remote_send_l = n_anchor_remote_send_l + 1
95 slipring(i)%FRAM(j)%N_REMOTE_PROC = slipring(i)%FRAM(j)%N_REMOTE_PROC + 1
96 n_send_proc(pp) = n_send_proc(pp) + 1
97 ENDIF
98 ENDDO
99 ELSEIF (nlocal(slipring(i)%FRAM(j)%ANCHOR_NODE,p)==1) THEN
100C-- Count of remote anchor node (receive)
101 n_anchor_remote_l = n_anchor_remote_l + 1
102 compt = 0
103 DO pp=1,nspmd
104 IF ((pp /= p).AND.(nlocal(slipring(i)%FRAM(j)%NODE(2),pp)==1)) THEN
105C-- Count of remote anchor node per main proc
106 n_rec_proc(pp) = n_rec_proc(pp) + 1
107 ENDIF
108 ENDDO
109 ENDIF
110 ENDDO
111C
112 ENDDO
113C
114 DO i = 1, nretractor
115 retractor(i)%IDG = i
116 IF (nlocal(retractor(i)%NODE(2),p)==1) THEN
117C-- Proc main of retractor
118 n_retractor_l = n_retractor_l + 1
119 local_retr(i) = n_retractor_l
120 DO pp=1,nspmd
121 IF ((pp /= p).AND.(nlocal(retractor(i)%ANCHOR_NODE,pp)==1)) THEN
122C-- remote anchor node (send)
123 n_anchor_remote_send_l = n_anchor_remote_send_l + 1
124 retractor(i)%N_REMOTE_PROC = retractor(i)%N_REMOTE_PROC + 1
125 n_send_proc(pp) = n_send_proc(pp) + 1
126 ENDIF
127 ENDDO
128 ELSEIF (nlocal(retractor(i)%ANCHOR_NODE,p)==1) THEN
129C-- Remote anchor node
130 n_anchor_remote_l = n_anchor_remote_l + 1
131 DO pp=1,nspmd
132 IF ((pp /= p).AND.(nlocal(retractor(i)%NODE(2),pp)==1)) THEN
133C-- Count of remote anchor node per main proc
134 n_rec_proc(pp) = n_rec_proc(pp) + 1
135 ENDIF
136 ENDDO
137 ENDIF
138 ENDDO
139C
140C--- Pass 2 : construction of arrays for remote anchor nodes-------------------------
141C
142 ALLOCATE(anchor_remote_l%ADD_PROC(nspmd+1))
143 ALLOCATE(anchor_remote_l%NODE(n_anchor_remote_l))
144 compt = 0
145C
146 ALLOCATE(anchor_remote_send_l%ADD_PROC(nspmd+1))
147 ALLOCATE(anchor_remote_send_l%NODE(n_anchor_remote_send_l))
148C
149 IF (n_anchor_remote_l > 0) THEN
150 anchor_remote_l%ADD_PROC(1) = 1
151 DO pp=1,nspmd
152 anchor_remote_l%ADD_PROC(pp+1) = anchor_remote_l%ADD_PROC(pp) + n_rec_proc(pp)
153 ENDDO
154 ENDIF
155C
156 IF (n_anchor_remote_send_l > 0) THEN
157 anchor_remote_send_l%ADD_PROC(1) = 1
158 DO pp=1,nspmd
159 anchor_remote_send_l%ADD_PROC(pp+1) = anchor_remote_send_l%ADD_PROC(pp) + n_send_proc(pp)
160 ENDDO
161 n_send_proc = 0
162 ENDIF
163C
164 nn = 0
165C
166 DO i = 1, nslipring
167 DO j=1,slipring(i)%NFRAM
168 IF (nlocal(slipring(i)%FRAM(j)%NODE(2),p)==1) THEN
169 IF (slipring(i)%FRAM(j)%N_REMOTE_PROC > 0) THEN
170C-- Proc main of slipring
171 nn = nn + 1
172 DO pp=1,nspmd
173 IF ((pp /= p).AND.(nlocal(slipring(i)%FRAM(j)%ANCHOR_NODE,pp)==1)) THEN
174C-- remote anchor node (send)
175 anchor_remote_send_l%NODE(anchor_remote_send_l%ADD_PROC(pp)+n_send_proc(pp)) = nn
176 n_send_proc(pp) = n_send_proc(pp) + 1
177 ENDIF
178 ENDDO
179 ENDIF
180 ELSEIF (nlocal(slipring(i)%FRAM(j)%ANCHOR_NODE,p)==1) THEN
181C-- Proc remote of slipring
182 compt = compt + 1
183 anchor_remote_l%NODE(compt) = nodlocal(slipring(i)%FRAM(j)%ANCHOR_NODE)
184 ENDIF
185 ENDDO
186 ENDDO
187C
188 DO i = 1, nretractor
189 IF (nlocal(retractor(i)%NODE(2),p)==1) THEN
190 IF (retractor(i)%N_REMOTE_PROC > 0) THEN
191C-- Proc main of retractor
192 nn = nn + 1
193 DO pp=1,nspmd
194 IF ((pp /= p).AND.(nlocal(retractor(i)%ANCHOR_NODE,pp)==1)) THEN
195C-- remote anchor node (send)
196 anchor_remote_send_l%NODE(anchor_remote_send_l%ADD_PROC(pp)+n_send_proc(pp)) = nn
197 n_send_proc(pp) = n_send_proc(pp) + 1
198 ENDIF
199 ENDDO
200 ENDIF
201 ELSEIF (nlocal(retractor(i)%ANCHOR_NODE,p)==1) THEN
202C-- Proc remote of slipring
203 compt = compt + 1
204 anchor_remote_l%NODE(compt) = nodlocal(retractor(i)%ANCHOR_NODE)
205 ENDIF
206 ENDDO
207C
208C--- COnstruction of arrays for spmd exchange of TH on proc 0
209 IF ((nspmd > 1).AND.(p == 1)) THEN
210C
211 nseatbelt_th_proc = 0
212 tag_proc = 0
213C
214 DO pp=1,nspmd
215 DO i=1,nslipring
216 IF ((pp /= p).AND.(nlocal(slipring(i)%FRAM(1)%NODE(2),pp)==1)) tag_proc(1,pp) = 1
217 ENDDO
218 DO i=1,nretractor
219 IF ((pp /= p).AND.(nlocal(retractor(i)%NODE(2),pp)==1)) tag_proc(2,pp) = 1
220 ENDDO
221 IF (tag_proc(1,pp) + tag_proc(2,pp) > 0) nseatbelt_th_proc = nseatbelt_th_proc + 1
222 ENDDO
223C
224 ALLOCATE(seatbelt_th_exch(nseatbelt_th_proc+1))
225C
226 compt = 0
227 seatbelt_th_exch(1)%ADD_PROC = 1
228 DO pp=1,nspmd
229 IF (tag_proc(1,pp) + tag_proc(2,pp) > 0) THEN
230 compt = compt + 1
231C-- data must be received from this proc for TH
232 seatbelt_th_exch(compt)%ID_PROC = pp
233 seatbelt_th_exch(compt)%NSLIPRING = 0
234 seatbelt_th_exch(compt)%NRETRACTOR = 0
235 DO i=1,nslipring
236 IF ((pp /= p).AND.(nlocal(slipring(i)%FRAM(1)%NODE(2),pp)==1)) THEN
237 seatbelt_th_exch(compt)%NSLIPRING = seatbelt_th_exch(compt)%NSLIPRING + 1
238 seatbelt_th_exch(compt+1)%ADD_PROC = seatbelt_th_exch(compt)%ADD_PROC + 6
239 ENDIF
240 ENDDO
241 DO i=1,nretractor
242 IF ((pp /= p).AND.(nlocal(retractor(i)%NODE(2),pp)==1)) THEN
243 seatbelt_th_exch(compt)%NRETRACTOR = seatbelt_th_exch(compt)%NRETRACTOR + 1
244 seatbelt_th_exch(compt+1)%ADD_PROC = seatbelt_th_exch(compt)%ADD_PROC + 3
245 ENDIF
246 ENDDO
247 ENDIF
248 ENDDO
249C
250 ENDIF
251
252C
253C--- Update of add_node in buffer element ----------------------------------------------
254
255 IF (n_slipring_l + n_retractor_l > 0) THEN
256C
257 DO ng=1,ngroup
258C
259 proc = iparg(32,ng)
260 ity = iparg(5,ng)
261 mtn = iparg(1,ng)
262 nel = iparg(2,ng)
263 iseatbelt = iparg(91,ng)
264c----
265 IF ((p == proc + 1).AND.(ity==6).AND.(mtn==114)) THEN
266 gbuf => elbuf_tab(ng)%GBUF
267 DO i=1,nel
268 IF (gbuf%ADD_NODE(i) > 0) gbuf%ADD_NODE(i) = nodlocal(gbuf%ADD_NODE(i))
269 IF (gbuf%ADD_NODE(nel+i) > 0) gbuf%ADD_NODE(nel+i) = nodlocal(gbuf%ADD_NODE(nel+i))
270 IF (gbuf%SLIPRING_ID(i) > 0) gbuf%SLIPRING_ID(i) = local_slip(gbuf%SLIPRING_ID(i))
271 IF (gbuf%RETRACTOR_ID(i) > 0) gbuf%RETRACTOR_ID(i) = local_retr(gbuf%RETRACTOR_ID(i))
272 ENDDO
273C
274 ELSEIF ((p == proc + 1).AND.(ity==3).AND.(iseatbelt==1)) THEN
275 gbuf => elbuf_tab(ng)%GBUF
276 DO i=1,nel
277 DO j=1,gbuf%G_ADD_NODE
278 k = nel*(j-1)
279 IF (gbuf%ADD_NODE(k+i) > 0) gbuf%ADD_NODE(k+i) = nodlocal(gbuf%ADD_NODE(k+i))
280 ENDDO
281 ENDDO
282
283 ENDIF
284C
285 ENDDO
286C
287 ENDIF
288C
289! --------------------------------------
290 RETURN
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::nseatbelt_th_proc
integer nseatbelt_th_proc
Definition seatbelt_mod.F:185
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
seatbelt_mod::seatbelt_tab
type(seatbelt_struct), dimension(:), allocatable seatbelt_tab
Definition seatbelt_mod.F:171
seatbelt_mod::seatbelt_th_exch
type(seatbelt_th_exch_struct), dimension(:), allocatable seatbelt_th_exch
Definition seatbelt_mod.F:194
seatbelt_mod::slipring
type(slipring_struct), dimension(:), allocatable slipring
Definition seatbelt_mod.F:110