OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop21.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_prop_read21 ../starter/source/properties/thickshell/hm_read_prop21.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!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| subrotvect ../starter/source/model/submodel/subrot.F
33!||--- uses -----------------------------------------------------
34!|| defaults_mod ../starter/source/modules/defaults_mod.F90
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_prop_read21(GEO ,IGEO ,IG ,ISKN ,UNITAB ,
40 . RTRANS ,LSUBMODEL ,SUB_ID,IDTITL ,IGTYP ,
41 . PROP_TAG, DEFAULTS_SOLID)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE submodel_mod
48 USE message_mod
49 USE defaults_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "units_c.inc"
59#include "com04_c.inc"
60#include "param_c.inc"
61#include "tablen_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
66 INTEGER IGEO(NPROPGI),IG,ISKN(LISKN,*),SUB_ID,IGTYP
67 my_real geo(npropg)
68 my_real rtrans(ntransf,*)
69 TYPE(submodel_data) LSUBMODEL(*)
70 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
71 TYPE(solid_defaults_), INTENT(IN) :: DEFAULTS_SOLID
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER IHBE,ISMSTR,IPLAST,ICPRE,ICSTR,NPT,NPTR,NPTS,NPTT,
76 . IINT,JCVT,IP,ISK,IREP,IDSK,ISTRAIN,NLY
77 my_real
78 . cvis,qa,qb,vx,vy,vz,angle,dtmin,pun,vdefmin,vdefmax,aspmax,asptet
79 INTEGER J,IHBE_DS,ISST_DS,ICONTROL_D,ICONTROL
80 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
81 CHARACTER(LEN=NCHARTITLE)::IDTITL
82C-----------------------------------------------
83C E x t e r n a l F u n c t i o n s
84C-----------------------------------------------
85 DATA pun/0.1/
86C======================================================================|
87C----------------------
88C 21 ORTHOTROPIC THICK SHELL
89C----------------------
90C======================================================================|
91
92 is_encrypted = .false.
93 is_available = .false.
94
95C HIDDEN FLAGS
96C----------------------
97 istrain = 1
98 iplast = 2
99 jcvt = 2
100 iint = 1
101 icpre = 0
102
103!--- defaults values
104 ihbe_ds= defaults_solid%ISOLID
105 isst_ds= defaults_solid%ISMSTR
106 icontrol_d=defaults_solid%ICONTROL
107C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
108 igeo( 1)=ig
109 igeo(11)=igtyp
110 geo(12) =igtyp+pun
111
112 npt = 0
113
114C--------------------------------------------------
115C EXTRACT DATA (IS OPTION CRYPTED)
116C--------------------------------------------------
117 CALL hm_option_is_encrypted(is_encrypted)
118C--------------------------------------------------
119C EXTRACT DATAS (INTEGER VALUES)
120C--------------------------------------------------
121 CALL hm_get_intv('ISOLID',ihbe,is_available,lsubmodel)
122 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
123 CALL hm_get_intv('Icstr',icstr,is_available,lsubmodel)
124 CALL hm_get_intv('NBP',npt,is_available,lsubmodel)
125 CALL hm_get_intv('SKEW_CSID',idsk,is_available,lsubmodel)
126 CALL hm_get_intv('Iorth',irep,is_available,lsubmodel)
127 CALL hm_get_intv('Icontrol',icontrol,is_available,lsubmodel)
128C--------------------------------------------------
129C EXTRACT DATAS (REAL VALUES)
130C--------------------------------------------------
131 CALL hm_get_floatv('dn',cvis,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv('VECTOR_X',vx,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv('VECTOR_Y',vy,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv('VECTOR_Z',vz,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv('MAT_BETA',angle,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv('qa',qa,is_available,lsubmodel,unitab)
137 CALL hm_get_floatv('qb',qb,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv('deltaT_min',dtmin,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv('vdef_min',vdefmin,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv('vdef_max',vdefmax,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('ASP_max',aspmax,is_available,lsubmodel,unitab)
142 CALL hm_get_floatv('COL_min',asptet,is_available,lsubmodel,unitab)
143C----------------------
144Capply submodel transform to V (VX,VY,VZ)
145C
146 IF (sub_id /= 0)
147 . CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
148
149C-----------------------
150C--- Default values
151C
152C ihbe
153 IF (ihbe == 0) ihbe = ihbe_ds
154 IF (ihbe /= 14 .AND. ihbe /= 15) THEN
155c CALL ANSTCKI(IG)
156c CALL ANSTCKI(IHBE)
157c CALL ANCERR(175,ANINFO_BLIND_1)
158 CALL ancmsg(msgid=549,
159 . msgtype=msgerror,
160 . anmode=aninfo_blind_1,
161 . i1=ig,
162 . c1=idtitl,
163 . i2=ihbe,
164 . i3=21)
165 ENDIF
166C
167C smstr
168 IF(ismstr == 0) ismstr=isst_ds
169 IF(ismstr == 0) ismstr=4
170 IF (isst_ds == -2.OR.ismstr<0) ismstr=4
171C
172C icpre/icstr
173C
174C ICPRE = 0
175 ip = 0
176 IF (ihbe == 14 .AND. icstr == 0) icstr = 10
177 IF (ihbe == 14 .AND.
178 . (icstr /= 1.AND.icstr /= 10.AND.icstr /= 100)) THEN
179 CALL ancmsg(msgid=677,
180 . msgtype=msgerror,
181 . anmode=aninfo_blind_1,
182 . i1=ig,
183 . c1=idtitl,
184 . i2=icstr)
185 ELSE
186 SELECT CASE (icstr)
187 CASE(100)
188 ip = 2
189 CASE(10)
190 ip = 3
191 CASE(1)
192 ip = 1
193 END SELECT
194 END IF
195C
196C npt
197C
198 nly = 0
199 SELECT CASE (ihbe)
200 CASE(15)
201 IF (npt == 0) npt = 3
202 IF (npt < 1 .OR. npt > 9) THEN
203 CALL ancmsg(msgid=563,
204 . msgtype=msgerror,
205 . anmode=aninfo_blind_1,
206 . i1=ig,
207 . c1=idtitl,
208 . i2=npt,
209 . i3=ihbe)
210 ENDIF
211 nly = npt
212 CASE(14)
213 IF (npt == 0) npt = 222
214 nptr= npt/100
215 npts= mod(npt/10,10)
216 nptt= mod(npt,10)
217 SELECT CASE(icstr)
218 CASE(1)
219 nly = nptt
220 CASE(10)
221 nly = npts
222 CASE(100)
223 nly = nptr
224 END SELECT
225 IF (ihbe == 14 .AND.
226 . (nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.
227 . nptr > 9 .OR. npts > 9 .OR. nptt > 9)) THEN
228 CALL ancmsg(msgid=563,
229 . msgtype=msgerror,
230 . anmode=aninfo_blind_1,
231 . i1=ig,
232 . c1=idtitl,
233 . i2=npt,
234 . i3=ihbe)
235 ENDIF
236 END SELECT
237!
238 IF (icontrol==0) icontrol=icontrol_d
239 IF (icontrol>1) icontrol=0
240C
241C viscosity
242C
243
244 IF (cvis == zero) THEN
245 cvis = em01
246 ENDIF
247C igeo(31) flag for default qa qb for law 70 can be used for other law
248 IF(qa == zero .AND. qb == zero) igeo(31) = 1
249 IF (qa == zero) qa = onep1
250 IF (qb == zero) qb = fiveem2
251C
252C orthotropy (plane r,t)
253C
254 IF (ihbe /= 14) ip = 3
255C
256 isk = 0
257 IF (idsk/=0) THEN
258 DO j=0,numskw
259 IF(idsk==iskn(4,j+1)) THEN
260 isk=j+1
261 GO TO 10
262 ENDIF
263 ENDDO
264 CALL ancmsg(msgid=184,
265 . msgtype=msgerror,
266 . anmode=aninfo,
267 . c1='PROPERTY',
268 . i1=ig,
269 . c2='PROPERTY',
270 . c3=idtitl,
271 . i2=idsk)
272 10 CONTINUE
273 ENDIF
274 IF (ip <= 0) THEN
275 DO j=0,numskw
276 IF(isk == iskn(4,j+1)) THEN
277 ip=-(j+1)
278 GO TO 100
279 ENDIF
280 ENDDO
281 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
282 . c1='PROPERTY',
283 . c2='PROPERTY',
284 . i2=isk,
285 . i1=ig,
286 . c3=idtitl)
287100 CONTINUE
288 ENDIF
289 igeo(2) = ip
290 igeo(4) = npt
291 igeo(5) = ismstr
292 igeo(6) = irep
293 igeo(7) = isk
294 igeo(9) = iplast-1
295 igeo(10) = ihbe
296 igeo(12) = istrain
297 igeo(13) = icpre
298 igeo(14) = icstr
299 igeo(15) = iint
300 igeo(16) = jcvt-1
301 igeo(30) = nly
302 igeo(97) = icontrol
303C
304 geo(1) = angle
305 geo(7) = vx
306 geo(8) = vy
307 geo(9) = vz
308 geo(13) = cvis
309 geo(14) = qa
310 geo(15) = qb
311 geo(172) = dtmin
312 geo(172) = dtmin
313 geo(190)= vdefmin
314 geo(191)= vdefmax
315 geo(192)= aspmax
316 geo(193)= asptet
317C----
318 IF(.NOT.is_encrypted)THEN
319 IF(igeo(31) == 1)THEN
320 WRITE(iout,1100)ig,ihbe,ismstr,npt,icstr,
321 . cvis,qa,qb,dtmin,icontrol
322 ELSE
323 WRITE(iout,1000)ig,ihbe,ismstr,npt,icstr,
324 . cvis,qa,qb,dtmin,icontrol
325 ENDIF
326 IF(isk == 0)THEN
327 WRITE(iout,1002) geo(7),geo(8),geo(9),irep,angle
328 ELSE
329 WRITE(iout,1001) idsk,irep,angle
330 ENDIF
331 ELSE
332 WRITE(iout,1099) ig
333 ENDIF
334 IF((vdefmin+vdefmax+aspmax+asptet)>zero) THEN
335 IF (vdefmax==zero) vdefmax=ep10
336 IF (aspmax==zero) aspmax=ep10
337 WRITE(iout,3000) vdefmin,vdefmax,aspmax,asptet
338 END IF
339C
340 IF(geo( 3)/=zero.AND.igeo( 5)== 0) igeo( 5)=nint(geo( 3))
341 IF(geo(39)/=zero.AND.igeo( 9)== 0) igeo( 9)=nint(geo(39))
342 IF(geo(171)/=zero.AND.igeo(10)== 0)igeo(10)=nint(geo(171))
343
344 IF (geo(16) /= zero .OR. geo(17) /= zero) THEN
345 igeo(33) = 1 ! ISVIS flag
346 ENDIF
347
348 igeo(17)=1
349
350
351C-------- Variables stored in element buffer
352c---- Thick Shells
353 prop_tag(igtyp)%G_SIG = 6
354 prop_tag(igtyp)%G_VOL = 1
355 prop_tag(igtyp)%G_EINT = 1
356 prop_tag(igtyp)%G_QVIS = 1
357 prop_tag(igtyp)%L_SIG = 6
358 prop_tag(igtyp)%L_EINT = 1
359 prop_tag(igtyp)%L_VOL = 1
360 prop_tag(igtyp)%L_QVIS = 1
361 prop_tag(igtyp)%G_FILL = 1
362
363 prop_tag(igtyp)%G_GAMA = 6
364 prop_tag(igtyp)%L_SIGL = 6
365C
366C Probably useless for PID21 (but addressed in thsol.F ...)
367 prop_tag(igtyp)%L_GAMA = 6
368
369
370C----
371 RETURN
372C---
373 1000 FORMAT(
374 & 5x,'ORTHOTROPIC THICK SHELL PROPERTY SET'/,
375 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
376 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
377 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
378 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/,
379 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
380 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
381 & 5x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13/,
382 & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
383 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
384 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
385 1001 FORMAT(
386 & 5x,'ORTHOTROPIC SKEW FRAME. . . . . . . . .=',i10/,
387 & 5x,'LOCAL ORTHOTROPY SYSTEM FORMULATION . .=',i10/,
388 & 5x,'ORTHOTROPIC ANGLE . . . . . . . . . . .=',1pg20.13/)
389 1002 FORMAT(
390 & 5x,'REFERENCE VECTOR VX . . . . . . . . . .=',1pg20.13/,
391 & 5x,'REFERENCE VECTOR VY . . . . . . . . . .=',1pg20.13/,
392 & 5x,'REFERENCE VECTOR VZ . . . . . . . . . .=',1pg20.13/,
393 & 5x,'LOCAL ORTHOTROPY SYSTEM FORMULATION . .=',i10/,
394 & 5x,'ORTHOTROPIC ANGLE . . . . . . . . . . .=',1pg20.13/)
395 1099 FORMAT(
396 & 5x,'ORTHOTROPIC THICK SHELL PROPERTY SET'/,
397 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i8/,
398 & 5x,'CONFIDENTIAL DATA'//)
399 1100 FORMAT(
400 & 5x,'ORTHOTROPIC THICK SHELL PROPERTY SET'/,
401 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
402 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
403 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
404 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/,
405 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
406 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
407 & 5x,'DEFAULT VALUE FOR QUADRATIC BULK. . . . ',/,
408 & 5x,' VISCOSITY (QA) WILL BE USED. . . .=',1pg20.13/,
409 & 5x,'EXCEPT IN CASE LAW 70 WHERE QA = 0. ',/,
410 & 5x,'DEFAULT VALUE FOR LINEAR BULK . . . . . ',/,
411 & 5x,' VISCOSITY (QB) WILL BE USED . . . =',1pg20.13/,
412 & 5x,'EXCEPT IN CASE LAW 70 WHERE QB = 0. ',/,
413 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
414 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
415 3000 FORMAT(
416 & 5x,'solid minimum volumetric strain........=',1PG20.13/,
417 & 5X,'solid maximum volumetric strain........=',1PG20.13/,
418 & 5X,'solid maximum aspect ratio.............=',1PG20.13/,
419 & 5X,'solid minimum collapse ratio...........=',1PG20.13/)
420C---
421 END SUBROUTINE HM_PROP_READ21
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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_prop_read21
subroutine hm_prop_read21(geo, igeo, ig, iskn, unitab, rtrans, lsubmodel, sub_id, idtitl, igtyp, prop_tag, defaults_solid)
Definition hm_read_prop21.F:42
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
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
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54