OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_xelem.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_read_xelem ../starter/source/elements/reader/hm_read_xelem.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.f
29!|| anodset ../starter/source/output/analyse/analyse_node.c
30!|| nodgrnr5 ../starter/source/starter/freform.F
31!|| udouble ../starter/source/system/sysfus.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_read_xelem(IGRNOD ,ITAB ,ITABM1,IPART,IPARTX,
37 . IPM,IGEO ,KXX ,IXX, LSUBMODEL)
38C-----------------------------------------------
39C ROUTINE DESCRIPTION :
40C ===================
41C READ /XELEM ELEMENTS USING HM_READER
42C-----------------------------------------------
43C DUMMY ARGUMENTS DESCRIPTION:
44C ===================
45C
46C NAME DESCRIPTION
47C
48C IGRNOD NODE GROUP ARRAY
49C ITAB USER ID OF NODES
50C ITABM1 REVERSE TAB ITAB
51C IPART PART ARRAY
52C IPARTX INTERNAL PART ID OF A GIVEN XELEM ELEMENT
53C IPM MAT ARRAY (INTEGER)
54C IGEO PROP ARRAY (INTEGER)
55C KXX XELEM CONNECTIVITY NODES
56C IXX XELEM ARRAY (INTEGER)
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE message_mod
62 USE submodel_mod
63 USE groupdef_mod
64C----------------------------------------------------------
65C XELEM ELEMENT READ
66C----------------------------------------------------------
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C A n a l y s e M o d u l e
73C-----------------------------------------------
74#include "analyse_name.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "scr17_c.inc"
79#include "scr23_c.inc"
80#include "com04_c.inc"
81#include "units_c.inc"
82#include "param_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86C INPUT ARGUMENTS
87 TYPE(group_),INTENT(IN)::IGRNOD(NGRNOD)
88 INTEGER,INTENT(IN)::ITAB(*)
89 INTEGER,INTENT(IN)::ITABM1(*)
90 INTEGER,INTENT(IN)::IPART(LIPART1,*)
91 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
92 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
93 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
94C OUTPUT ARGUMENTS
95 INTEGER,INTENT(OUT)::KXX(NIXX,*)
96 INTEGER,INTENT(OUT)::IXX(*)
97 INTEGER,INTENT(OUT)::IPARTX(*)
98C-----------------------------------------------
99C L o c a l V a r i a b l e s
100C-----------------------------------------------
101 INTEGER I, I1, I2,PID,N,J,STAT,MID,IAD,NNOD,IGS
102 INTEGER INDEX_PART
103 INTEGER TABIDS(NUMELX)
104 CHARACTER MESS*40
105 my_real
106 . bid
107 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_XELEM,IDEX,IDGU
108C-----------------------------------------------
109C E x t e r n a l F u n c t i o n s
110C-----------------------------------------------
111 INTEGER NODGRNR5
112 DATA mess /'MULTI-PURPOSE ELEMENTS DEFINITION '/
113C=======================================================================
114C--------------------------------------------------
115C ALLOCS & INITS
116C--------------------------------------------------
117 ALLOCATE (sub_xelem(numelx),stat=stat)
118 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
119 . msgtype=msgerror,
120 . c1='SUB_XELEM')
121 sub_xelem(1:numelx) = 0
122 ALLOCATE (idex(numelx),stat=stat)
123 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
124 . msgtype=msgerror,
125 . c1='IDEX')
126 idex(1:numelx) = 0
127 ALLOCATE (idgu(numelx),stat=stat)
128 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
129 . msgtype=msgerror,
130 . c1='IDGU')
131 idgu(1:numelx) = 0
132 index_part = 1
133C--------------------------------------------------
134C READING SPRING INPUTS IN HM STRUCTURE
135C--------------------------------------------------
136 CALL cpp_xelem_read(idex,idgu,ipartx,sub_xelem)
137
138 iad =1
139 DO n=1,numelx
140
141C--------------------------------------------------
142C INTERNAL PART ID
143C--------------------------------------------------
144 IF( ipart(4,index_part) /= ipartx(n) )THEN
145 DO j=1,npart
146 IF(ipart(4,j)== ipartx(n) ) index_part = j
147 ENDDO
148 ENDIF
149 IF(ipart(4,index_part) /= ipartx(n)) THEN
150 CALL ancmsg(msgid=402,
151 . msgtype=msgerror,
152 . anmode=aninfo_blind_1,
153 . c1='XELEM',
154 . i1=ipartx(n),
155 . i2=ipartx(n),
156 . prmod=msg_cumu)
157 ENDIF
158 ipartx(n) = index_part
159
160
161 kxx(1,n) =ipart(1,index_part)
162 kxx(2,n) =ipart(2,index_part)
163 kxx(4,n) =iad
164C
165 kxx(5,n)=idex(n)
166C
167 nnod = nodgrnr5(idgu(n) ,igs ,ixx(iad),igrnod ,
168 . itabm1 ,mess )
169C check non sorted nodes group type.
170 IF (igs/=0.AND.igrnod(igs)%SORTED/=1) THEN
171 CALL ancmsg(msgid=411,
172 . msgtype=msgerror,
173 . anmode=aninfo_blind_1,
174 . i1=kxx(5,n),
175 . i2=igrnod(igs)%ID)
176 ENDIF
177 IF (nnod < 1) THEN
178 CALL ancmsg(msgid=412,
179 . msgtype=msgerror,
180 . anmode=aninfo_blind_1,
181 . i1=kxx(5,n),
182 . i2=nnod)
183 ENDIF
184C
185 CALL anodset(ixx(iad), check_2n)
186 CALL anodset(ixx(iad+nnod-1), check_2n)
187 DO 10 i=2,nnod-2
188 CALL anodset(ixx(iad+i), check_used)
189 10 CONTINUE
190 kxx(3,n)=nnod
191 IF (nnod>maxnx) maxnx=nnod
192 isumnx =isumnx+nnod
193C
194 iad =iad+nnod
195 ENDDO
196C-----------
197 CALL ancmsg(msgid=402,
198 . msgtype=msgerror,
199 . anmode=aninfo_blind_1,
200 . prmod=msg_print)
201C-------------------------------------
202C Search for double IDs
203C-------------------------------------
204 DO i=1,numelx
205 tabids(i)= kxx(nixx,i)
206 ENDDO
207 CALL udouble(tabids,1,numelx,mess,0,bid)
208C-------------------------------------
209C Print
210C-------------------------------------
211 i1=1
212 i2=min0(50,numelx)
213C
214 90 WRITE (iout,300)
215 DO 100 i=i1,i2
216 mid=ipm(1,kxx(1,i))
217 pid=igeo(1,kxx(2,i))
218 WRITE (iout,'(4(I10,1X))') i,kxx(nixx,i),mid,pid
219 WRITE (iout,'(10(I10,1X))')
220 . (itab(ixx(iad)),iad=kxx(4,i),kxx(4,i)+kxx(3,i)-1)
221 WRITE (iout,'(A)') 'END OF ELEMENT TRACEBACK'
222c call flush(IOUT)
223 100 CONTINUE
224 IF(i2==numelx)GOTO 200
225 i1=i1+50
226 i2=min0(i2+50,numelx)
227 GOTO 90
228C
229 200 CONTINUE
230C
231 300 FORMAT(/' MULTI-PURPOSE ELEMENTS'/
232 + ' ----------------------'/
233 + ' LOC-EL GLO-EL MATER GEOM'/
234 + ' NODES LIST')
235 RETURN
236 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_xelem
subroutine hm_read_xelem(igrnod, itab, itabm1, ipart, ipartx, ipm, igeo, kxx, ixx, lsubmodel)
Definition hm_read_xelem.F:38
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
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
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573
starter
program starter
Definition starter.F:39
groupdef_mod::group_
Definition groupdef_mod.F:706
submodel_mod::submodel_data
Definition submodel_mod.F:728