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 47 of file lecstack_ply.F.

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