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.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
my_real
#define my_real
Definition cppsort.cpp:32
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
ale_mod
Definition ale_mod.F:150
elbuftag_mod
Definition elbuftag_mod.F:230
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517