OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
chkload.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/.
23C
24!||====================================================================
25!|| chkload ../engine/source/interfaces/chkload.F
26!||--- called by ------------------------------------------------------
27!|| resol ../engine/source/engine/resol.F
28!||--- calls -----------------------------------------------------
29!|| my_barrier ../engine/source/system/machine.F
30!|| spmd_exchseg_idel ../engine/source/mpi/kinematic_conditions/spmd_exchseg_idel.F
31!|| spmd_init_idel ../engine/source/mpi/interfaces/spmd_init_idel.F
32!||--- uses -----------------------------------------------------
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
35!||====================================================================
36 SUBROUTINE chkload(
37 1 IB ,IXS ,IXQ ,IXC ,IXT ,IXP ,
38 2 IXR ,IXTG ,ITAG ,ITASK ,ITAGL ,ITAB ,
39 3 NODES ,ADDCNEL ,CNEL ,TAGEL ,IPARG ,GEO ,
40 4 IBUFS ,NINDEX ,NINDG ,NPRESLOAD,LOADP_TAGDEL ,
41 5 ILOADP ,LLOADP ,IAD_ELEM)
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
313 END
314
chkload
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)
Definition chkload.F:42
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