OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecgroup.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!|| lecgroup ../starter/source/groups/lecgroup.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_lecgre ../starter/source/groups/hm_lecgre.F
29!||--- uses -----------------------------------------------------
30!|| submodel_mod ../starter/share/modules1/submodel_mod.F
31!||====================================================================
32 SUBROUTINE lecgroup(
33 1 ITAB ,ITABM1 ,ISUBMOD ,
34 2 X ,IXS ,IXQ ,IXC ,IXT ,IXP ,
35 3 IXR ,IXTG , IPART ,
36 4 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,IPARTR ,
37 5 IPARTG ,FLAGG ,SH4TREE ,SH3TREE ,
38 6 SKEW ,ISKN ,UNITAB ,IBOX ,
39 7 IXS10 ,IXS16 ,IXS20 ,RTRANS ,LSUBMODEL,
40 8 IXS_S ,IXS_S_IND, IXQ_S ,IXQ_S_IND ,IXC_S ,IXC_S_IND,
41 9 IXT_S ,IXT_S_IND, IXP_S ,IXP_S_IND ,IXR_S ,IXR_S_IND,
42 A IXTG_S ,IXTG_S_IND,IADBOXMAX,SUBSET,IGRBRIC,IGRQUAD,
43 B IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,IGRSPRING)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE submodel_mod
49 USE groupdef_mod
51 use element_mod , only : nixs, nixq, nixc, nixt, nixp, nixr, nixtg
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "scr17_c.inc"
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
67 INTEGER ITAB(*),ITABM1(*),
68 . ISUBMOD(*),IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),
69 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*),
70 . IXS10(6,*),IXS16(8,*),IXS20(12,*),IPART(LIPART1,*),
71 . IPARTQ(*),IPARTC(*),IPARTT(*),IPARTP(*),IPARTR(*),
72 . IPARTG(*), SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
73 . ISKN(LISKN,*),IPARTS(*),
74 . IXS_S(*), IXS_S_IND(*), IXQ_S(*), IXQ_S_IND(*),
75 . IXC_S(*), IXC_S_IND(*), IXT_S(*), IXT_S_IND(*),
76 . IXP_S(*), IXP_S_IND(*), IXR_S(*), IXR_S_IND(*),
77 . ixtg_s(*), ixtg_s_ind(*)
78 INTEGER FLAGG,IADBOXMAX
79 MY_REAL
80 . X(3,*),SKEW(LSKEW,*),RTRANS(*)
81 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
82!
83C-----------------------------------------------
84 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
85 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
86 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
87 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
88 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
89 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
90 TYPE (group_) , DIMENSION(NGRBEAM) :: igrbeam
91 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
92 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER ADMBID
97 DATA admbid/0/
98C-----------------------------------------------
99C IGRELEM(IGS)%ID : GROUP identifier
100C IGRELEM(IGS)%TITLE : GROUP title
101C IGRELEM(IGS)%NENTITY : Entities (elements) number of the GROUP
102C IGRELEM(IGS)%GRTYPE : TYPE ( 0-NOEUDS, 1-BRIC, 2-QUAD, 3-SHELL_4N,
103! 4-TRUSS, 5-BEAM, 6-SPRINGS,7-SHELL_3N)
104!! GRTYPE --- > OBSOLETE
105C IGRELEM(IGS)%SORTED : FLAG for sorted/unsorted elements
106! = 0 -> sorted
107! = 1 -> unsorted
108C IGRELEM(IGS)%GRPGRP : TYPE of element GROUP
109! = 1 ELEM
110! = 2 GRELEM
111! = 3 SUBSET,PART,MAT,PROP
112! = 4 BOX,GENE
113! = 5 SUBMOD
114C IGRELEM(IGS)%LEVEL : Hierarchy level
115! (FLAG 'SUBLEVEL DONE' FOR GROUPS OF GROUPS)
116! = 0 ---> not yet initialized
117! = 1 ---> done
118C-----------------------------------------------
119C READING ELEMENT GROUPS
120C=======================================================================
121C-----------------------------------------------
122C BRICK
123C-----------------------------------------------
124 IF (ngrbric > 0)THEN
125 CALL hm_lecgre(
126 1 igrbric,ixs ,
127 2 8 ,nixs ,numels,ngrbric, 1,
128 3 ipart ,iparts ,x ,'BRIC',
129 4 isubmod ,flagg ,admbid,admbid,admbid,
130 5 admbid ,admbid,skew ,iskn ,unitab,
131 6 itabm1 ,ibox ,rtrans ,lsubmodel,
132 7 ixs_s ,ixs_s_ind,iadboxmax,subset,'/GRBRIC')
133 ENDIF
134C-----------------------------------------------
135C QUAD
136C-----------------------------------------------
137 IF (ngrquad > 0)THEN
138 CALL hm_lecgre(
139 1 igrquad,ixq ,
140 2 4 ,nixq ,numelq,ngrquad, 2,
141 3 ipart ,ipartq ,x ,'QUAD',
142 4 isubmod ,flagg ,admbid,admbid,admbid,
143 5 admbid ,admbid,skew ,iskn ,unitab,
144 6 itabm1 ,ibox ,rtrans ,lsubmodel,
145 7 ixq_s ,ixq_s_ind,iadboxmax,subset,'/GRQUAD')
146 ENDIF
147C-----------------------------------------------
148C SHELL
149C-----------------------------------------------
150 IF (ngrshel > 0)THEN
151 CALL hm_lecgre(
152 1 igrsh4n,ixc ,
153 2 4 ,nixc ,numelc,ngrshel, 3,
154 3 ipart ,ipartc ,x ,'SHEL',
155 4 isubmod,flagg ,ksh4tree,sh4tree,2 ,
156 5 4 ,3 ,skew ,iskn ,unitab,
157 6 itabm1 ,ibox ,rtrans ,lsubmodel,
158 7 ixc_s ,ixc_s_ind,iadboxmax,subset,'/GRSHEL')
159 ENDIF
160C-----------------------------------------------
161C TRUS
162C-----------------------------------------------
163 IF (ngrtrus > 0)THEN
164 CALL hm_lecgre(
165 1 igrtruss,ixt ,
166 2 2 ,nixt ,numelt,ngrtrus, 4,
167 3 ipart ,ipartt ,x ,'TRUS',
168 4 isubmod ,flagg ,admbid,admbid,admbid,
169 5 admbid ,admbid,skew ,iskn ,unitab,
170 6 itabm1 ,ibox ,rtrans ,lsubmodel,
171 7 ixt_s ,ixt_s_ind,iadboxmax,subset,'/GRTRUS')
172 ENDIF
173C-----------------------------------------------
174C BEAM
175C-----------------------------------------------
176 IF (ngrbeam > 0)THEN
177 CALL hm_lecgre(
178 1 igrbeam,ixp ,
179 2 2 ,nixp ,numelp,ngrbeam, 5,
180 3 ipart ,ipartp ,x ,'BEAM',
181 4 isubmod ,flagg ,admbid,admbid,admbid,
182 5 admbid ,admbid,skew ,iskn ,unitab,
183 6 itabm1 ,ibox ,rtrans ,lsubmodel,
184 7 ixp_s ,ixp_s_ind,iadboxmax,subset,'/GRBEAM')
185 ENDIF
186C-----------------------------------------------
187C SPRI GROUP
188C-----------------------------------------------
189 IF (ngrspri > 0)THEN
190 CALL hm_lecgre(
191 1 igrspring,ixr ,
192 2 2 ,nixr ,numelr,ngrspri, 6,
193 3 ipart ,ipartr ,x ,'SPRI',
194 4 isubmod ,flagg ,admbid,admbid,admbid,
195 5 admbid ,admbid,skew ,iskn ,unitab,
196 6 itabm1 ,ibox ,rtrans ,lsubmodel,
197 7 ixr_s ,ixr_s_ind,iadboxmax,subset,'/GRSPRI')
198 ENDIF
199C-----------------------------------------------
200C SH_3N GROUP
201C-----------------------------------------------
202 IF (ngrsh3n > 0 .AND. n2d==0)THEN
203 CALL hm_lecgre(
204 1 igrsh3n ,ixtg ,
205 2 3 ,nixtg ,numeltg ,ngrsh3n ,7 ,
206 3 ipart ,ipartg ,x ,'SH3N' ,
207 4 isubmod ,flagg ,ksh3tree ,sh3tree ,2 ,
208 5 4 ,3 ,skew ,iskn ,unitab ,
209 6 itabm1 ,ibox ,rtrans ,lsubmodel ,
210 7 ixtg_s ,ixtg_s_ind,iadboxmax,subset ,'/GRSH3N')
211 ENDIF
212C-----------------------------------------------
213C TRIA GROUP
214C-----------------------------------------------
215 IF (ngrsh3n > 0 .AND. n2d/=0)THEN
216 CALL hm_lecgre(
217 1 igrsh3n ,ixtg ,
218 2 3 ,nixtg ,numeltg ,ngrsh3n ,7 ,
219 3 ipart ,ipartg ,x ,'TRIA' ,
220 4 isubmod ,flagg ,ksh3tree ,sh3tree ,2 ,
221 5 4 ,3 ,skew ,iskn ,unitab ,
222 6 itabm1 ,ibox ,rtrans ,lsubmodel ,
223 7 ixtg_s ,ixtg_s_ind,iadboxmax,subset ,'/GRTRIA')
224 ENDIF
225C-----------
226 RETURN
227 END
subroutine hm_lecgre(igrelem, ix, nix1, nix, numel, ngrele, ielt, ipart, iparte, x, elkey, isubmod, flag, keltree, eltree, ksontree, nsontree, klevtree, skew, iskn, unitab, itabm1, ibox, rtrans, lsubmodel, ixx_s, ixx_s_ind, iadboxmax, subset, startkey)
Definition hm_lecgre.F:56
subroutine lecgroup(itab, itabm1, isubmod, x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, flagg, sh4tree, sh3tree, skew, iskn, unitab, ibox, ixs10, ixs16, ixs20, rtrans, lsubmodel, ixs_s, ixs_s_ind, ixq_s, ixq_s_ind, ixc_s, ixc_s_ind, ixt_s, ixt_s_ind, ixp_s, ixp_s_ind, ixr_s, ixr_s_ind, ixtg_s, ixtg_s_ind, iadboxmax, subset, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring)
Definition lecgroup.F:44