OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop14.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_prop14 ../starter/source/properties/solid/hm_read_prop14.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!|| arret ../starter/source/system/arret.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| hm_read_ale_close ../starter/source/ale/hm_read_ale_close.F
34!||--- uses -----------------------------------------------------
35!|| defaults_mod ../starter/source/modules/defaults_mod.F90
36!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_prop14(GEO,IGEO,PROP_TAG,MULTI_FVM,IGTYP,IG,TITR,UNITAB,
41 . LSUBMODEL,IPART,DEFAULTS_SOLID)
42C-----------------------------------------------
43C ROUTINE DESCRIPTION :
44C ===================
45C READ PROPERTY TYPE14 (/PROP/SOLID)
46C-----------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C IGEO PROPERTY ARRAY(INTEGER)
53C GEO PROPERTY ARRAY(REAL)
54C UNITAB UNITS ARRAY
55C IG PROPERTY ID(INTEGER)
56C TITR MATERIAL TITLE
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE message_mod
63 USE submodel_mod
64 USE elbuftag_mod
65 USE multi_fvm_mod
66 USE ale_mod
67 USE defaults_mod
68 USE names_and_titles_mod , ONLY : nchartitle
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76#include "scr17_c.inc"
77#include "units_c.inc"
78#include "com01_c.inc"
79#include "com04_c.inc"
80#include "param_c.inc"
81#include "tablen_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85C INPUT ARGUMENTS
86 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
87 INTEGER,INTENT(IN)::IG,IGTYP
88 INTEGER,INTENT(IN)::IPART(LIPART1,*)
89 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)::TITR
90 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
91 TYPE(multi_fvm_struct),INTENT(IN) :: MULTI_FVM
92C MODIFIED ARGUMENT
93 INTEGER,INTENT(INOUT)::IGEO(NPROPGI)
94 my_real,INTENT(INOUT)::geo(npropg)
95 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
96 TYPE(solid_defaults_), INTENT(IN) :: DEFAULTS_SOLID
97C-----------------------------------------------
98C L o c a l V a r i a b l e s
99C-----------------------------------------------
100 INTEGER IHBE,ISMSTR,IPLAS,ICPRE,ICSTR,IINT,JCVT,NPG,NPT,NPTR,NPTS,NPTT, ISTRAIN,IET,IHBE_OLD,ID
101 INTEGER I8PT,ITET4,ITET4_PREV,NSPHDIR,ID_SENS,ID_PARTSPH,IPARTSPH,J,ITET10,I_ALE_FLAG,IHBE_PR
102 my_real cvis,qa,qb,qh,vns1,vns2,dtmin,vdefmin,vdefmax,aspmax,asptet
103 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS,ITET4_D,ITET10_D,ICPRE_D,ICONTROL_D,ICONTROL
104 LOGICAL IS_AVAILABLE, IS_ENCRYPTED, lFOUND
105 CHARACTER(LEN=NCHARLINE) :: MSGLINE
106C-----------------------------------------------
107C S o u r c e L i n e s
108C-----------------------------------------------
109 is_encrypted = .false.
110 is_available = .false.
111 nsphdir = 0
112 id_partsph = 0
113!--- defaults values
114 ihbe_ds= defaults_solid%ISOLID
115 isst_ds= defaults_solid%ISMSTR
116 icpre_d= defaults_solid%ICPRE
117 itet4_d= defaults_solid%ITETRA4
118 itet10_d= defaults_solid%ITETRA10
119 iframe_ds= defaults_solid%IFRAME
120 icontrol_d=defaults_solid%ICONTROL
121C--------------------------------------------------
122 CALL hm_option_is_encrypted(is_encrypted)
123C--------------------------------------------------
124C EXTRACT DATAS (INTEGER VALUES)
125C--------------------------------------------------
126 CALL hm_get_intv('ISOLID',ihbe,is_available,lsubmodel)
127 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
128 CALL hm_get_intv('Iale',i_ale_flag,is_available,lsubmodel)
129 CALL hm_get_intv('Icpre',icpre,is_available,lsubmodel)
130 CALL hm_get_intv('I_rot',itet4,is_available,lsubmodel)
131 CALL hm_get_intv('Iframe',jcvt,is_available,lsubmodel)
132 CALL hm_get_intv('Ndir',nsphdir,is_available,lsubmodel)
133 CALL hm_get_intv('sphpart_id',ID_PARTSPH,IS_AVAILABLE,LSUBMODEL)
134 CALL HM_GET_INTV('itetra10',ITET10,IS_AVAILABLE,LSUBMODEL)
135 CALL HM_GET_INTV('inpts_r',NPTR,IS_AVAILABLE,LSUBMODEL)
136 CALL HM_GET_INTV('inpts_s',NPTS,IS_AVAILABLE,LSUBMODEL)
137 CALL HM_GET_INTV('inpts_t',NPTT,IS_AVAILABLE,LSUBMODEL)
138 CALL HM_GET_INTV('icontrol',ICONTROL,IS_AVAILABLE,LSUBMODEL)
139C--------------------------------------------------
140C EXTRACT DATAS (REAL VALUES)
141C--------------------------------------------------
142 CALL HM_GET_FLOATV('qa',QA,IS_AVAILABLE,LSUBMODEL,UNITAB)
143 CALL HM_GET_FLOATV('qb',QB,IS_AVAILABLE,LSUBMODEL,UNITAB)
144 CALL HM_GET_FLOATV('lambda',VNS1,IS_AVAILABLE,LSUBMODEL,UNITAB)
145 CALL HM_GET_FLOATV('mu',vns2,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv('h',qh,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv('dn',cvis,is_available,lsubmodel,unitab)
148 CALL hm_get_floatv('deltaT_min',dtmin,is_available,lsubmodel,unitab)
149 CALL hm_get_floatv('vdef_min',vdefmin,is_available,lsubmodel,unitab)
150 CALL hm_get_floatv('vdef_max',vdefmax,is_available,lsubmodel,unitab)
151 CALL hm_get_floatv('ASP_max',aspmax,is_available,lsubmodel,unitab)
152 CALL hm_get_floatv('COL_min',asptet,is_available,lsubmodel,unitab)
153
154 icstr = 0
155 id_sens = 0
156 istrain = 1
157 iplas = 2
158 iet = 0
159
160C--------------------------------------------------
161C DEFAULT VALUES & CHECKS
162C--------------------------------------------------
163 ! --default ITET10 ---
164 IF(itet10 == 0)THEN
165 itet10 = itet10_d
166 ENDIF
167 IF(itet10/=0 .AND. itet10/=2 .AND. itet10/=3 .AND. itet10/=1000)THEN
168 itet10=1000
169 ENDIF
170
171 ! --default ITET4 ---
172 itet4_prev=itet4
173 IF(itet4 == 0 .OR. (itet4 >= 4 .AND. itet4/=1000) )THEN
174 ! use value from /DEF_SOLID (by default or in case of unexpected value) : and check it below
175 itet4 = itet4_d
176 ENDIF
177 IF(itet4 == 2) THEN
178 ! old single tetra4 & tetra10 formulation flag : set ITET4 to 1000
179 itet10 = 2
180 itet4 = 1000
181 msgline=' ITETRA4 IS SET TO 1000'
182 CALL ancmsg(msgid=2027,msgtype=msgwarning,anmode=aninfo,i1=ig,c1=titr,i2=2,c2=trim(msgline))
183 ELSEIF(itet4 >=4 .AND. itet4 /= 1000)THEN
184 ! ITET4 may have been updated (ITET4=ITET4_D) : do not allow unexpected values from /DEF_SOLID
185 msgline=' ITETRA4 IS SET TO 1000'
186 CALL ancmsg(msgid=2027,msgtype=msgwarning,anmode=aninfo,i1=ig,c1=titr,i2=itet4,c2=trim(msgline))
187 itet4 = 1000
188 ELSEIF(itet4_prev >= 4 .AND. itet4_prev/=1000)THEN
189 !warn that unexpected user value was overwritten by value from /def_solid which is an expected one
190 msgline=' ITETRA4 IS SET TO '
191 WRITE(msgline(22:31),fmt='(I0)')itet4
192 CALL ancmsg(msgid=2027,msgtype=msgwarning,anmode=aninfo,i1=ig,c1=titr,i2=itet4_prev,c2=trim(msgline))
193 ENDIF
194 !backward compatibility
195 iint = 0
196 IF(itet4 < 0) THEN
197 iint = -itet4
198 itet4 = 0
199 ENDIF
200
201 ! --check SPHPART_ID ---
202 id = ig
203 ipartsph=0
204 lfound=.false.
205 IF(id_partsph>0)THEN
206 DO j=1,npart
207 IF(ipart(4,j) == id_partsph) THEN
208 ipartsph=j
209 lfound=.true.
210 ENDIF
211 ENDDO
212 IF(.NOT.lfound)THEN
213 CALL ancmsg(msgid=1037,msgtype=msgerror,anmode=aninfo,i1=id, c1=titr,i2=id_partsph)
214 CALL arret(2)
215 ENDIF
216 END IF
217
218 ! --default IHBE ---
219 IF (ihbe == 0) ihbe = ihbe_ds
220 ! iint : Lobato/GAuss (cache)
221 ! used for elasto-platic critia parameter: IET---
222 IF (ihbe == 16 ) THEN ! not allowed
223 IF (iint == 0) iint = 1 ! gauss integration
224 ELSEIF (n2d ==1.AND.ihbe == 17 ) THEN
225 IF (iint == 0) iint = 1
226 ELSEIF (ihbe == 5 ) THEN
227 ihbe = 1
228 iint = 3
229 ELSE
230 IF (ihbe /= 24 ) iint = 1
231 ENDIF
232 ! solid17, IHBE will be changed to 17 in sgrtails.F
233 IF (ihbe == 18 ) iint = 2
234 ! solid17 IINT=3
235 IF (ihbe == 19 ) THEN
236 ihbe = 17
237 iint = 3
238 END IF
239
240 ! --check IHBE ---
241 IF (n2d > 0 .AND. ihbe/=0 .AND. ihbe/=2 .AND. ihbe/=17) THEN
242 ihbe_old=ihbe
243 ihbe=ihbe_ds
244 CALL ancmsg(msgid=321,msgtype=msgwarning,anmode=aninfo_blind_2,i1=id,c1=titr,i2=ihbe_old,i3=ihbe)
245 ELSEIF (ihbe / =1 .AND. ihbe/=2 .AND. ihbe/=12 .AND. ihbe / =13 .AND. ihbe /= 14 .AND. ihbe /= 16 .AND.
246 . ihbe /= 24 .AND. ihbe /= 222.AND. ihbe /= 17.AND. ihbe /= 18) THEN
247 CALL ancmsg(msgid=549, msgtype=msgwarning, anmode=aninfo_blind_1,i1=id,c1=titr,i2=ihbe,i3=14)
248 ihbe=1
249 ENDIF
250
251 ! --default I_ALE_FLAG ---
252 ! I_ALEF_LAG : 0 (Lagrange)
253 ! 1 (ale)
254 ! 2 (euler)
255 IF(i_ale_flag <= 0 .OR. i_ale_flag >= 3)THEN
256 i_ale_flag = 0
257 ENDIF
258 IF(i_ale_flag /= 0)THEN
259 IF(ihbe /= 0 .AND. ihbe /= 1 .AND. ihbe /= 2 )THEN
260 CALL ancmsg(msgid=131,msgtype=msgerror,anmode=aninfo_blind_1, i1=id, c1=titr, i2=ihbe)
261 ENDIF
262 ENDIF
263
264 ! --check QH ---
265 IF(qh < zero .OR. qh >= fifteen/hundred)THEN
266 CALL ancmsg(msgid=311,msgtype=msgwarning,anmode=aninfo_blind_1, i1=id,c1=titr,r1=qh)
267 ENDIF
268
269 ! --default JCVT ---
270 IF (jcvt == 0) jcvt = iframe_ds
271 IF (ihbe == 14.OR.ihbe == 18) jcvt = 2
272 IF (ihbe == 15) jcvt = 2
273 IF (ihbe == 16) jcvt = 1
274 IF (ihbe == 24) jcvt = 2
275 IF (iframe_ds == -2.OR.jcvt<0) jcvt = -1
276 ! JCVT = 2 for lagrangian IHBE=1,2
277
278 ! --default ISMSTR ---
279 IF (ismstr == 0) ismstr=isst_ds
280 IF (ismstr == 0.AND.ihbe /= 18) ismstr=4
281 IF (isst_ds == -2) ismstr = -1
282
283 ! --default icpre/icstr ---
284 IF (icpre == 0) icpre = icpre_d
285 IF((n2d > 0 .AND. ihbe == 17) ) THEN
286 IF(icpre/=1 .AND. icpre/=2) icpre=0
287 ! no effet for Axi Isolid17 for the moment
288 IF(n2d == 1 .AND. ihbe == 17) icpre=0
289 ELSE
290 IF (ihbe /= 14 .AND. ihbe /= 24 .AND. ihbe /= 17 .AND. ihbe /= 18) icpre = 0
291 IF (ihbe == 17 ) THEN
292 IF (icpre == 0 ) THEN
293 icpre = 1
294 ELSEIF(icpre == 3 ) THEN
295 icpre = 0
296 ENDIF
297 ENDIF
298 IF (icpre == 3 .AND. ihbe /= 18) icpre =0
299 icstr = 0
300 ENDIF
301 IF (icpre_d == -2) icpre = -1
302
303 ! --default NPT ---
304 npt = nptr*100 + npts*10 + nptt
305 SELECT CASE (ihbe)
306 CASE(14,16,222)
307 IF (npt== 0) THEN
308 nptr= 2
309 npts= 2
310 nptt= 2
311 npt = 222
312 END IF
313 npg = nptr*npts*nptt
314 IF (ihbe == 14 .AND.(nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.nptr > 9 .OR. npts > 9 .OR. nptt > 9)) THEN
315 CALL ancmsg(msgid=563,msgtype=msgerror,anmode=aninfo_blind_1,i1=id, c1=titr,i2=npt, i3=ihbe)
316 ELSEIF (ihbe == 16 .AND.(nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR. nptr > 3 .OR. npts > 9 .OR. nptt > 3)) THEN
317 CALL ancmsg(msgid=563,msgtype=msgerror,anmode=aninfo_blind_1, i1=id, c1=titr,i2=npt, i3=ihbe)
318 ENDIF
319 CASE(1,2,101,102,24)
320 npt = 1
321 npg = npt
322 CASE(12,112,13,18)
323 npt = 8
324 npg = npt
325 END SELECT
326
327 IF (ihbe == 12 .OR. ihbe == 13 .OR. ihbe == 17 .OR.(n2d == 1 .AND. ihbe == 22)) THEN
328 IF (n2d == 0) THEN
329 npt = 8
330 npg = npt
331 ELSE
332 npt = 4
333 npg = npt
334 ENDIF
335 ENDIF
336
337 IF(n2d > 0 .AND. ihbe/=0 .AND. ihbe/=2 .AND. ihbe/=17 .AND. (.NOT.(n2d==1.AND.ihbe==22))) THEN
338 ihbe_old=ihbe
339 ihbe=0
340 CALL ancmsg(msgid=324, msgtype=msgwarning, anmode=aninfo_blind_2, i1=id, c1=titr, i2=ihbe_old, i3=ihbe)
341 ENDIF
342 IF (icontrol==0) icontrol=icontrol_d
343 IF (icontrol>1) icontrol=0
344
345 ! --default QA,QB (PSEUDO VISCOSITY) ---
346 ! igeo(31) flag for default qa qb for law 70 can be used for other law
347 IF (qa == zero .AND. qb == zero) igeo(31) = 1
348 IF (qa == zero) qa = onep1
349 IF (qb == zero) qb = fiveem2
350
351 ! --default CVIS (hourglass) ---
352 IF (ihbe == 24) THEN
353 IF (cvis == zero) cvis = em01
354 geo(13) = cvis
355 qh = zero
356 ! default : auto
357 iint = iet
358 ELSEIF (ihbe==1.OR.ihbe==2) THEN
359 IF (qh == zero.AND.icontrol==0) qh = em01
360 IF (qh == zero.AND.icontrol==1) qh = one
361 cvis = zero
362 geo(13) = qh
363 ELSE
364 qh = zero
365 cvis = zero
366 geo(13) = zero
367 ENDIF
368
369C--------------------------------------------------
370C BUFFER STORAGE
371C--------------------------------------------------
372 igeo(4) = npt
373 igeo(5) = ismstr
374 igeo(9) = iplas-1
375 igeo(10) = ihbe
376 igeo(12) = istrain
377 igeo(13) = icpre
378 igeo(14) = icstr
379 igeo(15) = iint
380 igeo(16) = jcvt-1
381 igeo(37) = nsphdir
382 igeo(38) = ipartsph
383 igeo(39) = id_sens
384 igeo(62) = i_ale_flag
385 igeo(97) = icontrol
386
387 geo(14) = qa
388 geo(15) = qb
389 geo(16) = vns1
390 geo(17) = vns2
391 geo(172)= dtmin
392 geo(190)= vdefmin
393 geo(191)= vdefmax
394 geo(192)= aspmax
395 geo(193)= asptet
396
397C--------------------------------------------------
398C LISTING OUTPUTS
399C--------------------------------------------------
400 ihbe_pr = ihbe
401 IF (ihbe==1.AND.iint==3) ihbe_pr=5
402 IF(.NOT.is_encrypted)THEN
403 IF(igeo(31) == 1) THEN
404 WRITE(iout,1100)ig,ihbe_pr,ismstr,i_ale_flag,iplas,jcvt,itet4,
405 . itet10,icpre,icstr,cvis,qa,qb,qh,vns1,vns2,dtmin, istrain,icontrol
406 ELSE
407 WRITE(iout,1000)ig,ihbe_pr,ismstr,i_ale_flag,iplas,jcvt,itet4,
408 . itet10,icpre,icstr,cvis,qa,qb,qh,vns1,vns2,dtmin, istrain,icontrol
409 ENDIF
410 IF((vdefmin+vdefmax+aspmax+asptet)>zero) THEN
411 IF (vdefmax==zero) vdefmax=ep10
412 IF (aspmax==zero) aspmax=ep10
413 WRITE(iout,3000) vdefmin,vdefmax,aspmax,asptet
414 END IF
415 IF (iet > 0) WRITE(iout,2010) iet
416 IF (npt > 200) THEN
417 WRITE(iout,1001) npg,npt
418 ELSE
419 WRITE(iout,1002) npg
420 ENDIF
421 IF(nsphdir/=0)WRITE(iout,2020)nsphdir, id_partsph, id_sens
422 ELSE
423 WRITE(iout,1099) ig
424 ENDIF
425
426 IF (itet4 == 1000) itet4 = 0
427 igeo(20) = itet4
428 IF (itet10 == 1000) itet10 = 0
429 igeo(50) = itet10
430
431C--------------------------------------------------
432C /ALE/CLOSE/<prop_id>
433C--------------------------------------------------
434 CALL hm_read_ale_close(unitab, lsubmodel, geo) !GEO(129) & GEO(130)
435
436C--------------------------------------------------
437C SIZES FOR INITIALIZATION (lecgeo)
438C--------------------------------------------------
439
440 prop_tag(igtyp)%G_SIG = 6
441 prop_tag(igtyp)%L_SIG = 6
442 prop_tag(igtyp)%G_EINT = 1
443 prop_tag(igtyp)%G_QVIS = 1
444 prop_tag(igtyp)%L_EINT = 1
445 prop_tag(igtyp)%G_VOL = 1
446 prop_tag(igtyp)%L_VOL = 1
447 prop_tag(igtyp)%L_QVIS = 1
448 IF (multi_fvm%IS_USED) prop_tag(igtyp)%G_MOM = 3
449 prop_tag(igtyp)%G_FILL = 1
450 prop_tag(igtyp)%L_STRA = 6
451 IF (n2d /= 0 .AND. multi_fvm%IS_USED) prop_tag(igtyp)%G_AREA = 1
452 IF (geo(16) /= zero .OR. geo(17) /= zero) THEN
453 igeo(33) = 1 ! ISVIS flag
454 ENDIF
455 igeo(1) =ig
456 igeo(11)=igtyp
457 igeo(17)=0
458 IF(geo(39)/=zero.AND.igeo(9)== 0)igeo(9)=nint(geo(39))
459 IF(geo(171)/=zero.AND.igeo(10)== 0)igeo(10)=nint(geo(171))
460 geo(12)= igtyp + 0.1
461 IF(ale%GLOBAL%ICAA==1) THEN
462 geo(1) = igeo(4)
463 igeo(36) = 1
464 ENDIF
465C---
466 RETURN
467C---
468 1000 FORMAT(
469 & 5x,'STANDARD SOLID PROPERTY SET'/,
470 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
471 & 5x,'SOLID FORMULATION FLAG. . . . . . . . .=',i10/,
472 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
473 & 5x,'IALE FLAG (0:LAGRANGE,1:ALE,2:EULER). .=',i10/,
474 & 5x,'SOLID STRESS PLASTICITY FLAG. . . . . .=',i10/,
475 & 5x,'COROTATIONAL SYSTEM FLAG. . . . . . . .=',i10/,
476 & 5x,'TETRA4 FORMULATION FLAG. . . . . . . .=',i10/,
477 & 5x,'TETRA10 FORMULATION FLAG . . . . . . .=',i10/,
478 & 5x,'CONSTANT PRESSURE FLAG. . . . . . . . .=',i10/,
479 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
480 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
481 & 5x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13/,
482 & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
483 & 5x,'HOURGLASS VISCOSITY . . . . . . . . . .=',1pg20.13/,
484 & 5x,'NUMERICAL NAVIER STOKES VISCO. LAMBDA .=',1pg20.13/,
485 & 5x,'NUMERICAL NAVIER STOKES VISCOSITY MU. .=',1pg20.13/,
486 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
487 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
488 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
489 1001 FORMAT(
490 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i3,
491 & ' (',i3,')'/)
492 1002 FORMAT(
493 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/)
494 1099 FORMAT(
495 & 5x,'STANDARD SOLID PROPERTY SET'/,
496 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i8/,
497 & 5x,'CONFIDENTIAL DATA'//)
498 1100 FORMAT(
499 & 5x,'STANDARD SOLID PROPERTY SET'/,
500 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
501 & 5x,'SOLID FORMULATION FLAG. . . . . . . . .=',i10/,
502 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
503 & 5x,'IALE FLAG (0:LAGRANGE,1:ALE,2:EULER). .=',i10/,
504 & 5x,'SOLID STRESS PLASTICITY FLAG. . . . . .=',i10/,
505 & 5x,'COROTATIONAL SYSTEM FLAG. . . . . . . .=',i10/,
506 & 5x,'TETRA4 FORMULATION FLAG. . . . . . . .=',i10/,
507 & 5x,'TETRA10 FORMULATION FLAG . . . . . . .=',i10/,
508 & 5x,'CONSTANT PRESSURE FLAG. . . . . . . . .=',i10/,
509 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
510 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
511 & 5x,'DEFAULT VALUE FOR QUADRATIC BULK. . . . ',/,
512 & 5x,' VISCOSITY (QA) WILL BE USED. . . .=',1pg20.13/,
513 & 5x,'EXCEPT IN CASE LAW 70 QA = 0. ',/,
514 & 5x,'DEFAULT VALUE FOR LINEAR BULK . . . . . ',/,
515 & 5x,' VISCOSITY (QB) WILL BE USED . . . =',1pg20.13/,
516 & 5x,'EXCEPT IN CASE LAW 70 QB = 0. ',/,
517 & 5x,'HOURGLASS VISCOSITY . . . . . . . . . .=',1pg20.13/,
518 & 5x,'NUMERICAL NAVIER STOKES VISCO. LAMBDA .=',1pg20.13/,
519 & 5x,'NUMERICAL NAVIER STOKES VISCOSITY MU. .=',1pg20.13/,
520 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
521 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
522 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
523 2010 FORMAT(
524 & 5x,'HOURGLASS MODULUS FLAG. . . . . . . . .=',i10/)
525 2020 FORMAT(
526 & 5x,'NUMBER OF SPH PARTICLES PER DIRECTION .=',i10/,
527 & 5x,'CORRESPONDING PART FOR SPH PARTICLES. .=',i10/,
528 & 5x,'SENSOR TO ACTIVATE SPH PARTICLES ......=',i10/)
529 3000 FORMAT(
530 & 5x,'SOLID MINIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
531 & 5x,'SOLID MAXIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
532 & 5x,'SOLID MAXIMUM ASPECT RATIO.............=',1pg20.13/,
533 & 5x,'SOLID MINIMUM COLLAPSE RATIO...........=',1pg20.13/)
534C
535 END SUBROUTINE hm_read_prop14
536
537
538!||====================================================================
539!|| hm_read_prop14f ../starter/source/properties/solid/hm_read_prop14.F
540!||--- called by ------------------------------------------------------
541!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
542!||--- calls -----------------------------------------------------
543!|| ancmsg ../starter/source/output/message/message.f
544!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
545!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
546!|| hm_read_ale_close ../starter/source/ale/hm_read_ale_close.F
547!||--- uses -----------------------------------------------------
548!|| defaults_mod ../starter/source/modules/defaults_mod.f90
549!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
550!|| message_mod ../starter/share/message_module/message_mod.F
551!|| submodel_mod ../starter/share/modules1/submodel_mod.F
552!||====================================================================
553 SUBROUTINE hm_read_prop14f(GEO,IGEO,PROP_TAG,MULTI_FVM,IGTYP,IG,TITR,UNITAB,LSUBMODEL,
554 . DEFAULTS_SOLID)
555C-----------------------------------------------
556C ROUTINE DESCRIPTION :
557C ===================
558C READ PROPERTY /PROP/FLUID
559C-----------------------------------------------
560C DUMMY ARGUMENTS DESCRIPTION:
561C ===================
562C
563C NAME DESCRIPTION
564C
565C IGEO PROPERTY ARRAY(INTEGER)
566C GEO PROPERTY ARRAY(REAL)
567C UNITAB UNITS ARRAY
568C IG PROPERTY ID(INTEGER)
569C TITR MATERIAL TITLE
570C LSUBMODEL SUBMODEL STRUCTURE
571C-----------------------------------------------
572C M o d u l e s
573C-----------------------------------------------
574 USE unitab_mod
575 USE message_mod
576 USE submodel_mod
577 USE elbuftag_mod
578 USE multi_fvm_mod
579 USE ale_mod
580 USE defaults_mod
581 USE names_and_titles_mod , ONLY : nchartitle
582C-----------------------------------------------
583C I m p l i c i t T y p e s
584C-----------------------------------------------
585#include "implicit_f.inc"
586C-----------------------------------------------
587C C o m m o n B l o c k s
588C-----------------------------------------------
589#include "units_c.inc"
590#include "com01_c.inc"
591#include "param_c.inc"
592#include "tablen_c.inc"
593C-----------------------------------------------
594C D u m m y A r g u m e n t s
595C-----------------------------------------------
596C INPUT ARGUMENTS
597 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
598 INTEGER,INTENT(IN)::IG,IGTYP
599 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)::TITR
600 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
601 TYPE(multi_fvm_struct),INTENT(IN) :: MULTI_FVM
602C MODIFIED ARGUMENT
603 INTEGER,INTENT(INOUT)::IGEO(NPROPGI)
604 my_real,INTENT(INOUT)::GEO(NPROPG)
605 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
606 TYPE(solid_defaults_), INTENT(IN) :: DEFAULTS_SOLID
607C-----------------------------------------------
608C L o c a l V a r i a b l e s
609C-----------------------------------------------
610 INTEGER IHBE,ISMSTR,IPLAS,ICPRE,ICSTR,IINT,JCVT,NPG,NPT,NPTR,NPTS,NPTT, ISTRAIN,IET,IHBE_OLD,ID,I8PT,J
611 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS
612 my_real cvis,qa,qb,qh,vns1,vns2,dtmin
613 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
614C-----------------------------------------------
615C S o u r c e L i n e s
616C-----------------------------------------------
617 is_encrypted = .false.
618 is_available = .false.
619C--------------------------------------------------
620 CALL hm_option_is_encrypted(is_encrypted)
621C--------------------------------------------------
622 CALL hm_get_floatv('qa',qa,is_available,lsubmodel,unitab)
623 CALL hm_get_floatv('qb',qb,is_available,lsubmodel,unitab)
624 CALL hm_get_floatv('h',qh,is_available,lsubmodel,unitab)
625!--- defaults values
626 ihbe_ds= defaults_solid%ISOLID
627 isst_ds= defaults_solid%ISMSTR
628 iframe_ds= defaults_solid%IFRAME
629C-----hide and removed flags:
630 icstr = 0
631 ihbe=1
632 ismstr=isst_ds
633 IF (ismstr == 0) ismstr=4
634 iplas=0
635 icpre = 0
636 npt = 1
637 npg = npt
638 iint=1 !Lobato/GAuss (cache)
639 jcvt = iframe_ds
640 cvis=zero
641 id = ig
642 vns1=zero
643 vns2=zero
644C-----------------------
645C--- Default values
646C-----------------------
647C
648C ihbe
649C hide flag IHGFLU lost
650 IF(n2d > 0) ihbe = 0
651c IF(N2D > 0)IHBE = IHGFLU
652C
653 IF (n2d > 0 .AND. ihbe/=0 .AND. ihbe/=2) THEN
654 ihbe_old=ihbe
655 ihbe=ihbe_ds
656 CALL ancmsg(msgid=321,
657 . msgtype=msgwarning,
658 . anmode=aninfo_blind_2,
659 . i1=id,
660 . c1=titr,
661 . i2=ihbe_old,
662 . i3=ihbe)
663 ENDIF
664
665 IF(n2d > 0 .AND. ihbe /=0 .AND. ihbe /= 2)THEN
666 ihbe_old=ihbe
667 ihbe=0
668 CALL ancmsg(msgid=324,
669 . msgtype=msgwarning,
670 . anmode=aninfo_blind_2,
671 . i1=id,
672 . c1=titr,
673 . i2=ihbe_old,
674 . i3=ihbe)
675 ENDIF
676
677 IF(qh < zero .OR. qh >= fifteen/hundred)THEN
678 CALL ancmsg(msgid=311,
679 . msgtype=msgwarning,
680 . anmode=aninfo_blind_1,
681 . i1=id,
682 . c1=titr,
683 . r1=qh)
684 ENDIF
685C
686 IF (qh == zero) qh = em01
687 geo(13) = qh
688C
689 !PSEUDO-VISCOSITY IS REQUIRED FOR STABILITY AND FOR SHOCK MODELING (STAGGERED SCHEME)
690 IF(ale%GLOBAL%ICAA == 0)THEN
691 !CAA is an obsolete option. Unless it is defined, program will set default values
692 IF (qa == zero) qa = onep1
693 IF (qb == zero) qb = fiveem2
694 ENDIF
695
696! /ALE/CLOSE
697! ----------
698 CALL hm_read_ale_close(unitab, lsubmodel, geo)
699
700 igeo(4) = npt
701 igeo(5) = ismstr
702 igeo(10) = ihbe
703 igeo(13) = icpre
704 igeo(14) = icstr
705 igeo(15) = iint
706 igeo(16) = jcvt-1
707 igeo(36) = 1 !IGFLU
708C
709 geo(14) = qa
710 geo(15) = qb
711 geo(16) = zero
712 geo(17) = zero
713C----Initialization in lecgeo:
714c IF(GEO( 3)/=ZERO.AND.IGEO( 5)== 0)IGEO( 5)=NINT(GEO( 3))
715 prop_tag(igtyp)%G_SIG = 6
716 prop_tag(igtyp)%L_SIG = 6
717 prop_tag(igtyp)%G_EINT = 1
718 prop_tag(igtyp)%G_QVIS = 1
719 prop_tag(igtyp)%L_EINT = 1
720 prop_tag(igtyp)%G_VOL = 1
721 prop_tag(igtyp)%L_VOL = 1
722 prop_tag(igtyp)%L_QVIS = 1
723 IF (multi_fvm%IS_USED) prop_tag(igtyp)%G_MOM = 3
724 prop_tag(igtyp)%G_FILL = 1
725 prop_tag(igtyp)%L_STRA = 6
726 IF (n2d /= 0 .AND. multi_fvm%IS_USED) prop_tag(igtyp)%G_AREA = 1
727 igeo(1) =ig
728 igeo(11)=igtyp
729 igeo(17)=0
730 IF(geo(39)/=zero.AND.igeo(9)== 0)igeo(9)=nint(geo(39))
731 IF(geo(171)/=zero.AND.igeo(10)== 0)igeo(10)=nint(geo(171))
732 geo(12)= igtyp + 0.1
733 geo(1) = igeo(4)
734C----------------------
735 IF(.NOT.is_encrypted)THEN
736 WRITE(iout,1000)ig,ihbe,ismstr,jcvt,iint,cvis,qa,qb,qh,vns1,vns2
737 WRITE(iout,1002) npg
738 ELSE
739 WRITE(iout,1099) ig
740 ENDIF
741C----
742 RETURN
743C---
744 1000 FORMAT(
745 & 5x,'STANDARD FLUID PROPERTY SET'/,
746 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
747 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
748 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
749 & 5x,'COROTATIONAL SYSTEM FLAG. . . . . . . .=',i10/,
750 & 5x,'INTEGRATION FORMULATION FLAG. . . . . =',i10/,
751 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
752 & 5x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13/,
753 & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
754 & 5x,'HOURGLASS VISCOSITY . . . . . . . . . .=',1pg20.13/,
755 & 5x,'NUMERICAL NAVIER STOKES VISCO. LAMBDA .=',1pg20.13/,
756 & 5x,'NUMERICAL NAVIER STOKES VISCOSITY MU. .=',1pg20.13/,
757 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13)
758 1002 FORMAT(
759 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/)
760C---
761 1099 FORMAT(
762 & 5x,'STANDARD FLUID PROPERTY SET'/,
763 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i8/,
764 & 5x,'CONFIDENTIAL DATA'//)
765C
766 END SUBROUTINE hm_read_prop14f
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_read_ale_close
subroutine hm_read_ale_close(unitab, lsubmodel, geo)
Definition hm_read_ale_close.F:35
hm_read_prop14
subroutine hm_read_prop14(geo, igeo, prop_tag, multi_fvm, igtyp, ig, titr, unitab, lsubmodel, ipart, defaults_solid)
Definition hm_read_prop14.F:42
hm_read_prop14f
subroutine hm_read_prop14f(geo, igeo, prop_tag, multi_fvm, igtyp, ig, titr, unitab, lsubmodel, defaults_solid)
Definition hm_read_prop14.F:555
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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
arret
subroutine arret(nn)
Definition arret.F:87
starter
program starter
Definition starter.F:39
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723