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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_grogro (numen, ngreln, igrelem, icount, flag, iter, elkey, lsubmodel)

Function/Subroutine Documentation

◆ hm_grogro()

subroutine hm_grogro ( integer numen,
integer ngreln,
type (group_), dimension(ngreln) igrelem,
integer icount,
integer flag,
integer iter,
character elkey,
type(submodel_data), dimension(nsubmod) lsubmodel )

Definition at line 36 of file hm_grogro.F.

38!---
39! group des group des elements + parts
40!---
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE my_alloc_mod
45 USE message_mod
46 USE groupdef_mod
47 USE submodel_mod
48 USE hm_option_read_mod
49 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NUMEN,NGRELN,FLAG,ICOUNT,ITER
61C-----------------------------------------------
62 TYPE (GROUP_) , DIMENSION(NGRELN) :: IGRELEM
63 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I,J,K,L,ID,NEL,IGS,IGRS,JREC,ISU,NONTRI,JJ,KK,
68 . FLAG_FMT,GROUP_ID,IFIX_TMP,SKIPFLAG,UID,NN
69 CHARACTER(LEN=NCHARTITLE) :: TITR
70 CHARACTER(LEN=NCHARKEY)::KEY,KEY2
71 CHARACTER :: ELKEY*4
72 LOGICAL IS_ENCRYPTED, IS_AVAILABLE
73 INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ELEM
74 INTEGER,DIMENSION(:),ALLOCATABLE :: BUFTMP
75 INTEGER :: NENTITY
76C-----------------------------------------------
77 INTERFACE
78 SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
79 USE submodel_mod
80 INTEGER,DIMENSION(:),ALLOCATABLE :: arg1
81 INTEGER,INTENT(INOUT) :: arg2
82 TYPE(SUBMODEL_DATA) :: arg3(NSUBMOD)
83 END SUBROUTINE
84 END INTERFACE
85C=======================================================================
86 CALL my_alloc(buftmp,numen*2)
87 IF (flag == 0) icount=0
88 igs = 0
89C boucle sur les groupes
90 DO i=1,ngreln
91 CALL hm_option_read_key(lsubmodel,
92 . option_id = group_id,
93 . option_titr = titr ,
94 . keyword2 = key ,
95 . keyword3 = key2)
96 igs=igs+1
97 IF (igrelem(igs)%GRPGRP == 2) THEN
98 buftmp = 0
99 nel=0
100 nn = 0
101 nontri = igrelem(igs)%SORTED
102C-----------
103 IF (flag == 0 .AND. igrelem(igs)%NENTITY == -1) THEN
104
105 skipflag = 0
106 IF (skipflag == 0) THEN
107
108 CALL groups_get_elem_list(list_elem, nentity, lsubmodel)
109 DO kk=1,nentity
110 jj=list_elem(kk)
111 IF(jj /= 0)THEN
112 igrs=0
113 DO k=1,ngreln
114 IF (iabs(jj) == igrelem(k)%ID) THEN
115 igrs=k
116 EXIT
117 ENDIF
118 ENDDO
119 IF (igrs == 0) THEN
120 CALL ancmsg(msgid=174,
121 . msgtype=msgwarning,
122 . anmode=aninfo,
123 . i1=igrelem(igs)%ID,c1=titr,
124 . i2=iabs(jj))
125 ELSEIF (igrelem(igrs)%LEVEL == 0) THEN
126 !reference a un groupe non initialise
127 IF (iter > ngreln) GOTO 900
128 igrelem(igs)%NENTITY=-1
129 igrelem(igs)%LEVEL=0
130 icount=1
131 skipflag = 1
132 nel = 0
133 cycle
134 ELSE
135 !reference a un groupe initialise
136 IF (nontri == 0) THEN
137 !sorted group, tag les noeuds
138 DO l=1,igrelem(igrs)%NENTITY
139 IF (jj < 0) THEN
140 !retire les noeuds du group si JJ < 0
141 buftmp(igrelem(igrs)%ENTITY(l))=-1
142 ELSEIF (buftmp(igrelem(igrs)%ENTITY(l)) == 0) THEN
143 !ajoute les noeuds au group si JJ > 0 et noeud non rire
144 buftmp(igrelem(igrs)%ENTITY(l))=1
145 ENDIF
146 ENDDO
147 ELSE
148 !non sorted group
149 nel = nel + igrelem(igrs)%NENTITY
150 ENDIF
151 ENDIF
152 ENDIF
153 enddo! NEXT KK
154 IF(ALLOCATED(list_elem))DEALLOCATE (list_elem)
155 ENDIF
156
157C-----
158 IF (skipflag == 0) THEN
159 IF (nontri == 0 ) THEN
160C sorted group
161 DO j=1,numen
162 IF (buftmp(j) > 0) nel=nel+1
163 ENDDO
164 ENDIF
165C
166 igrelem(igs)%NENTITY = nel
167 CALL my_alloc(igrelem(igs)%ENTITY,nel)
168 igrelem(igs)%ENTITY = 0
169 ENDIF
170C-----------
171 ELSEIF (flag == 1 .AND. igrelem(igs)%LEVEL == 0 .AND.
172 . igrelem(igs)%NENTITY > -1) THEN
173
174
175
176 CALL groups_get_elem_list(list_elem, nentity, lsubmodel)
177 DO kk=1,nentity
178 jj=list_elem(kk)
179 IF(jj /= 0)THEN
180 igrs=0
181 DO k=1,ngreln
182 IF (iabs(jj) == igrelem(k)%ID) THEN
183 igrs=k
184 EXIT
185 ENDIF
186 ENDDO
187 IF (igrs == 0) THEN
188 ELSEIF (igrelem(igrs)%NENTITY == -1) THEN
189 cycle
190 ELSE
191 IF (nontri == 0) THEN
192C tag les noeuds
193 DO l=1,igrelem(igrs)%NENTITY
194 IF (jj < 0) THEN
195C retire les noeuds du group si JJ < 0
196 buftmp(igrelem(igrs)%ENTITY(l))=-1
197 ELSEIF (buftmp(igrelem(igrs)%ENTITY(l)) == 0) THEN
198C ajoute les noeuds au group si JJ > 0 et noeud non retire
199 buftmp(igrelem(igrs)%ENTITY(l))=1
200 ENDIF
201 ENDDO
202 ELSE
203 DO l=1,igrelem(igrs)%NENTITY
204 nn = nn + 1
205 igrelem(igs)%ENTITY(nn) = igrelem(igrs)%ENTITY(l)
206 ENDDO
207 ENDIF
208 ENDIF
209 ENDIF
210 enddo! NEXT KK
211 IF(ALLOCATED(list_elem))DEALLOCATE (list_elem)
212
213
214
215C-----
216 IF (nontri == 0) THEN
217c sorted group
218 DO j=1,numen
219 IF (buftmp(j) > 0) THEN
220 nn = nn + 1
221 igrelem(igs)%ENTITY(nn)=j
222 ENDIF
223 ENDDO
224 ENDIF
225 igrelem(igs)%LEVEL = 1
226C----------- end_ flag = 1
227 ENDIF
228 ENDIF
229
230 ENDDO
231
232 DEALLOCATE(buftmp)
233
234C-----------
235 RETURN
236 900 CALL ancmsg(msgid=176,
237 . msgtype=msgerror,
238 . anmode=aninfo,
239 . i1=id,
240 . c1=titr,
241 . i2=igrelem(igs)%ID,
242 . c2=elkey)
243C-----------
244 RETURN
groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
id
initmumps id
Definition multiplerhs_example.m:4
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
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