OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecstack_ply.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lecstack_ply (geo_stack, x, ix, pm, itabm1, iskn, igeo_stack, ipm, npc, pld, unitab, rtrans, lsubmodel, ipart, idrapeid, ply_info, stack_info, numgeo_stack, nprop_stack, defaults)

Function/Subroutine Documentation

◆ lecstack_ply()

subroutine lecstack_ply ( geo_stack,
x,
integer, dimension(*) ix,
pm,
integer, dimension(*) itabm1,
integer, dimension(liskn,*) iskn,
integer, dimension(npropgi,numstack + numply) igeo_stack,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(*) npc,
pld,
type (unit_type_), intent(in) unitab,
rtrans,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) idrapeid,
integer, dimension(3,numply) ply_info,
type(stack_info_ ), dimension (1:nprop_stack) stack_info,
integer, dimension(numgeo+numstack) numgeo_stack,
integer nprop_stack,
type(defaults_), intent(in) defaults )

Definition at line 46 of file lecstack_ply.F.

50C============================================================================
51C M o d u l e s
52C-----------------------------------------------
53 USE unitab_mod
54 USE elbuftag_mod
55 USE submodel_mod
56 USE message_mod
57 USE stack_mod
58 USE hm_option_read_mod
59 USE submodel_mod
60 USE names_and_titles_mod , ONLY : nchartitle
61 USE defaults_mod
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "units_c.inc"
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "scr17_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
77 INTEGER IX(*),ITABM1(*),ISKN(LISKN,*),
78 . IGEO_STACK(NPROPGI,NUMSTACK + NUMPLY),IPM(NPROPMI,NUMMAT),NPC(*),
79 . IPART(LIPART1,*),IDRAPEID(*),PLY_INFO(3,NUMPLY),
80 . NPROP_STACK,NUMGEO_STACK(NUMGEO+NUMSTACK)
81 my_real geo_stack(npropg,numstack+numply), x(*), pm(npropm,nummat),pld(*),rtrans(ntransf,*)
82 TYPE(STACK_INFO_ ) , DIMENSION (1:NPROP_STACK) :: STACK_INFO
83 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
84 TYPE(DEFAULTS_) , INTENT(IN) :: DEFAULTS
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 LOGICAL lFOUND
89 CHARACTER(LEN=NCHARTITLE) :: IDTITL,TITR1
90 CHARACTER MESS*40
91 INTEGER I, IG, IGTYP, J, IHBE, K, IDS, IUNIT, UID, ISORTH
92 INTEGER NSTACK, ISTACK, NUMS, IFLAGUNIT, JPID, N1, SUB_ID, JPID1, JPID2, NISUB, II, IPOS
93 my_real rbid, fac_l, zshift
94C-----------------------------------------------
95C E x t e r n a l F u n c t i o n s
96C-----------------------------------------------
97 DATA mess/'PID DEFINITION '/
98C----------------------
99C GEO(3) : ISMSTR
100C GEO(5) : DT (ISMSTR=3 expect for solid elems)
101C GEO(7) : VX shell/solids ortho - reference vector
102C GEO(8) : VY
103C GEO(9) : VZ
104C GEO(11): ISTRAIN (shell)
105C GEO(12): IGTYP -> IGEO(11)
106C GEO(35): ITHK
107C GEO(37): ISHEAR
108C GEO(38): FSHEAR
109C GEO(39): IPLAST
110C GEO(40): IG v50 -> IGEO(1)
111C GEO (20:34): porous medium (bricks)
112C GEO(129): HCLOS (bricks)
113C GEO(130): HTEST (bricks)
114C GEO(131:170): FREE
115C GEO(171): IHBE
116C GEO(212): ANGLE BETWEEN two orthotropy directions (DIR1,DIR2) for
117C the PID52 with LAW58
118C-------------------
119C IGEO(1) : IG
120C IGEO(2) : ISK
121C IGEO(3) : ISEN
122C IGEO(4) : NIP
123C IGEO(5) : ISMSTR
124C IGEO(6) : IREP
125C IGEO(7) : ITHK
126C IGEO(8) : ISHEAR
127C IGEO(9) : IPLAST
128C IGEO(10) : IHBE
129C IGEO(11) : IGTYP
130C IGEO(12) :
131C IGEO(13) : ICPRE
132C IGEO(14) : ICSTR
133C IGEO(15) : IINT
134C IGEO(16) : IFRAM
135C IGEO(17) : ISORTH
136C IGEO(18) : ISH3N
137C IGEO(19) : ICXFEM
138C IGEO(20) : ISROT
139C IGEO(40) : IAD_KNOT
140C IGEO(41) : POLYNOMIAL DEGREE in 1st direction
141C IGEO(42) : POLYNOMIAL DEGREE in 2nd direction
142C IGEO(43) : POLYNOMIAL DEGREE in 3rd direction
143C IGEO(44) : NUMBER OF CONTROL POINTS in 1st direction
144C IGEO(45) : NUMBER OF CONTROL POINTS in 2nd direction
145C IGEO(46) : NUMBER OF CONTROL POINTS in 3rd direction
146C IGEO(47) : INTEGRATION FORMULATION FLAG for PID51 (UNIFORM / GAUSS distribution)
147C IGEO(48) : DRAPE IDENTIFICATION NUMBER
148C IGEO(49) : =1 ORTHOTROPY ANGLE DEFINED AT ELEMENT LEVEL ( /PROP/TYPE19/51/52 )
149C =2 ORTHOTROPY ANGLE DEFINED AT STACK LEVEL ( /PROP/TYPE19/51/52 )
150C=======================================================================
151 WRITE(iout,1000)
152C----------------------
153 sub_id = 0
154 rbid=zero
155c----------
156 CALL hm_option_start('/STACK')
157 DO i=1,numstack
158 CALL hm_option_read_key(lsubmodel, option_id=ig, unit_id=uid, option_titr=idtitl)
159 isorth = 0
160 iflagunit = 0
161
162 DO iunit=1,unitab%NUNITS
163 IF (unitab%UNIT_ID(iunit) == uid) THEN
164 iflagunit = 1
165 EXIT
166 ENDIF
167 ENDDO
168
169 IF (uid /= 0 .AND. iflagunit == 0) THEN
170 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
171 . i1=ig, i2=uid,
172 . c1='STACK', c2='STACK', c3=idtitl)
173 ENDIF
174
175! Stack + ply are belong to /PROP/PCOMPP
176 igtyp = 52 ! belong to /PROP/PCOMP - TYPE52
177C
178C new shell property (stack based with multi NPT through one layer
179C---------------
180C GENERIC SHELL
181C----------------------
182C
183C----------------------------------------------------------------
184C COMPOSITE LAYERED SHELL (NEW)
185C LAYERS WITH : -VARIABLE THICKNESS
186C -VARIABLE MATERIAL (BUT LAW 25 OR 27 ONLY)
187C -VARIABLE NUMBER OF INTEGRATION POINTS THROUGH ONE LAYER
188C----------------------------------------------------------------
189 CALL fretitl(idtitl,igeo_stack(npropgi-ltitr+1,i),ltitr)
190 nums = numgeo_stack(numgeo + i)
191 CALL hm_read_stack(
192 . geo_stack(1,i) ,igeo_stack(1,i) ,ipm ,iskn ,
193 . ig ,rtrans ,sub_id ,stack_info(nums) ,
194 . idtitl ,unitab ,lsubmodel,defaults%SHELL )
195
196C-------- Variables stored in element buffer
197c---- Shells
198C should be done for pccomp
199C-------------------------------
200C temporary double storage : GEO() / IGEO() : may be optimized & deleted later
201!!! ---------------------
202 igeo_stack(17,i)=isorth
203 IF(geo_stack(39,i) /= zero .AND. igeo_stack(9,i) == 0) igeo_stack( 9,i)=nint(geo_stack(39,i))
204 IF(geo_stack(171,i) /= zero .AND. igeo_stack(10,i) == 0) igeo_stack(10,i)=nint(geo_stack(171,i))
205C
206 END do!next I
207C
208C-------------------------------
209C Objet /PLY
210C-------------------------------
211 i = numstack
212 CALL hm_option_start('/PLY')
213 DO ii = 1, numply
214 CALL hm_option_read_key(lsubmodel, option_id = ig, unit_id = uid, option_titr = idtitl)
215 isorth = 0
216 iflagunit = 0
217 DO iunit=1,unitab%NUNITS
218 IF (unitab%UNIT_ID(iunit) == uid) THEN
219 iflagunit = 1
220 EXIT
221 ENDIF
222 ENDDO
223c call BIDON2 to avoid optimization issue on FAC_L variable from compiler (issue
224c observed after global code compilation with -openmp flag
225 CALL bidon2(fac_l)
226 IF (uid /=0 .AND. iflagunit == 0) THEN
227 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
228 . i1=ig, i2=uid,
229 . c1='PLY',c2='PLY',c3=idtitl)
230 ENDIF
231 igtyp = 19
232 i = i + 1
233 ihbe = 0
234 igeo_stack( 1,i) = ig
235 istack = 1
236C
237 CALL fretitl(idtitl,igeo_stack(npropgi-ltitr+1,i),ltitr)
238C
239 CALL lcgeo19(geo_stack(1,i), igeo_stack(1,i), pm, ipm, unitab, iunit, istack,idrapeid, lsubmodel)
240 IF(igeo_stack(4,i) > 10) THEN
241 CALL ancmsg(msgid=1146,msgtype=msgerror,anmode=aninfo,i1=ig,c1=idtitl)
242 CALL arret(2)
243 ENDIF
244 ply_info(1,ii) = ig
245 ply_info(2,ii) = igeo_stack(4,i)
246 ply_info(3,ii) = igeo_stack(101,i)
247 igeo_stack(1,i) =ig
248 ENDDO
249C
250C-------------------------------cy
251 nplymax = max(nplymax,numply)
252C------------------------------
253 DO i = 1, numstack
254 geo_stack(100,i) = sqrt(geo_stack(38,i)) ! SHFSR
255 END DO
256C------------------------------
257C
258 DO i = 1,numstack
259 igtyp=igeo_stack(11,i)
260 nums= numgeo_stack(numgeo + i)
261 IF(igtyp == 52) THEN
262 ! Initialization of stack thickness
263 geo_stack(1,i) = zero
264 !--- generalizing ZSHIFT ! keep only IPOS= 2 as before
265 ipos =igeo_stack(99,i)
266 zshift = geo_stack(199, i)
267 IF(ipos == 0 )THEN
268 zshift = - half
269 ELSEIF(ipos == 3) THEN
270 zshift = -one
271 ELSEIF(ipos == 4) THEN
272 zshift = zero
273 ENDIF
274 geo_stack(199, i) = zshift
275 n1 = igeo_stack(4,i)
276 DO j =1 , n1
277C ply of stack JPID
278 jpid = stack_info(nums)%PID(j)
279 lfound = .false.
280 IF(jpid > 0)THEN
281 DO k=1,numply
282 IF (igeo_stack(1,numstack + k) == jpid) THEN
283 stack_info(nums)%PID(j) = numstack + k
284C tag if the ply is in the stack
285 ids = igeo_stack(42,numstack + k)
286 igeo_stack(42 ,numstack + k) = i
287 IF(ids > 0 .AND. ids /= i) THEN
288 CALL fretitl2(titr1,igeo_stack(npropgi-ltitr+1,numstack+k),ltitr)
289 CALL ancmsg(msgid=1148,msgtype=msgerror,anmode=aninfo_blind_1,
290 . i1=igeo_stack(1,numstack + k), i2= igeo_stack(1,ids), i3= igeo_stack(1,i),
291 . c1=titr1, c2='PLY')
292 ENDIF
293C update stack thicness
294 geo_stack(1,i) = geo_stack(1,i) + geo_stack(1,numstack + k)
295 lfound = .true.
296 EXIT
297 ENDIF
298 ENDDO
299 IF(.NOT.lfound)THEN
300 CALL fretitl2(titr1,igeo_stack(npropgi-ltitr+1,i),ltitr)
301 CALL ancmsg(msgid=1149,msgtype=msgerror,anmode=aninfo_blind_1,
302 . i1=igeo_stack(1,i), i2=jpid,
303 . c1=titr1, c2='STACK')
304 ENDIF
305 endif!(JPID > 0)
306 END do!next J
307C interface substack
308 nisub = igeo_stack(44,i)
309 IF (nisub > 0) THEN
310 DO j =1 , nisub
311 jpid1 = stack_info(nums)%ISUB( 3*(j-1) + 1 )
312 jpid2 = stack_info(nums)%ISUB( 3*(j-1) + 2 )
313 IF (jpid1 > 0 .OR. jpid2 > 0) THEN
314 DO k=1,numply
315 nstack = 0
316 lfound=.false.
317 IF (igeo_stack(1,numstack + k) == jpid1) THEN
318 stack_info(nums)%ISUB (3*(j-1) + 1) = numstack + k
319 lfound=.true.
320 EXIT !next J
321 ELSEIF (igeo_stack(1,numstack + k) == jpid2) THEN
322 stack_info(nums)%ISUB (3*(j-1) + 2) = numstack + k
323 lfound=.true.
324 EXIT !next J
325 ENDIF
326 ENDDO
327 IF(.NOT.lfound)THEN
328 CALL fretitl2(titr1,igeo_stack(npropgi-ltitr+1,i),ltitr)
329 CALL ancmsg(msgid=1149,msgtype=msgerror,anmode=aninfo_blind_1,
330 . i1=igeo_stack(1,i), i2=jpid1,
331 . c1=titr1, c2='STACK')
332 CALL fretitl2(titr1,igeo_stack(npropgi-ltitr+1,i),ltitr)
333 CALL ancmsg(msgid=1149,msgtype=msgerror,anmode=aninfo_blind_1,
334 . i1=igeo_stack(1,i), i2=jpid2,
335 . c1=titr1, c2='STACK')
336 ENDIF
337 ENDIF ! IF (JPID1 > 0 .OR. JPID2 > 0)
338 ENDDO !next J
339 ENDIF ! IF (NISUB > 0)
340C
341 DO j=1,n1
342 jpid = stack_info(nums)%PID(j)
343 stack_info(nums)%THK(j) = geo_stack(1,jpid)
344 stack_info(nums)%DIR(j) = geo_stack(212,jpid) ! angle (DIR1,DIR2) - for compatibility of law58 with PID51)
345 stack_info(nums)%MID(j) = igeo_stack(101,jpid)
346 ENDDO
347!
348 ENDIF
349 ENDDO ! DO I = 1, NUMSTACK
350C-------------------------------------
351C Search for double IDs
352C-------------------------------------
353 ids = 79
354 i = 0
355 j = 0
356c CALL ANCNTS(IDS,I)
357 CALL vdouble(igeo_stack(1,1),npropgi,numstack,mess,0,rbid)
358 CALL vdouble(igeo_stack(1,numstack+1),npropgi,numply,mess,0,rbid)
359C
360C-----------
361 RETURN
362C-----------
363 1000 FORMAT(//
364 & 5x,' STACK OBJECT FOR PLY-BASED SHELL ELEMENT SETS'/,
365 & 5x,' ----------------------------------------------'//)
my_real
#define my_real
Definition cppsort.cpp:32
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_stack
subroutine hm_read_stack(geo_stack, igeo_stack, ipm, iskn, prop_id, rtrans, sub_id, stack_info, titr, unitab, lsubmodel, defaults_shell)
Definition hm_read_stack.F:48
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
lcgeo19
subroutine lcgeo19(geo, igeo, pm, ipm, unitab, iunit, istack, idrapeid, lsubmodel)
Definition lcgeo19.F:39
max
#define max(a, b)
Definition macros.h:21
elbuftag_mod
Definition elbuftag_mod.F:230
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
stack_mod
Definition stack_mod.F:75
stack_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_mod.F:133
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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:895
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
arret
subroutine arret(nn)
Definition arret.F:86
bidon2
subroutine bidon2(fac_l)
Definition machine.F:58
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:868