OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type21.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_inter_type21 ../starter/source/interfaces/int21/hm_read_inter_type21.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_struct ../starter/source/interfaces/reader/hm_read_inter_struct.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_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.f
32!|| inter_dcod_friction ../starter/source/interfaces/reader/inter_dcod_friction.F
33!|| inter_dcod_function ../starter/source/interfaces/reader/inter_dcod_function.F
34!|| inter_dcod_sensor ../starter/source/interfaces/reader/inter_dcod_sensor.F
35!|| ngr2usr ../starter/source/system/nintrr.F
36!||--- uses -----------------------------------------------------
37!|| message_mod ../starter/share/message_module/message_mod.f
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
41 1 IPARI ,STFAC ,FRIGAP ,NOINT ,NI ,
42 2 IGRSURF ,XFILTR ,FRIC_P ,NPC1 ,SENSORS ,
43 3 NOM_OPT ,UNITAB ,LSUBMODEL ,TITR ,NPC ,
44 4 TF ,NPARI ,NPARIR ,SNPC ,SNPC1 ,
45 5 LNOPT1 ,ITHERM_FE ,INTHEAT ,NOM_OPTFRIC ,INTBUF_FRIC_TAB )
46C============================================================================
47C
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE message_mod
52 USE intbuf_fric_mod
53 USE groupdef_mod
55 USE unitab_mod
56 USE sensor_mod
57 USE intbufdef_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER,INTENT(IN) :: NPARI,NPARIR,SNPC,SNPC1,LNOPT1
67 INTEGER,INTENT(IN) :: ITHERM_FE
68 INTEGER,INTENT(INOUT) :: INTHEAT
69 INTEGER,INTENT(IN) :: NOM_OPTFRIC(LNOPT1,NINTERFRIC)
70 INTEGER NOM_OPT(LNOPT1,*)
71 INTEGER ISU1,ISU2,ILAGM,NI
72 INTEGER IPARI(NPARI),NPC1(SNPC1),NPC(SNPC)
73 my_real stfac,xfiltr
74 my_real frigap(nparir),fric_p(10),tf(*)
75 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
76C-----------------------------------------------
77 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
78 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
79 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
80 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
81 TYPE(INTBUF_FRIC_STRUCT_),INTENT(INOUT) :: INTBUF_FRIC_TAB(NINTERFRIC)
82C-----------------------------------------------
83C C o m m o n B l o c k s
84C-----------------------------------------------
85#include "scr06_c.inc"
86#include "com01_c.inc"
87#include "com04_c.inc"
88#include "intstamp_c.inc"
89#include "units_c.inc"
90#include "scr12_c.inc"
91#include "remesh_c.inc"
92C-----------------------------------------------
93C L o c a l V a r i a b l e s
94C-----------------------------------------------
95 CHARACTER(LEN=NCHARTITLE) :: TITR1
96 INTEGER I,J,L,IBC1, IBC2, IBC3, NOINT, NTYP, IBID,INACTI, IBC1M,
97 . IBC2M, IBC3M, IGSTI,IEULT, IVIS2,IS1, IS2,ILEV, IGAP,MULTIMP,
98 . HIERA,MFROT,IFQ,MODFR,IADM,UID,NRADM,INTTH,IFORM,IERR1,IKTHE,
99 . IDEL21,IMOD,IFILTR,IFUNS,IFUNN,IFUNT,IFUN1,IFUN2,HFLAG,NUVAR,
100 . ifstf,kk,ii,igap0,flagremnod,idsens,idelkeep,intkg,irsth,invn,
101 . ifricth,iftlim,fcond,intfric
102 my_real
103 . fric,gap,startt,bumult,stopt,fheat,fheats,fheatm,rsth,tint,padm,
104 . angladm, cadm, depth,c1,c2,c3,c4,c5,c6, alpha,gapscale,gapmax,
105 . stmin,stmax,stiff, pmax,area, kthe, xthe, frad, drad,
106 . visc,xfricth,ptmax,pskid,dcond,xthe_unit,kthe_unit
107 INTEGER, DIMENSION(:), POINTER :: INGR2USR
108 LOGICAL IS_AVAILABLE
109C-----------------------------------------------
110C E x t e r n a l F u n c t i o n s
111C-----------------------------------------------
112 INTEGER NGR2USR
113CC=======================================================================
114C READING PENALTY INTERFACE /INTER/TYPE21
115C=======================================================================
116
117C Initializations
118 is1=0
119 is2=0
120 ibc1=0
121 ibc2=0
122 ibc3=0
123 ibc1m=0
124 ibc2m=0
125 ibc3m=0
126 mfrot=0
127 ifq=0
128 igsti = 0
129 invn = 0
130 iftlim=1
131 iadm =0
132 nradm=1
133 inacti = 0
134 ilev = 0
135 idsens = 0
136 idel21= 0
137 idelkeep=0
138 intth = 0
139 ifricth = 0
140 ikthe= 0
141 iform = 0
142 intkg = 0
143 fcond = 0
144 igap = 0
145 multimp = 0
146 intfric = 0
147C
148 padm =one
149 angladm=zero
150 stopt=ep30
151 fric = zero
152 gap = zero
153 gapscale = zero
154 startt = zero
155 visc = zero
156 xfiltr = zero
157
158 DO i = 1, 10
159 fric_p(i) = zero
160 ENDDO
161
162 kthe = zero
163 xthe = zero
164 tint = zero
165 frad = zero
166 drad = zero
167 fheat= zero
168 c1=zero
169 c2=zero
170 c3=zero
171 c4=zero
172 c5=zero
173 c6=zero
174 gapmax=ep30
175 gapscale = zero
176 dcond = zero
177 depth = zero
178C
179 nintstamp=nintstamp+1
180 ipari(43)=nintstamp
181C
182 ntyp=21
183 ipari(15)=noint
184 ipari(7)=ntyp
185C
186 is_available = .false.
187C--------------------------------------------------
188C EXTRACT DATAS (INTEGER VALUES)
189C--------------------------------------------------
190 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
191 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
192 CALL hm_get_intv('Istf',igsti,is_available,lsubmodel)
193 CALL hm_get_intv('Ithe',intth,is_available,lsubmodel)
194 CALL hm_get_intv('Igap',igap,is_available,lsubmodel)
195 CALL hm_get_intv('Multimp',multimp,is_available,lsubmodel)
196 CALL hm_get_intv('TYPE21_Idel',idel21,is_available,lsubmodel)
197 CALL hm_get_intv('TYPE21_Invn',invn,is_available,lsubmodel)
198 CALL hm_get_intv('Iadm',iadm,is_available,lsubmodel)
199C
200 IF(igap==1.OR.igap==2) CALL hm_get_intv('TYPE21_ITim',iftlim,is_available,lsubmodel)
201C
202 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
203 CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
204 CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
205 CALL hm_get_intv('INACTIV',inacti,is_available,lsubmodel)
206C
207 CALL hm_get_intv('Ifric',mfrot,is_available,lsubmodel)
208 CALL hm_get_intv('Ifiltr',ifq,is_available,lsubmodel)
209 CALL hm_get_intv('ISENSOR',idsens,is_available,lsubmodel)
210 CALL hm_get_intv('Crx_Fun',ifricth,is_available,lsubmodel)
211 CALL hm_get_intv('Ifric',mfrot,is_available,lsubmodel)
212 CALL hm_get_intv('Fric_ID',intfric,is_available,lsubmodel)
213C
214 IF(iadm==2) CALL hm_get_intv('NRadm',nradm,is_available,lsubmodel)
215C
216 IF(intth > 0) THEN
217 CALL hm_get_intv('Ithe_form',iform,is_available,lsubmodel)
218 CALL hm_get_intv('fct_ID_k',ikthe,is_available,lsubmodel)
219 CALL hm_get_intv('F_COND',fcond,is_available,lsubmodel)
220 ENDIF
221C
222C--------------------------------------------------
223C EXTRACT DATAS (REAL VALUES)
224C--------------------------------------------------
225 IF(igap==1.OR.igap==2)THEN
226 CALL hm_get_floatv('GAPSCALE',gapscale,is_available,lsubmodel,unitab)
227 CALL hm_get_floatv('GAPMAX',gapmax,is_available,lsubmodel,unitab)
228 CALL hm_get_floatv('DIST',depth,is_available,lsubmodel,unitab)
229 CALL hm_get_floatv('PMAX',pmax,is_available,lsubmodel,unitab)
230 ENDIF
231C
232 CALL hm_get_floatv('STMIN',stmin,is_available,lsubmodel,unitab)
233 CALL hm_get_floatv('STMAX',stmax,is_available,lsubmodel,unitab)
234 CALL hm_get_floatv('Pskid',pskid,is_available,lsubmodel,unitab)
235C
236 CALL hm_get_floatv('STFAC',stfac,is_available,lsubmodel,unitab)
237 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
238 CALL hm_get_floatv('MINI',gap,is_available,lsubmodel,unitab)
239 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
240 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
241C
242 CALL hm_get_floatv('VISC',visc,is_available,lsubmodel,unitab)
243 CALL hm_get_floatv('SORT_FACT',bumult,is_available,lsubmodel,unitab)
244C
245 CALL hm_get_floatv('Xfreq',alpha,is_available,lsubmodel,unitab)
246 CALL hm_get_floatv('scale1',xfricth,is_available,lsubmodel,unitab)
247C
248 IF (mfrot>0) THEN
249 CALL hm_get_floatv('C1',c1,is_available,lsubmodel,unitab)
250 CALL hm_get_floatv('C2',c2,is_available,lsubmodel,unitab)
251 CALL hm_get_floatv('C3',c3,is_available,lsubmodel,unitab)
252 CALL hm_get_floatv('C4',c4,is_available,lsubmodel,unitab)
253 CALL hm_get_floatv('C5',c5,is_available,lsubmodel,unitab)
254 ENDIF
255 IF (mfrot>1) THEN
256 CALL hm_get_floatv('C6',c6,is_available,lsubmodel,unitab)
257 ENDIF
258C
259 IF(iadm==2)THEN
260 CALL hm_get_floatv('Padm',padm,is_available,lsubmodel,unitab)
261 CALL hm_get_floatv('Angladm',angladm,is_available,lsubmodel,unitab)
262 ENDIF
263C
264C
265 IF(intth > 0) THEN
266 CALL hm_get_floatv('Kthe',kthe,is_available,lsubmodel,unitab)
267 CALL hm_get_floatv('Tint',tint,is_available,lsubmodel,unitab)
268 CALL hm_get_floatv('A_scale_k',xthe,is_available,lsubmodel,unitab)
269 CALL hm_get_floatv('F_RAD',frad,is_available,lsubmodel,unitab)
270 CALL hm_get_floatv('D_RAD',drad,is_available,lsubmodel,unitab)
271 CALL hm_get_floatv('HEAT_AL',fheat,is_available,lsubmodel,unitab)
272 CALL hm_get_floatv('D_COND',dcond,is_available,lsubmodel,unitab)
273 ENDIF
274
275C------------------------------------------------------------
276C Card1 :flags
277C------------------------------------------------------------
278
279C
280C.....* CHECKS *........
281C
282 IF (idel21 < 0) THEN
283 idelkeep=1
284 idel21=abs(idel21)
285 END IF
286C
287 IF (idel21>2.OR.n2d==1) idel21 = 0
288C
289 IF(ilev==0)THEN
290 ilev=1
291 ELSEIF(ilev==-1)THEN
292C emul past
293 ilev=0
294 END IF
295C
296 is1=1
297 ingr2usr => igrsurf(1:nsurf)%ID
298 isu1=ngr2usr(isu1,ingr2usr,nsurf)
299 is2=1
300 isu2=ngr2usr(isu2,ingr2usr,nsurf)
301C
302 IF (iadm/=0.AND.nadmesh==0) THEN
303 CALL ancmsg(msgid=647,
304 . msgtype=msgwarning,
305 . anmode=aninfo_blind_2,
306 . i1=noint,
307 . c1=titr)
308 iadm=0
309 ENDIF
310
311C.......* Storage IPARI FRIGAP *........
312 ipari(21) = igap
313 ipari(61) = idelkeep
314 ipari(17) = idel21
315 ipari(20) = ilev
316 ipari(34) = igsti
317 ipari(51) = invn ! flag to detect if normals are inverted (default =0)
318 ipari(45)=isu1
319 ipari(46)=isu2
320 ipari(13)=is1*10+is2
321 ipari(44)=iadm
322
323 IF(multimp==0)THEN
324 multimp=12
325 END IF
326 ipari(23)=multimp
327
328C------------------------------------------------------------
329C Card2
330C------------------------------------------------------------
331 IF(igap==1.OR.igap==2)THEN
332C
333C.....* CHECKS *........
334C
335 IF(gapscale==zero)gapscale=one
336
337ce flag dit sil faut calculer les epaisseurs nodales dans l'engine
338 IF(igap==2) inter_ithknod=1 !defined in interface module (common_source directory)
339C
340 IF(igap==2)THEN
341 IF(pmax==zero) pmax=ep30
342 ELSE
343C Igap=1, Pmax is not used
344 pmax=ep30
345 END IF
346C
347
348 ELSE
349C Igap=0, Pmax is not used
350 pmax=ep30
351 ENDIF
352
353C.......* Storage IPARI FRIGAP *........
354 frigap(19) = gapscale
355 frigap(16) = gapmax
356 frigap(23) = depth
357 frigap(15) = pmax
358 ipari(52) = iftlim ! flag to deactivate tangential force limitation (default =1)
359
360C------------------------------------------------------------
361C Card3
362C------------------------------------------------------------
363
364C
365C.....* CHECKS *........
366C
367 IF(igsti==0)THEN
368 i7stifs=1
369 IF(stmax==zero)stmax=ep30
370 frigap(17) = stmin
371 frigap(18) = stmax
372 ELSE
373 stmin = zero
374 stmax = ep30
375 END IF
376C
377 IF(pskid==zero) pskid=ep30
378 frigap(35) = pskid
379C------------------------------------------------------------
380C Card3
381C------------------------------------------------------------
382
383C
384C.....* CHECKS *........
385C
386 IF(stfac==zero) THEN
387 stfac=one
388 ENDIF
389 IF(igsti==1)stfac=-stfac
390C
391 IF (stopt == zero) stopt = ep30
392
393C.....* Storage IPARI FRIGAP *.......
394 ipari(34)=igsti
395 frigap(1)=fric
396 frigap(2)=gap
397 frigap(3)=startt
398 frigap(11)=stopt
399
400C------------------------------------------------------------
401C Card4
402C------------------------------------------------------------
403 IF(visc==zero) visc=one
404
405C.....* Storage IPARI FRIGAP *.........
406
407 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
408 ipari(22)=inacti
409 frigap(14)=visc
410
411C BUMULT is increased for big models
412 IF(bumult==zero) THEN
413 bumult = bmul0
414 IF(numnod > 2500000) THEN
415 bumult = bmul0*two
416 ELSEIF(numnod > 1500000) THEN
417 bumult = bmul0*three/two
418 END IF
419 END IF
420 frigap(4)=bumult
421C------------------------------------------------------------
422C Card5 : FRICTION data
423C------------------------------------------------------------
424
425C
426C.....* CHECKS *........
427C
428 IF(fric == zero)THEN
429 IF(ifricth /= 0)THEN
430 fric = one
431 ENDIF
432 ENDIF
433
434 IF(xfricth == zero) xfricth=one
435C
436 IF (alpha==zero) ifq = 0
437c
438 modfr=2
439 ifq = ifq + 10
440c
441 IF (ifq>0) THEN
442 IF (ifq==10) xfiltr = one
443 IF (mod(ifq,10)==1) xfiltr = alpha
444 IF (mod(ifq,10)==2) xfiltr=four*atan2(one,zero) / alpha
445 IF (mod(ifq,10)==3) xfiltr=four*atan2(one,zero) * alpha
446 IF (xfiltr<zero) THEN
447 CALL ancmsg(msgid=554,
448 . msgtype=msgerror,
449 . anmode=aninfo_blind_1,
450 . i1=noint,
451 . c1=titr,
452 . r1=alpha)
453 ELSEIF (xfiltr>1.AND.mod(ifq,10)<=2) THEN
454 CALL ancmsg(msgid=554,
455 . msgtype=msgerror,
456 . anmode=aninfo_blind_1,
457 . i1=noint,
458 . c1=titr,
459 . r1=alpha)
460 ENDIF
461 ELSE
462 xfiltr = zero
463 ENDIF
464C------------------------------------------------------------
465C Optional Card5 Card6 : C1...C5.C6 friction data
466C------------------------------------------------------------
467
468C.....* Storage IPARI FRIGAP *.........
469 fric_p(1) = c1
470 fric_p(2) = c2
471 fric_p(3) = c3
472 fric_p(4) = c4
473 fric_p(5) = c5
474 fric_p(6) = c6
475 ipari(50) = ifricth
476 frigap(34) = xfricth
477 ipari(30) = mfrot
478 ipari(31) = ifq
479 ipari(72) = intfric
480
481C------------------------------------------------------------
482C Option Card8 :Adm = 2 adaptative mesh
483C------------------------------------------------------------
484C
485 IF(iadm==2)THEN
486 IF(nradm==0) nradm =3
487 IF(padm==zero) padm =one
488 ELSE
489 nradm =1
490 padm =one
491 angladm=zero
492 END IF
493
494C.....* Storage IPARI FRIGAP *.........
495 cadm =cos(angladm*pi/hundred80)
496 kcontact =max(kcontact,iadm)
497 ipari(49) =nradm
498 frigap(24)=padm
499 frigap(25)=cadm
500C------------------------------------------------------------
501C Option Card9 :Thermal input
502C------------------------------------------------------------
503 IF(intth > 0 ) THEN
504 intheat = 1
505 ENDIF
506C
507C....* CHECKS *.............
508C
509 IF(kthe == zero)THEN
510 IF(ikthe /= 0)THEN
511 kthe = one
512 CALL hm_get_floatv_dim('Kthe' ,kthe_unit ,is_available, lsubmodel, unitab)
513 kthe = one * kthe_unit
514 ENDIF
515 ENDIF
516
517 IF (xthe == zero) THEN
518 !units
519 CALL hm_get_floatv_dim('A_scale_k' ,xthe_unit ,is_available, lsubmodel, unitab)
520 xthe = one * xthe_unit
521 ENDIF
522
523 IF(iform /= 0)THEN
524 intth = 2
525 ipari(47) = 2
526 ENDIF
527
528C.....* Storage IPARI FRIGAP *.........
529 ipari(47) = intth
530 ipari(48) = iform
531 ipari(42) = ikthe
532 frigap(21 ) = tint
533 frigap(30) = xthe
534C------------------------------------------------------------
535C Card5 : THERMAL MODELLING card2
536C------------------------------------------------------------
537
538C
539C....* CHECKS *.............
540C
541 IF(itherm_fe == 0 .AND. intth > 0 ) THEN
542 intheat = 0
543 ipari(47) = 0
544 CALL ancmsg(msgid=702,
545 . msgtype=msgwarning,
546 . anmode=aninfo,
547 . i1=noint,
548 . c1=titr,
549 . r1=dcond,
550 . r2=drad)
551 ENDIF
552
553 IF(intth == 2 ) ftempvar21 = 1
554
555 IF(fcond ==0) dcond = zero
556
557 IF(frad==zero ) drad = zero
558
559 IF(fcond /= 0.AND.dcond/=zero.AND.drad==zero) THEN
560 drad = dcond
561 CALL ancmsg(msgid=1810,
562 . msgtype=msgwarning,
563 . anmode=aninfo,
564 . i1=noint,
565 . c1=titr,
566 . r1=dcond,
567 . r2=drad)
568 ENDIF
569
570 IF(dcond > drad) THEN
571 dcond = drad
572 CALL ancmsg(msgid=1809,
573 . msgtype=msgwarning,
574 . anmode=aninfo,
575 . i1=noint,
576 . c1=titr,
577 . r1=dcond,
578 . r2=drad)
579 ENDIF
580
581C
582C.....* Storage IPARI FRIGAP *.........
583 frigap(20) = kthe
584 frigap(31) = frad
585 frigap(32) = drad
586 frigap(33) = fheat
587 frigap(36) = dcond ! max conduction distance
588 ipari(53) = fcond ! function of variation of heat exchange as funct of distance
589C
590 ipari(65) = intkg
591C FRIGAP(10) is initialized but used only in engine for storing number of couples candidates
592 frigap(10)=float(0)
593C
594C
595C------------------------------------------------------------
596C RENUMBERING OF FUNCTIONS AND SENSOR - USER TO INTERNAL ID
597C------------------------------------------------------------
598C
599 CALL inter_dcod_function(ntyp,ni,ipari,npc1,nom_opt,npc,tf)
600 CALL inter_dcod_sensor (ntyp,ni,ipari,nom_opt,sensors)
601 CALL inter_dcod_friction(ntyp,ni,ipari,nom_opt,nom_optfric,
602 . intbuf_fric_tab)
603
604C
605C------------------------------------------------------------
606C PRINTOUT
607C------------------------------------------------------------
608C
609 IF(idsens/=0) THEN
610 WRITE(iout,2101)ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
611 . ilev,igsti,stfac,stmin,stmax,
612 . fric,igap,gap,gapmax,gapscale,idsens,
613 . bumult,inacti,visc,pmax,multimp,invn,iftlim,
614 . pskid
615 ELSE
616 WRITE(iout,2104)ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
617 . ilev,igsti,stfac,stmin,stmax,
618 . fric,igap,gap,gapmax,gapscale,startt,stopt,
619 . bumult,inacti,visc,pmax,multimp,invn,iftlim,
620 . pskid
621 ENDIF
622
623 IF(intfric > 0 ) THEN
624 WRITE(iout,1527) intfric
625 ELSE
626C
627 WRITE(iout,1520)mod(ifq,10), xfiltr
628C
629 IF(mfrot==0)THEN
630 IF(ifricth ==0 ) THEN
631 WRITE(iout,1524) fric
632 ELSE
633 WRITE(iout,1525) ifricth,xfricth,fric
634 ENDIF
635 ELSEIF(mfrot==1)THEN
636 WRITE(iout,1515)fric_p(1),fric_p(2),fric_p(3),
637 . fric_p(4),fric_p(5)
638 ELSEIF(mfrot==2)THEN
639 WRITE(iout,1522)fric,fric_p(1),fric_p(2),fric_p(3),
640 . fric_p(4),fric_p(5),fric_p(6)
641 ELSEIF(mfrot==3)THEN
642 WRITE(iout,1523)fric_p(1),fric_p(2),fric_p(3),
643 . fric_p(4),fric_p(5),fric_p(6)
644 ELSEIF(mfrot==4)THEN
645 WRITE(iout,1526) fric,fric_p(1),fric_p(2)
646 ENDIF
647 ENDIF
648C
649 IF(idel21/=0) THEN
650 WRITE(iout,'(A,I5/)')
651 . ' DELETION FLAG ON FAILURE (1:YES) : ',idel21
652 IF(idelkeep == 1)THEN
653 WRITE(iout,'(A)')
654 . ' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
655 ENDIF
656 ENDIF
657 IF(iadm/=0) THEN
658 WRITE(iout,*)' MESH REFINEMENT CASE OF CONTACT',
659 . ' (0:NO/1:DUE TO CURVATURE/2:DUE TO CURVATURE OR PENETRATION)',
660 . ' SET TO ',iadm
661 IF(iadm==2)THEN
662 WRITE(iout,1557) nradm,padm,angladm
663 END IF
664 ENDIF
665C
666 IF(intth > 0 )THEN
667 IF(ikthe==0)THEN
668 WRITE(iout,2102) kthe,tint,frad,drad,fheat,iform,fcond,dcond
669 ELSE
670 WRITE(iout,2103) ikthe,xthe,kthe,tint,frad,drad,fheat,iform,fcond,dcond
671 END IF
672 END IF
673C--------------------------------------------------------------
674 IF(is1==0)THEN
675 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
676 ELSEIF(is1==1)THEN
677 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
678 ELSEIF(is1==2)THEN
679 WRITE(iout,'(6x,a)')'secondary surface input by nodes'
680 ELSEIF(IS1==3)THEN
681 WRITE(IOUT,'(6x,a)')'secondary surface input by segments'
682 ELSEIF(IS1==4 )THEN
683 WRITE(IOUT,'(6x,a)')'secondary side input by bricks'
684 ELSEIF(IS1==5 )THEN
685 WRITE(IOUT,'(6x,a)')'secondary side input by solid elements'
686 ENDIF
687 IF(IS2==0)THEN
688 WRITE(IOUT,'(6x,a)')'no main surface input'
689 ELSEIF(IS2==1)THEN
690 WRITE(IOUT,'(6x,a)')'main surface input by segments'
691 ELSEIF(IS2==2)THEN
692 WRITE(IOUT,'(6x,a)')'main surface input by nodes'
693 ELSEIF(IS2==3)THEN
694 WRITE(IOUT,'(6x,a)')'main surface input by segments'
695 ELSEIF(IS2==4)THEN
696 WRITE(IOUT,'(6x,a)')'main surface refers ',
697 . 'to hyper-ellipsoidal surface'
698 ENDIF
699C
700C--------------------------------------------------------------
701 1000 FORMAT(/1X,' INTERFACE number :',I10,1X,A)
702C------------
703 RETURN
704 1534 FORMAT(
705 . ' thermal INTERFACE . . . . . . . . . . . . . ',//
706 . ' thermal heat exchange coefficient .. . . . .',1PG20.13/)
707 2502 FORMAT(' rupture parameters '
708 . /10X,'scal_f . . . . . . . . . . . . . . ',1PG20.13
709 . /10X,'scal_disp . . . . . . . . . . . . . ',1PG20.13
710 . /10X,'scal_sr . . . . . . . . . . . . . . ',1PG20.13
711 . /10X,'filtering coeff . . . . . . . . . . ',1PG20.13
712 . /10X,'default secondary area. . . . . . . . . ',1PG20.13
713 . /10X,'dn_max . . . . . . . . . . . . . . ',1PG20.13
714 . /10X,'dt_max . . . . . . . . . . . . . . ',1PG20.13
715 . /10X,'ifunn . . . . . . . . . . . . . . ',I10
716 . /10X,'ifunt . . . . . . . . . . . . . . ',I10
717 . /10X,'ifuns . . . . . . . . . . . . . . ',I10
718 . /10X,'imod . . . . . . . . . . . . . . ',I10
719 . /10X,'isym . . . . . . . . . . . . . . ',I10
720 . /10X,'ifiltr . . . . . . . . . . . . . . ',I10//)
721 1515 FORMAT(//
722 . ' friction model 1 (viscous polynomial)'/,
723 . ' mu = muo + c1 p + c2 v + c3 pv + c4 p^2 + c5 v^2'/,
724 . ' c1 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
725 . ' c2 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
726 . ' c3 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
727 . ' c4 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
728 . ' c5 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
729 . ' tangential pressure limit. . .. . . . . .',1PG20.13/)
730 1522 FORMAT(/
731 . ' friction model 2 (darmstad law) :'/,
732 . ' mu = muo+c1*exp(c2*v)*p^2+c3*exp(c4*v)*p+c5*exp(c6*v)'/,
733 . ' muo. . . . . . . . . . . . . . . . . . . ',1PG20.13/,
734 . ' c1 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
735 . ' c2 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
736 . ' c3 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
737 . ' c4 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
738 . ' c5 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
739 . ' c6 . . . . . . . . . . . . . . . . . . . ',1PG20.13/)
740 1523 FORMAT(/
741 . ' friction model 3 (renard law) :'/,
742 . ' c1 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
743 . ' c2 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
744 . ' c3 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
745 . ' c4 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
746 . ' c5 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
747 . ' c6 . . . . . . . . . . . . . . . . . . . ',1PG20.13/)
748 1524 FORMAT(/
749 . ' friction model 0 (coulomb law) :'/,
750 . ' friction coefficient . . . . . . . . . ',1PG20.13/)
751 1525 FORMAT(//
752 . ' friction model 0 (coulomb law) :'/,
753 . ' Function for friction coefficient wrt temperature',I10/,
754 . ' abscissa scale factor on ifuntcf. . . . . ',1PG20.13/,
755 . ' ordinate scale factor on ifuntcf . . . . ',1PG20.13/)
756 1526 FORMAT(/
757 . ' exponential decay friction law '/
758 . ' mu = c1+(MUo-c1)*exp(-c2*v)'/
759 . ' static coefficient muo . . . . . . . . . ',1PG20.13/,
760 . ' dynamic coefficient c1 . . . . . . . . . ',1PG20.13/,
761 . ' exponential decay coefficient c2 . . . . ',1PG20.13/)
762C
763 1527 FORMAT(/
764 . ' interface friction model. . . . . . . . . ',I10)
765
766 1518 FORMAT( ' friction formulation: incremental (STIFFNESS) ',
767 . 'formulation')
768 1519 FORMAT( ' friction formulation: total (VISCOUS) ',
769 . 'formulation')
770 1520 FORMAT(
771 . ' friction filtering flag. . . . . . . . . ',I10/,
772 . ' filtering factor . . . . . . . . . . . . ',1PG20.13)
773 1557 FORMAT(
774 .' number of elements within a 90 degrees fillet ',I5/,
775 .' --------------------------------------------- '/,
776 .' criteria for refinement due to penetration : '/,
777 .' ------------------------------------------ '/,
778 .' minimum percentage of penetration ',
779 . 1PG20.13/,
780 .' maximum angle on main side at contact location ',
781 . 1PG20.13//)
782 2101 FORMAT(//
783 . ' type==21 parallel/stamping ' //,
784 . ' bound. cond. deleted after impact in x dir ',I1/,
785 . ' secondary node (1:YES 0:NO) y dir ',I1/,
786 . ' z dir ',I1/,
787 . ' bound. cond. deleted after impact in x dir ',I1/,
788 . ' main node (1:YES 0:NO) y dir ',I1/,
789 . ' z dir ',I1/,
790 . ' formulation level. . . . . . . . . . . . . .',I1/,
791 . ' (0:OLD, 1:OPTIMIZED). . . . . . . .',/,
792 . ' stiffness formulation. . . . . . . . . . ',I1/,
793 .' 0 : stiffness is computed from stiffness on secondary side'/,
794 .' 1 : stfac is a stiffness value '/,
795 . ' stiffness factor or stiffness value . . . . ',1PG20.13/,
796 . ' minimum stiffness. . . . . . . . . . . . . ',1PG20.13/,
797 . ' maximum stiffness. . . . . . . . . . . . . ',1PG20.13/,
798 . ' friction factor . . . . . . . . . . . . . . ',1PG20.13/,
799 . ' variable gap flag . . . . . . . . . . . . . ',I5/,
800 . ' minimum gap . . . . . . . . . . . . . . . . ',1PG20.13/,
801 . ' maximum gap (= 0. <=> NO MAXIMUM GAP) . . . ',1PG20.13/,
802 . ' gap scale factor. . . . . . . . . . . . . . ',1PG20.13/,
803 . ' start time/stop time activated by sensor id ',I10/,
804 . ' bucket factor . . . . . . . . . . . . . . . ',1PG20.13/,
805 . ' de-activation of initial penetrations . . . ',I10/,
806 . ' critical damping factor . . . . . . . . . . ',1PG20.13/,
807 . ' maximum pressure due to thickness variation '/,
808 . ' case of igap=2. . . . . . . ',1PG20.13/,
809 . ' mean possible number of impact/node . . . . ',I5/,
810 . ' inverted normals detection flag . . . . . . ',I5/,
811 . ' tangential force limitation flag . . . . . . ',I5/,
812 . ' maximum pressure for skid line output ',1PG20.13)
813 2104 FORMAT(//
814 . ' type==21 parallel/stamping ' //,
815 . ' bound. cond. deleted after impact in x dir ',I1/,
816 . ' secondary node (1:YES 0:NO) y dir ',I1/,
817 . ' z dir ',I1/,
818 . ' bound. cond. deleted after impact in x dir ',I1/,
819 . ' main node (1:YES 0:NO) y dir ',I1/,
820 . ' z dir ',I1/,
821 . ' formulation level. . . . . . . . . . . . . .',I1/,
822 . ' (0:OLD, 1:OPTIMIZED). . . . . . . .',/,
823 . ' stiffness formulation. . . . . . . . . . ',I1/,
824 .' 0 : stiffness is computed from stiffness on secondary side'/,
825 .' 1 : stfac is a stiffness value '/,
826 . ' stiffness factor or stiffness value . . . ',1PG20.13/,
827 . ' minimum stiffness. . . . . . . . . . . . ',1PG20.13/,
828 . ' maximum stiffness. . . . . . . . . . . . ',1PG20.13/,
829 . ' friction factor . . . . . . . . . . . . . ',1PG20.13/,
830 . ' variable gap flag . . . . . . . . . . . . ',I5/,
831 . ' minimum gap . . . . . . . . . . . . . . . ',1PG20.13/,
832 . ' maximum gap (= 0. <=> NO MAXIMUM GAP) . . ',1PG20.13/,
833 . ' gap scale factor. . . . . . . . . . . . . ',1PG20.13/,
834 . ' start time. . . . . . . . . . . . . . . . ',1PG20.13/,
835 . ' stop time . . . . . . . . . . . . . . . . ',1PG20.13/,
836 . ' bucket factor . . . . . . . . . . . . . . ',1PG20.13/,
837 . ' de-activation of initial penetrations . . ',I10/,
838 . ' critical damping factor . . . . . . . . . ',1PG20.13/,
839 . ' maximum pressure due to thickness variation'/,
840 . ' case of igap=2. . . . . . ',1PG20.13/,
841 . ' mean possible number of impact/node . . . ',I5/,
842 . ' inverted normals detection flag . . . . . . ',I5/,
843 . ' tangential force limitation flag . . . . . . ',I5/,
844 . ' maximum pressure for skid line output ',1PG20.13)
845 2102 FORMAT(//
846 . ' thermal interface ' //,
847 . ' thermal heat exchange coefficient . . . . .',1PG20.13/,
848 . ' interface temperature . . . . . . . . . . ',1PG20.13/,
849 . ' radiation factor . . . . . . . . . . . . . ',1PG20.13/,
850 . ' maximum distance for radiation computation.',1PG20.13/,
851 . ' frictional heat transfer. . . . . . . . . .',1PG20.13/,
852 . ' formulation choice : . . . . . . . . . . . ',I10,/,
853 . ' 0 : heat transfer between secondary side',/,
854 . ' and constant temperature in interface',/,
855 . ' 1 : heat exchange between pieces in contact'/
856 . ' function for thermal heat exchange coefficient wrt distance',I10/,
857 . ' maximum distance for conductive heat exchange',1PG20.13)
858 2103 FORMAT(//
859 . ' thermal interface ' //,
860 . ' function for thermal heat exchange coefficient wrt contact pressure',I10/,
861 . ' abscissa scale factor on ifuntck. . . . . ',1PG20.13/,
862 . ' ordinate scale factor on ifuntck . . . . ',1PG20.13/,
863 . ' interface temperature . . . . . . . . . . ',1PG20.13/,
864 . ' radiation factor . . . . . . . . . . . . . ',1PG20.13/,
865 . ' maximum distance for radiation computation.',1PG20.13/,
866 . ' frictional heat generation . . . . . . . . ',1PG20.13/,
867 . ' formulation choice : . . . . . . . . . . . ',I10,/,
868 . ' 0 : heat transfer between secondary side',/,
869 . ' and constant temperature in interface',/,
870 . ' 1 : heat exchange between pieces in contact'/
871 . ' Function for thermal heat exchange coefficient wrt distance',i10/,
872 . ' Maximum distance for conductive heat exchange',1pg20.13)
873C
874 END
#define my_real
Definition cppsort.cpp:32
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
#define alpha
Definition eval.h:35
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_read_inter_type21(ipari, stfac, frigap, noint, ni, igrsurf, xfiltr, fric_p, npc1, sensors, nom_opt, unitab, lsubmodel, titr, npc, tf, npari, nparir, snpc, snpc1, lnopt1, itherm_fe, intheat, nom_optfric, intbuf_fric_tab)
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine inter_dcod_friction(ntyp, ni, ipari, nom_opt, nom_optfric, intbuf_fric_tab)
subroutine inter_dcod_function(ntyp, ni, ipari, npc1, nom_opt, npc, pld)
subroutine inter_dcod_sensor(ntyp, ni, ipari, nom_opt, sensors)
#define max(a, b)
Definition macros.h:21
initmumps id
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
integer, parameter ncharkey
integer nsubmod
subroutine radiation(ibcr, fradia, npc, tf, x, temp, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition radiation.F:38
int main(int argc, char *argv[])
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
program starter
Definition starter.F:39
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33