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!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
34!||====================================================================
35 SUBROUTINE chkload(
36 1 IB ,IXS ,IXQ ,IXC ,IXT ,IXP ,
37 2 IXR ,IXTG ,ITAG ,ITASK ,ITAGL ,ITAB ,
38 3 NODES ,ADDCNEL ,CNEL ,TAGEL ,IPARG ,GEO ,
39 4 IBUFS ,NINDEX ,NINDG ,NPRESLOAD,LOADP_TAGDEL ,
40 5 ILOADP ,LLOADP ,IAD_ELEM)
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
311 END
312
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:41
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