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)

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 )

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