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

Go to the source code of this file.

Functions/Subroutines

subroutine create_box_clause (clause, jclause, is_available, lsubmodel, keyset, itabm1, ibox, x, skew, ixs10, set_title, ipart, sh4tree, sh3tree, iparts, ipartq, ipartc, ipartg, ipartt, ipartp, ipartr, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, knod2elq, nod2elq, opt_a, opt_o, opt_e, delbuf, rby_msn, irbodym)

Function/Subroutine Documentation

◆ create_box_clause()

subroutine create_box_clause ( type (set_) clause,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel,
character(len=ncharfield) keyset,
integer, dimension(numnod,2), intent(in) itabm1,
type (box_), dimension(nbbox) ibox,
x,
skew,
integer, dimension(6,*), intent(in) ixs10,
character(len=nchartitle) set_title,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(*), intent(in) sh4tree,
integer, dimension(*), intent(in) sh3tree,
integer, dimension(*), intent(in) iparts,
integer, dimension(*), intent(in) ipartq,
integer, dimension(*), intent(in) ipartc,
integer, dimension(*), intent(in) ipartg,
integer, dimension(*), intent(in) ipartt,
integer, dimension(*), intent(in) ipartp,
integer, dimension(*), intent(in) ipartr,
integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(nixq,*), intent(in) ixq,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg,
integer, dimension(nixt,*), intent(in) ixt,
integer, dimension(nixp,*), intent(in) ixp,
integer, dimension(nixr,*), intent(in) ixr,
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) knod2elq,
integer, dimension(*), intent(in) nod2elq,
integer opt_a,
integer opt_o,
integer opt_e,
type (set_scratch) delbuf,
integer, dimension(2,nrbody), intent(in) rby_msn,
integer, dimension(nrbody,2), intent(in) irbodym )

Definition at line 39 of file create_box_clause.F.

