OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ininode_rm.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!|| ininode_rm ../starter/source/materials/mat/mat019/ininode_rm.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.f
27!||====================================================================
28 SUBROUTINE ininode_rm(CONNEC,IRIG_NODE,IRBY,SLN,NRB,NRSLN,
29 . STIFN,STIFR, RMSTIFN, RMSTIFR,NUMEL,
30 . NER)
31C=======================================================================
32C EN SORTIE
33C IRBY Rigid node
34C SLN second node number by rigid material
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C A n a l y s e M o d u l e
41C-----------------------------------------------
42#include "com04_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER IRBY(*),SLN(*),NRSLN,NRB,NUMEL,NER
47 INTEGER IRIG_NODE(*),CONNEC(NUMEL,*)
49 . stifn(*),stifr(*),rmstifn(*), rmstifr(*)
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER I,J,II,NR,NR1,NR0,KK,IR,N,NREST,IE,
54 . NER1,NER0,IEL
55C REAL
56
57 INTEGER, DIMENSION(:), ALLOCATABLE ::
58 . IRN,INDX,INDX0,ITAG,
59 . indxe, indxe0, itage
60C
61C construction of rigid materials
62C
63 ALLOCATE (irn(numnod))
64 irn = 0
65 nr = 0
66 nrsln =0
67 DO i = 1, numnod
68 IF(irig_node(i) > 0) THEN
69 nr = nr + 1
70 irn(nr)= i
71 ENDIF
72 ENDDO
73C
74C allocation of work array
75C
76 ALLOCATE (indx(nr),indx0(nr),itag(numnod))
77 ALLOCATE (indxe(ner),indxe0(ner),itage(ner))
78C initialisation
79 itag = 0
80 itage = 0
81 indx = 0
82 indx0 = 0
83 indxe = 0
84 indxe0 = 0
85C
86 nr1 = 0
87 nrb = 1
88 itage(1) = nrb
89 indxe(1) = 1
90C
91 DO j=1,10
92 ie = indxe(1)
93 ii = connec(ie,j)
94 IF(ii > 0 ) THEN
95 itag(ii) = nrb
96 nr1 = nr1 + 1
97 indx(nr1) = ii
98 ENDIF
99 ENDDO
100C
101 nrest = nr - nr1
102 ner1 = 0
103
104 DO i=2,ner
105 ner1 = ner1 + 1
106 indxe(ner1) = i
107 ENDDO
108c NRC = NR1
109 kk = 0
110 DO WHILE(nrest > 0 )
111 nr0 = 0
112 ner0 = 0
113 DO i=1,nr1
114 ii = indx(i)
115 DO ie =1 , ner1
116 iel = indxe(ie)
117 IF(itage(iel) == 0) THEN
118 DO j=1,10
119 IF(ii == connec(iel, j)) THEN
120 ner0 = ner0 + 1
121 indxe0(ner0) = iel
122 itage(iel) = nrb
123 ENDIF
124 ENDDO
125 ENDIF
126 ENDDO
127 ENDDO
128 nr1 = 0
129 IF(ner0 > 0) THEN
130 DO i=1,ner0
131 iel = indxe0(i)
132 DO j=1,10
133 ii= connec(iel,j)
134 IF(ii > 0) THEN
135 IF(itag(ii) == 0)THEN
136 itag(ii) = nrb
137 nr1 = nr1 + 1
138 indx(nr1) = ii
139 END IF
140 ENDIF
141 ENDDO
142 ENDDO
143 IF(nr1 > 0) THEN
144C remaining number of elements
145 ner0 = 0
146 DO ie = 1, ner1
147 iel = indxe(ie)
148 IF(itage(iel) == 0) THEN
149 ner0 = ner0 + 1
150 indxe0(ner0) = iel
151 ENDIF
152 ENDDO
153 ner1 = ner0
154 DO i=1,ner0
155 indxe(i) = indxe0(i)
156 ENDDO
157C node restant
158 nrest = nrest - nr1
159 ELSE
160 nrb = nrb + 1
161 ner0 = 0
162 DO ie =1 , ner1
163 iel = indxe(ie)
164 IF(itage(iel) == 0) THEN
165 ner0 = ner0 + 1
166 indxe0(ner0) = iel
167 ENDIF
168 ENDDO
169C creation of another rigid body
170 ner1 = ner0
171 DO i=1,ner1
172 indxe(i) = indxe0(i)
173 ENDDO
174C
175 iel = indxe(1)
176 nr1 = 0
177 DO j=1,10
178 iel = indxe(1)
179 ii = connec(iel,j)
180 itage(iel) = nrb
181 IF(ii > 0 ) THEN
182 itag(ii) = nrb
183 nr1 = nr1 + 1
184 indx(nr1) = ii
185 ENDIF
186 ENDDO
187C
188 nrest = nrest - nr1
189 ENDIF
190 ELSE
191 nrb = nrb + 1
192C creation of another rigid body
193 ner0 = 0
194 DO ie =1 , ner1
195 iel = indxe(ie)
196 IF(itage(iel) == 0) THEN
197 ner0 = ner0 + 1
198 indxe0(ner0) = iel
199 ENDIF
200 ENDDO
201C creation of another rigid body
202 ner1 = ner0
203 DO i=1,ner1
204 indxe(i) = indxe0(i)
205 ENDDO
206 iel = indxe(1)
207 itage(iel) = nrb
208 nr1 = 0
209 DO j=1,10
210cc IEL = INDXE(1)
211 ii = connec(iel,j)
212 IF(ii > 0 ) THEN
213 itag(ii) = nrb
214 nr1 = nr1 + 1
215 indx(nr1) = ii
216 ENDIF
217 ENDDO
218C
219 nrest = nrest - nr1
220 ENDIF
221 ENDDO
222C
223C creation of rigid bodies
224C
225 kk = 0
226 DO ir =1,nrb
227 ii = 0
228 DO i=1,nr
229 n = irn(i)
230 IF(itag(n) == ir) THEN
231 ii = ii + 1
232 irby(ii + kk) = n
233 rmstifn(ii + kk) = stifn(n)
234 rmstifr(ii + kk) = stifr(n)
235 stifn(n) = em20
236 stifr(n) = em20
237 ENDIF
238 ENDDO
239 sln(ir) = ii
240 kk = kk + ii
241 nrsln = nrsln + ii
242 ENDDO
243C
244 DEALLOCATE(itag,irn,indx,indx0)
245 DEALLOCATE(indxe,indxe0,itage)
246 RETURN
247 END
248
#define my_real
Definition cppsort.cpp:32
subroutine ininode_rm(connec, irig_node, irby, sln, nrb, nrsln, stifn, stifr, rmstifn, rmstifr, numel, ner)
Definition ininode_rm.F:31
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine, lsigi, lsigsp, srnoise, nprw, lprw, rwstif_pen, sln_pen)
Definition initia.F:198
program starter
Definition starter.F:39