OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type09.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type09 (ipari, stfac, frigap, noint, igrsurf, unitab, lsubmodel, npari, nparir)

Function/Subroutine Documentation

◆ hm_read_inter_type09()

subroutine hm_read_inter_type09 ( integer, dimension(npari) ipari,
stfac,
frigap,
integer noint,
type (surf_), dimension(nsurf), target igrsurf,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
integer, intent(in) npari,
integer, intent(in) nparir )

Definition at line 35 of file hm_read_inter_type09.F.

39C============================================================================
40C
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE unitab_mod , ONLY : unit_type_
45 USE message_mod
46 USE groupdef_mod , ONLY : surf_
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER,INTENT(IN) :: NPARI,NPARIR
57 INTEGER ISU1,ISU2,NOINT
58 INTEGER IPARI(NPARI)
59 my_real stfac
60 my_real frigap(nparir)
61 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
62 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
63 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com04_c.inc"
68#include "units_c.inc"
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER NTYP,IS1, IS2,IEULT,IGSTI,ILEV,IBUC,
73 . IBC1, IBC2, IBC3,IBC1M, IBC2M, IBC3M,INTKG
75 . fric,gap,startt,stopt,fheat,stens,visc
76
77!
78 INTEGER, DIMENSION(:), POINTER :: INGR2USR
79 LOGICAL :: IS_AVAILABLE
80C-----------------------------------------------
81C E x t e r n a l F u n c t i o n s
82C-----------------------------------------------
83 INTEGER NGR2USR
84C-----------------------------------------------
85C=======================================================================
86C READING ALE INTERFACE /INTER/TYPE9
87C=======================================================================
88 ! Initializations of integer values
89 is1 = 0
90 is2 = 0
91 ibc1 = 0
92 ibc2 = 0
93 ibc3 = 0
94 ibc1m = 0
95 ibc2m = 0
96 ibc3m = 0
97 igsti = 0
98 ilev = 0
99 intkg = 0
100 ibuc = 0
101 ieult = 0
102 ! Initializations of float values
103 fric = zero
104 gap = zero
105 startt = zero
106 stopt = infinity
107 visc = zero
108 fheat = zero
109 stens = zero
110 ! Type
111 ntyp = 9
112 ipari(15) = noint
113 ipari(7) = ntyp
114C=======================================================================
115C CARD 1 : Surfaces ids
116C=======================================================================
117 ! Lagrangian surface
118 CALL hm_get_intv('surf_IDA', isu1, is_available, lsubmodel)
119 ! ALE surface
120 CALL hm_get_intv('surf_IDL', isu2, is_available, lsubmodel)
121 ! Checks
122 is1=1
123 ingr2usr => igrsurf(1:nsurf)%ID
124 isu1=ngr2usr(isu1,ingr2usr,nsurf)
125 IF(isu2==0)THEN
126 is2=0
127 ELSE
128 is2=1
129 isu2=ngr2usr(isu2,ingr2usr,nsurf)
130 ENDIF
131 ! Storage IPARI FRIGAP
132 ipari(45) = isu1
133 ipari(46) = isu2
134 ipari(13) = is1*10+is2
135 ipari(20) = ilev
136C=======================================================================
137C CARD 2 : Thermal resistance + Friction coefficient + Init GAP
138C=======================================================================
139 ! Thermal resistance
140 CALL hm_get_floatv('R_TH' ,stfac ,is_available, lsubmodel, unitab)
141 ! Friction coefficient
142 CALL hm_get_floatv('FRIC' ,fric ,is_available, lsubmodel, unitab)
143 ! Initial Gap
144 CALL hm_get_floatv('GAP' ,gap ,is_available, lsubmodel, unitab)
145 ! Storage IPARI FRIGAP
146 frigap(1) = fric
147 frigap(2) = gap
148 frigap(3) = startt
149 frigap(11) = stopt
150C=======================================================================
151C CARD 3 : Thermal bridge + Euler + Upwind + Surface tension
152C=======================================================================
153 ! Thermal bridge flag
154 CALL hm_get_intv('I_TH' ,ibuc ,is_available, lsubmodel)
155 ! Euler flag
156 CALL hm_get_intv('I_EUL' ,ieult ,is_available, lsubmodel)
157 ! Upwind value
158 CALL hm_get_floatv('UPWIND' ,visc ,is_available, lsubmodel, unitab)
159 ! Surface tension force
160 CALL hm_get_floatv('Fs' ,stens ,is_available, lsubmodel, unitab)
161 ! Storage IPARI FRIGAP
162 ipari(14) = ieult
163 frigap(4) = fheat
164 frigap(15) = stens
165 ipari(11) = 4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
166 frigap(14) = visc
167 ipari(12) = ibuc
168 ipari(65) = intkg
169C=======================================================================
170C PRINTOUT
171C=======================================================================
172C
173 WRITE(iout,1509) ibuc,ipari(14),stfac,fric,gap,visc,stens
174C
175 IF(is1==0)THEN
176 WRITE(iout,'(6X,A)')'NO ALE SURFACE INPUT'
177 ELSEIF(is1==1)THEN
178 WRITE(iout,'(6X,A)')'ALE SURFACE INPUT BY SEGMENTS'
179 ELSEIF(is1==2)THEN
180 WRITE(iout,'(6X,A)')'ALE SURFACE INPUT BY NODES'
181 ELSEIF(is1==3)THEN
182 WRITE(iout,'(6X,A)')'ALE SURFACE INPUT BY SEGMENTS'
183 ELSEIF(is1==4 )THEN
184 WRITE(iout,'(6X,A)')'ALE SIDE INPUT BY BRICKS'
185 ELSEIF(is1==5 )THEN
186 WRITE(iout,'(6X,A)')'ALE SIDE INPUT BY SOLID ELEMENTS'
187 ENDIF
188 IF(is2==0)THEN
189 WRITE(iout,'(6X,A)')'NO LAGRANGIAN SURFACE INPUT'
190 ELSEIF(is2==1)THEN
191 WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE INPUT BY SEGMENTS'
192 ELSEIF(is2==2)THEN
193 WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE INPUT BY NODES'
194 ELSEIF(is2==3)THEN
195 WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE INPUT BY SEGMENTS'
196 ELSEIF(is2==4)THEN
197 WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE REFERS ',
198 . 'TO HYPER-ELLIPSOIDAL SURFACE'
199 ENDIF
200C
201C--------------------------------------------------------------
202C------------
203 1509 FORMAT(//
204 . ' TYPE==9 ALE-THERMAL SLIDING AND VOIDS ' //,
205 . ' THERMAL BRIDGE (1 YES 0 NO) . . . . . . . ',i10/,
206 . ' TANG. DIR. EULER.(FREE SURF.) (1 YES 0 NO)',i10/,
207 . ' THERMAL RESISTANCE. . . . . . . . . . . . ',1pg20.13/,
208 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
209 . ' INITIAL GAP . . . . . . . . . . . . . . . ',1pg20.13/,
210 . ' FREE SURFACE UPWIND . . . . . . . . . . . ',1pg20.13/,
211 . ' SURFACE TENSION . . . . . . . . . . . . . ',1pg20.13//)
212
213 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
integer, parameter nchartitle
integer, parameter ncharkey
integer nsubmod
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323