44
45
46
47
48
55
56
57
58#include "implicit_f.inc"
59
60
61
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com09_c.inc"
65#include "units_c.inc"
66#include "scr12_c.inc"
67
68
69
70 INTEGER,INTENT(IN) :: NPARI,NPARIR,SNPC1
71 INTEGER,INTENT(INOUT) :: INTHEAT
72 INTEGER NOINT
73 INTEGER IPARI(NPARI),DEF_INTER(100),NPC1(SNPC1)
75 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
77 CHARACTER(LEN=NCHARTITLE) :: TITR
78
79 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
80 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
81 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(NSUBMOD)
82
83
84
85 INTEGER J,IBUC, NTYP, IGSTI,IS1, IS2,PID,IPRINT,
86 . ILEV, HIERA,IDEL2,INT2DEF,INTTH,IMOD,IFILTR,IGNORE,
87 . IFUNS,IFUNN,IFUNT,NUVAR,ISYM,INTKG,IPROJ,IASSIGN,
88 . PENFLAG,IROT,OK,ISU1,ISU2,ISI1,ISI2,ISU3,ISI3
90 . startt,stopt,kthe,visc,dnmax,dtmax,scal_f,
91 . scal_sr,scal_d,
alpha,
area,f_unit,sr_unit,d_unit
92 CHARACTER(LEN=NCHARKEY) :: KEY1
93
94 INTEGER, DIMENSION(:), POINTER :: INGR2USR
95 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
96
97
98
99 INTEGER,EXTERNAL :: NGR2USR
100
101 DATA int2def/5/
102
103
104
105
106
107
108 is1=0
109 is2=0
110 ibuc=0
111 imod = 0
112 igsti = 0
113 intth = 0
114 idel2 = 0
115 intkg = 0
116 ilev = 0
117
118
119 stopt=ep30
120 startt = zero
121 visc = zero
122 kthe = zero
123
124 iassign = 1
125
126 ntyp = 2
127 ipari(15)=noint
128 ipari(7)=ntyp
129
130 is_encrypted = .false.
131 is_available = .false.
132
133
134
136
137
138
139
140
141
142
143
144 CALL hm_get_intv(
'secondaryentityids',isi1,is_available,lsubmodel)
145 CALL hm_get_intv(
'mainentityids',isi2,is_available,lsubmodel)
146 CALL hm_get_intv(
'SECONDARY_NODES_TO_DELETE',ignore,is_available,lsubmodel)
147 CALL hm_get_intv(
'WFLAG',ilev,is_available,lsubmodel)
148 CALL hm_get_intv(
'LEVEL',hiera,is_available,lsubmodel)
149 CALL hm_get_intv(
'Isearch',ibuc,is_available,lsubmodel)
150 CALL hm_get_intv(
'NodDel2',idel2,is_available,lsubmodel)
151 CALL hm_get_intv(
'secondarysurfids',isi3,is_available,lsubmodel)
152
153 pid = 0
154
155
156
157 CALL hm_get_floatv(
'dsearch',frigap(4),is_available,lsubmodel,unitab)
158
159
160
161
162 iprint = 0
163
164 key1='IGNORE'
165 CALL definter(key1 ,ignore ,iassign ,iprint ,ntyp ,def_inter)
166
167 key1='ILEV'
168 CALL definter(key1 ,ilev ,iassign ,iprint ,ntyp ,def_inter)
169
170 key1='IBUC'
171 CALL definter(key1 ,ibuc ,iassign ,iprint ,ntyp ,def_inter)
172
173 key1='IDEL2'
174 CALL definter(key1 ,idel2 ,iassign ,iprint ,ntyp ,def_inter)
175
176
177
178 is1=2
179 is2=1
180 ingr2usr => igrnod(1:ngrnod)%ID
181 isu1=
ngr2usr(isi1,ingr2usr,ngrnod)
182 ingr2usr => igrsurf(1:nsurf)%ID
183 isu2=
ngr2usr(isi2,ingr2usr,nsurf)
184
185 isu3 = 0
186 IF (isi3>0) THEN
187 isu3=
ngr2usr(isi3,ingr2usr,nsurf)
188 IF(isu3 == 0) THEN
190 . anmode=aninfo_blind_1,
191 . msgtype=msgerror,
192 . i1=noint,
193 . i2=isi3,
194 . c1=titr)
195 END IF
196 IF (ilev /= 25 .and. ilev /= 26 .and. ilev /= 27 .and. ilev /= 28) THEN
198 . anmode=aninfo_blind_1,
199 . msgtype=msgwarning,
200 . i1=noint,
201 . i2=ilev,
202 . i3=isi3,
203 . c1=titr)
204 isu3 = 0
205 END IF
206 END IF
207
208
209 IF (isu1==0.AND.isu3 == 0) THEN
211 . anmode=aninfo_blind_1,
212 . msgtype=msgerror,
213 . i1=noint,
214 . i2=isi1,
215 . c1=titr)
216 is1=0
217 END IF
218 IF(isu2 == 0) THEN
220 . anmode=aninfo_blind_1,
221 . msgtype=msgerror,
222 . i1=noint,
223 . i2=isi2,
224 . c1=titr)
225 is2=0
226 END IF
227
228 IF (isu1 > 0.AND.isu3== 0) THEN
229 IF (igrnod(isu1)%NENTITY == 0)
231 . anmode=aninfo_blind_1,
232 . msgtype=msgerror,
233 . i1=noint,
234 . c1=titr)
235 END IF
236
237 IF (isu3 > 0) THEN
238 ipari(45) = isu2
239 ipari(46) = isu3
240 is1=-1
241 is2=-1
242 ELSE
243 ipari(45) = isu1
244 ipari(46) = isu2
245 END IF
246 ipari(13) = is1*10+is2
247
248! ilev
249 IF (ilev /= 0 .AND. ilev /= 1 .AND. ilev /= 2 .AND.
250 . ilev /= 3 .and .ilev /= 4 .AND. ilev /= 5 .AND.
251 . ilev /= 10 .AND. ilev /= 11 .AND. ilev /= 12 .AND.
252 . ilev /= 20 .AND. ilev /= 21 .AND. ilev /= 22 .AND.
253 . ilev /= 25 .AND. ilev /= 26 .AND. ilev /= 27 .AND.
254 . ilev /= 28 .AND. ilev /= 30) THEN
255
257 . msgtype=msgerror,
258 . anmode=aninfo_blind_2,
259 . i1=noint,
260 . c1=titr,
261 . c2='SPOTFLAG',
262 . c3='TYPE2',
263 . i2=ilev)
264 ENDIF
265 IF (
ale%GLOBAL%ICAA == 1 .AND. ilev == 0) ilev=4
266 IF (ilev == 5) ilev=0
267
268
269 IF ((ilev/=0 .AND. ilev/=1 .AND. ilev/=5 .AND. ilev/=25 .AND. ilev/=26 .AND. ilev/=27 .AND. ilev/=28)) idel2 = 0
270 IF (n2d == 1) idel2 = 0
271 ipari(17) = idel2
272
273 IF ((n2d > 0).AND.(ilev/=0)) THEN
275 . anmode=aninfo_blind_1,
276 . msgtype=msgerror,
277 . i1=noint,
278 . c1=titr,
279 . i2=ilev)
280 ENDIF
281
282 IF(ibuc==0)ibuc=2
283 ipari(12) = ibuc
284
285
286 IF (ilev == 25 .or. ilev == 26 .or. ilev == 27 .or. ilev == 28) hiera = 0
287
288 ipari(20)=ilev
289
290 nhin2=
max(nhin2,hiera)
291
292
293 ipari(43) = pid
294 ipari(26) = hiera
295 ipari(34) = ignore
296
297
298
299
300
301 IF (ilev == 25 .or. ilev == 26 .or. ilev == 27 .or. ilev == 28) THEN
302
303 i7stifs=1
304
305
306
307
308 CALL hm_get_intv(
'Istf',igsti,is_available,lsubmodel)
309 IF (.NOT. is_available) igsti = 0
310
311 penflag = 0
312 irot = 0
313
314
315
316 CALL hm_get_floatv(
'STFAC',stfac,is_available,lsubmodel,unitab
317 CALL hm_get_floatv(
'MAT_MaxVisc',visc,is_available,lsubmodel,unitab)
318
319
320 IF (stfac == zero) stfac=one
321 IF (visc == zero) visc=fiveem2
322
323
324
325 key1='IGSTI'
326 CALL definter(key1 ,igsti ,iassign ,iprint ,
327 . ntyp ,def_inter)
328
329 IF (igsti == 0) igsti=2
330
331
332 ipari(58) = igsti
333 ipari(43) = penflag
334 ipari(48) = irot
335 frigap(14)= visc
336
337 ENDIF
338
339
340
341
342
343 IF (ilev==20 .OR. ilev==21 .OR. ilev==22) THEN
344
345
346
347
348 CALL hm_get_intv(
'RUPT',imod,is_available,lsubmodel)
349 CALL hm_get_intv(
'Ifiltr',ifiltr,is_available,lsubmodel
350 CALL hm_get_intv(
'FUNCT_ID_sr',ifuns,is_available,lsubmodel)
352 CALL hm_get_intv(
'FUNCT_ID_st',ifunt,is_available,lsubmodel)
353 CALL hm_get_intv(
'Ismstr',isym,is_available,lsubmodel)
354
355
356
357 CALL hm_get_floatv(
'MAX_N_DIST',dnmax,is_available,lsubmodel,unitab)
358 CALL hm_get_floatv(
'MAX_T_DIST',dtmax,is_available,lsubmodel,unitab)
359 CALL hm_get_floatv(
'FScale11',scal_f,is_available,lsubmodel,unitab)
360 CALL hm_get_floatv(
'FScale22',scal_sr,is_available,lsubmodel,unitab)
361 CALL hm_get_floatv(
'FScale33',scal_d,is_available,lsubmodel,unitab)
364
368
369
370
371
372 IF (imod == 0) imod = 2
373 IF (scal_f == zero) scal_f = one*f_unit
374 IF (scal_sr == zero) scal_sr = one*sr_unit
375 IF (scal_d == zero) scal_d = one*d_unit
376 IF (dnmax == zero) dnmax = ep20
377 IF (dtmax == zero) dtmax = ep20
378
379 IF (ifiltr == 1) THEN
383 ENDIF
384 IF (ifunn == 0) THEN
386 . msgtype=msgerror,
387 . anmode=aninfo,
388 . i1=noint,
389 . c1=titr,
390 . i2=ifunn,
391 . c2='Func_sn')
392 ENDIF
393 IF (ifunt == 0) THEN
395 . msgtype=msgerror,
396 . anmode=aninfo,
397 . i1=noint,
398 . c1=titr,
399 . i2=ifunt,
400 . c2='Func_st')
401 ENDIF
402 nuvar = 2
403
404
405 ipari(35) = nuvar
406 ipari(43) = imod
407 ipari(44) = isym
408 ipari(59) = ifiltr
409 ipari(48) = ifuns
410 ipari(49) = ifunn
411 ipari(50) = ifunt
419
420 ENDIF
421
422
423
424
425
426 iproj = 1
427
428
429
430
431 CALL hm_get_intv(
'I_TH',intth,is_available,lsubmodel)
432 CALL hm_get_intv(
'Iproj',iproj,is_available,lsubmodel)
433
434
435
436 CALL hm_get_floatv(
'Kthe',kthe,is_available,lsubmodel,unitab)
437
438
439 IF (iproj==0) iproj = 1
440 IF (intth > 0 ) intheat = 1
441
442 ipari(47) = intth
443 frigap(15) = kthe
444 ipari(57) = iproj
445
446 IF (stfac == zero )stfac = one_fifth
447
448 frigap(3)=startt
449 IF (stopt == zero) stopt = ep30
450 frigap(11)=stopt
451 ipari(65) = intkg
452
453
454
455
456
457 IF (ipari(20)==20.OR.ipari(20)==21.OR.ipari(20)==22) THEN
458
459
460
461 ok = 0
462 DO j=1,nfunct
463 IF (ipari(48) == npc1(j)) THEN
464 ipari(48)=j
465 EXIT
466 ENDIF
467 ENDDO
468 DO j=1,nfunct
469 IF (ipari(49) == npc1(j)) THEN
470 ipari(49)=j
471 ok = 1
472 EXIT
473 ENDIF
474 ENDDO
475 DO j=1,nfunct
476 IF (ipari(50) == npc1(j)) THEN
477 ipari(50)=j
478 ok = 1
479 EXIT
480 ENDIF
481 ENDDO
482 IF (ok == 0) THEN
484 . msgtype=msgerror,
485 . anmode=aninfo_blind_1,
486 . i1=noint,
487 . c1=titr,
488 . i2=ipari(11))
489 ENDIF
490
491 ENDIF
492
493
494
495
496
497 iprint = 1
498
499
500 key1='IGNORE'
501 CALL definter(key1 ,ignore ,iassign ,iprint ,
502 . ntyp ,def_inter)
503
504 key1='ILEV'
505 CALL definter(key1 ,ilev ,iassign ,iprint ,
506 . ntyp ,def_inter)
507
508 key1='IBUC'
509 CALL definter(key1 ,ibuc ,iassign ,iprint ,
510 . ntyp ,def_inter)
511
512 key1='IDEL2'
513 CALL definter(key1 ,idel2 ,iassign ,iprint ,
514 . ntyp ,def_inter)
515
516 key1='IGSTI'
517 CALL definter(key1 ,igsti ,iassign ,iprint ,
518 . ntyp ,def_inter)
519
520
521
522 IF (ilev == 20 .OR. ilev == 21 .OR. ilev == 22) THEN
523 WRITE(iout,1502)ilev,hiera,ibuc,frigap(4),ignore
524 WRITE(iout,2502)scal_f,scal_d,scal_sr,
alpha,areasl,
525 . dnmax,dtmax,ifunn,ifunt,ifuns,imod,isym,ifiltr
526 ELSEIF (ilev == 25 .or. ilev == 26 .or. ilev == 27 .or. ilev == 28) THEN
527 WRITE(iout,1532) ilev,hiera,ibuc,frigap(4),stfac,igsti,
528 . visc,ignore
529 ELSEIF (ilev /= 0) THEN
530 WRITE(iout,1502)ipari(20),hiera,ibuc,frigap(4),ignore
531 ELSE
532 WRITE(iout,1502)int2def,hiera,ibuc,frigap(4),ignore
533 END IF
534 IF (ilev/=1 .and. ilev/=30 .and. ilev/=26) THEN
535 WRITE(iout,1533) iproj
536 END IF
537 WRITE(iout,'(A,A,I5/)')
538 . ' DELETION FLAG CASE FAILURE OF MAIN ELEMENT',
539 . ' SET TO ',idel2
540 IF (intth > 0) THEN
541 WRITE(iout,1534) kthe
542 END IF
543
544
545 IF(is1==0)THEN
546 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
547 ELSEIF(is1==1)THEN
548 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
549 ELSEIF(is1==2)THEN
550 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
551 ELSEIF(is1==3)THEN
552 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
553 ELSEIF(is1==4 )THEN
554 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
555 ELSEIF(is1==5 )THEN
556 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
557 ENDIF
558 IF(is2==0)THEN
559 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
560 ELSEIF(is2==1)THEN
561 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
562 ELSEIF(is2==2)THEN
563 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
564 ELSEIF(is2==3)THEN
565 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
566 ELSEIF(is2==4)THEN
567 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
568 . 'TO HYPER-ELLIPSOIDAL SURFACE'
569 ENDIF
570 IF(is1<0.AND.is2<0) WRITE(iout,'(4X,A)')'SURFACE TO SURFACE INPUT'
571
572
573 1000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
574 1300 FORMAT( /1x,' INTERFACES ' /
575 . 1x,' -------------- '// )
576
577 RETURN
578 1502 FORMAT(//
579 . ' TYPE==2 TIED SLIDING ' //
580 . ' FORMULATION LEVEL . . . . . . . . . . . . ',i5/,
581 . ' HIERARCHICAL SOLVING LEVEL. . . . . . . . ',i5/,
582 . ' SEARCH FORMULATION. . . . . . . . . . . . ',i5/,
583 . ' SEARCH DISTANCE . . . . . . . . . . . . . ',1pg20.13/,
584 . ' IGNORE FLAG . . . . . . . . . . . . . . . ',i5/)
585 1532 FORMAT(//
586 . ' TYPE==2 TIED SLIDING ' //
587 . ' FORMULATION LEVEL . . . . . . . . . . . . ',i5/,
588 . ' HIERARCHICAL SOLVING LEVEL. . . . . . . . ',i5/,
589 . ' SEARCH FORMULATION. . . . . . . . . . . . ',i5/,
590 . ' SEARCH DISTANCE . . . . . . . . . . . . . ',1pg20.13/,
591 . ' STIFFNESS FACTOR. . . . . . . . . . . . . ',1pg20.13/,
592 . ' STIFFNESS FORMULATION . . . . . . . . . . ',i1/,
593 .' 1 : STIFFNESS IS COMPUTED ON MAIN SEGMENT'/,
594 .' 2,3,4,5 : STIFFNESS IS COMPUTED FROM MAIN SEGMENT'/,
595 .' AND SECONDARY NODE'/,
596 . ' CRITICAL DAMPING FACTOR . . . . . . . . . ',1pg20.13/,
597 . ' IGNORE FLAG . . . . . . . . . . . . . . . ',i5/)
598 1533 FORMAT(
599 . ' PROJECTION FLAG . . . . . . . . . . . . . ',i1/)
600 1534 FORMAT(
601 . ' THERMAL INTERFACE . . . . . . . . . . . . . ',//
602 . ' THERMAL heat exchange coefficient .. . . . .',1pg20.13/)
603 2502 FORMAT(' RUPTURE PARAMETERS '
604 . /10x,'SCAL_F . . . . . . . . . . . . . . ',1pg20.13
605 . /10x,'SCAL_DISP . . . . . . . . . . . . . ',1pg20.13
606 . /10x,'SCAL_SR . . . . . . . . . . . . . . ',1pg20.13
607 . /10x,'FILTERING COEFF . . . . . . . . . . ',1pg20.13
608 . /10x,'DEFAULT SECONDARY AREA. . . . . . . . . ',1pg20.13
609 . /10x,'DN_MAX . . . . . . . . . . . . . . ',1pg20.13
610 . /10x,'DT_MAX . . . . . . . . . . . . . . ',1pg20.13
611 . /10x,'IFUNN . . . . . . . . . . . . . . ',i10
612 . /10x,'IFUNT . . . . . . . . . . . . . . ',i10
613 . /10x,'IFUNS . . . . . . . . . . . . . . ',i10
614 . /10x,'IMOD . . . . . . . . . . . . . . ',i10
615 . /10x,'ISYM . . . . . . . . . . . . . . ',i10
616 . /10x,'IFILTR . . . . . . . . . . . . . . ',i10//)
subroutine definter(key, ival, flag, iprint, ityp, def_inter)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine i2rupt(x, v, a, ms, in, stifn, fsav, weight, irect, nsv, msr, irtl, irupt, crst, mmass, miner, smass, siner, area, uvar, xsm0, dsm, fsm, prop, ipari, nsn, nmn, nuvar, igtyp, pid, npf, tf, itab, fncont, pdama2, isym, inorm, h3d_data, fncontp, ftcontp)
integer, parameter nchartitle
integer, parameter ncharkey
integer function ngr2usr(iu, igr, ngr)
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)