OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop15.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "tablen_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop15 (ig, igtyp, geo, igeo, prop_tag, unitab, lsubmodel, idtitl, iskn, itabm1, defaults_solid)

Function/Subroutine Documentation

◆ hm_read_prop15()

subroutine hm_read_prop15 ( integer ig,
integer igtyp,
geo,
integer, dimension(*) igeo,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*) lsubmodel,
character(len=nchartitle) idtitl,
integer, dimension(liskn,*) iskn,
integer, dimension(*) itabm1,
type(solid_defaults_), intent(in) defaults_solid )

Definition at line 40 of file hm_read_prop15.F.

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 IF(ale%GLOBAL%ICAA==0 .AND. 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 IF (ismstr < 0.OR.isst_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 IF(n2d==0.AND.i8pt==1) geo(1)=8
173 IF(iabs(ihbe)>=222) geo(1)=ihbe
174 IF(n2d>0.AND.i8pt==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 IF(n2d>0.AND.ihbe/=0.AND.ihbe/=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 IF(ihbe>=3.AND.ihbe<13.AND.ihbe/=4) ihbe=1
194 geo(171)=ihbe
195 IF(ihbe>1000.AND.ihbe<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 IF(geo( 3)/=zero.AND.igeo( 5)== 0)igeo( 5)=nint(geo( 3))
245 IF(geo(39)/=zero.AND.igeo( 9)== 0)igeo( 9)=nint(geo(39))
246 IF(geo(171)/=zero.AND.igeo(10)== 0)
247 . igeo(10)=nint(geo(171))
248
249 IF (geo(16) /= zero .OR. 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
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_ale_close
subroutine hm_read_ale_close(unitab, lsubmodel, geo)
Definition hm_read_ale_close.F:35
min
#define min(a, b)
Definition macros.h:20
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
unitab_mod
Definition unitab_mod.F:513
ancmsg
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
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160