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

Go to the source code of this file.

Functions/Subroutines

subroutine create_surface_from_element (ixs, ixs10, sh4tree, sh3tree, ixc, ixtg, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, ipart, clause, opt_a, opt_o, ixq, knod2elq, nod2elq, x, keyset, delbuf, go_in_array, ipartq)

Function/Subroutine Documentation

◆ create_surface_from_element()

subroutine create_surface_from_element ( integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(6,*), intent(in) ixs10,
integer, dimension(*), intent(in) sh4tree,
integer, dimension(*), intent(in) sh3tree,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg,
integer, dimension(*), intent(in) knod2els,
integer, dimension(*), intent(in) nod2els,
integer, dimension(*), intent(in) knod2elc,
integer, dimension(*), intent(in) nod2elc,
integer, dimension(*), intent(in) knod2eltg,
integer, dimension(*), intent(in) nod2eltg,
integer, dimension(*), intent(in) ipartc,
integer, dimension(*), intent(in) ipartg,
integer, dimension(*), intent(in) iparts,
integer, dimension(lipart1,*), intent(in) ipart,
type (set_) clause,
integer opt_a,
integer opt_o,
integer, dimension(nixq,*), intent(in) ixq,
integer, dimension(*), intent(in) knod2elq,
integer, dimension(*), intent(in) nod2elq,
x,
character(len=ncharfield) keyset,
type (set_scratch) delbuf,
logical go_in_array,
integer, dimension(numelq), intent(in) ipartq )

