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
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "scr17_c.inc"
59#include "com01_c.inc"
60#include "com04_c.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
66 INTEGER ITAB(*),ITABM1(*),
67 . ISUBMOD(*),IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),
68 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*),
69 . IXS10(6,*),IXS16(8,*),IXS20(12,*),IPART(LIPART1,*),
70 . IPARTQ(*),IPARTC(*),IPARTT(*),IPARTP(*),IPARTR(*),
71 . IPARTG(*), SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
72 . ISKN(LISKN,*),IPARTS(*),
73 . IXS_S(*), IXS_S_IND(*), IXQ_S(*), IXQ_S_IND(*),
74 . IXC_S(*), IXC_S_IND(*), IXT_S(*), IXT_S_IND(*),
75 . IXP_S(*), IXP_S_IND(*), IXR_S(*), IXR_S_IND(*),
76 . ixtg_s(*), ixtg_s_ind(*)
77 INTEGER FLAGG,IADBOXMAX
78 MY_REAL
79 . X(3,*),SKEW(LSKEW,*),RTRANS(*)
80 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
81!
82C-----------------------------------------------
83 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
84 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
85 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
86 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
87 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
88 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
89 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
90 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
91 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
92C-----------------------------------------------
93C L o c a l V a r i a b l e s
94C-----------------------------------------------
95 INTEGER KK,K
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 LECTURE DES GROUPES D'ELEMENTS
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.AND. IF (NGRSH3N > 0 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.AND. IF (NGRSH3N > 0 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