OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_submodgr.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!|| hm_submodgrn ../starter/source/groups/hm_submodgr.F
25!||--- called by ------------------------------------------------------
26!|| hm_lecgrn ../starter/source/groups/hm_lecgrn.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| groups_get_elem_list ../starter/source/groups/groups_get_elem_list.F
30!|| usr2sys ../starter/source/system/sysfus.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
35 SUBROUTINE hm_submodgrn(
36 . ITAB ,ITABM1 ,ISUBMOD ,SID ,
37 . NNOD ,MESS ,FLAG ,TITR ,
38 . TITR1 ,LSUBMODEL ,IGRNOD ,NN )
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
162 END
163!||====================================================================
164!|| hm_submodgre ../starter/source/groups/hm_submodgr.F
165!||--- called by ------------------------------------------------------
166!|| hm_lecgre ../starter/source/groups/hm_lecgre.F
167!||--- calls -----------------------------------------------------
168!|| ancmsg ../starter/source/output/message/message.F
169!|| groups_get_elem_list ../starter/source/groups/groups_get_elem_list.F
170!||--- uses -----------------------------------------------------
171!|| message_mod ../starter/share/message_module/message_mod.f
172!|| submodel_mod ../starter/share/modules1/submodel_mod.F
173!||====================================================================
174 SUBROUTINE hm_submodgre(
175 . ISUBMOD ,IX ,NIX ,SID ,
176 . NEL ,NUMEL ,IELT ,MESS ,
177 . FLAG ,TITR ,TITR1 ,LSUBMODEL,IGRELEM ,
178 . NN ,IGS )
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
330 END
groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46
hm_submodgrn
subroutine hm_submodgrn(itab, itabm1, isubmod, sid, nnod, mess, flag, titr, titr1, lsubmodel, igrnod, nn)
Definition hm_submodgr.F:39
hm_submodgre
subroutine hm_submodgre(isubmod, ix, nix, sid, nel, numel, ielt, mess, flag, titr, titr1, lsubmodel, igrelem, nn, igs)
Definition hm_submodgr.F:179
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
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
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723