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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_elngr (ix, nix, nix1, nix2, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
subroutine hm_elngrs (ixs, ixs10, ixs20, ixs16, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)

Function/Subroutine Documentation

◆ hm_elngr()

subroutine hm_elngr ( integer, dimension(nix,*) ix,
integer nix,
integer nix1,
integer nix2,
integer ngrele,
character, dimension(*) elchar,
integer id,
type (group_), dimension(ngrele) igrelem,
integer, dimension(*) tagbuf,
character(len=nchartitle) titr,
integer flag,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 36 of file hm_elngr.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE groupdef_mod
44 USE submodel_mod
45 USE hm_option_read_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER IX(NIX,*),TAGBUF(*)
58 INTEGER NIX,NIX1,NIX2,NGRELE,ID,FLAG
59 CHARACTER ELCHAR*(*)
60 CHARACTER(LEN=NCHARTITLE) :: TITR
61 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
62C-----------------------------------------------
63 TYPE (GROUP_) , DIMENSION(NGRELE) :: IGRELEM
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER L, IE, K, ISU, KK, JJ, NEMAX
68 LOGICAL IS_AVAILABLE
69C=======================================================================
70 is_available = .false.
71 CALL hm_get_intv('idsmax' ,nemax,is_available,lsubmodel)
72 DO kk = 1,nemax
73 CALL hm_get_int_array_index ('ids',jj ,kk,is_available,lsubmodel)
74 IF (jj /= 0) THEN
75 isu=0
76 DO k=1,ngrele
77 IF(jj == igrelem(k)%ID) isu=k
78 ENDDO
79 IF (isu /= 0) THEN
80 DO l=1,igrelem(isu)%NENTITY
81 ie=igrelem(isu)%ENTITY(l)
82 DO k=nix1,nix2
83C tag nodes connected to the element
84 tagbuf(ix(k,ie))=1
85 ENDDO
86 ENDDO
87 ELSEIF(flag==0)THEN
88 CALL ancmsg(msgid=172,
89 . msgtype=msgwarning,
90 . anmode=aninfo,
91 . i1=id,c1=titr,
92 . c2=elchar,
93 . i2=jj)
94 ENDIF
95 ENDIF
96 ENDDO
97C-----------
98 RETURN
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
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
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

◆ hm_elngrs()

subroutine hm_elngrs ( integer, dimension(nixs,*) ixs,
integer, dimension(nixs10,*) ixs10,
integer, dimension(nixs20,*) ixs20,
integer, dimension(nixs16,*) ixs16,
integer ngrele,
character, dimension(*) elchar,
integer id,
type (group_), dimension(ngrele) igrelem,
integer, dimension(*) tagbuf,
character(len=nchartitle) titr,
integer flag,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 113 of file hm_elngr.F.

116C-----------------------------------------------
117C M o d u l e s
118C-----------------------------------------------
119 USE message_mod
120 USE groupdef_mod
121 USE submodel_mod
122 USE hm_option_read_mod
123 use element_mod , only : nixs, nixs10, nixs20, nixs16
124C-----------------------------------------------
125C I m p l i c i t T y p e s
126C-----------------------------------------------
127#include "implicit_f.inc"
128C-----------------------------------------------
129C C o m m o n B l o c k s
130C-----------------------------------------------
131#include "com04_c.inc"
132C-----------------------------------------------
133C D u m m y A r g u m e n t s
134C-----------------------------------------------
135 INTEGER IXS(NIXS,*),IXS10(nixs10,*),IXS20(nixs20,*),IXS16(nixs16,*),
136 . TAGBUF(*)
137 INTEGER NGRELE,ID,FLAG
138 CHARACTER ELCHAR*(*)
139 CHARACTER(LEN=NCHARTITLE) :: TITR
140 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
141C-----------------------------------------------
142 TYPE (GROUP_) , DIMENSION(NGRELE) :: IGRELEM
143C-----------------------------------------------
144C L o c a l V a r i a b l e s
145C-----------------------------------------------
146 INTEGER I, L, IE, K, ISU, ITETRA10, JJ, NEMAX, KK
147 LOGICAL IS_AVAILABLE
148C=======================================================================
149 itetra10=0
150 CALL hm_get_intv('idsmax' ,nemax,is_available,lsubmodel)
151 DO kk = 1,nemax
152 CALL hm_get_int_array_index ('ids',jj ,kk,is_available,lsubmodel)
153 IF (jj /= 0) THEN
154 isu = 0
155 DO k = 1,ngrele
156 IF (jj == igrelem(k)%ID) THEN
157 isu = k
158 EXIT
159 ENDIF
160 ENDDO
161 IF (isu /= 0) THEN
162 DO l=1,igrelem(isu)%NENTITY
163 ie = igrelem(isu)%ENTITY(l)
164 DO k=2,9
165C tag nodes connected to the element
166 tagbuf(ixs(k,ie))=1
167 ENDDO
168 IF (ie > numels8 .AND. ie <= numels8+numels10) THEN
169 itetra10=itetra10+1
170 i = ie-numels8
171 DO k=1,6
172 tagbuf(ixs10(k,i))=1
173 ENDDO
174 ELSEIF (ie > numels8+numels10 .AND.
175 . ie <= numels8+numels10+numels20) THEN
176 i = ie-numels8-numels10
177 DO k=1,12
178 tagbuf(ixs20(k,i))=1
179 ENDDO
180 ELSEIF (ie > numels8+numels10+numels20 .AND.
181 . ie <= numels8+numels10+numels20+numels16) THEN
182 i = ie-numels8-numels10-numels20
183 DO k=1,8
184 tagbuf(ixs16(k,i))=1
185 ENDDO
186 ENDIF
187 ENDDO
188 ELSEIF(flag==0)THEN
189 CALL ancmsg(msgid=172,
190 . msgtype=msgwarning,
191 . anmode=aninfo,
192 . i1=id,c1=titr,
193 . c2=elchar,
194 . i2=jj)
195 ENDIF
196 ENDIF
197 ENDDO
198C-----------
199 IF (itetra10 /= 0)THEN
200 CALL ancmsg(msgid=500,
201 . msgtype=msgwarning,
202 . anmode=aninfo_blind_1,
203 . c1='GRNOD',
204 . i1=id,
205 . c2='GRNOD',
206 . c3=titr)
207 ENDIF
208C-----------
209 RETURN