OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lgmini_i2.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_i2 ../starter/source/tools/lagmul/lgmini_i2.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_i2(IADLL ,JLL ,LLL ,INTBUF_TAB ,IPARI, NC,
34 . MASS , ITAB ,NOM_OPT)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE message_mod
39 USE intbufdef_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 "param_c.inc"
49#include "lagmult.inc"
50#include "com04_c.inc"
51#include "scr17_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER NC, IADLL(*), JLL(*), LLL(*), IPARI(NPARI,NINTER),ITAB(*)
56 my_real mass(*)
57 INTEGER NOM_OPT(LNOPT1,*)
58 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER INOD(5), N, II, JJ, IK, L,
63 . ilagm, nrts, nrtm, nsn, nmn,irect ,nsv ,irtl, iaddb,
64 . nir, nty, ndl, iad, i, j, nn0, nm0
65 INTEGER ID
66 CHARACTER(LEN=NCHARTITLE) :: TITR
67C======================================================================|
68 DO n=1,ninter
69 id=nom_opt(1,n)
70 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,n),ltitr)
71 nty = ipari(7 ,n)
72 ilagm = ipari(33,n)
73 IF (nty == 2 .AND. ilagm == 1)THEN
74 nrts =ipari(3,n)
75 nrtm =ipari(4,n)
76 nsn =ipari(5,n)
77 nmn =ipari(6,n)
78C---
79 DO i=1,nsn
80 nn0=intbuf_tab(n)%NSV(i)
81 IF(mass(nn0) == 0)THEN
82 CALL ancmsg(msgid=535,
83 . msgtype=msgerror,
84 . anmode=aninfo_blind_1,
85 . c1='INTERFACE TYPE2',
86 . i1=id,
87 . c2='INTERFACE TYPE2',
88 . c3=titr,c4='SECONDARY',
89 . i2=itab(nn0))
90 ENDIF
91 ENDDO
92 DO j=1,nmn
93 nm0=intbuf_tab(n)%MSR(j)
94 IF(mass(nm0) == 0)THEN
95 CALL ancmsg(msgid=535,
96 . msgtype=msgerror,
97 . anmode=aninfo_blind_1,
98 . c1='INTERFACE',
99 . i1=id,
100 . c2='INTERFACE',
101 . c3=titr,c4='SECONDARY',
102 . i2=itab(nm0))
103 ENDIF
104 ENDDO
105C
106 DO ii=1,nsn
107 l = intbuf_tab(n)%IRTLM(ii)
108 nir = 4
109 DO jj=1,nir
110 inod(jj) = intbuf_tab(n)%IRECTM((l-1)*nir+jj)
111 ENDDO
112 IF(inod(4) == inod(3)) nir=3
113 inod(nir+1)=intbuf_tab(n)%NSV(ii)
114 ndl = 3*nir+1
115C --- ic = 1 (vx)
116 nc = nc + 1
117 IF(nc > lag_ncf)THEN
118 CALL ancmsg(msgid=468,
119 . msgtype=msgerror,
120 . anmode=aninfo,
121 . i1=id,
122 . c1='INTERFACE TYPE 2',
123 . c2='INTERFACE TYPE 2',
124 . c3=titr)
125 ENDIF
126 iadll(nc+1) = iadll(nc) + ndl
127 IF(iadll(nc+1)-1 > lag_nkf)THEN
128 CALL ancmsg(msgid=469,
129 . msgtype=msgerror,
130 . anmode=aninfo,
131 . i1=id,
132 . c1='INTERFACE TYPE 2',
133 . c2='INTERFACE TYPE 2',
134 . c3=titr)
135 ENDIF
136 iad = iadll(nc) -1
137 DO jj=1,nir
138 ik = iad+jj
139 lll(ik) = inod(jj)
140 jll(ik) = 1
141 ENDDO
142 iad = iad + nir
143 DO jj=1,nir
144 ik = iad+jj
145 lll(ik) = inod(jj)
146 jll(ik) = 2
147 ENDDO
148 iad = iad + nir
149 DO jj=1,nir
150 ik = iad+jj
151 lll(ik) = inod(jj)
152 jll(ik) = 3
153 ENDDO
154 ik = iad + nir+1
155 lll(ik) = inod(nir + 1)
156 jll(ik) = 1
157C --- ic = 2 (vy)
158 nc = nc + 1
159 IF(nc > lag_ncf)THEN
160 CALL ancmsg(msgid=468,
161 . msgtype=msgerror,
162 . anmode=aninfo,
163 . i1=id,
164 . c1='INTERFACE TYPE 2',
165 . c2='INTERFACE TYPE 2',
166 . c3=titr)
167 ENDIF
168 iadll(nc+1) = iadll(nc) + ndl
169 IF(iadll(nc+1)-1 > lag_nkf)THEN
170 CALL ancmsg(msgid=469,
171 . msgtype=msgerror,
172 . anmode=aninfo,
173 . i1=id,
174 . c1='INTERFACE TYPE 2',
175 . c2='INTERFACE TYPE 2',
176 . c3=titr)
177 ENDIF
178 iad = iadll(nc) -1
179 DO jj=1,nir
180 ik = iad+jj
181 lll(ik) = inod(jj)
182 jll(ik) = 1
183 ENDDO
184 iad = iad + nir
185 DO jj=1,nir
186 ik = iad+jj
187 lll(ik) = inod(jj)
188 jll(ik) = 2
189 ENDDO
190 iad = iad + nir
191 DO jj=1,nir
192 ik = iad+jj
193 lll(ik) = inod(jj)
194 jll(ik) = 3
195 ENDDO
196 ik = iad + nir+1
197 lll(ik) = inod(nir + 1)
198 jll(ik) = 2
199C --- ic = 3 (vz)
200 nc = nc + 1
201 IF(nc > lag_ncf)THEN
202 CALL ancmsg(msgid=468,
203 . msgtype=msgerror,
204 . anmode=aninfo,
205 . i1=id,
206 . c1='INTERFACE TYPE 2',
207 . c2='INTERFACE TYPE 2',
208 . c3=titr)
209 ENDIF
210 iadll(nc+1) = iadll(nc) + ndl
211 IF(iadll(nc+1)-1 > lag_nkf)THEN
212 CALL ancmsg(msgid=469,
213 . msgtype=msgerror,
214 . anmode=aninfo,
215 . i1=id,
216 . c1='INTERFACE TYPE 2',
217 . c2='INTERFACE TYPE 2',
218 . c3=titr)
219 ENDIF
220 iad = iadll(nc) -1
221 DO jj=1,nir
222 ik = iad+jj
223 lll(ik) = inod(jj)
224 jll(ik) = 1
225 ENDDO
226 iad = iad + nir
227 DO jj=1,nir
228 ik = iad+jj
229 lll(ik) = inod(jj)
230 jll(ik) = 2
231 ENDDO
232 iad = iad + nir
233 DO jj=1,nir
234 ik = iad+jj
235 lll(ik) = inod(jj)
236 jll(ik) = 3
237 ENDDO
238 ik = iad + nir+1
239 lll(ik) = inod(nir+1)
240 jll(ik) = 3
241C --- ic = 4 (wx)
242 nc = nc + 1
243 IF(nc > lag_ncf)THEN
244 CALL ancmsg(msgid=468,
245 . msgtype=msgerror,
246 . anmode=aninfo,
247 . i1=id,
248 . c1='INTERFACE TYPE 2',
249 . c2='INTERFACE TYPE 2',
250 . c3=titr)
251 ENDIF
252 iadll(nc+1) = iadll(nc) + ndl
253 IF(iadll(nc+1)-1 > lag_nkf)THEN
254 CALL ancmsg(msgid=469,
255 . msgtype=msgerror,
256 . anmode=aninfo,
257 . i1=id,
258 . c1='INTERFACE TYPE 2',
259 . c2='INTERFACE TYPE 2',
260 . c3=titr)
261 ENDIF
262 iad = iadll(nc) -1
263 DO jj=1,nir
264 ik = iad+jj
265 lll(ik) = inod(jj)
266 jll(ik) = 1
267 ENDDO
268 iad = iad + nir
269 DO jj=1,nir
270 ik = iad+jj
271 lll(ik) = inod(jj)
272 jll(ik) = 2
273 ENDDO
274 iad = iad + nir
275 DO jj=1,nir
276 ik = iad+jj
277 lll(ik) = inod(jj)
278 jll(ik) = 3
279 ENDDO
280 ik = iad + nir + 1
281 lll(ik) = inod(nir+1)
282 jll(ik) = 4
283C --- ic = 5 (wy)
284 nc = nc + 1
285 IF(nc > lag_ncf)THEN
286 CALL ancmsg(msgid=468,
287 . msgtype=msgerror,
288 . anmode=aninfo,
289 . i1=id,
290 . c1='INTERFACE TYPE 2',
291 . c2='INTERFACE TYPE 2',
292 . c3=titr)
293 ENDIF
294 iadll(nc+1) = iadll(nc) + ndl
295 IF(iadll(nc+1)-1 > lag_nkf)THEN
296 CALL ancmsg(msgid=469,
297 . msgtype=msgerror,
298 . anmode=aninfo,
299 . i1=id,
300 . c1='INTERFACE TYPE 2',
301 . c2='INTERFACE TYPE 2',
302 . c3=titr)
303 ENDIF
304 iad = iadll(nc) -1
305 DO jj=1,nir
306 ik = iad+jj
307 lll(ik) = inod(jj)
308 jll(ik) = 1
309 ENDDO
310 iad = iad + nir
311 DO jj=1,nir
312 ik = iad+jj
313 lll(ik) = inod(jj)
314 jll(ik) = 2
315 ENDDO
316 iad = iad + nir
317 DO jj=1,nir
318 ik = iad+jj
319 lll(ik) = inod(jj)
320 jll(ik) = 3
321 ENDDO
322 ik = iad + nir + 1
323 lll(ik) = inod(nir+1)
324 jll(ik) = 5
325C --- ic = 6 (wz)
326 nc = nc + 1
327 IF(nc > lag_ncf)THEN
328 CALL ancmsg(msgid=468,
329 . msgtype=msgerror,
330 . anmode=aninfo,
331 . i1=id,
332 . c1='INTERFACE TYPE 2',
333 . c2='INTERFACE TYPE 2',
334 . c3=titr)
335 ENDIF
336 iadll(nc+1) = iadll(nc) + ndl
337 IF(iadll(nc+1)-1 > lag_nkf)THEN
338 CALL ancmsg(msgid=469,
339 . msgtype=msgerror,
340 . anmode=aninfo,
341 . i1=id,
342 . c1='INTERFACE TYPE 2',
343 . c2='INTERFACE TYPE 2',
344 . c3=titr)
345 ENDIF
346 iad = iadll(nc) -1
347 DO jj=1,nir
348 ik = iad+jj
349 lll(ik) = inod(jj)
350 jll(ik) = 1
351 ENDDO
352 iad = iad + nir
353 DO jj=1,nir
354 ik = iad+jj
355 lll(ik) = inod(jj)
356 jll(ik) = 2
357 ENDDO
358 iad = iad + nir
359 DO jj=1,nir
360 ik = iad+jj
361 lll(ik) = inod(jj)
362 jll(ik) = 3
363 ENDDO
364 ik = iad + nir + 1
365 lll(ik) = inod(nir+1)
366 jll(ik) = 6
367 ENDDO
368C---
369 ENDIF
370 ENDDO
371C-----------
372 RETURN
373 END
my_real
#define my_real
Definition cppsort.cpp:32
lagm_ini
subroutine lagm_ini(nhf, iadhf, iadll, jll, lll, ipari, intbuf_tab, igrnod, ibcslag, mass, iner, gjbufi, ibufnc, ibufnn, ibufdl, ibufsk, ibfv, vel, itab, nom_opt, ptr_nopt_inter, ptr_nopt_fxv, ptr_nopt_bcs, ptr_nopt_mpc, ptr_nopt_gjoint)
Definition lagm_ini.F:43
lgmini_i2
subroutine lgmini_i2(iadll, jll, lll, intbuf_tab, ipari, nc, mass, itab, nom_opt)
Definition lgmini_i2.F:35
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
starter
program starter
Definition starter.F:39