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