OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop15.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_prop15 ../starter/source/properties/solid/hm_read_prop15.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.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_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| hm_read_ale_close ../starter/source/ale/hm_read_ale_close.F
33!|| usr2sys ../starter/source/system/sysfus.F
34!||--- uses -----------------------------------------------------
35!|| defaults_mod ../starter/source/modules/defaults_mod.f90
36!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_prop15 (IG , IGTYP , GEO , IGEO ,PROP_TAG ,UNITAB ,
41 . LSUBMODEL,IDTITL ,ISKN ,ITABM1,DEFAULTS_SOLID )
42C============================================================================
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE submodel_mod
48 USE message_mod
49 USE ale_mod
50 USE defaults_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "units_c.inc"
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63#include "tablen_c.inc"
64#include "sphcom.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
69 INTEGER IGTYP , IGEO(*) ,ISKN(LISKN,*) ,ITABM1(*)
70 TYPE(submodel_data) LSUBMODEL(*)
71 my_real geo(*)
72 CHARACTER(LEN=NCHARTITLE)::IDTITL
73 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
74 TYPE(solid_defaults_), INTENT(IN) :: DEFAULTS_SOLID
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER IG, ISMSTR, NIP, J,K ,NPTS ,
79 . ihbe,ish3n,isrot ,i8pt ,isk,ihon ,itu ,irb,
80 . igflu ,ihbe_old
81 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS
82
83 my_real angl,pun,cvis,rbid,vx,vy,vz,fac_l,fac_t,fac_m, pthk, an, phi
84 CHARACTER(LEN=NCHARTITLE)::TITR
85 CHARACTER MESS*40
86 CHARACTER(LEN=NCHARKEY)::KEY
87 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
88C-----------------------------------------------
89C E x t e r n a l F u n c t i o n s
90C-----------------------------------------------
91 INTEGER USR2SYS
92 DATA pun/0.1/
93 DATA mess/'PID DEFINITION '/
94C------------------------------
95C POROUS SOLID
96c------------------------------
97 ihbe=0
98 ismstr=0
99 isrot=0
100 igflu=1
101 cvis =zero
102!--- defaults values
103 ihbe_ds= defaults_solid%ISOLID
104 isst_ds= defaults_solid%ISMSTR
105 iframe_ds= defaults_solid%IFRAME
106
107 is_encrypted = .false.
108 is_available = .false.
109C--------------------------------------------------
110C EXTRACT DATA (IS OPTION CRYPTED)
111C--------------------------------------------------
112 CALL hm_option_is_encrypted(is_encrypted)
113C--------------------------------------------------
114C EXTRACT DATAS (INTEGER VALUES)
115C--------------------------------------------------
116 CALL hm_get_intv('SKEW_CSID',isk,is_available,lsubmodel)
117 CALL hm_get_intv('MAT_Iflag',ihon,is_available,lsubmodel)
118 CALL hm_get_intv('I_TH',itu,is_available,lsubmodel)
119 CALL hm_get_intv('IRBY',irb,is_available,lsubmodel)
120
121C--------------------------------------------------
122C EXTRACT DATAS (REAL VALUES)
123C--------------------------------------------------
124 CALL hm_get_floatv('qa_l',geo(14),is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('qb_l',geo(15),is_available,lsubmodel,unitab)
126 CALL hm_get_floatv('h_l',geo(13),is_available,lsubmodel,unitab)
127 CALL hm_get_floatv('MAT_POROS',geo(21),is_available,lsubmodel,unitab)
128 CALL hm_get_floatv('MAT_PDIR1',geo(24),is_available,lsubmodel,unitab)
129 CALL hm_get_floatv('MAT_PDIR2',geo(25),is_available,lsubmodel,unitab)
130 CALL hm_get_floatv('MAT_PDIR3',geo(26),is_available,lsubmodel,unitab)
131 CALL hm_get_floatv('ALPHA1',geo(22),is_available,lsubmodel,unitab)
132 CALL hm_get_floatv('thick',GEO(23),IS_AVAILABLE,LSUBMODEL,UNITAB)
133
134c CALL FRETITL(IDTITL,IGEO(NPROPGI-LTITR+1),LTITR)
135c WRITE(IOUT,'(A40)') IDTITL
136C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
137 IGEO(1) = IG
138 IGEO(11)= IGTYP
139 GEO(12) = IGTYP+PUN
140
141.AND. IF(ALE%GLOBAL%ICAA==0 IGFLU==0)THEN
142 IF(GEO(14)==ZERO) GEO(14)=ONEP1
143 IF(GEO(15)==ZERO) GEO(15)=FIVEEM2
144 ENDIF
145 IF(GEO(13)==ZERO)GEO(13)=EM01
146 IF(IHBE==0)THEN
147 IHBE=IHBE_DS
148 ENDIF
149 I8PT=0
150C
151 IF(ISMSTR==0)ISMSTR=ISST_DS
152.OR. IF (ISMSTR < 0ISST_DS==-2) ISMSTR=4
153 IF(ISMSTR==0)ISMSTR=4
154 IF(ISMSTR==3)GEO(5)=EP06
155 GEO(3) =ISMSTR
156 IGEO(5) = ISMSTR
157C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
158 IGEO(10)=IHBE
159 GEO(171)=IHBE
160c
161 IF(IHBE==12)THEN
162 I8PT=1
163 IHBE=0
164 ELSEIF(IHBE==13)THEN
165 I8PT=1
166 ELSEIF(IHBE==112)THEN
167 I8PT=1
168 ELSEIF(IHBE>=222)THEN
169 I8PT=1
170 ENDIF
171 GEO(1)=1
172.AND. IF(N2D==0I8PT==1) GEO(1)=8
173 IF(IABS(IHBE)>=222) GEO(1)=IHBE
174.AND. IF(N2D>0I8PT==1)THEN
175 GEO(1)=4
176 CALL ANCMSG(MSGID=323,
177 . MSGTYPE=MSGWARNING,
178 . ANMODE=ANINFO_BLIND_2,
179 . I1=IG,
180 . C1=IDTITL)
181 ENDIF
182.AND..AND. IF(N2D>0IHBE/=0IHBE/=2)THEN
183 IHBE_OLD=IHBE
184 IHBE=0
185 CALL ANCMSG(MSGID=324,
186 . MSGTYPE=MSGWARNING,
187 . ANMODE=ANINFO_BLIND_2,
188 . I1=IG,
189 . C1=IDTITL,
190 . I2=IHBE_OLD,
191 . I3=IHBE)
192 ENDIF
193.AND..AND. IF(IHBE>=3IHBE<13IHBE/=4) IHBE=1
194 GEO(171)=IHBE
195.AND. IF(IHBE>1000IHBE<1050) THEN
196 NPTS=IHBE-1000
197 ELSEIF(IABS(IHBE)>=222) THEN
198 NPTS=IABS(IHBE)/100*MOD(IABS(IHBE)/10,10)*MOD(IABS(IHBE),10)
199 ELSE
200 NPTS=NINT(GEO(1))
201 ENDIF
202 IGEO(4) = NPTS
203 IGEO(10) = IHBE
204C----------------------
205 IF(GEO(21)==0.) GEO(21)=ONE
206 ITU=MIN(ITU,1)
207 IF(ITU==1)THEN
208 IF(GEO(22)==ZERO)GEO(22)=EM01
209 IF(GEO(23)==ZERO)THEN
210 GEO(23)=EM20
211 IWARN = IWARN + 1
212 WRITE(IOUT,*)
213 . ' mixing length required IF turbulence',
214 . ' is imposed by porous medium'
215 ENDIF
216 ENDIF
217C
218 DO K=0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
219 IF(ISK == ISKN(4,K+1)) THEN
220 ISK=K+1
221 GO TO 10
222 ENDIF
223 ENDDO
224 CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
225 . C1='property',
226 . C2='property',
227 . I1=IG,I2=ISK,C3=IDTITL)
22810 CONTINUE
229C
230 GEO(27)=ISK + EM01
231 GEO(28)=ITU + EM01
232 IF(IRB/=0)THEN
233 GEO(29)=USR2SYS(IRB,ITABM1,MESS,IG)+PUN
234 ELSE
235 GEO(29)=0
236 ENDIF
237 GEO(30)=IHON+EM01
238 IF(GEO(24)+GEO(25)+GEO(26)==ZERO)GEO(20)=ONEP1
239 WRITE(IOUT,1800)IG,NINT(GEO(1)),IHBE,GEO(14),GEO(15),
240 . GEO(13),GEO(21),(GEO(J),J=24,26),ISKN(4,ISK),
241 . IHON,IRB
242 IF(ITU==1) WRITE(IOUT,1850)GEO(22),GEO(23)
243
244.AND. IF(GEO( 3)/=ZEROIGEO( 5)== 0)IGEO( 5)=NINT(GEO( 3))
245.AND. IF(GEO(39)/=ZEROIGEO( 9)== 0)IGEO( 9)=NINT(GEO(39))
246.AND. IF(GEO(171)/=ZEROIGEO(10)== 0)
247 . IGEO(10)=NINT(GEO(171))
248
249.OR. IF (GEO(16) /= ZERO GEO(17) /= ZERO) THEN
250 IGEO(33) = 1 ! ISVIS flag
251 ENDIF
252
253! /ALE/CLOSE
254! ----------
255 CALL HM_READ_ALE_CLOSE(UNITAB, LSUBMODEL, GEO)
256
257C-------- Variables stored in element buffer
258c---- Solids
259 PROP_TAG(IGTYP)%G_SIG = 6
260 PROP_TAG(IGTYP)%G_VOL = 1
261 PROP_TAG(IGTYP)%G_EINT = 1
262 PROP_TAG(IGTYP)%G_QVIS = 1
263 PROP_TAG(IGTYP)%L_SIG = 6
264 PROP_TAG(IGTYP)%L_EINT = 1
265 PROP_TAG(IGTYP)%L_VOL = 1
266 PROP_TAG(IGTYP)%L_QVIS = 1
267 PROP_TAG(IGTYP)%G_FILL = 1
268 PROP_TAG(IGTYP)%L_STRA = 6
269C-----------
270 RETURN
271C-----------
272 1800 FORMAT(
273 & 5X,'porous fluid property set'/,
274 & 5X,'property set number . . . . . . . . . .=',I10/,
275 & 5X,'number of gauss point . . . . . . . . .=',I10/,
276 & 5X,'hourglass belytshko . . . . . . . . . .=',I10/,
277 & 5X,'quadratic bulk viscosity. . . . . . . .=',1pg20.13/,
278 & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
279 & 5x,'HOURGLASS VISCOSITY . . . . . . . . . .=',1pg20.13/,
280 & 5x,'POROSITY . . . . . . . . . . . . . . .=',1pg20.13/,
281 & 5x,'RESISTANCE FACTOR DIR 1 . . . . . . . .=',1pg20.13/,
282 & 5x,'RESISTANCE FACTOR DIR 2 . . . . . . . .=',1pg20.13/,
283 & 5x,'RESISTANCE FACTOR DIR 3 . . . . . . . .=',1pg20.13/,
284 & 5x,'SKEW NUMBER AS REFERENCE FRAME . . . .=',i10/,
285 & 5x,'FLAG FOR HONEYCOMB IN DIR 1 . . . . . .=',i10/,
286 & 5x,'rigid body number to which',/,
287 & 5X,' substrate reaction is applied . .=',I10/)
288 1850 FORMAT(
289 & 5X,'turbulence is imposed by porous medium'/,
290 & 5X,'turbulent fluctuation coeff . . . . . .=',1PG20.13/,
291 & 5X,'mixing length . . . . . . . . . . . . .=',1PG20.13/)
292C-----------
293
294 END
295
296
297
298
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_prop15
subroutine hm_read_prop15(ig, igtyp, geo, igeo, prop_tag, unitab, lsubmodel, idtitl, iskn, itabm1, defaults_solid)
Definition hm_read_prop15.F:42
ale_mod
Definition ale_mod.F:149
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
starter
program starter
Definition starter.F:39
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723