OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_submodgr.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_submodgrn (itab, itabm1, isubmod, sid, nnod, mess, flag, titr, titr1, lsubmodel, igrnod, nn)
subroutine hm_submodgre (isubmod, ix, nix, sid, nel, numel, ielt, mess, flag, titr, titr1, lsubmodel, igrelem, nn, igs)

Function/Subroutine Documentation

◆ hm_submodgre()

subroutine hm_submodgre ( integer, dimension(*) isubmod,
integer, dimension(nix,*) ix,
integer nix,
integer sid,
integer nel,
integer numel,
integer ielt,
character, dimension(*) mess,
integer flag,
character(len=nchartitle) titr,
character(len=nchartitle) titr1,
type(submodel_data), dimension(nsubmod) lsubmodel,
type (group_), dimension(*) igrelem,
integer nn,
integer igs )

Definition at line 174 of file hm_submodgr.F.

179C-----------------------------------------------
180C M o d u l e s
181C-----------------------------------------------
182 USE message_mod
183 USE submodel_mod
184 USE groupdef_mod
185 USE names_and_titles_mod , ONLY : ncharfield, ncharline, ncharkey
186C-----------------------------------------------
187C I m p l i c i t T y p e s
188C-----------------------------------------------
189#include "implicit_f.inc"
190C-----------------------------------------------
191C C o m m o n B l o c k s
192C-----------------------------------------------
193#include "units_c.inc"
194C-----------------------------------------------
195C D u m m y A r g u m e n t s
196C-----------------------------------------------
197 INTEGER NIX,SID,NEL,NUMEL,IELT,FLAG,NN,IGS
198 INTEGER ISUBMOD(*),IX(NIX,*)
199 CHARACTER MESS(*)
200 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
201 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
202C-----------------------------------------------
203 TYPE (GROUP_) IGRELEM(*)
204C-----------------------------------------------
205C L o c a l V a r i a b l e s
206C-----------------------------------------------
207 INTEGER I,J,K,ISU,IDEL,INUM,TAG,CUR_SUBMOD,ISELECT,IOK, ID,IDU,ELEMTYPE,KK,JJ
208 INTEGER TAGS(0:NSUBMOD)
209 CHARACTER(LEN=NCHARKEY) :: KEY
210 CHARACTER(LEN=NCHARLINE) ::CART
211 CHARACTER(LEN=NCHARFIELD) ::VERS_IN
212 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGELEMSUB
213 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
214 INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ELEM
215 INTEGER :: NENTITY
216C-----------------------------------------------
217 INTERFACE
218 SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
219 USE submodel_mod
220 INTEGER,DIMENSION(:),ALLOCATABLE :: arg1
221 INTEGER,INTENT(INOUT) :: arg2
222 TYPE(SUBMODEL_DATA) :: arg3(NSUBMOD)
223 END SUBROUTINE
224 END INTERFACE
225C-----------------------------------------------
226C IELT = ELEMENT TYPE (0 POUR NOEUDS, 1 BRIC, 2 QUAD, 3 SHELL,
227C 4 TRUSS, 5 BEAM, 6 SPRINGS,7 SHELL_3N)
228C=======================================================================
229C Tag submodels
230C-------------------------
231 tags = 0
232
233 CALL groups_get_elem_list(list_elem, nentity, lsubmodel)
234 DO kk=1,nentity
235 jj=list_elem(kk)
236 IF(jj /= 0)THEN
237 isu=0
238 iselect = 0
239 iok = 0
240 DO k=1,nsubmod
241 cur_submod = k
242 iselect = 0
243 DO WHILE (cur_submod /= 0 .AND. iselect == 0)
244 IF (lsubmodel(cur_submod)%NOSUBMOD == jj) iselect = 1
245 IF (lsubmodel(cur_submod)%NOSUBMOD == -jj) iselect = -1
246 cur_submod = lsubmodel(cur_submod)%IFATHER
247 ENDDO
248 IF (iselect == 1) THEN
249 isu=k
250 tags(k) = tags(k) + 1
251 iok = 1
252 ELSEIF (iselect == -1) THEN
253 isu=k
254 tags(k) = tags(k) - 1
255 iok = 1
256 ENDIF
257 ENDDO
258 IF (iok == 0) CALL ancmsg(msgid=194,
259 . msgtype=msgwarning,
260 . anmode=aninfo,
261 . c1=titr1,
262 . i1=sid,
263 . c2=titr1,
264 . c3=titr,
265 . c4='SUBMODEL',
266 . i2=jj)
267 ENDIF
268 enddo! NEXT KK
269 IF(ALLOCATED(list_elem))DEALLOCATE (list_elem)
270
271
272C--- -
273 DO k=1,nsubmod
274 IF (tags(k) > 1) tags(k) = 1
275 IF (tags(k) < -1) tags(k) = -1
276 ENDDO
277c
278 isu = 0
279 tag = 0
280 cur_submod = 0
281 rewind iusbm
282
283C-------------------------------------
284C Tag submodel ELEMS
285C-------------------------------------
286C IELT = ELEMENT TYPE (0 POUR NOEUDS, 1 BRIC, 2 QUAD, 3 SHELL,
287C 4 TRUSS, 5 BEAM, 6 SPRINGS,7 SHELL_3N)
288 IF (ielt == 1) THEN
289 elemtype = 208
290 ELSEIF (ielt == 2) THEN
291 elemtype = 104
292 ELSEIF (ielt == 3) THEN
293 elemtype = 104
294 ELSEIF (ielt == 4) THEN
295 elemtype = 61
296 ELSEIF (ielt == 5) THEN
297 elemtype = 60
298 ELSEIF (ielt == 6) THEN
299 elemtype = 21
300 ELSEIF (ielt == 7) THEN
301 elemtype = 103
302 ENDIF
303
304 ALLOCATE(tagelemsub(numel))
305 tagelemsub = 0
306 CALL cpp_elem_sub_tag(elemtype,tagelemsub)
307 IF (flag == 0) THEN
308 DO i=1,nsubmod
309 IF(tags(i) >= 1)THEN
310 DO j=1,numel
311 IF(tagelemsub(j) == i) nel=nel+1
312 ENDDO
313 ENDIF
314 ENDDO
315 ELSEIF (flag == 1) THEN
316 DO i=1,nsubmod
317 IF(tags(i) >= 1)THEN
318 DO j=1,numel
319 IF(tagelemsub(j) == i) THEN
320 nn = nn + 1
321 igrelem(igs)%ENTITY(nn) = j
322 ENDIF
323 ENDDO
324 ENDIF
325 ENDDO
326 ENDIF
327 IF (ALLOCATED(tagelemsub)) DEALLOCATE(tagelemsub)
328C-------------------------
329 RETURN
groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46
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::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
submodel_mod
Definition submodel_mod.F:712
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

