OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
prelecsec.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!|| prelecsec ../starter/source/tools/sect/prelecsec.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!|| r2r_prelec ../starter/source/coupling/rad2rad/r2r_prelec.F
28!|| r2r_split ../starter/source/coupling/rad2rad/r2r_split.F
29!||--- calls -----------------------------------------------------
30!|| ancmsg ../starter/source/output/message/message.F
31!|| fretitl ../starter/source/starter/freform.F
32!|| grsize_ele ../starter/source/system/nintrr.F
33!|| grsize_ele_trans ../starter/source/system/nintrr.F
34!|| grsize_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
35!|| grsizen ../starter/source/system/nintrr.F
36!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
37!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
38!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
39!|| hm_sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
40!|| usr2sys ../starter/source/system/sysfus.F
41!||--- uses -----------------------------------------------------
42!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
43!|| message_mod ../starter/share/message_module/message_mod.F
44!|| r2r_mod ../starter/share/modules1/r2r_mod.F
45!|| submodel_mod ../starter/share/modules1/submodel_mod.F
46!||====================================================================
47 SUBROUTINE prelecsec(
48 1 SNSTRF ,SSECBUF ,ITABM1 ,FLAG_R2R ,NOM_OPT ,
49 2 IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
50 3 IGRBEAM ,IGRSPRING ,IGRNOD, LSUBMODEL , SEATBELT_SHELL_TO_SPRING,
51 4 NB_SEATBELT_SHELLS)
52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE r2r_mod
56 USE message_mod
57 USE groupdef_mod
58 USE submodel_mod
59 USE hm_option_read_mod
60 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "scr17_c.inc"
69#include "com04_c.inc"
70#include "r2r_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER ,INTENT(INOUT) :: SNSTRF,SSECBUF
75 INTEGER ,INTENT(IN) :: ITABM1(*)
76 INTEGER NOM_OPT(LNOPT1,*)
77 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
78 INTEGER ,INTENT(IN) :: NB_SEATBELT_SHELLS
79 INTEGER ,INTENT(IN) :: SEATBELT_SHELL_TO_SPRING(NUMELC,2)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I,KK,IBID,ISAV,IGU,IGUS,IGUQ,IGUC,IGUT,IGUP,IGUR,IGUTG,
84 . NNOD,NBINTER,NSEGQ,NSEGS,NSEGC,NSEGT,NSEGP,NSEGR,NSEGTG,NFRAM,
85 . ID,UID,L,ISTYP,
86 . FLAG_R2R,N1,N2,N3,POS_SEC_R2R,NSEG0,NSEG,
87 . compt,ng
88 CHARACTER(LEN=NCHARTITLE)::TITR
89 CHARACTER(LEN=NCHARKEY) :: KEY2
90 CHARACTER MESS*40
91 LOGICAL IS_AVAILABLE
92C-----------------------------------------------
93 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
94 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
95 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
96 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
97 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
98 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
99 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
100 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
101C-----------------------------------------------
102C E x t e r n a l F u n c t i o n s
103C-----------------------------------------------
104 INTEGER GRSIZEN,USR2SYS,GRSIZE_R2R,GRSIZE_ELE,GRSIZE_ELE_TRANS
105 EXTERNAL GRSIZEN,USR2SYS,GRSIZE_R2R,GRSIZE_ELE,GRSIZE_ELE_TRANS
106C=======================================================================
107 NFRAM = 0
108 snstrf = 30
109 ssecbuf = 20
110 l = 7
111 compt = 0
112 ng = 0
113
114 IF (flag_r2r == 1) THEN
115 ALLOCATE(tagsec(nsect))
116 tagsec = 0
117 ENDIF
118
119
120 CALL hm_option_start('/SECT')
121
122 DO i=1,nsect
123
124 ng=ng+1
125C----------Multidomain --> non tagged sections ignored----
126 IF (flag_r2r == 0) THEN
127 IF( nsubdom > 0 ) THEN
128 IF( tagsec(ng) == 0 ) CALL hm_sz_r2r(tagsec,ng,lsubmodel)
129 ENDIF
130 ENDIF
131C-----------------------------------------------------------------
132
133 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr, unit_id=uid, keyword2=key2)
134 nom_opt(1,i)=id
135 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
136
137 CALL hm_get_intv('Axis_Origin_Node_N1', n1, is_available, lsubmodel)
138 CALL hm_get_intv('Axis_Node_N2', n2, is_available, lsubmodel)
139 CALL hm_get_intv('Axis_Node_N3', n3, is_available, lsubmodel)
140 CALL hm_get_intv('ISAVE', isav, is_available, lsubmodel)
141
142 IF(key2(1:5) == 'PARAL' .OR. key2(1:6) == 'CIRCLE') THEN
143 istyp = 1
144 ELSE
145 istyp = 0
146 CALL hm_get_intv('Grnod_ID', igu, is_available, lsubmodel)
147 CALL hm_get_intv('System_Id', nfram, is_available, lsubmodel)
148 ENDIF
149
150 iguq=0
151 CALL hm_get_intv('grbrick_id', igus, is_available, lsubmodel)
152 CALL hm_get_intv('grshel_id', iguc, is_available, lsubmodel)
153 CALL hm_get_intv('grtrus_id', igut, is_available, lsubmodel)
154 CALL hm_get_intv('grbeam_id', igup, is_available, lsubmodel)
155 CALL hm_get_intv('grsprg_id', igur, is_available, lsubmodel)
156 CALL hm_get_intv('grtria_id', igutg, is_available, lsubmodel)
157 CALL hm_get_intv('Niter', nbinter, is_available, lsubmodel)
158C---
159 IF (flag_r2r == 1) THEN
160C----------tag section s skew nodes---------------
161 IF (n1 /= 0) n1=usr2sys(n1,itabm1,mess,id)
162 IF (n2 /= 0) n2=usr2sys(n2,itabm1,mess,id)
163 IF (n3 /= 0) n3=usr2sys(n3,itabm1,mess,id)
164 IF(tagno(n1+npart) < 2) tagno(n1+npart) = 2
165 IF(tagno(n2+npart) < 2) tagno(n2+npart) = 2
166 IF(tagno(n3+npart) < 2) tagno(n3+npart) = 2
167 ELSEIF (flag_r2r == 2) THEN
168C----------set section position wrt multidomain interface
169C----------element groups
170 nseg = grsize_ele(igus,igrbric,ngrbric)
171 nsegc = grsize_r2r(igus,igrbric,ngrbric,9)
172 nseg0 = grsize_r2r(igus,igrbric,ngrbric,8)
173C
174 nseg = nseg + grsize_ele(iguq,igrquad,ngrquad)
175 nsegc = nsegc + grsize_r2r(iguq,igrquad,ngrquad,9)
176 nseg0 = nseg0 + grsize_r2r(iguq,igrquad,ngrquad,8)
177C
178 nseg = nseg + grsize_ele(iguc,igrsh4n,ngrshel)
179 nsegc = nsegc + grsize_r2r(iguc,igrsh4n,ngrshel,9)
180 nseg0 = nseg0 + grsize_r2r(iguc,igrsh4n,ngrshel,8)
181C
182 nseg = nseg + grsize_ele(igut,igrtruss,ngrtrus)
183 nsegc = nsegc + grsize_r2r(igut,igrtruss,ngrtrus,9)
184 nseg0 = nseg0 + grsize_r2r(igut,igrtruss,ngrtrus,8)
185C
186 nseg = nseg + grsize_ele(igup,igrbeam,ngrbeam)
187 nsegc = nsegc + grsize_r2r(igup,igrbeam,ngrbeam,9)
188 nseg0 = nseg0 + grsize_r2r(igup,igrbeam,ngrbeam,8)
189C
190 nseg = nseg + grsize_ele(igur,igrspring,ngrspri)
191 nsegc = nsegc + grsize_r2r(igur,igrspring,ngrspri,9)
192 nseg0 = nseg0 + grsize_r2r(igur,igrspring,ngrspri,8)
193C
194 nseg = nseg + grsize_ele(igutg,igrsh3n,ngrsh3n)
195 nsegc = nsegc + grsize_r2r(igutg,igrsh3n,ngrsh3n,9)
196 nseg0 = nseg0 + grsize_r2r(igutg,igrsh3n,ngrsh3n,8)
197C
198 tagsec(i)=id
199 compt = compt + 1
200C-----------sorting criteria
201 IF ((nsegc > 0).OR.((nseg/=nseg0).AND.(nseg > 0))) THEN
202C-------------multidomains interface sections
203 CALL ancmsg(msgid=1006,
204 . msgtype=msgwarning,
205 . anmode=aninfo_blind_1,
206 . i1=id)
207 ELSEIF ((nseg == 0).AND.(nseg0 > 0)) THEN
208C------------ external sections : not keeped
209 tagsec(i)=0
210 compt = compt - 1
211 ENDIF
212 ELSE
213C---
214 IF (nfram == 0 .AND. istyp == 0) THEN
215 nnod = grsizen(igu,igrnod,ngrnod)
216 ELSE
217 nnod = 20 * grsize_ele(igus,igrbric,ngrbric)
218 nnod = nnod + 4 * grsize_ele(iguq,igrquad,ngrquad)
219 nnod = nnod + 4 * grsize_ele(iguc,igrsh4n,ngrshel)
220 nnod = nnod + 2 * grsize_ele(igut,igrtruss,ngrtrus)
221 nnod = nnod + 2 * grsize_ele(igup,igrbeam,ngrbeam)
222 nnod = nnod + 2 * grsize_ele(igur,igrspring,ngrspri)
223 nnod = nnod + 3 * grsize_ele(igutg,igrsh3n,ngrsh3n)
224 ENDIF
225 nsegs = grsize_ele(igus,igrbric,ngrbric)
226 nsegq = grsize_ele(iguq,igrquad,ngrquad)
227 nsegc = grsize_ele(iguc,igrsh4n,ngrshel)
228 nsegt = grsize_ele(igut,igrtruss,ngrtrus)
229 nsegp = grsize_ele(igup,igrbeam,ngrbeam)
230 nsegr = grsize_ele(igur,igrspring,ngrspri)
231 IF (nb_seatbelt_shells /=0)
232 . nsegr = nsegr + grsize_ele_trans(iguc,igrsh4n,ngrshel,seatbelt_shell_to_spring)
233 nsegtg = grsize_ele(igutg,igrsh3n,ngrsh3n)
234C---
235 snstrf = snstrf +30 + nbinter!+ NNOD + 2*(NSEGS+NSEGQ+NSEGC+NSEGT+NSEGP+NSEGR+NSEGTG)
236 ssecbuf=ssecbuf+10
237 IF(isav >= 100) ssecbuf=ssecbuf+12*nnod
238 IF(isav >= 101) ssecbuf=ssecbuf+12*nnod
239 IF(isav >= 102) ssecbuf=ssecbuf+6*nnod
240 ENDIF
241 ENDDO
242C
243 IF (flag_r2r == 2) nsect = compt
244
245C-----------
246 RETURN
247C-----------
248 END
249C-----------
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::tagsec
integer, dimension(:), allocatable tagsec
Definition r2r_mod.F:137
submodel_mod
Definition submodel_mod.F:712
prelecsec
subroutine prelecsec(snstrf, ssecbuf, itabm1, flag_r2r, nom_opt, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrnod, lsubmodel, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition prelecsec.F:52
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:300
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620