OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
chkload.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "task_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine chkload (ib, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, itag, itask, itagl, itab, nodes, addcnel, cnel, tagel, iparg, geo, ibufs, nindex, nindg, npresload, loadp_tagdel, iloadp, lloadp, iad_elem)

Function/Subroutine Documentation

◆ chkload()

subroutine chkload ( integer, dimension(nibcld,*) ib,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) itag,
integer itask,
integer, dimension(*) itagl,
integer, dimension(*) itab,
type(nodal_arrays_), intent(in) nodes,
integer, dimension(0:*) addcnel,
integer, dimension(0:*) cnel,
integer, dimension(*) tagel,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(*) ibufs,
integer, dimension(*) nindex,
integer nindg,
integer, intent(in) npresload,
integer, dimension(npresload), intent(inout) loadp_tagdel,
integer, dimension(sizloadp,nloadp), intent(in) iloadp,
integer, dimension(slloadp), intent(in) lloadp,
integer, dimension(2,nspmd+1), intent(in) iad_elem )

Definition at line 36 of file chkload.F.

42C-----------------------------------------------
43 USE nodal_arrays_mod
44 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "task_c.inc"
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "param_c.inc"
57#include "tabsiz_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER ITASK, NINDG
62 INTEGER, INTENT(IN) :: NPRESLOAD
63 INTEGER IB(NIBCLD,*), ITAG(*),
64 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
65 . IXR(NIXR,*), IXTG(NIXTG,*),IPARG(NPARG,*), ITAGL(*), ITAB(*),
66 . CNEL(0:*), ADDCNEL(0:*), TAGEL(*), IBUFS(*) , NINDEX(*)
67 INTEGER, INTENT(INOUT) :: LOADP_TAGDEL(NPRESLOAD)
68 INTEGER, INTENT(IN) :: LLOADP(SLLOADP), ILOADP(SIZLOADP,NLOADP)
69 INTEGER, DIMENSION(2,NSPMD+1), INTENT(in) :: IAD_ELEM
70 my_real
71 . geo(npropg,*)
72 TYPE(nodal_arrays_), intent(in) :: NODES
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I, J, N1, N2, N3, N4,
77 . NN, II, IX, K, NIND, N, IRSIZE, IRECV(NSPMD),
78 . OFC, OFQ, OFT, OFP ,OFR ,OFTG, OFUR,NCONLDF ,
79 . NCONLDL,NL , NIND2 ,
80 . NINDPLOAD ,NUMPRESLOAD, JJ, IAD, NPRES, NP
81
82 INTEGER, DIMENSION(:,:), ALLOCATABLE :: NINDL
83C-----------------------------------------------
84 ofq=numels
85 ofc=ofq+numelq
86 oft=ofc+numelc
87 ofp=oft+numelt
88 ofr=ofp+numelp
89 oftg=ofr+numelr
90 ofur=oftg+numeltg
91C
92 ALLOCATE(nindl(2,nconld+npresload))
93C
94 CALL my_barrier()
95C
96 nconldf = 1 + itask*nconld / nthread
97 nconldl = (itask+1)*nconld / nthread
98C
99 nind = 0
100C
101C--------------------------------------------------------
102C SEARCH FOR NODES WHERE SURROUNDING ELEMENTS
103C--------------------------------------------------------
104 DO nl=nconldf,nconldl
105 IF( ib(7,nl) == 1 ) THEN ! IF deleted Segment is ON
106 n1 = ib(1,nl)
107 n2 = ib(2,nl)
108 n3 = ib(3,nl)
109 n4 = ib(4,nl)
110 IF(n3 == 0) n3 = n2
111 IF(n4 == 0) n4 = n3
112 IF(itag(n1) == 0.OR.itag(n2) == 0.OR.
113 + itag(n3) == 0.OR.itag(n4) == 0) THEN ! IF ALL SURROUNDED ELEMENTS ARE OFF
114 ib(8,nl) = 1
115 ELSEIF(itag(numnod+n1)>=1.AND.itag(numnod+n2)>=1.AND.
116 + itag(numnod+n3)>=1.AND.itag(numnod+n4)>=1) THEN ! IF ALL NODES BELONGING TO 1 ACTIF ELEMENT
117 nind = nind + 1
118 nindl(1,nind) = nl
119 ENDIF
120 ENDIF
121 ENDDO
122
123 nindpload = nind
124
125 numpresload = 0
126
127 DO np=1,nloadp_hyd
128
129 npres = iloadp(1,np)
130 iad = iloadp(4,np)
131
132 DO n=1, npres/4
133C
134 n1 = lloadp(iad+4*(n-1))
135 n2 = lloadp(iad+4*(n-1)+1)
136 n3 = lloadp(iad+4*(n-1)+2)
137 n4 = lloadp(iad+4*(n-1)+3)
138 numpresload = numpresload + 1
139
140 IF(n3 == 0) n3 = n2
141 IF(n4 == 0) n4 = n3
142 IF(itag(n1) == 0.OR.itag(n2) == 0.OR.
143 + itag(n3) == 0.OR.itag(n4) == 0) THEN ! IF ALL SURROUNDED ELEMENTS ARE OFF
144 loadp_tagdel(numpresload) = 1
145 ELSEIF(itag(numnod+n1)>=1.AND.itag(numnod+n2)>=1.AND.
146 + itag(numnod+n3)>=1.AND.itag(numnod+n4)>=1) THEN ! IF ALL NODES BELONGING TO 1 ACTIF ELEMENT
147 nind = nind + 1
148 nindl(1,nind) = iad+4*(n-1)
149 nindl(2,nind) = numpresload
150 ENDIF
151 ENDDO
152 ENDDO
153C--------------------------------------------------------
154C SEARCH IF SEGMENT ELEMENT IS DELETED
155C--------------------------------------------------------
156C
157 DO n = 1, nind
158 i = nindl(1,n)
159 IF(n <= nindpload) THEN
160 n1 = ib(1,i)
161 n2 = ib(2,i)
162 n3 = ib(3,i)
163 n4 = ib(4,i)
164 ELSE
165 n1 = lloadp(i)
166 n2 = lloadp(i+1)
167 n3 = lloadp(i+2)
168 n4 = lloadp(i+3)
169 ENDIF
170 IF(n3 == 0) n3 = n2
171 IF(n4 == 0) n4 = n3
172
173 DO j = addcnel(n1),addcnel(n1+1)-1
174 ii = cnel(j)
175 IF(tagel(ii) > 0) THEN ! elt actif found
176 itagl(n1) = 0
177 itagl(n2) = 0
178 itagl(n3) = 0
179 itagl(n4) = 0
180 IF(ii<=ofq) THEN ! Solid Actif
181 DO k = 2, 9
182 ix = ixs(k,ii)
183 itagl(ix) = 1
184 END DO
185 ELSEIF(ii > ofq.AND.ii<=ofc) THEN ! Quad actif
186 ii = ii - ofq
187 DO k=2,5
188 ix = ixq(k,ii)
189 itagl(ix)=1
190 END DO
191 ELSEIF(ii > ofc.AND.ii<=oft) THEN ! shell actif
192 ii = ii - ofc
193 DO k=2,5
194 ix = ixc(k,ii)
195 itagl(ix)=1
196 END DO
197 ELSEIF(ii > oftg.AND.ii<=ofur)THEN ! triangle actif
198 ii = ii - oftg
199 DO k=2,4
200 ix = ixtg(k,ii)
201 itagl(ix) = 1
202 END DO
203 ELSEIF(ii > oft.AND.ii<=ofp)THEN ! truss actif
204 ii = ii - oft
205 DO k=2,3
206 ix = ixt(k,ii)
207 itagl(ix) = 1
208 ENDDO
209 ELSEIF(ii > ofp.AND.ii<=ofr)THEN ! Beam actif
210 ii = ii - ofp
211 DO k=2,3
212 ix = ixp(k,ii)
213 itagl(ix) = 1
214 ENDDO
215 ELSEIF(ii > ofr.AND.ii<=oftg)THEN ! Spring actif
216 ii = ii - ofr
217 DO k=2,3
218 ix = ixr(k,ii)
219 itagl(ix) = 1
220 ENDDO
221 IF(nint(geo(12,ixr(1,ii))) == 12) THEN ! Spring actif
222 ix = ixr(4,ii)
223 itagl(ix) = 1
224 ENDIF
225 END IF
226
227 IF(itagl(n1)+itagl(n2)+itagl(n3)+itagl(n4) == 4)THEN ! SEGMENT IS BELONGING TO ACTIF ELEMENT
228 GOTO 400
229 END IF
230 END IF
231 END DO
232C Active element
233 IF(nspmd == 1) THEN
234 IF(n <= nindpload) THEN
235 ib(8,i) = 1
236 ELSE
237 jj = nindl(2,n)
238 loadp_tagdel(jj) = 1
239 ENDIF
240
241 ELSE
242C Comm en spmd needed : look if nodes belonging to another element actif of another proc
243#include "lockon.inc"
244 nindg = nindg + 1
245 nind2 = nindg
246C
247 IF(n <= nindpload) THEN
248 nindex(nind2) = i
249 ELSE
250 jj = nindl(2,n)
251 nindex(nind2) = -jj
252 ENDIF
253 ibufs(4*(nind2-1)+1 ) = itab(n1)
254 ibufs(4*(nind2-1)+2 ) = itab(n2)
255 ibufs(4*(nind2-1)+3 ) = itab(n3)
256 ibufs(4*(nind2-1)+4 ) = itab(n4)
257
258#include "lockoff.inc"
259
260 END IF
261
262 400 CONTINUE
263
264 END DO
265
266C
267 CALL my_barrier()
268C
269C
270C Partie non parallele
271
272 IF(nspmd > 1) THEN
273
274!$OMP SINGLE
275
276C
277C SPMD communication : if a node is not in the same proc as element
278C
279
280 CALL spmd_init_idel(4*nindg , irsize, irecv,iad_elem)
281 CALL spmd_exchseg_idel(
282 1 ibufs ,4*nindg ,ixs ,ixc ,ixtg ,
283 2 ixq ,iparg ,itagl ,nodes,tagel ,
284 3 irsize ,irecv ,cnel ,addcnel,ofc ,
285 4 oft ,oftg ,ofur ,ofr ,ofp ,
286 5 ofq ,nindg ,ixp ,ixr ,ixt ,
287 6 geo ,iad_elem)
288
289C
290C If no element actif after spmd comm
291C
292 DO j = 1, nindg
293 nn = ibufs(j)
294 IF(nn == 0) THEN
295 i = nindex(j)
296C Segment is deleted
297 IF(i > 0) THEN
298 ib(8,i) = 1
299 ELSE
300 loadp_tagdel(-i) = 1
301 ENDIF
302 END IF
303 END DO
304
305C Fin Partie non parallele
306!$OMP END SINGLE
307 ENDIF
308
309C
310 DEALLOCATE(nindl)
311C
312 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
spmd_exchseg_idel
subroutine spmd_exchseg_idel(bufs, lbufs, ixs, ixc, ixtg, ixq, iparg, itagl, nodes, tagel, irsize, irecv, cnel, addcnel, ofc, oft, oftg, ofur, ofr, ofp, ofq, lindex, ixp, ixr, ixt, geo, iad_elem)
Definition spmd_exchseg_idel.F:42
spmd_init_idel
subroutine spmd_init_idel(nindex, irsize, irecv, iad_elem)
Definition spmd_init_idel.F:34
nl
character *2 function nl()
Definition message.F:2360
my_barrier
subroutine my_barrier
Definition machine.F:31