39
40
41
42
43
49
50
51
52#include "implicit_f.inc"
53
54
55
56 INTEGER,INTENT(IN) :: NPARI,NPARIR
57 INTEGER ISU1,ISU2,NOINT
58 INTEGER IPARI(NPARI)
61 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
62 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
63 TYPE () ,TARGET , DIMENSION(NSURF) :: IGRSURF
64
65
66
67#include "com04_c.inc"
68#include "units_c.inc"
69
70
71
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
80
81
82
83 INTEGER NGR2USR
84
85
86
87
88
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
103 fric = zero
104 gap = zero
105 startt = zero
106 stopt = infinity
107 visc = zero
108 fheat = zero
109 stens = zero
110
111 ntyp = 9
112 ipari(15) = noint
113 ipari(7) = ntyp
114
115
116
117
118 CALL hm_get_intv(
'surf_IDA', isu1, is_available, lsubmodel)
119
120 CALL hm_get_intv(
'surf_IDL', isu2, is_available, lsubmodel)
121
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
132 ipari(45) = isu1
133 ipari(46) = isu2
134 ipari(13) = is1*10+is2
135 ipari(20) = ilev
136
137
138
139
140 CALL hm_get_floatv(
'R_TH' ,stfac ,is_available, lsubmodel, unitab)
141
142 CALL hm_get_floatv(
'FRIC' ,fric ,is_available, lsubmodel, unitab)
143
144 CALL hm_get_floatv(
'GAP' ,gap ,is_available, lsubmodel, unitab)
145
146 frigap(1) = fric
147 frigap(2) = gap
148 frigap(3) = startt
149 frigap(11) = stopt
150
151
152
153
154 CALL hm_get_intv(
'I_TH' ,ibuc ,is_available, lsubmodel)
155
156 CALL hm_get_intv(
'I_EUL' ,ieult ,is_available, lsubmodel)
157
158 CALL hm_get_floatv(
'UPWIND' ,visc ,is_available, lsubmodel, unitab)
159
160 CALL hm_get_floatv(
'Fs' ,stens ,is_available, lsubmodel, unitab)
161
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
169
170
171
172
173 WRITE(iout,1509) ibuc,ipari(14),stfac,fric,gap,visc,stens
174
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
200
201
202
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. . . . . . . . . . . . '
208 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
209 . ' INITIAL GAP . . . . . . . . . . . . . . . ',1pg20.13/,
210 . ' FREE SURFACE UPWIND . . . . . . . . . . . ',1pg20.13/,
211 . ' SURFACE TENSION . . . . . . . . . . . . . ',1pg20.13//)
212
213 RETURN
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 function ngr2usr(iu, igr, ngr)