OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_elngr.F File Reference
#include "implicit_f.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 J,L,IE,IADV,JREC,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 les noeuds connectes a l'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:523
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
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

◆ hm_elngrs()

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