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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_grogronod (igrnod, icount, flag, iter, elkey, lsubmodel)

Function/Subroutine Documentation

◆ hm_grogronod()

subroutine hm_grogronod ( type (group_), dimension(ngrnod) igrnod,
integer icount,
integer flag,
integer iter,
character elkey,
type(submodel_data), dimension(nsubmod) lsubmodel )

Definition at line 37 of file hm_grogronod.F.

39!---
40! group of groups of 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 loop over the groups
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 IF (flag == 0 .AND. 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 has an initialized group
140 IF (nontri == 0) THEN
141C sorted group, tag the nodes
142 DO l=1,igrnod(igrs)%NENTITY
143 IF (jj < 0) THEN
144C remove nodes from the group if j10 < 0
145 buftmp(igrnod(igrs)%ENTITY(l))=-1
146 ELSEIF (buftmp(igrnod(igrs)%ENTITY(l)) == 0) THEN
147 buftmp(igrnod(igrs)%ENTITY(l))=1
148 ENDIF
149 ENDDO
150 ELSE
151c non sorted group
152 nel = nel + igrnod(igrs)%NENTITY
153 ENDIF
154 ENDIF ! IF (IGRS == 0)
155 ENDIF ! IF (J10(J) /= 0)
156 ENDDO ! DO J=1,10
157 IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)
158 ENDIF ! IF (SKIPFLAG == 0)
159C-----
160 IF (skipflag == 0) THEN
161 IF (nontri == 0 ) THEN
162C sorted group
163 DO j=1,numnod
164 IF (buftmp(j) > 0) nel=nel+1
165 ENDDO
166 ENDIF
167C
168 igrnod(igs)%NENTITY = nel
169 CALL my_alloc(igrnod(igs)%ENTITY,nel)
170 igrnod(igs)%ENTITY = 0
171 ENDIF ! IF (SKIPFLAG == 0)
172C-----------
173 ELSEIF (flag == 1 .AND. igrnod(igs)%LEVEL == 0 .AND.
174 . igrnod(igs)%NENTITY > -1) THEN
175c
176 CALL groups_get_elem_list(list_entity, nentity, lsubmodel)
177 DO kk=1,nentity
178 jj = list_entity(kk)
179 IF (jj /= 0) THEN
180 igrs=0
181 DO k=1,ngrnod
182 IF (iabs(jj) == igrnod(k)%ID) THEN
183 igrs=k
184 EXIT
185 ENDIF
186 ENDDO
187 IF (igrs == 0) THEN
188 ELSEIF (igrnod(igrs)%NENTITY == -1) THEN
189 cycle
190 ELSE
191 IF (nontri == 0) THEN
192C tag the nodes
193 DO l=1,igrnod(igrs)%NENTITY
194 IF (jj < 0) THEN
195C remove nodes from the group if j10 < 0
196 buftmp(igrnod(igrs)%ENTITY(l))=-1
197 ELSEIF (buftmp(igrnod(igrs)%ENTITY(l)) == 0) THEN
198 buftmp(igrnod(igrs)%ENTITY(l))=1
199 ENDIF
200 ENDDO
201 ELSE
202 DO l=1,igrnod(igrs)%NENTITY
203 nn = nn + 1
204 igrnod(igs)%ENTITY(nn) = igrnod(igrs)%ENTITY(l)
205 ENDDO
206 ENDIF ! IF (NONTRI == 0)
207 ENDIF ! IF (IGRS == 0)
208 ENDIF ! IF (J10(J) /= 0)
209 ENDDO ! DO J=1,10
210 IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)
211C-----
212 IF (nontri == 0) THEN
213c sorted group
214 DO j=1,numnod
215 IF (buftmp(j) > 0) THEN
216 nn = nn + 1
217 igrnod(igs)%ENTITY(nn)=j
218 ENDIF
219 ENDDO
220 ENDIF ! IF (NONTRI == 0)
221 igrnod(igs)%LEVEL = 1
222C----------- end_ flag = 1
223 ENDIF ! IF (FLAG == 0 .AND. IGRNOD(IGS)%NENTITY == -1)
224 ENDIF ! IF (IGRNOD(IGS)%GRPGRP == 2)
225 ENDDO ! DO I=1,NLINE(KCUR)
226C-----------
227 DEALLOCATE(buftmp)
228 RETURN
229 900 CALL ancmsg(msgid=176,
230 . msgtype=msgerror,
231 . anmode=aninfo,
232 . i1=id,
233 . c1=titr,
234 . i2=igrnod(igs)%ID,
235 . c2=elkey)
236C-----------
237 RETURN
groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
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:895