OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type09.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_type09 ../starter/source/interfaces/int09/hm_read_inter_type09.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_fsi ../starter/source/interfaces/reader/hm_read_inter_fsi.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| ngr2usr ../starter/source/system/nintrr.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
36 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
37 2 IGRSURF ,UNITAB ,LSUBMODEL ,NPARI ,
38 3 NPARIR)
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
74 my_real
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
214 END
#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)
subroutine hm_read_inter_type09(ipari, stfac, frigap, noint, igrsurf, unitab, lsubmodel, npari, nparir)
integer, parameter nchartitle
integer, parameter ncharkey
integer nsubmod
subroutine upwind(rho, vis, vdx, vdy, vdz, r, s, t, deltax, gam, nel)
Definition upwind.F:35