◆ hm_submodgrn()

subroutine hm_submodgrn ( integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) isubmod,
integer sid,
integer nnod,
character, dimension(*) mess,
integer flag,
character(len=nchartitle) titr,
character(len=nchartitle) titr1,
type(submodel_data), dimension(*) lsubmodel,
type (group_), target igrnod,
integer nn )

Definition at line 35 of file hm_submodgr.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE submodel_mod
44 USE groupdef_mod
45 USE names_and_titles_mod , ONLY : nchartitle, ncharline, ncharfield, ncharkey
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER ITAB(*),ITABM1(*),ISUBMOD(*)
57 INTEGER SID,NNOD,FLAG,NN
58 CHARACTER MESS(*)
59 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
60 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
61C-----------------------------------------------
62 TYPE (GROUP_),TARGET :: IGRNOD
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J,K,ISU,IDNOD,INUM,JREC,NTAG,CTAG,CUR_SUBMOD,ISELECT,IOK,
67 . ID,IDU,NBNODES,NENTITY,KK,JJ,NBCNODES
68 INTEGER TAGS(0:NSUBMOD),J10(10)
69 CHARACTER(LEN=NCHARKEY) :: KEY
70 CHARACTER(LEN=NCHARLINE) :: CART
71 CHARACTER(LEN=NCHARFIELD) ::VERS_IN
72 INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ENTITY
73 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNODSUB
74 LOGICAL IS_AVAILABLE
75C-----------------------------------------------
76C E x t e r n a l F u n c t i o n s
77C-----------------------------------------------
78 INTEGER USR2SYS
79 INTERFACE
80 SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
81 USE submodel_mod
82 INTEGER,DIMENSION(:),ALLOCATABLE :: arg1
83 INTEGER,INTENT(INOUT) :: arg2
84 TYPE(SUBMODEL_DATA) :: arg3(NSUBMOD)
85 END SUBROUTINE
86 END INTERFACE
87C=======================================================================
88C Tag submodels
89C-------------------------
90 tags = 0
91 is_available = .false.
92 CALL groups_get_elem_list(list_entity, nentity, lsubmodel)
93 DO kk=1,nentity
94 jj = list_entity(kk)
95 IF(jj /= 0)THEN
96 isu=0
97 iselect = 0
98 iok = 0
99 DO k=1,nsubmod
100 cur_submod = k
101 iselect = 0
102 DO WHILE (cur_submod /= 0 .AND. iselect == 0)
103 IF (lsubmodel(cur_submod)%NOSUBMOD == jj) iselect = 1
104 IF (lsubmodel(cur_submod)%NOSUBMOD == -jj) iselect = -1
105 cur_submod = lsubmodel(cur_submod)%IFATHER
106 ENDDO
107
108 IF (iselect == 1) THEN
109 isu=k
110 tags(k) = tags(k) + 1
111 iok = 1
112 ELSEIF (iselect == -1) THEN
113 isu=k
114 tags(k) = tags(k) - 1
115 iok = 1
116 ENDIF
117 ENDDO
118 IF (iok == 0) CALL ancmsg(msgid=194,
119 . msgtype=msgwarning,
120 . anmode=aninfo,
121 . c1=titr1,
122 . i1=sid,
123 . c2=titr1,
124 . c3=titr,
125 . c4='SUBMODEL',
126 . i2=jj)
127 ENDIF
128 ENDDO
129 IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)
130C---
131C-------------------------------------
132C Tag submodel nodes
133C-------------------------------------
134 CALL cpp_nodes_count(nbnodes,nbcnodes)
135 ALLOCATE(tagnodsub(nbnodes+nbcnodes))
136 tagnodsub = 0
137 CALL cpp_node_sub_tag(tagnodsub)
138 IF (flag == 0) THEN
139 DO i=1,nsubmod
140 IF(tags(i) >= 1)THEN
141 DO j=1,nbnodes+nbcnodes
142 IF(tagnodsub(j) == i) nnod=nnod+1
143 ENDDO
144 ENDIF
145 ENDDO
146 ELSE
147 DO i=1,nsubmod
148 IF(tags(i) >= 1)THEN
149 DO j=1,nbnodes +nbcnodes
150 IF(tagnodsub(j) == i) THEN
151 nn = nn + 1
152 igrnod%ENTITY(nn)=j
153 ENDIF
154 ENDDO
155 ENDIF
156 ENDDO
157 ENDIF
158 IF (ALLOCATED(tagnodsub)) DEALLOCATE(tagnodsub)
159
160C-------------------------
161 RETURN
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003