OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
state_admesh.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!|| state_admesh ../starter/source/model/remesh/state_admesh.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.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!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
32!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
33!|| nintlst2 ../starter/source/system/nintrr.F
34!||--- uses -----------------------------------------------------
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE state_admesh(IPART ,IPARTC,IPARTTG,IXC ,IXTG ,
40 . SH4TREE,SH3TREE,SH4TRIM,SH3TRIM,LSUBMODEL)
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 IF(i1+i2+i3+i4 /=0 .AND.
429 . (i2-i1/=1 .OR. i3-i1 /= 2 .OR. 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 IF(ixtg(2,ii) /= ixtg(2,i1).OR.ixtg(3,ii) /= ixtg(3,i2)
443 . .OR.ixtg(4,ii) /= ixtg(4,i3)) THEN
444 erroradj =1
445 ELSEIF(ixtg(3,i1) /= ixtg(2,i2).OR.ixtg(4,i2) /= ixtg(3,i3)
446 . .OR.ixtg(2,i3) /= ixtg(3,i4)) THEN
447 erroradj =1
448 ELSEIF(ixtg(4,i1) /= ixtg(2,i3).OR.ixtg(4,i1) /= ixtg(3,i4)
449 . .OR.ixtg(4,i2) /= ixtg(2,i4).OR.ixtg(4,i4) /= ixtg(2,i2).OR.
450 . ixtg(4,i4) /= ixtg(3,i1)) THEN
451 erroradj =1
452 ENDIF
453 ENDIF
454 IF(erroradj ==1.AND.abs(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 IF(level<-levelmax-1.OR.level>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
490 END
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
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
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
state_admesh
subroutine state_admesh(ipart, ipartc, iparttg, ixc, ixtg, sh4tree, sh3tree, sh4trim, sh3trim, lsubmodel)
Definition state_admesh.F:41
submodel_mod::submodel_data
Definition submodel_mod.F:728