Definition at line 35 of file create_surface_from_element.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE my_alloc_mod
46 USE setdef_mod
47 USE message_mod
48 USE set_scratch_mod
49 USE names_and_titles_mod , ONLY : ncharfield
50 USE surf_mod , ONLY : ext_surf,all_surf
51 use element_mod , only : nixs,nixq,nixc,nixtg
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56#include "com04_c.inc"
57#include "scr17_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER OPT_A,OPT_O
62 INTEGER, INTENT(IN) :: IXS(NIXS,*),IXS10(6,*),IXC(NIXC,*),IXTG(NIXTG,*),
63 . KNOD2ELS(*),KNOD2ELC(*),KNOD2ELTG(*),NOD2ELS(*),NOD2ELC(*),
64 . NOD2ELTG(*),IPARTS(*),IPARTC(*),IPARTG(*),SH4TREE(*),SH3TREE(*),
65 . IPART(LIPART1,*),KNOD2ELQ(*),NOD2ELQ(*),IXQ(NIXQ,*),IPARTQ(NUMELQ)
66 my_real x(3,*)
67 CHARACTER(LEN=NCHARFIELD) :: KEYSET
68!
69 TYPE (SET_) :: CLAUSE
70 TYPE (SET_SCRATCH) :: DELBUF
71 LOGICAL GO_IN_ARRAY
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER IEXT, L, NIX, SZELMAX, IAD_SURF, NSEG, NFACES
76 INTEGER IWORK(70000)
77!
78 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ITRI
79 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX, BUFTMPSURF
80C=======================================================================
81 delbuf%SZ_SURF = 0
82 delbuf%SZ_LINE = 0
83!
84!! SZELMAX = MAX(CLAUSE%NB_SOLID,CLAUSE%NB_QUAD,CLAUSE%NB_SH4N,CLAUSE%NB_SH3N)
85 szelmax = clause%NB_SOLID + clause%NB_QUAD + clause%NB_SH4N + clause%NB_SH3N
86 IF (szelmax == 0) RETURN
87!
88 nfaces = 6 ! HEXA_8
89 IF (numels > numels8) nfaces = 16 ! TETRA_10
90!
91 ALLOCATE(buftmpsurf(szelmax*nfaces*6))
92 ALLOCATE(itri(5,szelmax*nfaces))
93 ALLOCATE(index(2*szelmax*nfaces))
94!
95 iad_surf = 1
96!------------------
97 iext = ext_surf ! by default (external surface)
98 IF ( opt_a == 1 ) iext = all_surf ! all surfaces (internal + external)
99 clause%EXT_ALL = iext
100!------------------
101
102!
103!----
104! ! temporary surface segments got from elements
105 nseg = 0
106 CALL surface_buffer(
107 . ixs ,ixs10 ,ixc ,sh4tree ,sh3tree ,
108 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
109 . knod2eltg ,nod2eltg ,nseg ,iext ,ipartc ,
110 . iparts ,ipartg ,clause ,buftmpsurf,iad_surf ,
111 . opt_o ,ipart ,knod2elq ,nod2elq ,x ,
112 . ixq ,keyset ,ipartq)
113!----
114!
115 nix = 6
116!
117 DO l=1,nseg
118 index(l)=l
119 itri(1,l) = buftmpsurf((l-1)*nix+1)
120 itri(2,l) = buftmpsurf((l-1)*nix+2)
121 itri(3,l) = buftmpsurf((l-1)*nix+3)
122 itri(4,l) = buftmpsurf((l-1)*nix+4)
123 itri(5,l) = buftmpsurf((l-1)*nix+6)
124 ENDDO
125 iwork(1:70000) = 0
126 CALL my_orders(0,iwork,itri,index,nseg,5)
127!---
128! clause surf allocation
129!---
130!------------------
131!
132! Decide whether the result is stored in an array or in the clause.
133! In certain cases it is useful to store in ARRAY.
134! Example : Clause with delete clause. Surfaces must be recreated & merged...
135! ----------------------------------------------------------------------------
136 IF (go_in_array .EQV. .true.) THEN
137 delbuf%SZ_SURF = nseg
138 ALLOCATE(delbuf%SURF(nseg,6))
139 DO l=1,nseg
140 delbuf%SURF(l,1) = buftmpsurf((index(l)-1)*nix+1)
141 delbuf%SURF(l,2) = buftmpsurf((index(l)-1)*nix+2)
142 delbuf%SURF(l,3) = buftmpsurf((index(l)-1)*nix+3)
143 delbuf%SURF(l,4) = buftmpsurf((index(l)-1)*nix+4)
144 delbuf%SURF(l,5) = buftmpsurf((index(l)-1)*nix+5)
145 delbuf%SURF(l,6) = buftmpsurf((index(l)-1)*nix+6)
146 ENDDO
147 ELSE
148 IF (ALLOCATED(clause%SURF_NODES)) DEALLOCATE(clause%SURF_NODES)
149 IF (ALLOCATED(clause%SURF_ELTYP)) DEALLOCATE(clause%SURF_ELTYP)
150 IF (ALLOCATED(clause%SURF_ELEM)) DEALLOCATE(clause%SURF_ELEM)
151!
152 clause%NB_SURF_SEG = nseg
153 CALL my_alloc(clause%SURF_NODES,nseg,4)
154 CALL my_alloc(clause%SURF_ELTYP,nseg)
155 CALL my_alloc(clause%SURF_ELEM,nseg)
156!
157 DO l=1,nseg
158 clause%SURF_NODES(l,1) = buftmpsurf((index(l)-1)*nix+1)
159 clause%SURF_NODES(l,2) = buftmpsurf((index(l)-1)*nix+2)
160 clause%SURF_NODES(l,3) = buftmpsurf((index(l)-1)*nix+3)
161 clause%SURF_NODES(l,4) = buftmpsurf((index(l)-1)*nix+4)
162 clause%SURF_ELTYP(l) = buftmpsurf((index(l)-1)*nix+5)
163 clause%SURF_ELEM(l) = buftmpsurf((index(l)-1)*nix+6)
164 ENDDO
165 ENDIF ! IF (GO_IN_ARRAY .EQV. .TRUE.)
166!------------------
167 IF(ALLOCATED(itri)) DEALLOCATE(itri)
168 IF(ALLOCATED(index)) DEALLOCATE(index)
169 IF(ALLOCATED(buftmpsurf)) DEALLOCATE(buftmpsurf)
170C-----------
171!-----------
172 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
set_scratch_mod
Definition setdef_mod.F:247
setdef_mod
Definition setdef_mod.F:107
surf_mod
Definition surf_mod.F:37
surf_mod::ext_surf
integer, parameter ext_surf
definition of /EXT surface
Definition surf_mod.F:42
surf_mod::all_surf
integer, parameter all_surf
definition of /ALL surface
Definition surf_mod.F:43
surface_buffer
subroutine surface_buffer(ixs, ixs10, ixc, sh4tree, sh3tree, ixtg, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, nseg, iext, ipartc, iparts, ipartg, clause, buftmpsurf, iad_surf, opt_o, ipart, knod2elq, nod2elq, x, ixq, keyset, ipartq)
Definition surface_buffer.F:41