OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
prelecsec.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ prelecsec()

subroutine prelecsec ( integer, intent(inout) snstrf,
integer, intent(inout) ssecbuf,
integer, dimension(*), intent(in) itabm1,
integer flag_r2r,
integer, dimension(lnopt1,*) nom_opt,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrquad) igrquad,
type (group_), dimension(ngrshel) igrsh4n,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrtrus) igrtruss,
type (group_), dimension(ngrbeam) igrbeam,
type (group_), dimension(ngrspri) igrspring,
type (group_), dimension(ngrnod) igrnod,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, dimension(numelc,2), intent(in) seatbelt_shell_to_spring,
integer, intent(in) nb_seatbelt_shells )

Definition at line 47 of file prelecsec.F.

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-----------
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
id
initmumps id
Definition multiplerhs_example.m:4
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
grsizen
integer function grsizen(igu, igrnod, grlen)
Definition nintrr.F:497
grsize_ele
integer function grsize_ele(igu, igrelem, ngrelem)
Definition nintrr.F:538
grsize_ele_trans
integer function grsize_ele_trans(igu, igrelem, ngrelem, seatbelt_shell_to_spring)
Definition nintrr.F:578
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:300
grsize_r2r
integer function grsize_r2r(igu, igrelem, grlen, typ)
Definition routines_r2r.F:542
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
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160