OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_grogronod.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_grogronod ../starter/source/groups/hm_grogronod.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.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!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
31!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
32!||--- uses -----------------------------------------------------
33!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_grogronod(IGRNOD ,ICOUNT ,FLAG ,ITER ,ELKEY,
38 . LSUBMODEL)
39!---
40! group des group des elements + parts
41!---
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE my_alloc_mod
46 USE message_mod
47 USE groupdef_mod
48 USE submodel_mod
49 USE hm_option_read_mod
50 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com04_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER FLAG,ICOUNT,ITER
63C-----------------------------------------------
64 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
65 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,J,K,L,ID,NEL,IGS,IGRS,JREC,ISU,NONTRI,JJ,KK,
70 . flag_fmt,flag_fmt_tmp,ifix_tmp,skipflag,uid,nn,nentity
71 INTEGER J10(10)
72 INTEGER,DIMENSION(:),ALLOCATABLE :: BUFTMP
73 INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ENTITY
74 CHARACTER(LEN=NCHARTITLE) :: TITR
75 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
76 CHARACTER ELKEY*4
77 LOGICAL IS_AVAILABLE
78 INTERFACE
79 SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
80 USE submodel_mod
81 INTEGER,DIMENSION(:),ALLOCATABLE :: arg1
82 INTEGER,INTENT(INOUT) :: arg2
83 TYPE(submodel_data) :: arg3(NSUBMOD)
84 END SUBROUTINE
85 END INTERFACE
86C=======================================================================
87 CALL my_alloc(buftmp,numnod*2)
88 is_available = .false.
89 IF (flag == 0) icount=0
90 igs =0
91 CALL hm_option_start('/grnod')
92C boucle sur les groupes
93 DO I=1,NGRNOD
94 CALL HM_OPTION_READ_KEY(LSUBMODEL,
95 . OPTION_ID = ID,
96 . OPTION_TITR = TITR ,
97 . UNIT_ID = UID,
98 . KEYWORD2 = KEY ,
99 . KEYWORD3 = KEY2 )
100
101 IGS=IGS+1
102 IF (IGRNOD(IGS)%GRPGRP == 2) THEN
103 BUFTMP = 0
104 NEL=0
105 NN = 0
106 NONTRI = IGRNOD(IGS)%SORTED
107C-----------
108.AND. IF (FLAG == 0 IGRNOD(IGS)%NENTITY == -1) THEN
109c
110 SKIPFLAG = 0
111 IF (SKIPFLAG == 0) THEN
112 CALL GROUPS_GET_ELEM_LIST(LIST_ENTITY, NENTITY, LSUBMODEL)
113 DO KK = 1,NENTITY
114 JJ = LIST_ENTITY(KK)
115 IF (JJ /= 0) THEN
116 IGRS=0
117 DO K=1,NGRNOD
118 IF (IABS(JJ) == IGRNOD(K)%ID) THEN
119 IGRS=K
120 EXIT
121 ENDIF
122 ENDDO
123 IF (IGRS == 0) THEN
124 CALL ANCMSG(MSGID=174,
125 . MSGTYPE=MSGWARNING,
126 . ANMODE=ANINFO,
127 . I1=IGRNOD(IGS)%ID,C1=TITR,
128 . I2=IABS(JJ))
129 ELSEIF (IGRNOD(IGRS)%LEVEL == 0) THEN
130C reference a un groupe non initialise
131 IF (ITER > NGRNOD) GOTO 900
132 IGRNOD(IGS)%NENTITY=-1
133 IGRNOD(IGS)%LEVEL=0
134 ICOUNT=1
135 SKIPFLAG = 1
136 NEL = 0
137 CYCLE
138 ELSE
139C reference a un groupe initialise
140 IF (NONTRI == 0) THEN
141C sorted group, tag les noeuds
142 DO L=1,IGRNOD(IGRS)%NENTITY
143 IF (JJ < 0) THEN
144C retire les noeuds du group si j10 < 0
145 BUFTMP(IGRNOD(IGRS)%ENTITY(L))=-1
146 ELSEIF (BUFTMP(IGRNOD(IGRS)%ENTITY(L)) == 0) THEN
147C ajoute les noeuds au group si j10 > 0 et noeud non rire
148 BUFTMP(IGRNOD(IGRS)%ENTITY(L))=1
149 ENDIF
150 ENDDO
151 ELSE
152c non sorted group
153 NEL = NEL + IGRNOD(IGRS)%NENTITY
154 ENDIF
155 ENDIF ! IF (IGRS == 0)
156 ENDIF ! IF (J10(J) /= 0)
157 ENDDO ! DO J=1,10
158 IF(ALLOCATED(LIST_ENTITY))DEALLOCATE (LIST_ENTITY)
159 ENDIF ! IF (SKIPFLAG == 0)
160C-----
161 IF (SKIPFLAG == 0) THEN
162 IF (NONTRI == 0 ) THEN
163C sorted group
164 DO J=1,NUMNOD
165 IF (BUFTMP(J) > 0) NEL=NEL+1
166 ENDDO
167 ENDIF
168C
169 IGRNOD(IGS)%NENTITY = NEL
170 CALL MY_ALLOC(IGRNOD(IGS)%ENTITY,NEL)
171 IGRNOD(IGS)%ENTITY = 0
172 ENDIF ! IF (SKIPFLAG == 0)
173C-----------
174.AND..AND. ELSEIF (FLAG == 1 IGRNOD(IGS)%LEVEL == 0
175 . IGRNOD(IGS)%NENTITY > -1) THEN
176c
177 CALL GROUPS_GET_ELEM_LIST(LIST_ENTITY, NENTITY, LSUBMODEL)
178 DO KK=1,NENTITY
179 JJ = LIST_ENTITY(KK)
180 IF (JJ /= 0) THEN
181 IGRS=0
182 DO K=1,NGRNOD
183 IF (IABS(JJ) == IGRNOD(K)%ID) THEN
184 IGRS=K
185 EXIT
186 ENDIF
187 ENDDO
188 IF (IGRS == 0) THEN
189 ELSEIF (IGRNOD(IGRS)%NENTITY == -1) THEN
190 CYCLE
191 ELSE
192 IF (NONTRI == 0) THEN
193C tag les noeuds
194 DO L=1,IGRNOD(IGRS)%NENTITY
195 IF (JJ < 0) THEN
196C retire les noeuds du group si j10 < 0
197 BUFTMP(IGRNOD(IGRS)%ENTITY(L))=-1
198 ELSEIF (BUFTMP(IGRNOD(IGRS)%ENTITY(L)) == 0) THEN
199C ajoute les noeuds au group si j10 > 0 et noeud non retire
200 BUFTMP(IGRNOD(IGRS)%ENTITY(L))=1
201 ENDIF
202 ENDDO
203 ELSE
204 DO L=1,IGRNOD(IGRS)%NENTITY
205 NN = NN + 1
206 IGRNOD(IGS)%ENTITY(NN) = IGRNOD(IGRS)%ENTITY(L)
207 ENDDO
208 ENDIF ! IF (NONTRI == 0)
209 ENDIF ! IF (IGRS == 0)
210 ENDIF ! IF (J10(J) /= 0)
211 ENDDO ! DO J=1,10
212 IF(ALLOCATED(LIST_ENTITY))DEALLOCATE (LIST_ENTITY)
213C-----
214 IF (NONTRI == 0) THEN
215c sorted group
216 DO J=1,NUMNOD
217 IF (BUFTMP(J) > 0) THEN
218 NN = NN + 1
219 IGRNOD(IGS)%ENTITY(NN)=J
220 ENDIF
221 ENDDO
222 ENDIF ! IF (NONTRI == 0)
223 IGRNOD(IGS)%LEVEL = 1
224C----------- end_ flag = 1
225.AND. ENDIF ! IF (FLAG == 0 IGRNOD(IGS)%NENTITY == -1)
226 ENDIF ! IF (IGRNOD(IGS)%GRPGRP == 2)
227 ENDDO ! DO I=1,NLINE(KCUR)
228C-----------
229 DEALLOCATE(BUFTMP)
230 RETURN
231 900 CALL ANCMSG(MSGID=176,
232 . MSGTYPE=MSGERROR,
233 . ANMODE=ANINFO,
234 . I1=ID,
235 . C1=TITR,
236 . I2=IGRNOD(IGS)%ID,
237 . C2=ELKEY)
238C-----------
239 RETURN
240 END
groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46
hm_grogronod
subroutine hm_grogronod(igrnod, icount, flag, iter, elkey, lsubmodel)
Definition hm_grogronod.F:39
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
submodel_mod
Definition submodel_mod.F:712
submodel_mod::submodel_data
Definition submodel_mod.F:723