OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lgmini_bc.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/.
23!||====================================================================
24!|| lgmini_bc ../starter/source/tools/lagmul/lgmini_bc.F
25!||--- called by ------------------------------------------------------
26!|| lagm_ini ../starter/source/tools/lagmul/lagm_ini.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE lgmini_bc(IADLL ,JLL ,LLL ,IGRNOD ,IBCSLAG,
34 . MASS ,INER ,NC ,NOM_OPT)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE message_mod
39 USE groupdef_mod
40 USE names_and_titles_mod , ONLY : nchartitle
41C----------------------------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com04_c.inc"
49#include "lagmult.inc"
50#include "scr17_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NC, IADLL(*), JLL(*), LLL(*),IBCSLAG(5,*)
55 my_real mass(*),iner(*)
56 INTEGER NOM_OPT(LNOPT1,*)
57C-----------------------------------------------
58 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I, IK, IG, IGR, CT, CR, ISK, NN
63 INTEGER ID
64 CHARACTER(LEN=NCHARTITLE) :: TITR
65C======================================================================|
66 DO i=1,nbcslag
67 igr = ibcslag(1,i)
68 ct = ibcslag(2,i)
69 cr = ibcslag(3,i)
70 isk = ibcslag(4,i)
71 id=nom_opt(1,i)
72 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
73 DO ig=1,igrnod(igr)%NENTITY
74 nn=igrnod(igr)%ENTITY(ig)
75 IF(mass(nn)/=0.0)THEN
76C--- Translations
77 IF(ct==1.OR.ct==3.OR.ct==5.OR.ct==7)THEN
78C--- dz
79 nc = nc + 1
80 IF(nc>lag_ncf)THEN
81 CALL ancmsg(msgid=500,
82 . msgtype=msgerror,
83 . anmode=aninfo,
84 . c1='BCS',
85 . i1=id,
86 . c2='BCS',
87 . c3=titr)
88 ENDIF
89 IF(isk==1)THEN
90 iadll(nc+1)=iadll(nc) + 1
91 IF(iadll(nc+1)-1>lag_nkf)THEN
92 CALL ancmsg(msgid=469,
93 . msgtype=msgerror,
94 . anmode=aninfo,
95 . i1=id,
96 . c1='BOUNDARY CONDITIONS',
97 . c2='BOUNDARY CONDITIONS',
98 . c3=titr)
99 ENDIF
100 ik = iadll(nc)
101 lll(ik) = nn
102 jll(ik) = 3
103 ELSE
104 iadll(nc+1)=iadll(nc) + 3
105 IF(iadll(nc+1)-1>lag_nkf)THEN
106 CALL ancmsg(msgid=469,
107 . msgtype=msgerror,
108 . anmode=aninfo,
109 . i1=id,
110 . c1='BOUNDARY CONDITIONS',
111 . c2='BOUNDARY CONDITIONS',
112 . c3=titr)
113 ENDIF
114 ik = iadll(nc)
115 lll(ik) = nn
116 jll(ik) = 1
117 ik = ik + 1
118 lll(ik) = nn
119 jll(ik) = 2
120 ik = ik + 1
121 lll(ik) = nn
122 jll(ik) = 3
123 ENDIF
124 ENDIF
125 IF(ct==2.OR.ct==3.OR.ct==6.OR.ct==7)THEN
126C--- dy
127 nc = nc + 1
128 IF(nc>lag_ncf)THEN
129 CALL ancmsg(msgid=468,
130 . msgtype=msgerror,
131 . anmode=aninfo,
132 . i1=id,
133 . c1='BOUNDARY CONDITIONS',
134 . c2='BOUNDARY CONDITIONS',
135 . c3=titr)
136 ENDIF
137 IF(isk==1)THEN
138 iadll(nc+1)=iadll(nc) + 1
139 IF(iadll(nc+1)-1>lag_nkf)THEN
140 CALL ancmsg(msgid=469,
141 . msgtype=msgerror,
142 . anmode=aninfo,
143 . i1=id,
144 . c1='BOUNDARY CONDITIONS',
145 . c2='BOUNDARY CONDITIONS',
146 . c3=titr)
147 ENDIF
148 ik = iadll(nc)
149 lll(ik) = nn
150 jll(ik) = 2
151 ELSE
152 iadll(nc+1)=iadll(nc) + 3
153 IF(iadll(nc+1)-1>lag_nkf)THEN
154 CALL ancmsg(msgid=469,
155 . msgtype=msgerror,
156 . anmode=aninfo,
157 . i1=id,
158 . c1='BOUNDARY CONDITIONS',
159 . c2='BOUNDARY CONDITIONS',
160 . c3=titr)
161 ENDIF
162 ik = iadll(nc)
163 lll(ik) = nn
164 jll(ik) = 1
165 ik = ik + 1
166 lll(ik) = nn
167 jll(ik) = 2
168 ik = ik + 1
169 lll(ik) = nn
170 jll(ik) = 3
171 ENDIF
172 ENDIF
173 IF(ct==4.OR.ct==5.OR.ct==6.OR.ct==7)THEN
174C--- dx
175 nc = nc + 1
176 IF(nc>lag_ncf)THEN
177 CALL ancmsg(msgid=468,
178 . msgtype=msgerror,
179 . anmode=aninfo,
180 . i1=id,
181 . c1='BOUNDARY CONDITIONS',
182 . c2='BOUNDARY CONDITIONS',
183 . c3=titr)
184 ENDIF
185 IF(isk==1)THEN
186 iadll(nc+1)=iadll(nc) + 1
187 IF(iadll(nc+1)-1>lag_nkf)THEN
188 CALL ancmsg(msgid=469,
189 . msgtype=msgerror,
190 . anmode=aninfo,
191 . i1=id,
192 . c1='BOUNDARY CONDITIONS',
193 . c2='BOUNDARY CONDITIONS',
194 . c3=titr)
195 ENDIF
196 ik = iadll(nc)
197 lll(ik) = nn
198 jll(ik) = 1
199 ELSE
200 iadll(nc+1)=iadll(nc) + 3
201 IF(iadll(nc+1)-1>lag_nkf)THEN
202 CALL ancmsg(msgid=469,
203 . msgtype=msgerror,
204 . anmode=aninfo,
205 . i1=id,
206 . c1='BOUNDARY CONDITIONS',
207 . c2='BOUNDARY CONDITIONS',
208 . c3=titr)
209 ENDIF
210 ik = iadll(nc)
211 lll(ik) = nn
212 jll(ik) = 1
213 ik = ik + 1
214 lll(ik) = nn
215 jll(ik) = 2
216 ik = ik + 1
217 lll(ik) = nn
218 jll(ik) = 3
219 ENDIF
220 ENDIF
221 ENDIF
222 IF(iner(nn)/=0.0)THEN
223C--- Rotations
224 IF(cr==1.OR.cr==3.OR.cr==5.OR.cr==7)THEN
225C--- rz
226 nc = nc + 1
227 IF(nc>lag_ncf)THEN
228 CALL ancmsg(msgid=468,
229 . msgtype=msgerror,
230 . anmode=aninfo,
231 . i1=id,
232 . c1='BOUNDARY CONDITIONS')
233 ENDIF
234 IF(isk==1)THEN
235 iadll(nc+1)=iadll(nc) + 1
236 IF(iadll(nc+1)-1>lag_nkf)THEN
237 CALL ancmsg(msgid=469,
238 . msgtype=msgerror,
239 . anmode=aninfo,
240 . i1=id,
241 . c1='BOUNDARY CONDITIONS',
242 . c2='BOUNDARY CONDITIONS',
243 . c3=titr)
244 ENDIF
245 ik = iadll(nc)
246 lll(ik) = nn
247 jll(ik) = 6
248 ELSE
249 iadll(nc+1)=iadll(nc) + 3
250 IF(iadll(nc+1)-1>lag_nkf)THEN
251 CALL ancmsg(msgid=469,
252 . msgtype=msgerror,
253 . anmode=aninfo,
254 . i1=id,
255 . c1='BOUNDARY CONDITIONS',
256 . c2='BOUNDARY CONDITIONS',
257 . c3=titr)
258 ENDIF
259 ik = iadll(nc)
260 lll(ik) = nn
261 jll(ik) = 4
262 ik = ik + 1
263 lll(ik) = nn
264 jll(ik) = 5
265 ik = ik + 1
266 lll(ik) = nn
267 jll(ik) = 6
268 ENDIF
269 ENDIF
270 IF(cr==2.OR.cr==3.OR.cr==6.OR.cr==7)THEN
271C--- ry
272 nc = nc + 1
273 IF(nc>lag_ncf)THEN
274 CALL ancmsg(msgid=468,
275 . msgtype=msgerror,
276 . anmode=aninfo,
277 . i1=id,
278 . c1='BOUNDARY CONDITIONS',
279 . c2='BOUNDARY CONDITIONS',
280 . c3=titr)
281 ENDIF
282 IF(isk==1)THEN
283 iadll(nc+1)=iadll(nc) + 1
284 IF(iadll(nc+1)-1>lag_nkf)THEN
285 CALL ancmsg(msgid=469,
286 . msgtype=msgerror,
287 . anmode=aninfo,
288 . i1=id,
289 . c1='BOUNDARY CONDITIONS',
290 . c2='BOUNDARY CONDITIONS',
291 . c3=titr)
292 ENDIF
293 ik = iadll(nc)
294 lll(ik) = nn
295 jll(ik) = 5
296 ELSE
297 iadll(nc+1)=iadll(nc) + 3
298 IF(iadll(nc+1)-1>lag_nkf)THEN
299 CALL ancmsg(msgid=469,
300 . msgtype=msgerror,
301 . anmode=aninfo,
302 . i1=id,
303 . c1='BOUNDARY CONDITIONS',
304 . c2='BOUNDARY CONDITIONS',
305 . c3=titr)
306 ENDIF
307 ik = iadll(nc)
308 lll(ik) = nn
309 jll(ik) = 4
310 ik = ik + 1
311 lll(ik) = nn
312 jll(ik) = 5
313 ik = ik + 1
314 lll(ik) = nn
315 jll(ik) = 6
316 ENDIF
317 ENDIF
318 IF(cr==4.OR.cr==5.OR.cr==6.OR.cr==7)THEN
319C--- rx
320 nc = nc + 1
321 IF(nc>lag_ncf)THEN
322 CALL ancmsg(msgid=468,
323 . msgtype=msgerror,
324 . anmode=aninfo,
325 . i1=id,
326 . c1='BOUNDARY CONDITIONS',
327 . c2='BOUNDARY CONDITIONS',
328 . c3=titr)
329 ENDIF
330 IF(isk==1)THEN
331 iadll(nc+1)=iadll(nc) + 1
332 IF(iadll(nc+1)-1>lag_nkf)THEN
333 CALL ancmsg(msgid=469,
334 . msgtype=msgerror,
335 . anmode=aninfo,
336 . i1=id,
337 . c1='BOUNDARY CONDITIONS',
338 . c2='BOUNDARY CONDITIONS',
339 . c3=titr)
340 ENDIF
341 ik = iadll(nc)
342 lll(ik) = nn
343 jll(ik) = 4
344 ELSE
345 iadll(nc+1)=iadll(nc) + 3
346 IF(iadll(nc+1)-1>lag_nkf)THEN
347 CALL ancmsg(msgid=469,
348 . msgtype=msgerror,
349 . anmode=aninfo,
350 . i1=id,
351 . c1='BOUNDARY CONDITIONS',
352 . c2='BOUNDARY CONDITIONS',
353 . c3=titr)
354 ENDIF
355 ik = iadll(nc)
356 lll(ik) = nn
357 jll(ik) = 4
358 ik = ik + 1
359 lll(ik) = nn
360 jll(ik) = 5
361 ik = ik + 1
362 lll(ik) = nn
363 jll(ik) = 6
364 ENDIF
365 ENDIF
366 ENDIF
367C---
368 ENDDO
369 ENDDO
370C---
371 RETURN
372 END
my_real
#define my_real
Definition cppsort.cpp:32
lgmini_bc
subroutine lgmini_bc(iadll, jll, lll, igrnod, ibcslag, mass, iner, nc, nom_opt)
Definition lgmini_bc.F:35
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804