OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_xelem.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "scr17_c.inc"
#include "scr23_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_xelem (igrnod, itab, itabm1, ipart, ipartx, ipm, igeo, kxx, ixx, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_xelem()

subroutine hm_read_xelem ( type(group_), dimension(ngrnod), intent(in) igrnod,
integer, dimension(*), intent(in) itab,
integer, dimension(*), intent(in) itabm1,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(*), intent(out) ipartx,
integer, dimension(npropmi,*), intent(in) ipm,
integer, dimension(npropgi,*), intent(in) igeo,
integer, dimension(nixx,*), intent(out) kxx,
integer, dimension(*), intent(out) ixx,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 36 of file hm_read_xelem.F.

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,ID,IDS,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 Recherche des ID doubles
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
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
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
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:303
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589