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