42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
65 USE multi_fvm_mod
67 USE defaults_mod
69
70
71
72#include "implicit_f.inc"
73
74
75
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"
82
83
84
85
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) ::
92
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
97
98
99
100 INTEGER IHBE,ISMSTR,IPLAS,ICPRE,ICSTR,IINT,JCVT,NPG,NPT,NPTR,NPTS,NPTT, ISTRAIN,IET,IHBE_OLD,ID
101 INTEGER
102
103 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS,ITET4_D,ITET10_D,ICPRE_D,ICONTROL_D
104LOGICAL IS_AVAILABLE, IS_ENCRYPTED, lFOUND
105 CHARACTER(LEN=NCHARLINE) :: MSGLINE
106
107
108
109 is_encrypted = .false.
110 is_available = .false.
111 nsphdir = 0
112 id_partsph = 0
113
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
121
123
124
125
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)
139
140
141
144 CALL hm_get_floatv(
'Lambda',vns1,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
160
161
162
163
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
175 itet4 = itet4_d
176 ENDIF
177 IF(itet4 == 2) THEN
178
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
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
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
195 iint = 0
196 IF(itet4 < 0) THEN
197 iint = -itet4
198 itet4 = 0
199 ENDIF
200
201
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)
215 ENDIF
216 END IF
217
218
219 IF (ihbe == 0) ihbe = ihbe_ds
220
221
222 IF (ihbe == 16 ) THEN
223 IF (iint == 0) iint = 1
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
233 IF (ihbe == 18 ) iint = 2
234
235 IF (ihbe == 19 ) THEN
236 ihbe = 17
237 iint = 3
238 END IF
239
240
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 /= 1
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
252
253
254
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
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
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
277
278
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
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
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
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
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
341 ENDIF
342 IF (icontrol==0) icontrol=icontrol_d
343 IF (icontrol>1) icontrol=0
344
345
346
347 IF (qa == zero .AND. qb == zero) igeo(31) = 1
348 IF (qa == zero) qa = onep1
349 IF (qb == zero) qb = fiveem2
350
351
352 IF (ihbe == 24) THEN
353 IF (cvis == zero) cvis = em01
354 geo(13) = cvis
355 qh = zero
356
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
369
370
371
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
397
398
399
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
431
432
433
435
436
437
438
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
452 IF (geo(16) /= zero .OR. geo(17) /= zero) THEN
453 igeo(33) = 1
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
465
466 RETURN
467
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/)
534
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_ale_close(unitab, lsubmodel, geo)
integer, parameter nchartitle
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)