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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_tria (ixtg, itab, itabm1, ipart, iparttg, pm, geo, icnod, igeo, ipm, unitab, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_tria()

subroutine hm_read_tria ( integer, dimension(nixtg,*), intent(out) ixtg,
integer, dimension(*), intent(in) itab,
integer, dimension(*), intent(in) itabm1,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(*), intent(out) iparttg,
dimension(npropm,*), intent(in) pm,
dimension(npropg,*), intent(in) geo,
integer, dimension(*), intent(out) icnod,
integer, dimension(npropgi,numgeo), intent(in) igeo,
integer, dimension(npropmi,*), intent(in) ipm,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 37 of file hm_read_tria.F.

40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C READ /TRIA ELEMENTS USING HM_READER
44C-----------------------------------------------
45C DUMMY ARGUMENTS DESCRIPTION:
46C ===================
47C
48C NAME DESCRIPTION
49C
50C IXTG /TRIA ARRAY : CONNECTIVITY, ID, MID PID
51C ITAB USER ID OF NODES
52C ITABM1 REVERSE TAB ITAB
53C IPART PART ARRAY
54C IPARTTG INTERNAL PART ID OF A GIVEN TRIA (INTERNAL ID)
55C PM MATERIAL ARRAY
56C GEO PROP ARRAY (REAL)
57C ICNOD FLAG FOR TRIA WITH ISH3N = 31
58C IGEO PROP ARRAY (INTEGER)
59C IPM MATERIAL ARRAY (INTEGER)
60C UNITAB UNIT ARRAY
61C LSUBMODEL SUBMODEL STRUCTURE
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE unitab_mod
66 USE message_mod
67 USE submodel_mod , ONLY : submodel_data
68 USE reader_old_mod , ONLY : line
69 USE user_id_mod , ONLY : id_limit
70 use element_mod , only : nixtg
71C--------------------------------------------------------
72C READING DES ELEMENTS 2D TRIANGULAIRES
73C--------------------------------------------------------
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C A n a l y s e M o d u l e
80C-----------------------------------------------
81#include "analyse_name.inc"
82C-----------------------------------------------
83C C o m m o n B l o c k s
84C-----------------------------------------------
85#include "com04_c.inc"
86#include "units_c.inc"
87#include "scr03_c.inc"
88#include "scr17_c.inc"
89#include "param_c.inc"
90#include "remesh_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94C INPUT ARGUMENTS
95 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
96 INTEGER,INTENT(IN)::ITAB(*)
97 INTEGER,INTENT(IN)::ITABM1(*)
98 INTEGER,INTENT(IN)::IPART(LIPART1,*)
99 INTEGER,INTENT(IN)::IGEO(NPROPGI,NUMGEO)
100 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
101 my_real,
102 . INTENT(IN)::geo(npropg,*)
103 my_real,
104 . INTENT(IN)::pm(npropm,*)
105 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
106C OUTPUT ARGUMENTS
107 INTEGER,INTENT(OUT)::IXTG(NIXTG,*)
108 INTEGER,INTENT(OUT)::IPARTTG(*)
109 INTEGER,INTENT(OUT)::ICNOD(*)
110C-----------------------------------------------
111C L o c a l V a r i a b l e s
112C-----------------------------------------------
113 my_real
114 . bid,fac_l
115 INTEGER I, J, I1, I2, ID,IDS,IPID,MT,N,MID,PID,UID,STAT,IPARTTG_TMP
116 INTEGER INDEX_PART
117 CHARACTER*40 MESS
118 DATA mess /'2D TRIANGULAR ELEMENT DEFINITION '/
119 INTEGER ISH3N,KK,IFLAGUNIT
120 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_TRIA,UID_TRIA,TMP_IPARTTG
121 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TMP_IXTG
122C-----------------------------------------------
123C FUNCTION
124C-----------------------------------------------
125 INTEGER USR2SYS
126C=======================================================================
127C--------------------------------------------------
128C ALLOCS & INITS
129c use NUMELTG0 IN PLACE OF NUMELTG ( NBADMESH routine is modifying NUMELTG )
130C--------------------------------------------------
131 ALLOCATE (sub_tria(numeltg0),stat=stat)
132 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
133 . msgtype=msgerror,
134 . c1='SUB_TRIA')
135 ALLOCATE (uid_tria(numeltg0),stat=stat)
136 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
137 . msgtype=msgerror,
138 . c1='UID_TRIA')
139 ALLOCATE (tmp_ixtg(nixtg,numeltg0),stat=stat)
140 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
141 . msgtype=msgerror,
142 . c1='TMP_IXTG')
143 ALLOCATE (tmp_iparttg(numeltg0),stat=stat)
144 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
145 . msgtype=msgerror,
146 . c1='tmp_iparttg')
147 SUB_TRIA(1:NUMELTG0) = 0
148 UID_TRIA(1:NUMELTG0) = 0
149 TMP_IXTG(1:NIXTG,1:NUMELTG0) = 0
150 TMP_IPARTTG(1:NUMELTG0) = 0
151 INDEX_PART = 1
152 UID = -1
153 KK=3
154 I = 0
155C--------------------------------------------------
156C READING TRIAS INPUTS IN HM STRUCTURE
157C--------------------------------------------------
158 CALL CPP_TRIA_READ(TMP_IXTG,NIXTG,TMP_IPARTTG,SUB_TRIA,UID_TRIA)
159C--------------------------------------------------
160C FILL OTHER STRUCTURES + CHECKS
161C--------------------------------------------------
162 NUMELTG6 = 0
163 DO WHILE (KK <= 6)
164 DO N=1,NUMELTG0
165 IPARTTG_TMP = TMP_IPARTTG(N)
166
167 IF( IPART(4,INDEX_PART) /= IPARTTG_TMP)THEN
168 DO J=1,NPART
169 IF(IPART(4,J)== IPARTTG_TMP )INDEX_PART = J
170 ENDDO
171 ENDIF
172 ISH3N = IGEO(18,IPART(2,INDEX_PART))
173.AND. IF(KK == 6 ISH3N==31) NUMELTG6 = NUMELTG6 + 1
174
175.AND..OR..AND. IF((KK==3ISH3N/=31)(KK==6ISH3N==31))THEN
176 I = I + 1
177 ICNOD(I)=KK
178 DO J=1,NIXTG
179 IXTG(J,I) = TMP_IXTG(J,N)
180 ENDDO
181 IPARTTG(I) = TMP_IPARTTG(N)
182C--------------------------------------------------
183 IF(SUB_TRIA(N) /= 0)THEN
184.AND. IF(UID_TRIA(N) == 0 LSUBMODEL(SUB_TRIA(N))%UID /= 0)
185 . UID_TRIA(N) = LSUBMODEL(SUB_TRIA(N))%UID
186 ENDIF
187C--------------------------------------------------
188C UNITS
189C--------------------------------------------------
190 IF(UID_TRIA(N) /= UID )THEN
191 UID = UID_TRIA(N)
192 IFLAGUNIT = 0
193 DO J=1,UNITAB%NUNITS
194 IF (UNITAB%UNIT_ID(J) == UID) THEN
195 FAC_L = UNITAB%FAC_L(J)
196 IFLAGUNIT = 1
197 ENDIF
198 ENDDO
199.AND. IF (UID/=0IFLAGUNIT==0) THEN
200 CALL ANCMSG(MSGID=643,ANMODE=ANINFO,MSGTYPE=MSGERROR,
201 . I1=UID,C1='/tria')
202 ENDIF
203 ENDIF
204C--------------------------------------------------
205C INTERNAL PART ID
206C--------------------------------------------------
207 IF( IPART(4,INDEX_PART) /= IPARTTG(I) )THEN
208 DO J=1,NPART
209 IF(IPART(4,J)== IPARTTG(I) ) INDEX_PART = J
210 ENDDO
211 ENDIF
212 IF( IPART(4,INDEX_PART) /= IPARTTG(I) ) THEN
213 CALL ANCMSG(MSGID=402,
214 . MSGTYPE=MSGERROR,
215 . ANMODE=ANINFO_BLIND_1,
216 . C1="TRIA",
217 . I1=IPARTTG(I),
218 . I2=IPARTTG(I),
219 . PRMOD=MSG_CUMU)
220 ENDIF
221 IPARTTG(I) = INDEX_PART
222C--------------------------------------------------
223 MT=IPART(1,INDEX_PART)
224 IPID=IPART(2,INDEX_PART)
225 IXTG(1,I)=MT
226 IXTG(5,I)=IPID
227 IF (IXTG(NIXTG,I)>ID_LIMIT%GLOBAL)THEN
228 CALL ANCMSG(MSGID=509,ANMODE=ANINFO,MSGTYPE=MSGERROR,
229 . I1=IXTG(NIXTG,I),C1=LINE,C2='/tria')
230.AND. ELSEIF (NADMESH/=0IXTG(NIXTG,I)>ID_LIMIT%ADMESH)THEN
231 CALL ANCMSG(MSGID=1069,ANMODE=ANINFO,MSGTYPE=MSGERROR,
232 . I1=IXTG(NIXTG,I),C1=LINE,C2='/tria')
233 ENDIF
234
235 DO J=2,4
236 IXTG(J,I)=USR2SYS(IXTG(J,I),ITABM1,MESS,ID)
237 CALL ANODSET(IXTG(J,I), CHECK_SHELL)
238 ENDDO
239 ENDIF
240 IF (I == NUMELTG0) KK = 7
241 ENDDO
242 IF (I < NUMELTG0) THEN
243 KK = 6
244 ELSE
245c exit from DOWHILE (kk <=6)
246 KK = 7
247 ENDIF
248 ENDDO
249 IF(ALLOCATED(SUB_TRIA)) DEALLOCATE(SUB_TRIA)
250 IF(ALLOCATED(UID_TRIA)) DEALLOCATE(UID_TRIA)
251
252 IF(ALLOCATED(TMP_IXTG)) DEALLOCATE(TMP_IXTG)
253 IF(ALLOCATED(TMP_IPARTTG)) DEALLOCATE(TMP_IPARTTG)
254C
255 I1=1
256 I2=MIN0(50,NUMELTG0)
257C
258 IF(IPRI>=5)THEN
259 90 WRITE (IOUT,'(//a/a//a/)')' 2d triangular elements ',
260 & ' element internal mater prset node1 node2 node3'
261 DO I=I1,I2
262 MID = IPM (1,IXTG(1,I))
263 PID = IGEO(1,IXTG(5,I))
264 WRITE (IOUT,'(7(i10,1x))') IXTG(NIXTG,I),I,MID,PID,
265 . (ITAB(IXTG(J,I)),J=2,4)
266 ENDDO
267 IF(I2==NUMELTG0)GOTO 200
268 I1=I1+50
269 I2=MIN0(I2+50,NUMELTG0)
270 GOTO 90
271 ENDIF
272C
273 200 CONTINUE
274C-----------
275 CALL ANCMSG(MSGID=402,
276 . MSGTYPE=MSGERROR,
277 . ANMODE=ANINFO_BLIND_1,
278 . PRMOD=MSG_PRINT)
279C-------------------------------------
280C Search for double IDs
281C-------------------------------------
282 IDS = 79
283 I = 0
284 J = 0
285c
286 CALL VDOUBLE(IXTG(NIXTG,1),NIXTG,NUMELTG0,MESS,0,BID)
287c CALL ANCNTG(IDS,I,J)
288 IDS = 44
289c CALL ANCHECK(IDS)
290C
291 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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
submodel_mod::submodel_data
Definition submodel_mod.F:728