49C-----------------------------------------------
50C ROUTINE DESCRIPTION :
51C ===================
52C Treat the Elmeent Clause, read Elements from HM_READER & fill clause
53C------------------------------------------------------------------
54C DUMMY ARGUMENTS DESCRIPTION:
55C ===================
56C
57C NAME DESCRIPTION
58C
59C CLAUSE (SET structure) Clause to be treated
60C IPARTM1 MAP Table UID -> LocalID
61C JCLAUSE parameter with HM_READER (current clause read)
62C IS_AVAILABLE Bool / Result of HM_interface
63C LSUBMODEL SUBMODEL Structure.
64C============================================================================
65C-----------------------------------------------
66C M o d u l e s
67C-----------------------------------------------
68 USE setdef_mod
69 USE submodel_mod
70 USE message_mod
75 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
76C-----------------------------------------------
77C I m p l i c i t T y p e s
78C-----------------------------------------------
79#include "implicit_f.inc"
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83#include "radioss_maptable.inc"
84#include "com04_c.inc"
85#include "param_c.inc"
86#include "scr17_c.inc"
87C-----------------------------------------------
88C D u m m y A r g u m e n t s
89C-----------------------------------------------
90 INTEGER, INTENT(IN) :: IPART(LIPART1,*),SH4TREE(*),
91 . SH3TREE(*),IXS(NIXS,*),IXC(NIXC,*),IXTG(NIXTG,*),IXS10(6,*),
92 . IXQ(NIXQ,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IPARTS(*),
93 . IPARTQ(*),IPARTC(*),IPARTG(*),IPARTT(*),IPARTP(*),IPARTR(*),
94 . KNOD2ELS(*),KNOD2ELC(*),KNOD2ELTG(*),NOD2ELS(*),NOD2ELC(*),
95 . NOD2ELTG(*),NOD2ELQ(*),KNOD2ELQ(*)
96 INTEGER JCLAUSE, OPT_A, OPT_O, OPT_E
97!
98 INTEGER, INTENT(IN), DIMENSION(NUMNOD,2) :: ITABM1
99 INTEGER, INTENT(IN), DIMENSION(NRBODY,2) :: IRBODYM
100 INTEGER, INTENT(IN), DIMENSION(2,NRBODY) :: RBY_MSN
101
102! INTEGER, INTENT(IN) :: MAPSIZE
103! INTEGER, DIMENSION(MAPSIZE,2) :: MAP
104 LOGICAL :: IS_AVAILABLE
105 my_real
106 . x(3,*),skew(lskew,*)
107 CHARACTER(LEN=NCHARFIELD) :: KEYSET
108 CHARACTER(LEN=NCHARTITLE) :: SET_TITLE
109 TYPE (SET_SCRATCH) :: DELBUF
110C-----------------------------------------------
111 TYPE (SET_) :: CLAUSE
112 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
113 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
114C-----------------------------------------------
115C L o c a l V a r i a b l e s
116C-----------------------------------------------
117 INTEGER BOXTYPE, SURF_LIST, LINE_LIST_1D
118!
119 INTEGER ADMBID
120 DATA admbid/0/
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124!
125 IF (keyset == 'BOX') boxtype = 1
126 IF (keyset == 'BOX2') boxtype = 2
127!
128!
129 ! ---------------------
130 ! Fill Boxes
131 ! ---------------------
132!
133!
134 ! NODE box
135 CALL create_node_box(
136 . clause ,itabm1 ,jclause ,is_available ,lsubmodel,
137 . ibox ,x ,skew ,set_title ,keyset )
138
139
140 ! Solid's in box
141 IF (numels > 0)
142 * CALL create_elt_box(
143 * clause ,iparts ,jclause ,is_available ,lsubmodel,
144 * ibox ,x ,skew ,set_title ,keyset ,
145 * boxtype ,numels ,nixs ,ixs ,8 ,
146 * ipart ,admbid ,admbid ,admbid ,elt_solid)
147
148 ! Quad's in box
149 IF (numelq > 0)
150 * CALL create_elt_box(
151 * clause ,ipartq ,jclause ,is_available ,lsubmodel,
152 * ibox ,x ,skew ,set_title ,keyset ,
153 * boxtype ,numelq ,nixq ,ixq ,4 ,
154 * ipart ,admbid ,admbid ,admbid ,elt_quad )
155
156 ! Shell's in box
157 IF (numelc > 0)
158 * CALL create_elt_box(
159 * clause ,ipartc ,jclause ,is_available ,lsubmodel,
160 * ibox ,x ,skew ,set_title ,keyset ,
161 * boxtype ,numelc ,nixc ,ixc ,4 ,
162 * ipart ,sh4tree ,3 ,ksh4tree ,elt_sh4n )
163
164 ! She3n's in box
165 IF (numeltg > 0 .AND. numeltria == 0)
166 * CALL create_elt_box(
167 * clause ,ipartg ,jclause ,is_available ,lsubmodel,
168 * ibox ,x ,skew ,set_title ,keyset ,
169 * boxtype ,numeltg ,nixtg ,ixtg ,3 ,
170 * ipart ,sh3tree ,3 ,ksh3tree ,elt_sh3n )
171
172 ! Tria's in box
173 IF (numeltria > 0)
174 * CALL create_elt_box(
175 * clause ,ipartg ,jclause ,is_available ,lsubmodel,
176 * ibox ,x ,skew ,set_title ,keyset ,
177 * boxtype ,numeltria,nixtg ,ixtg ,3 ,
178 * ipart ,admbid ,admbid ,admbid ,elt_tria )
179
180 ! Truss's in box
181 IF (numelt > 0)
182 * CALL create_elt_box(
183 * clause ,ipartt ,jclause ,is_available ,lsubmodel,
184 * ibox ,x ,skew ,set_title ,keyset ,
185 * boxtype ,numelt ,nixt ,ixt ,2 ,
186 * ipart ,admbid ,admbid ,admbid ,elt_truss)
187
188 ! Beam's in box
189 IF (numelp > 0)
190 * CALL create_elt_box(
191 * clause ,ipartp ,jclause ,is_available ,lsubmodel,
192 * ibox ,x ,skew ,set_title ,keyset ,
193 * boxtype ,numelp ,nixp ,ixp ,2 ,
194 * ipart ,admbid ,admbid ,admbid ,elt_beam )
195
196 ! Spring's in box
197 IF (numelr > 0)
198 * CALL create_elt_box(
199 * clause ,ipartr ,jclause ,is_available ,lsubmodel,
200 * ibox ,x ,skew ,set_title ,keyset ,
201 * boxtype ,numelr ,nixr ,ixr ,2 ,
202 * ipart ,admbid ,admbid ,admbid ,elt_spring)
203!------------------------------------------------------
204!------------------------------------------------------
205 ! Line's --- 1D --- in box
206 line_list_1d = clause%NB_TRUSS + clause%NB_BEAM + clause%NB_SPRING
207 IF (line_list_1d > 0)
208 ! Line from 1D_ELEMENT
209 !-------------------
210 * CALL create_line_from_element(ixt ,ixp ,ixr ,clause,delbuf,
211 * .false. )
212!------------------------------------------------------
213!------------------------------------------------------
214 ! Surface's in box
215 surf_list = clause%NB_SOLID + clause%NB_QUAD +
216 + clause%NB_SH4N + clause%NB_SH3N
217 IF (surf_list > 0) THEN
218 ! Surface from ELEMENT
219 !-------------------
221 * ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
222 * ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
223 * knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
224 * ipart ,clause ,opt_a ,opt_o ,ixq ,
225 * knod2elq ,nod2elq ,x ,keyset ,delbuf ,
226 * .false. ,ipartq )
227!
228 ! Line from SURFACE
229 CALL create_line_from_surface(clause ,keyset,opt_a,opt_e,delbuf,
230 . .false.)
231 ENDIF ! IF (SURF_LIST > 0)
232!------------------------------------------------------
233!------------------------------------------------------
234 ! Rbodys in box
235 IF (clause%NB_RBODY > 0) THEN
236 CALL create_rbody_box(clause ,irbodym ,jclause ,is_available ,lsubmodel,
237 . ibox ,x ,skew ,set_title ,keyset ,
238 . rby_msn )
239 ENDIF ! IF (CLAUSE%NB_RBODY > 0)
240C-----------------------------------------------
#define my_real
Definition cppsort.cpp:32
subroutine create_elt_box(clause, iparte, jclause, is_available, lsubmodel, ibox, x, skew, set_title, keyset, boxtype, numel, nix, ix, nix1, ipart, eltree, klevtree, keltree, eltyp)
subroutine create_line_from_element(ixt, ixp, ixr, clause, delbuf, go_in_array)
subroutine create_line_from_surface(clause, keyset, opt_a, opt_e, delbuf, go_in_array)
subroutine create_node_box(clause, itabm1, jclause, is_available, lsubmodel, ibox, x, skew, set_title, keyset)
subroutine create_rbody_box(clause, irbodym, jclause, is_available, lsubmodel, ibox, x, skew, set_title, keyset, rby_msn)
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)
integer, parameter nchartitle
integer, parameter ncharfield