OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_box_clause.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!|| create_box_clause ../starter/source/model/sets/create_box_clause.F
25!||--- called by ------------------------------------------------------
26!|| hm_set ../starter/source/model/sets/hm_set.F
27!||--- calls -----------------------------------------------------
28!|| create_elt_box ../starter/source/model/sets/create_elt_box.F
29!|| create_line_from_element ../starter/source/model/sets/create_line_from_element.F
30!|| create_line_from_surface ../starter/source/model/sets/create_line_from_surface.F
31!|| create_node_box ../starter/source/model/sets/create_node_box.F
32!|| create_rbody_box ../starter/source/model/sets/create_rbody_box.F
33!|| create_surface_from_element ../starter/source/model/sets/create_surface_from_element.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 create_box_clause(
40 * CLAUSE ,JCLAUSE ,IS_AVAILABLE,LSUBMODEL ,KEYSET ,
41 * ITABM1 ,IBOX ,X ,SKEW ,IXS10 ,
42 * SET_TITLE,IPART ,SH4TREE ,SH3TREE ,IPARTS ,
43 * IPARTQ ,IPARTC ,IPARTG ,IPARTT ,IPARTP ,
44 * IPARTR ,IXS ,IXQ ,IXC ,IXTG ,
45 * IXT ,IXP ,IXR ,KNOD2ELS ,NOD2ELS ,
46 * KNOD2ELC ,NOD2ELC ,KNOD2ELTG ,NOD2ELTG ,KNOD2ELQ ,
47 * NOD2ELQ ,OPT_A ,OPT_O ,OPT_E ,DELBUF ,
48 * RBY_MSN ,IRBODYM )
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-----------------------------------------------
241 END
#define my_real
Definition cppsort.cpp:32
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)
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_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