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 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 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 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 ELSEIF (flag == 1 .AND. igrnod(igs)%LEVEL == 0 .AND.
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 ENDIF ! IF (FLAG == 0 .AND. 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
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:251
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