OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop17.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!|| hm_read_prop17 ../starter/source/properties/shell/hm_read_prop17.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| hm_get_float_array_2indexes ../starter/source/devtools/hm_reader/hm_get_float_array_2indexes.F
31!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
33!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
34!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
35!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
36!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
37!|| subrotvect ../starter/source/model/submodel/subrot.F
38!||--- uses -----------------------------------------------------
39!|| defaults_mod ../starter/source/modules/defaults_mod.F90
40!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
41!|| message_mod ../starter/share/message_module/message_mod.F
42!|| stack_mod ../starter/share/modules1/stack_mod.F
43!|| submodel_mod ../starter/share/modules1/submodel_mod.F
44!||====================================================================
45 SUBROUTINE hm_read_prop17(GEO ,IGEO ,PM ,IPM ,ISKN ,
46 . UNITAB ,RTRANS ,LSUBMODEL,SUB_ID ,IDTITL ,
47 . PROP_ID ,PROP_TAG , STACK_INFO,DEFAULTS_SHELL)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE unitab_mod
52 USE elbuftag_mod
53 USE submodel_mod
54 USE message_mod
55 USE stack_mod
56 USE names_and_titles_mod , ONLY : nchartitle
57 USE defaults_mod
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "units_c.inc"
66#include "com01_c.inc"
67#include "com04_c.inc"
68#include "param_c.inc"
69#include "scr16_c.inc"
70#include "scr17_c.inc"
71#include "sphcom.inc"
72#include "tablen_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 ::
78 . igeo(npropgi),ipm(npropmi,*),sub_id,iskn(liskn,*),
79 . prop_id
80 my_real
81 . geo(npropg), pm(npropm,*),rtrans(ntransf,*)
82 TYPE(submodel_data) LSUBMODEL(*)
83 CHARACTER(LEN=NCHARTITLE)::IDTITL
84 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
85 TYPE(stack_info_) , TARGET :: STACK_INFO
86 TYPE(shell_defaults_), INTENT(IN) :: DEFAULTS_SHELL
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 CHARACTER LAW_ID*4
91 INTEGER :: IGMAT, IHBE , ISMSTR, ISROT, ISHXFEM ,ISTRAIN, ITHK, IPLAST, IDSK,
92 . iorth, ipos , lamin , nsub , nisub , nn, nply, idsub , i, ply_id,
93 . imid_pi,inter ,ipid1 , ipid2 , irep, ishear ,ihbeoutp ,ipid0,
94 . isk , j, iss, n1, imid, k, nc, kk, ii, npt_sub, m1, imat,
95 . n,ipid,ishell,ish3n,id,id1,iun,nply_sub,igtyp,fail_shell,is,irp
96 my_real ::
97 . an, vx, vy, vz, thickt, dt, tmin, tmax,pthk,cvis,pun,zshift, thk ,
98 . ashear, ang, pos, hm, hf, hr, dn, dm,visc_int
99 INTEGER IHBE_D,IPLA_D,ISTR_D,ITHK_D,ISHEA_D,ISST_D,
100 . ISH3N_D, ISTRA_D,NPTS_D,IDRIL_D
101 INTEGER, DIMENSION(:),ALLOCATABLE :: IDMAT_INTP,IDMAT_SUB
102
103 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
104 LOGICAL :: IS_AVAILABLE, IS_ENCRYPTED
105C-----------------------------------------------
106C D a t a
107C-----------------------------------------------
108 DATA iun/1/
109 DATA pun/0.1/
110C======================================================================|
111C----------------------------------------------------------------
112C COMPOSITE LAYERED SHELL
113C LAYERS WITH : -VARIABLE THICKNESS
114C -VARIABLE MATERIAL (BUT LAW 25 OR 27 ONLY)
115C----------------------------------------------------------------
116C======================================================================|
117 is_available = .false.
118 is_encrypted = .false.
119c
120 igtyp = 17
121 igmat = 1
122 cvis = one
123 istrain = 1
124 irp = 0
125 idsk = 0
126!
127 ihbe_d = defaults_shell%ishell
128 ish3n_d= defaults_shell%ish3n
129 isst_d = defaults_shell%ismstr
130 ipla_d = defaults_shell%iplas
131 ithk_d = defaults_shell%ithick
132 idril_d= defaults_shell%idrill
133 ishea_d = 0
134 npts_d = 0
135 istra_d = 1
136C--------------------------------------------------
137C EXTRACT DATA (IS OPTION CRYPTED)
138C--------------------------------------------------
139 CALL hm_option_is_encrypted(is_encrypted)
140C======================================================================|
141 ! Card 1
142 CALL hm_get_intv('Ishell',ihbe,is_available,lsubmodel)
143 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
144 CALL hm_get_intv('ISH3N',ish3n,is_available,lsubmodel)
145 CALL hm_get_intv('Idrill',isrot,is_available,lsubmodel)
146 CALL hm_get_intv('plyxfem',ishxfem,is_available,lsubmodel)
147 CALL hm_get_floatv('Z0',zshift,is_available,lsubmodel,unitab)
148 CALL hm_get_floatv('Vinterply',visc_int,is_available,lsubmodel,unitab) ! global interply viscosity for plyxfem formulation
149 ! Card 2
150
151 CALL hm_get_floatv('Hm',hm,is_available,lsubmodel,unitab)
152 CALL hm_get_floatv('Hf',hf,is_available,lsubmodel,unitab)
153 CALL hm_get_floatv('Hr',hr,is_available,lsubmodel,unitab)
154 CALL hm_get_floatv('Dm',dm,is_available,lsubmodel,unitab)
155 CALL hm_get_floatv('Dn',dn,is_available,lsubmodel,unitab)
156 ! card3
157!! CALL HM_GET_INTV ('ISTRAIN' ,ISTRAIN ,IS_AVAILABLE, LSUBMODEL) ! removed
158 CALL hm_get_floatv('P_Thick_Fail', pthk ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('THICK' ,thk ,is_available, lsubmodel, unitab)
160 CALL hm_get_floatv('AREA_SHEAR',ashear ,is_available, lsubmodel, unitab)
161 CALL hm_get_intv ('ITHICK' ,ithk ,is_available, lsubmodel)
162 CALL hm_get_intv ('IPLAS' ,iplast ,is_available, lsubmodel)
163!! CALL HM_GET_FLOATV('Fexp' ,FAIL_SHELL ,IS_AVAILABLE, LSUBMODEL, UNITAB) not existing
164 ! card4
165 CALL hm_get_floatv('V_X' ,vx ,is_available, lsubmodel, unitab)
166 CALL hm_get_floatv('V_Y' ,vy ,is_available, lsubmodel, unitab)
167 CALL hm_get_floatv('V_Z' ,vz ,is_available, lsubmodel, unitab)
168 CALL hm_get_intv('SKEW_CSID' ,idsk ,is_available, lsubmodel)
169 CALL hm_get_intv('Iorth' ,iorth ,is_available, lsubmodel)
170 CALL hm_get_intv('Ipos' ,ipos ,is_available, lsubmodel)
171 CALL hm_get_intv('Ip',irp,is_available,lsubmodel)
172c--------------------------------------------
173c Read ply input cards from laminate.cfg & sub_laminate.cfg
174c either using list of plies or list of sub_stacks with interfaces
175c Fill up STACK_INFO data base
176c--------------------------------------------
177 CALL hm_get_intv('laminateconfig' ,lamin, is_available, lsubmodel)
178c
179 nsub = 0
180 nisub = 0
181 IF (lamin > 0) THEN
182 CALL hm_get_intv('sublaminateidlistmax' ,nsub, is_available, lsubmodel)
183 CALL hm_get_intv('interfacepairsize' ,nisub, is_available, lsubmodel)
184 nply = 0
185 DO is = 1,nsub
186 CALL hm_get_int_array_index('plyidlistmax',nply_sub,is,is_available,lsubmodel)
187 CALL hm_get_int_array_index('DUMMY',idsub,is,is_available,lsubmodel) !
188 !!
189 stack_info%SUB(2*(is - 1) + 1) = idsub
190 stack_info%SUB(2*(is - 1) + 2) = nply_sub
191 DO i = 1,nply_sub
192 CALL hm_get_int_array_2indexes ('plyidlist',ply_id,is,i,is_available,lsubmodel)
193 CALL hm_get_float_array_2indexes('Prop_phi' ,ang ,is,i,is_available,lsubmodel,unitab)
194 CALL hm_get_float_array_2indexes('Prop_Zi' ,pos ,is,i,is_available,lsubmodel,unitab)
195 CALL hm_get_int_array_2indexes ('Prop_mi' ,imid_pi,is,i,is_available,lsubmodel)
196 ! stockage
197 stack_info%PID(nply + i) = ply_id
198 stack_info%ANG(nply + i) = ang
199 stack_info%POS(nply + i) = pos
200 stack_info%MID_IP(nply + i) = imid_pi
201 END DO
202 nply = nply + nply_sub
203 END DO
204c
205 IF (nisub > 0) THEN
206 DO inter = 1,nisub
207 CALL hm_get_int_array_2indexes ('interfacepairplyids' ,ipid1 ,1 ,inter,is_available,lsubmodel)
208 CALL hm_get_int_array_2indexes ('interfacepairplyids' ,ipid2 ,2 ,inter,is_available,lsubmodel)
209 CALL hm_get_int_array_index ('interfacepair_Prop_mi' ,imid_pi,inter,is_available,lsubmodel)
210 !!
211 stack_info%ISUB(3*(inter - 1) + 1) = ipid1
212 stack_info%ISUB(3*(inter - 1) + 2) = ipid2
213 stack_info%ISUB(3*(inter - 1) + 3) = imid_pi
214 END DO
215 END IF
216 ELSE ! property defined by a list of plies
217 CALL hm_get_intv('plyidlistmax' ,nply ,is_available ,lsubmodel)
218 DO i=1,nply
219 CALL hm_get_int_array_index ('plyidlist' ,ply_id,i,is_available,lsubmodel)
220 CALL hm_get_float_array_index('Prop_phi',ang,i,is_available,lsubmodel,unitab)
221 CALL hm_get_float_array_index('Prop_Zi' ,pos,i,is_available,lsubmodel,unitab)
222 CALL hm_get_int_array_index ('Prop_mi' ,imid_pi,i,is_available,lsubmodel) !
223 !!
224 stack_info%PID(i) = ply_id
225 stack_info%ANG(i) = ang
226 stack_info%POS(i) = pos
227 stack_info%MID_IP(i) = imid_pi
228 END DO
229 END IF
230c
231 irep = iorth
232C IPOS = 0
233C IDSK = 0
234C----------------------
235C Default value
236C----------------------
237 IF (pthk == zero) pthk = one-em06
238 pthk = min(pthk, one)
239 pthk = max(pthk,-one)
240C ISHEAR NEVER USED
241 ishear = 0
242C CVIS
243 cvis = zero
244
245C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
246 igeo( 1)= prop_id
247C
248C recommended formulation Iplyxfem=2 (old formulation iplyxfem=1)
249 IF(ishxfem > 0) iplyxfem = 2
250 IF(ishxfem > 0 .AND. ishxfem /= 2 ) THEN
251 CALL ancmsg(msgid=1607,
252 . msgtype=msgwarning,
253 . anmode=aninfo_blind_2,
254 . i1=prop_id,
255 . c1=idtitl)
256 ENDIF
257 ishxfem = min(1,ishxfem)
258C
259 IF(ihbe /= 12 .AND. ishxfem >0) THEN
260 ishxfem = 0
261 iplyxfem = 0
262 CALL ancmsg(msgid=726,
263 . msgtype=msgwarning,
264 . anmode=aninfo_blind_2,
265 . i1=prop_id,
266 . c1=idtitl)
267 ENDIF
268 IF(ihbe==0)ihbe=ihbe_d
269 ihbeoutp=ihbe
270 IF (ihbe == 4 .AND. ish3n==0 .AND. ish3n_d == 1) THEN
271 CALL ancmsg(msgid=680,
272 . msgtype=msgwarning,
273 . anmode=aninfo_blind_1,
274 . i1=prop_id,
275 . c1=idtitl)
276 ENDIF
277 IF (ihbe==22.OR.ihbe==23) THEN
278 CALL ancmsg(msgid=539,
279 . msgtype=msgwarning,
280 . anmode=aninfo_blind_1,
281 . i1=prop_id,
282 . c1=idtitl)
283 ihbe=24
284 ENDIF
285 IF(ish3n==0) ish3n = ish3n_d
286 igeo(18) = ish3n
287 IF (dm == zero) igeo(31) = 1
288
289 IF (ihbe==24) THEN
290 IF (cvis==zero) cvis = one
291 IF (dn == zero) dn = zep015
292 IF (dm == zero) THEN
293C-------------remove in cgrtails
294C IF (IGTYP==1.OR.IGTYP==9) GEO(16,I)=ZEP015
295 END IF
296 ENDIF
297C---
298 IF(ismstr==0)ismstr=isst_d
299 IF(ihbe==3)THEN
300 IF(hm == zero)hm = em01
301 IF(hf == zero)hf = em01
302 IF(hr == zero)hr = em02
303 ELSE
304 IF(hm == zero)hm = em02
305 IF(hf == zero)hf = em02
306 IF(hr == zero)hr = em02
307 ENDIF
308
309 IF(ashear == zero) ashear=five_over_6
310C
311 IF (ihbe>11.AND.ihbe<29) THEN
312C---------GEO(13,I) est utilise pour porte dn;GEO(17,I),CVIS se change ----
313 hm = dn
314 dn = cvis
315C IGEO(20,I)=ISROT
316 ENDIF
317C
318C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
319 igeo(10)=ihbe
320 geo(171)=ihbe
321C
322 IF(isrot==0)isrot=idril_d
323 IF(isrot==2) isrot = 0
324 igeo(20)=isrot
325C-------to have DR----
326 IF (ismstr == 10 .AND. isrot > 0 .AND. idrot == 0 ) idrot = 1
327 IF(ismstr == 0)ismstr=2
328 IF(ismstr == 3. and.ihbe /= 0 .AND. ihbe /= 2) THEN
329 ismstr = 2
330 CALL ancmsg(msgid=319,
331 . msgtype=msgwarning,
332 . anmode=aninfo_blind_2,
333 . i1=prop_id,
334 . c1=idtitl)
335 ENDIF
336 geo(3) =ismstr
337 igeo(5)=ismstr
338C
339 IF (sub_id /= 0)
340 . CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
341C---
342 geo(1) = thk
343 igeo(32) = 0 ! ISLV not used (may be needed for plyxfem)
344 IF(geo(38) == zero) geo(38) = five_over_6
345 !! IF(NLY == 1) GEO(38)= ZERO
346 fail_shell = 0
347 an=sqrt(vx*vx+vy*vy+vz*vz)
348 IF(an < em10)THEN
349 vx=one
350 vy=zero
351 vz=zero
352 IF (irp==23) THEN
353 CALL ancmsg(msgid=1922,
354 . msgtype=msgerror,
355 . anmode=aninfo,
356 . c1='PROPERTY',
357 . i1=prop_id,
358 . c2='PROPERTY',
359 . c3=titr,
360 . i2=irp)
361 END IF
362 ELSE
363 vx=vx/an
364 vy=vy/an
365 vz=vz/an
366 ENDIF
367 isk = 0
368 IF (idsk/=0) THEN
369 DO j=0,numskw+min(iun,nspcond)*numsph+nsubmod
370 IF(idsk == iskn(4,j+1)) THEN
371 isk=j+1
372 GO TO 10
373 ENDIF
374 END DO
375 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
376 CALL ancmsg(msgid=184,
377 . msgtype=msgerror,
378 . anmode=aninfo,
379 . c1='PROPERTY',
380 . i1=prop_id,
381 . c2='PROPERTY',
382 . c3=titr,
383 . i2=idsk)
384 10 CONTINUE
385 ENDIF
386 IF ((irp==22.OR.irp==25).AND.isk==0) THEN
387 CALL ancmsg(msgid=1923,
388 . msgtype=msgerror,
389 . anmode=aninfo,
390 . c1='PROPERTY',
391 . i1=prop_id,
392 . c2='PROPERTY',
393 . c3=titr,
394 . i2=irp)
395 END IF
396c check duplicated py IDs
397 ipid0 = stack_info%PID(1)
398 DO k=2,nply
399 IF (stack_info%PID(k) == ipid0) THEN
400 CALL ancmsg(msgid=1584,msgtype=msgerror,anmode=aninfo_blind_2,
401 . i1=prop_id,
402 . i2=ipid0)
403 ENDIF
404 ENDDO
405c
406 IF(ithk == 0)ithk=ithk_d
407 IF(ishear == 0)ishear=ishea_d
408 IF(iplast == 0)iplast=ipla_d
409!
410 ihbe = igeo(10)
411 iss = igeo(5)
412C======================================================================|
413 IF (dm == zero) igeo(31) = 1
414 igeo( 1) = prop_id
415 igeo(2) = isk
416 igeo(5) = ismstr
417 igeo(6) = iorth ! IREP
418 igeo(11) = igtyp
419 igeo(18) = ish3n
420 igeo(19) = ishxfem
421 igeo(20) = isrot
422 igeo(14) = irp
423!! IGEO(47) = IINT
424 !! is not necessary it done in translation : before 2017 igmat=-1
425 !! the new global mat is by default since 2017 version IGMAT IS USED GENERALLY > 0
426 igeo(98) = igmat
427c
428 geo(3) = ismstr
429 geo(7) = vx
430 geo(8) = vy
431 geo(9) = vz
432 geo(11) = istrain
433 geo(12) = igtyp
434 geo(13) = hm
435 geo(14) = hf
436 geo(15) = hr
437 geo(16) = dm
438 geo(17) = dn
439 geo(20) = visc_int ! for ply-xfem formulation
440 geo(35) = ithk
441 geo(37) = ishear
442 geo(38) = ashear
443 geo(39) = iplast
444 geo(42) = pthk
445 geo(43) = one
446 geo(171)= ihbe ! double stockage
447 geo(199)= zshift
448C
449 ihbe=nint(geo(171))
450 IF(ihbe==0)THEN
451 geo(171)=0
452 ELSEIF(ihbe==1)THEN
453 geo(171)= 1
454 ELSEIF(ihbe==2)THEN
455 geo(171)=0
456 ELSEIF(ihbe>=3.AND.ihbe<100.AND.ihbe/=4)THEN
457 geo(171)=ihbe-1
458 ENDIF
459
460 istrain=nint(geo(11))
461 IF(istrain==0)THEN
462 geo(11)=0
463 ELSEIF(istrain==1)THEN
464 geo(11)=1
465 ELSEIF(istrain==2)THEN
466 geo(11)=0
467 ENDIF
468
469 ishear = geo(37)
470 IF(ishear==0)THEN
471 geo(37)=0
472 ELSEIF(ishear==1)THEN
473 geo(37)=1
474 ELSEIF(ishear==2)THEN
475 geo(37)=0
476 ENDIF
477!! N1 it not used only with old input format
478!! IGEO(IPPID + N1) = IPOS
479 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
480C-----------------------------------------------------------------
481 IF(is_encrypted)THEN
482 WRITE(iout,1000)prop_id
483 1000 FORMAT(
484 & 5x,'COMPOSITE LAYERED SHELL PROPERTY SET'/,
485 & 5x,'------------------------------------'/,
486 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
487 & 5x,'CONFIDENTIAL DATA'//)
488 ELSE
489 IF(isk==0)THEN
490 IF (ihbe > 11.AND.ihbe < 29) THEN
491 WRITE(iout,2112)prop_id,istrain,geo(1),iss,ihbe,
492 . ish3n,igeo(20),
493 . geo(16),geo(13),geo(38),pthk,fail_shell,ishear,ithk,
494 . iplast,irep,geo(7),geo(8),geo(9),igeo(14)
495 ELSE
496 WRITE(iout,2110)prop_id,istrain,geo(1),iss,ihbe, ! nly de moins
497 . ish3n,
498 . geo(13),geo(14),geo(15),geo(16),
499 . geo(38),pthk,fail_shell,ishear,ithk,iplast,irep,
500 . geo(7),geo(8),geo(9),igeo(14)
501 ENDIF
502 ELSE
503 IF (ihbe > 11.AND.ihbe < 29) THEN
504 WRITE(iout,2113)prop_id,istrain,geo(1),iss,ihbe,
505 . ish3n,igeo(20),
506 . geo(16),geo(13),geo(38),pthk,fail_shell,ishear,ithk,
507 . iplast,irep,idsk,igeo(14)
508 ELSE
509 WRITE(iout,2111)prop_id,istrain,geo(1),iss,ihbe,
510 . ish3n,
511 . geo(13),geo(14),geo(15),geo(16),geo(38),pthk,
512 . fail_shell,ishear,ithk,iplast,irep,idsk,igeo(14)
513 ENDIF
514 ENDIF
515 IF(ishxfem > 0) WRITE(iout, 2114)
516 ENDIF
517
518C---
519!!! IF (NLY>NLYMAX) THEN
520!! CALL ANCMSG(MSGID=28,
521!! . MSGTYPE=MSGERROR,
522!! . ANMODE=ANINFO_BLIND_1,
523!! . I1=IG,
524!! . C1=TITR,
525!! . I2=NLYMAX)
526!! ENDIF
527C
528 nc = nply
529 ALLOCATE( idmat_intp(nply),idmat_sub(nisub))
530 idmat_intp = 0
531 idmat_sub = 0
532 n1 = nply
533 geo(6)=n1 + em01
534 igeo(4) = n1
535C
536 igeo(43) = nsub ! number of substack
537 igeo(44) = nisub ! number of interface
538 DO 250 k = 1, nply
539 imid = stack_info%MID_IP(k)
540 idmat_intp(k) = imid
541 IF( imid == 0 .AND. ishxfem > 0) THEN
542 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
543 CALL ancmsg(msgid=2019,
544 . msgtype=msgerror,
545 . anmode=aninfo_blind_2,
546 . i1=prop_id,
547 . c1=titr,
548 . i2=imid)
549 ENDIF
550 DO j=1,nummat
551 IF(ipm(1,j) == imid) THEN
552 stack_info%MID_IP(k) = j
553 GO TO 250
554 ENDIF
555 ENDDO
556 IF(ishxfem > 0) THEN
557 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
558 CALL ancmsg(msgid=2019,
559 . msgtype=msgerror,
560 . anmode=aninfo_blind_2,
561 . i1=prop_id,
562 . c1=titr,
563 . i2=imid)
564 ENDIF
565 stack_info%MID_IP(k) = 0
566 250 CONTINUE
567C isub stack
568 IF(igeo(44) > 0) THEN
569 DO 300 k = 1, nisub
570 imid = stack_info%ISUB (3*(k-1) + 3)
571 idmat_sub(k) = imid
572 IF( imid == 0 .AND. ishxfem > 0) THEN
573 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
574 CALL ancmsg(msgid=31,
575 . msgtype=msgerror,
576 . anmode=aninfo_blind_2,
577 . i1=prop_id,
578 . c1=titr,
579 . i2=imid)
580 ENDIF
581 DO j=1,nummat
582 IF(ipm(1,j) == imid) THEN
583 stack_info%ISUB (3*(k-1) + 3) = j
584 GO TO 300
585 ENDIF
586 ENDDO
587 IF(ishxfem > 0) THEN
588 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
589 CALL ancmsg(msgid=31,
590 . msgtype=msgerror,
591 . anmode=aninfo_blind_2,
592 . i1=prop_id,
593 . c1=titr,
594 . i2=imid)
595 ENDIF
596 stack_info%ISUB (3*(k-1) + 3) = 0
597 300 CONTINUE
598 ENDIF
599 igeo(99) = ipos
600 IF(nsub > 0) THEN
601 kk = 0
602 DO ii = 1,nsub
603 idsub = stack_info%SUB ( 2*(ii - 1) + 1)
604 npt_sub = stack_info%SUB ( 2*(ii - 1) + 2)
605C
606 IF(is_encrypted .EQV. .false. )WRITE(iout,3000)idsub
607 DO k=1,npt_sub
608 m1= kk + k
609 IF(is_encrypted .EQV. .false. ) THEN
610 WRITE(iout,2121)k,stack_info%PID(m1),stack_info%ANG(m1),
611 . stack_info%POS(m1)
612 IF(ishxfem > 0) WRITE(iout,2122)idmat_intp(m1),geo(20)
613 ENDIF
614 stack_info%ANG(m1)=stack_info%ANG(m1)*pi/hundred80
615 ENDDO
616 kk = kk + npt_sub
617 ENDDO
618 nisub= igeo(44)
619 DO k=1,nisub
620 ipid1 =stack_info%ISUB (3*(k - 1) + 1)
621 ipid2 =stack_info%ISUB (3*(k - 1) + 2)
622 imat =stack_info%ISUB (3*(k - 1) + 3)
623 IF( is_encrypted .EQV. .false. ) THEN
624 WRITE(iout,3100)k
625 IF(ishxfem > 0) THEN
626 WRITE(iout,3200)ipid1,ipid2,imat
627 ELSE
628 WRITE(iout,3300)ipid1,ipid2
629 ENDIF
630 ENDIF
631 ENDDO
632 ELSE
633 DO n=1,n1
634 IF(is_encrypted .EQV. .false. )THEN
635 WRITE(iout,2121)n,stack_info%PID(n),stack_info%ANG(n),
636 . stack_info%POS(n)
637 IF(n < n1 .AND. ishxfem > 0) WRITE(iout,2122)idmat_intp(n),geo(20)
638 ENDIF
639 stack_info%ANG(n)=stack_info%ANG(n)*pi/hundred80
640 ENDDO
641 ENDIF
642C
643 DEALLOCATE (idmat_intp,idmat_sub)
644C----
645 RETURN
646 2110 FORMAT(
647 & 5x,'COMPOSITE STACK SHELL PROPERTY SET ',
648 & 'WITH VARIABLE THICKNESSES AND MATERIALS'/,
649 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
650!! & 5X,'NUMBER OF LAYERS. . . . . . . . . . . .=',I10/,
651 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
652 & 5x,'SHELL THICKNESS . . . . . . . . . . . .=',1pg20.13/,
653 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
654 & 5x,'SHELL FORMULATION FLAG. . . . . . . . .=',i10/,
655 & 5x,'3NODE SHELL FORMULATION FLAG. . . . . .=',i10/,
656 & 5x,'SHELL HOURGLASS MEMBRANE DAMPING. . . .=',1pg20.13/,
657 & 5x,'SHELL HOURGLASS FLEXURAL DAMPING. . . .=',1pg20.13/,
658 & 5x,'SHELL HOURGLASS ROTATIONAL DAMPING. . .=',1pg20.13/,
659 & 5x,'SHELL MEMBRANE DAMPING. . . . . . . . .=',1pg20.13/,
660 & 5x,'SHEAR AREA REDUCTION FACTOR . . . . . .=',1pg20.13/,
661 & 5x,'ELEMENT DELETION PARAMETER. . . . . . .=',1pg20.13/,
662 & 5x,' > 0.0 : FRACTION OF FAILED THICKNESS ',/,
663 & 5x,' < 0.0 : FRACTION OF FAILED LAYERS/PLYS ',/,
664 & 5x,'SHELL FAILURE FLAG. . . . . . . . . . .=',i10/,
665 & 5x,'SHEAR FORMULATION FLAG. . . . . . . . .=',i10/,
666 & 5x,'THICKNESS VARIATION FLAG. . . . . . . .=',i10/,
667 & 5x,'PLASTICITY FORMULATION FLAG . . . . . .=',i10/,
668 & 5x,'LOCAL ORTOTHROPY SYSTEM FLAG. . . . . .=',i10/,
669 & 5x,'X COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
670 & 5x,'Y COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
671 & 5x,'Z COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
672 & 5x,'REFERENCE DIRECTION FLAG IN SHELL PLANE=',i10/)
673 2111 FORMAT(
674 & 5x,'COMPOSITE STACK SHELL PROPERTY SET ',
675 & 'WITH VARIABLE THICKNESSES AND MATERIALS'/,
676 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
677!! & 5X,'NUMBER OF LAYERS. . . . . . . . . . . .=',I10/,
678 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
679 & 5x,'SHELL THICKNESS . . . . . . . . . . . .=',1pg20.13/,
680 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
681 & 5x,'SHELL FORMULATION FLAG. . . . . . . . .=',i10/,
682 & 5x,'3NODE SHELL FORMULATION FLAG. . . . . .=',i10/,
683 & 5x,'SHELL HOURGLASS MEMBRANE DAMPING. . . .=',1pg20.13/,
684 & 5x,'SHELL HOURGLASS FLEXURAL DAMPING. . . .=',1pg20.13/,
685 & 5x,'SHELL HOURGLASS ROTATIONAL DAMPING. . .=',1pg20.13/,
686 & 5x,'SHELL MEMBRANE DAMPING. . . . . . . . .=',1pg20.13/,
687 & 5x,'SHEAR AREA REDUCTION FACTOR . . . . . .=',1pg20.13/,
688 & 5x,'ELEMENT DELETION PARAMETER. . . . . . .=',1pg20.13/,
689 & 5x,' > 0.0 : FRACTION OF FAILED THICKNESS ',/,
690 & 5x,' < 0.0 : FRACTION OF FAILED LAYERS/PLYS ',/,
691 & 5x,'SHELL FAILURE FLAG. . . . . . . . . . .=',i10/,
692 & 5x,'SHEAR FORMULATION FLAG. . . . . . . . .=',i10/,
693 & 5x,'THICKNESS VARIATION FLAG. . . . . . . .=',i10/,
694 & 5x,'PLASTICITY FORMULATION FLAG . . . . . .=',i10/,
695 & 5x,'LOCAL ORTOTHROPY SYSTEM FLAG. . . . . .=',i10/,
696 & 5x,'SKEW OF THE FIRST ORTHOTROPY DIRECTION.=',i10/,
697 & 5x,'REFERENCE DIRECTION FLAG IN SHELL PLANE=',i10/)
698 2112 FORMAT(
699 & 5x,'COMPOSITE STACK SHELL PROPERTY SET ',
700 & 'WITH VARIABLE THICKNESSES AND MATERIALS'/,
701 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
702!! & 5X,'NUMBER OF LAYERS. . . . . . . . . . . .=',I10/,
703 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
704 & 5x,'SHELL THICKNESS . . . . . . . . . . . .=',1pg20.13/,
705 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
706 & 5x,'SHELL FORMULATION FLAG. . . . . . . . .=',i10/,
707 & 5x,'3NODE SHELL FORMULATION FLAG. . . . . .=',i10/,
708 & 5x,'DRILLING D.O.F. FLAG . . . . . . . . .=',i10/,
709 & 5x,'SHELL MEMBRANE DAMPING. . . . . . . . .=',1pg20.13/,
710 & 5x,'SHELL NUMERICAL DAMPING . . . . . . . .=',1pg20.13/,
711 & 5x,'SHEAR AREA REDUCTION FACTOR . . . . . .=',1pg20.13/,
712 & 5x,'ELEMENT DELETION PARAMETER. . . . . . .=',1pg20.13/,
713 & 5x,' > 0.0 : FRACTION OF FAILED THICKNESS ',/,
714 & 5x,' < 0.0 : FRACTION OF FAILED LAYERS/PLYS ',/,
715 & 5x,'SHELL FAILURE FLAG. . . . . . . . . . .=',i10/,
716 & 5x,'SHEAR FORMULATION FLAG. . . . . . . . .=',i10/,
717 & 5x,'THICKNESS VARIATION FLAG. . . . . . . .=',i10/,
718 & 5x,'PLASTICITY FORMULATION FLAG . . . . . .=',i10/,
719 & 5x,'LOCAL ORTOTHROPY SYSTEM FLAG. . . . . .=',i10/,
720 & 5x,'X COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
721 & 5x,'Y COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
722 & 5x,'Z COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
723 & 5x,'reference direction flag in shell plane=',I10/)
724 2113 FORMAT(
725 & 5X,'composite stack shell property set ',
726 & 'with variable thicknesses and materials'/,
727 & 5X,'property set number . . . . . . . . . .=',I10/,
728!! & 5X,'number of layers. . . . . . . . . . . .=',I10/,
729 & 5X,'post processing strain flag . . . . . .=',I10/,
730 & 5X,'shell thickness . . . . . . . . . . . .=',1PG20.13/,
731 & 5X,'small strain flag . . . . . . . . . . .=',I10/,
732 & 5X,'shell formulation flag. . . . . . . . .=',I10/,
733 & 5X,'3node shell formulation flag. . . . . .=',I10/,
734 & 5X,'drilling d.o.f. flag . . . . . . . . .=',I10/,
735 & 5X,'shell membrane damping. . . . . . . . .=',1PG20.13/,
736 & 5X,'shell numerical damping . . . . . . . .=',1PG20.13/,
737 & 5X,'shear area reduction factor . . . . . .=',1PG20.13/,
738 & 5X,'element deletion PARAMETER. . . . . . .=',1PG20.13/,
739 & 5X,' > 0.0 : fraction of failed thickness ',/,
740 & 5X,' < 0.0 : fraction of failed layers/plys ',/,
741 & 5X,'shell failure flag. . . . . . . . . . .=',I10/,
742 & 5X,'shear formulation flag. . . . . . . . .=',I10/,
743 & 5X,'thickness variation flag. . . . . . . .=',I10/,
744 & 5X,'plasticity formulation flag . . . . . .=',I10/,
745 & 5X,'local ortothropy system flag. . . . . .=',I10/,
746 & 5X,'skew of the first orthotropy direction.=',I10/,
747 & 5X,'reference direction flag in shell plane=',I10/)
748 2114 FORMAT(
749 & 5X,'ply xfem shell composite formulation is activated '/)
750 2121 FORMAT(
751 & 5X,' ply ',I3/,
752 & 5X,' ply pid number . . . . . . . . .=',I10/
753 & 5X,' angle(dir 1,proj(dir 1 / shell).=',1PG20.13/,
754 & 5X,' position. . . . . . . . . . . . .=',1PG20.13/)
755 2122 FORMAT(
756 & 5X,' inter-ply mid number . . . . . .=',I10/
757 & 5X,' inter-ply shell damping . . . . . .=',1PG20.13/)
758 3000 FORMAT(
759 & 5X,' composite substack shell id . . . . . . =',I10/ )
760 3100 FORMAT(
761 & 5X,' INTERFACE number between-substack . . .:',I10/ )
762 3200 FORMAT(
763 & 5X,' inter-ply_1 pid number . . . . . =',I10/,
764 & 5X,' inter-ply_2 pid number . . . . . .=',I10/,
765 & 5X,' inter-ply mid number . . . . . . =',I10/)
766 3300 FORMAT(
767 & 5X,' inter-ply_1 pid number . . . . . =',I10/,
768 & 5X,' inter-ply_2 pid number . . . . . .=',I10/)
769 END
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
the
end diagonal values have been computed in the(sparse) matrix id.SOL
hm_get_float_array_2indexes
subroutine hm_get_float_array_2indexes(name, rval, index1, index2, is_available, lsubmodel, unitab)
Definition hm_get_float_array_2indexes.F:36
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_int_array_2indexes
subroutine hm_get_int_array_2indexes(name, ival, index1, index2, is_available, lsubmodel)
Definition hm_get_int_array_2indexes.F:57
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_prop17
subroutine hm_read_prop17(geo, igeo, pm, ipm, iskn, unitab, rtrans, lsubmodel, sub_id, idtitl, prop_id, prop_tag, stack_info, defaults_shell)
Definition hm_read_prop17.F:48
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
elbuftag_mod
Definition elbuftag_mod.F:227
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
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
stack_mod::stack_info_
Definition stack_mod.F:86
submodel_mod::submodel_data
Definition submodel_mod.F:723
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54