OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_elngr.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_elngr ../starter/source/groups/hm_elngr.f
25!||--- called by ------------------------------------------------------
26!|| hm_lecgrn ../starter/source/groups/hm_lecgrn.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!||--- uses -----------------------------------------------------
32!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_elngr(IX ,NIX ,NIX1 ,NIX2 ,NGRELE ,
37 . ELCHAR ,ID ,IGRELEM ,TAGBUF ,TITR ,
38 . FLAG ,LSUBMODEL)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE groupdef_mod
44 USE submodel_mod
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
99 END
100!||====================================================================
101!|| hm_elngrs ../starter/source/groups/hm_elngr.F
102!||--- called by ------------------------------------------------------
103!|| hm_lecgrn ../starter/source/groups/hm_lecgrn.F
104!||--- calls -----------------------------------------------------
105!|| ancmsg ../starter/source/output/message/message.F
106!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
107!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
108!||--- uses -----------------------------------------------------
109!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
110!|| message_mod ../starter/share/message_module/message_mod.F
111!|| submodel_mod ../starter/share/modules1/submodel_mod.F
112!||====================================================================
113 SUBROUTINE hm_elngrs(IXS ,IXS10 ,IXS20 ,IXS16 ,NGRELE ,
114 . ELCHAR ,ID ,IGRELEM ,TAGBUF ,TITR ,
115 . FLAG ,LSUBMODEL)
116C-----------------------------------------------
117C M o d u l e s
118C-----------------------------------------------
119 USE message_mod
120 USE groupdef_mod
121 USE submodel_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
210 END
subroutine hm_elngr(ix, nix, nix1, nix2, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngr.F:39
subroutine hm_elngrs(ixs, ixs10, ixs20, ixs16, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngr.F:116
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
integer, parameter nchartitle
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
program starter
Definition starter.F:39