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

Go to the source code of this file.

Functions/Subroutines

subroutine state_admesh (ipart, ipartc, iparttg, ixc, ixtg, sh4tree, sh3tree, sh4trim, sh3trim, lsubmodel)

Function/Subroutine Documentation

◆ state_admesh()

subroutine state_admesh ( integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
integer, dimension(*) sh4trim,
integer, dimension(*) sh3trim,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 39 of file state_admesh.F.

41C----------------------------------------------------------
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE hm_option_read_mod
47 USE submodel_mod
48 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
49 use element_mod , only : nixc,nixtg
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "param_c.inc"
58#include "com04_c.inc"
59#include "scr17_c.inc"
60#include "remesh_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IPART(LIPART1,*), IPARTC(*), IPARTTG(*),
65 . IXC(NIXC,*), IXTG(NIXTG,*),
66 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
67 . SH4TRIM(*), SH3TRIM(*)
68 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER ID,ID1,ID2,ID3,ID4,II,I1,I2,I3,I4,NLIST,N,LEVEL,NN,
73 . ITRIM,I
74 INTEGER IERROR, NINTLST2,ERRORADJ,NSHELL,NSH3N
75 INTEGER, DIMENSION(:),ALLOCATABLE :: LIST,INDEXL
76 INTEGER IX1(MAX(NUMELC,NUMELTG)),
77 . IX2(MAX(NUMELC,NUMELTG)),
78 . INDEX(2*MAX(NUMELC,NUMELTG))
79 CHARACTER MESS*40
80 CHARACTER(LEN=NCHARTITLE) :: TITR
81 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
82 LOGICAL IS_AVAILABLE
83C-----------------------------------------------
84 DATA mess /'ADAPTIVE MESHING STATE DEFINITION '/
85C-----------------------------------------------
86 nlist =0
87
88C-------------------------------------------------------------
89C READING /ADMESH/STATE/SHELL : 4-NODE SHELLS => Counting
90C------------------------------------------------------------
91C
92 CALL hm_option_start('/admesh/state')
93C
94 DO N =1,NADMESHSTAT
95 TITR = ''
96C
97 CALL HM_OPTION_READ_KEY(LSUBMODEL,
98 . OPTION_TITR = TITR,
99 . KEYWORD2 = KEY,
100 . KEYWORD3 = KEY2)
101
102 IF(KEY2(1:LEN_TRIM(KEY2))=='shell')THEN
103
104C
105 IS_AVAILABLE = .FALSE.
106C
107C--------* EXTRACT DATAS (INTEGER VALUES) *------
108C
109 CALL HM_GET_INTV('nshell',NSHELL,IS_AVAILABLE,LSUBMODEL)
110 NLIST = NLIST + NSHELL
111C
112 ENDIF
113
114 ENDDO
115C------
116 ALLOCATE(LIST (5*NLIST),STAT=IERROR)
117 IF(IERROR/=0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
118 . MSGTYPE=MSGERROR,
119 . C1='list')
120 ALLOCATE(INDEXL(10*NLIST),STAT=IERROR)
121 IF(IERROR/=0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
122 . MSGTYPE=MSGERROR,
123 . C1='indexl')
124
125 NLIST=0
126
127C-------------------------------------------------------------------------------
128C READING /ADMESH/STAT/SHELL : 4-NODE SHELLS => Storing and Tri( local Ids)
129C-------------------------------------------------------------------------------
130C
131 CALL HM_OPTION_START('/admesh/state')
132
133 DO N =1,NADMESHSTAT
134 TITR = ''
135
136 CALL HM_OPTION_READ_KEY(LSUBMODEL,
137 . OPTION_TITR = TITR,
138 . KEYWORD2 = KEY,
139 . KEYWORD3 = KEY2)
140
141 IF(KEY2(1:LEN_TRIM(KEY2))=='shell')THEN
142
143C
144 IS_AVAILABLE = .FALSE.
145C
146C--------* EXTRACT DATAS (INTEGER VALUES) *------
147C
148 CALL HM_GET_INTV('nshell',NSHELL,IS_AVAILABLE,LSUBMODEL)
149
150 DO I=1,NSHELL
151
152 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID,I,IS_AVAILABLE,LSUBMODEL)
153 CALL HM_GET_INT_ARRAY_INDEX('shell_id1',ID1,I,IS_AVAILABLE,LSUBMODEL)
154 CALL HM_GET_INT_ARRAY_INDEX('shell_id2',ID2,I,IS_AVAILABLE,LSUBMODEL)
155 CALL HM_GET_INT_ARRAY_INDEX('shell_id3',ID3,I,IS_AVAILABLE,LSUBMODEL)
156 CALL HM_GET_INT_ARRAY_INDEX('shell_id4',ID4,I,IS_AVAILABLE,LSUBMODEL)
157
158 NLIST=NLIST+1
159 LIST(NLIST)=ID
160 NLIST=NLIST+1
161 LIST(NLIST)=ID1
162 NLIST=NLIST+1
163 LIST(NLIST)=ID2
164 NLIST=NLIST+1
165 LIST(NLIST)=ID3
166 NLIST=NLIST+1
167 LIST(NLIST)=ID4
168C
169 ENDDO
170 ENDIF
171 ENDDO
172
173 NN=NINTLST2(LIST,NLIST,INDEXL,IXC,NIXC,NUMELC,
174 . MESS,IX1,IX2,INDEX,0)
175
176 NLIST=0
177
178C---------------------------------------------------------------------
179C READING /ADMESH/STAT/SHELL : 4-NODE SHELLS => Storing in SH4TREE
180C---------------------------------------------------------------------
181
182C
183 CALL HM_OPTION_START('/admesh/state')
184
185 DO N =1,NADMESHSTAT
186 TITR = ''
187
188 CALL HM_OPTION_READ_KEY(LSUBMODEL,
189 . OPTION_TITR = TITR,
190 . KEYWORD2 = KEY,
191 . KEYWORD3 = KEY2)
192
193 IF(KEY2(1:LEN_TRIM(KEY2))=='shell')THEN
194
195C
196 IS_AVAILABLE = .FALSE.
197C
198C--------* EXTRACT DATAS (INTEGER VALUES) *------
199C
200 CALL HM_GET_INTV('nshell',NSHELL,IS_AVAILABLE,LSUBMODEL)
201
202 DO I=1,NSHELL
203
204
205 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID,I,IS_AVAILABLE,LSUBMODEL)
206 CALL HM_GET_INT_ARRAY_INDEX('shell_id1',ID1,I,IS_AVAILABLE,LSUBMODEL)
207 CALL HM_GET_INT_ARRAY_INDEX('shell_id2',ID2,I,IS_AVAILABLE,LSUBMODEL)
208 CALL HM_GET_INT_ARRAY_INDEX('shell_id3',ID3,I,IS_AVAILABLE,LSUBMODEL)
209 CALL HM_GET_INT_ARRAY_INDEX('shell_id4',ID4,I,IS_AVAILABLE,LSUBMODEL)
210 CALL HM_GET_INT_ARRAY_INDEX('actlev',LEVEL,I,IS_AVAILABLE,LSUBMODEL)
211 CALL HM_GET_INT_ARRAY_INDEX('imapping',ITRIM,I,IS_AVAILABLE,LSUBMODEL)
212
213 NLIST=NLIST+1
214 II=LIST(NLIST)
215 NLIST=NLIST+1
216 I1=LIST(NLIST)
217 NLIST=NLIST+1
218 I2=LIST(NLIST)
219 NLIST=NLIST+1
220 I3=LIST(NLIST)
221 NLIST=NLIST+1
222 I4=LIST(NLIST)
223.AND. IF(I1+I2+I3+I4 /=0
224.OR..OR. . (I2-I1/=1 I3-I1 /= 2 I4-I1 /= 3))THEN
225 CALL ANCMSG(MSGID=654,
226 . MSGTYPE=MSGERROR,
227 . ANMODE=ANINFO,
228 . I1=ID1,
229 . I2=ID2,
230 . I3=ID3,
231 . I4=ID4,
232 . I5=ID)
233 END IF
234C
235 IF(I1+I2+I3+I4 /=0) THEN
236 ERRORADJ =0
237.OR. IF(IXC(2,II) /= IXC(2,I1)IXC(3,II) /= IXC(3,I2)
238.OR..OR. . IXC(4,II) /= IXC(4,I3)IXC(5,II) /= IXC(5,I4)) THEN
239 ERRORADJ =1
240.OR. ELSEIF(IXC(4,I1) /= IXC(5,I2)IXC(5,I2) /= IXC(2,I3)
241.OR..OR. . IXC(2,I3) /= IXC(3,I4)IXC(4,I1) /= IXC(3,I4)) THEN
242 ERRORADJ =1
243.OR. ELSEIF(IXC(3,I1) /= IXC(2,I2)IXC(4,I2) /= IXC(3,I3)
244.OR..OR. . IXC(5,I3) /= IXC(4,I4)IXC(5,I1) /= IXC(2,I4)) THEN
245 ERRORADJ =1
246 ENDIF
247 ENDIF
248.AND. IF(ERRORADJ ==1ABS(LEVEL)<LEVELMAX) THEN
249 CALL ANCMSG(MSGID=1023,
250 . MSGTYPE=MSGERROR,
251 . ANMODE=ANINFO,
252 . I1=ID1,
253 . I2=ID2,
254 . I3=ID3,
255 . I4=ID4,
256 . I5=ID)
257 END IF
258C
259.OR. IF(LEVEL<-LEVELMAX-1LEVEL>LEVELMAX)THEN
260 CALL ANCMSG(MSGID=656,
261 . MSGTYPE=MSGERROR,
262 . ANMODE=ANINFO,
263 . I1=ID)
264 END IF
265 SH4TREE(2,II)=I1
266 SH4TREE(3,II)=LEVEL
267 IF(I1/=0)THEN
268 SH4TREE(1,I1)=II
269 SH4TREE(1,I2)=II
270 SH4TREE(1,I3)=II
271 SH4TREE(1,I4)=II
272 END IF
273 SH4TRIM(II)=ITRIM
274C
275 ENDDO
276 ENDIF
277 ENDDO
278
279 DEALLOCATE(LIST)
280 DEALLOCATE(INDEXL)
281
282C-----------------------------------------------
283C 3-NODE SHELLS
284C-----------------------------------------------
285 NLIST=0
286
287C-----------------------------------------------------------
288C READING /ADMESH/STAT/SH3N : 3-NODE SHELLS => Counting
289C----------------------------------------------------------
290
291 CALL HM_OPTION_START('/admesh/state')
292
293 DO N =1,NADMESHSTAT
294 TITR = ''
295
296 CALL HM_OPTION_READ_KEY(LSUBMODEL,
297 . OPTION_TITR = TITR,
298 . KEYWORD2 = KEY,
299 . KEYWORD3 = KEY2)
300
301 IF(KEY2(1:LEN_TRIM(KEY2))=='sh3n')THEN
302
303C
304 IS_AVAILABLE = .FALSE.
305C
306C--------* EXTRACT DATAS (INTEGER VALUES) *------
307C
308 CALL HM_GET_INTV('nsh3n',NSH3N,IS_AVAILABLE,LSUBMODEL)
309 NLIST = NLIST + NSH3N
310C
311
312 ENDIF
313
314 ENDDO
315
316C------
317 ALLOCATE(LIST(5*NLIST),STAT=IERROR)
318 IF(IERROR/=0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
319 . MSGTYPE=MSGERROR,
320 . C1='list')
321 ALLOCATE(INDEXL(10*NLIST),STAT=IERROR)
322 IF(IERROR/=0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
323 . MSGTYPE=MSGERROR,
324 . C1='indexl')
325
326C---------
327
328 NLIST=0
329
330C------------------------------------------------------------------------------
331C READING /ADMESH/STAT/SH3N : 3-NODE SHELLS => Storing and Tri( local Ids)
332C------------------------------------------------------------------------------
333
334 CALL HM_OPTION_START('/admesh/state')
335
336 DO N =1,NADMESHSTAT
337 TITR = ''
338
339 CALL HM_OPTION_READ_KEY(LSUBMODEL,
340 . OPTION_TITR = TITR,
341 . KEYWORD2 = KEY,
342 . KEYWORD3 = KEY2)
343
344 IF(KEY2(1:LEN_TRIM(KEY2))=='sh3n')THEN
345C
346 IS_AVAILABLE = .FALSE.
347C
348C--------* EXTRACT DATAS (INTEGER VALUES) *------
349C
350 CALL HM_GET_INTV('nsh3n',NSH3N,IS_AVAILABLE,LSUBMODEL)
351
352 DO I=1,NSH3N
353
354 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id',ID,I,IS_AVAILABLE,LSUBMODEL)
355 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id1',ID1,I,IS_AVAILABLE,LSUBMODEL)
356 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id2',ID2,I,IS_AVAILABLE,LSUBMODEL)
357 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id3',ID3,I,IS_AVAILABLE,LSUBMODEL)
358 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id4',ID4,I,IS_AVAILABLE,LSUBMODEL)
359
360 NLIST=NLIST+1
361 LIST(NLIST)=ID
362 NLIST=NLIST+1
363 LIST(NLIST)=ID1
364 NLIST=NLIST+1
365 LIST(NLIST)=ID2
366 NLIST=NLIST+1
367 LIST(NLIST)=ID3
368 NLIST=NLIST+1
369 LIST(NLIST)=ID4
370 ENDDO
371C
372
373 ENDIF
374
375 ENDDO
376
377 NN=NINTLST2(LIST,NLIST,INDEXL,IXTG,NIXTG,NUMELTG,
378 . MESS,IX1,IX2,INDEX,0)
379
380 NLIST=0
381C---------------------------------------------------------------------
382C READING /ADMESH/STAT/SH3N : 3-NODE SHELLS => Storing in SH3TREE
383C---------------------------------------------------------------------
384
385 CALL HM_OPTION_START('/admesh/state')
386
387 DO N =1,NADMESHSTAT
388 TITR = ''
389C
390C--------* EXTRACT DATAS OF /ADMESH/... LINE *------
391C
392 CALL HM_OPTION_READ_KEY(LSUBMODEL,
393 . OPTION_TITR = TITR,
394 . KEYWORD2 = KEY,
395 . KEYWORD3 = KEY2)
396
397 IF(KEY2(1:LEN_TRIM(KEY2))=='sh3n')THEN
398
399C
400 IS_AVAILABLE = .FALSE.
401C
402C--------* EXTRACT DATAS (INTEGER VALUES) *------
403C
404 CALL HM_GET_INTV('nsh3n',NSH3N,IS_AVAILABLE,LSUBMODEL)
405
406 DO I=1,NSH3N
407
408 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id',ID,I,IS_AVAILABLE,LSUBMODEL)
409 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id1',ID1,I,IS_AVAILABLE,LSUBMODEL)
410 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id2',ID2,I,IS_AVAILABLE,LSUBMODEL)
411 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id3',ID3,I,IS_AVAILABLE,LSUBMODEL)
412 CALL HM_GET_INT_ARRAY_INDEX('sh3n_id4',ID4,I,IS_AVAILABLE,LSUBMODEL)
413 CALL HM_GET_INT_ARRAY_INDEX('actlev',LEVEL,I,IS_AVAILABLE,LSUBMODEL)
414 CALL HM_GET_INT_ARRAY_INDEX('imapping',ITRIM,I,IS_AVAILABLE,LSUBMODEL)
415
416
417 NLIST=NLIST+1
418 II=LIST(NLIST)
419 NLIST=NLIST+1
420 I1=LIST(NLIST)
421 NLIST=NLIST+1
422 I2=LIST(NLIST)
423 NLIST=NLIST+1
424 I3=LIST(NLIST)
425 NLIST=NLIST+1
426 I4=LIST(NLIST)
427C
428.AND. IF(I1+I2+I3+I4 /=0
429.OR..OR. . (I2-I1/=1 I3-I1 /= 2 I4-I1 /= 3))THEN
430 CALL ANCMSG(MSGID=655,
431 . MSGTYPE=MSGERROR,
432 . ANMODE=ANINFO,
433 . I1=ID1,
434 . I2=ID2,
435 . I3=ID3,
436 . I4=ID4,
437 . I5=ID)
438 END IF
439C
440 IF(I1+I2+I3+I4 /=0) THEN
441 ERRORADJ =0
442.OR. IF(IXTG(2,II) /= IXTG(2,I1)IXTG(3,II) /= IXTG(3,I2)
443.OR. . IXTG(4,II) /= IXTG(4,I3)) THEN
444 ERRORADJ =1
445.OR. ELSEIF(IXTG(3,I1) /= IXTG(2,I2)IXTG(4,I2) /= IXTG(3,I3)
446.OR. . IXTG(2,I3) /= IXTG(3,I4)) THEN
447 ERRORADJ =1
448.OR. ELSEIF(IXTG(4,I1) /= IXTG(2,I3)IXTG(4,I1) /= IXTG(3,I4)
449.OR..OR..OR. . IXTG(4,I2) /= IXTG(2,I4)IXTG(4,I4) /= IXTG(2,I2)
450 . IXTG(4,I4) /= IXTG(3,I1)) THEN
451 ERRORADJ =1
452 ENDIF
453 ENDIF
454.AND. IF(ERRORADJ ==1ABS(LEVEL)<LEVELMAX) THEN
455 CALL ANCMSG(MSGID=1023,
456 . MSGTYPE=MSGERROR,
457 . ANMODE=ANINFO,
458 . I1=ID1,
459 . I2=ID2,
460 . I3=ID3,
461 . I4=ID4,
462 . I5=ID)
463 END IF
464C
465.OR. IF(LEVEL<-LEVELMAX-1LEVEL>LEVELMAX)THEN
466 CALL ANCMSG(MSGID=657,
467 . MSGTYPE=MSGERROR,
468 . ANMODE=ANINFO,
469 . I1=ID)
470 END IF
471 SH3TREE(2,II)=I1
472 SH3TREE(3,II)=LEVEL
473 IF(I1/=0)THEN
474 SH3TREE(1,I1)=II
475 SH3TREE(1,I2)=II
476 SH3TREE(1,I3)=II
477 SH3TREE(1,I4)=II
478 END IF
479 SH3TRIM(II)=ITRIM
480 ENDDO
481
482 ENDIF
483
484 ENDDO
485
486 DEALLOCATE(LIST)
487 DEALLOCATE(INDEXL)
488
489 RETURN
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717