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 35 of file chkload.F.

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