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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop34 (geo, igeo, iout, nuvar, pargeo, qa, qb, iskn, ig, titr, unitab, prop_tag, igtyp, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_prop34()

subroutine hm_read_prop34 ( geo,
integer, dimension(*) igeo,
integer iout,
integer nuvar,
pargeo,
qa,
qb,
integer, dimension(liskn,*) iskn,
integer ig,
character(len=nchartitle) titr,
type (unit_type_), intent(in) unitab,
type(prop_tag_), dimension(0:maxprop) prop_tag,
integer igtyp,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 39 of file hm_read_prop34.F.

42C============================================================================
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE message_mod
47 USE elbuftag_mod
48 USE submodel_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "param_c.inc"
59#include "sphcom.inc"
60#include "tablen_c.inc"
61C-----------------------------------------------
62C A n a l y s e M o d u l e
63C-----------------------------------------------
64C----------+---------+---+---+--------------------------------------------
65C VAR | SIZE |TYP| RW| DEFINITION
66C----------+---------+---+---+--------------------------------------------
67C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
68C NUVAR | 1 | I | W | NUMBER OF USER ELEMENT VARIABLES
69C----------+---------+---+---+--------------------------------------------
70C PARGEO | * | F | W | 1)SKEW NUMBER
71C | | | | 2)STIFNESS FOR INTERFACE
72C | | | | 3)FRONT WAVE OPTION
73C | | | | 4)... not yet used
74C----------+---------+---+---+--------------------------------------------
75C
76C This subroutine read the user geometry parameters.
77C
78C The geometry datas has to bee stored in radioss storage
79C with the function SET_U_GEO(value_index,value).
80C
81C If some standard radioss functions (time function or
82C x,y function) are used, this function IDs has to
83C bee stored with the function SET_U_PNU(func_index,func_id,KFUNC).
84C
85C If this property refers to a user material, this
86C material IDs has to bee stored with the function
87C SET_U_PNU(mat_index,mat_id,KMAT).
88C
89C If this property refers to a user property, this
90C sub-property IDs has to bee stored with the function
91C SET_U_PNU(sub_prop_index,sub_prop_id,KMAT).
92C
93C SET_U_GEO and SET_U_PNU return 0 if no error
94C SET_U_GEO and SET_U_PNU return the maximum allowed index
95C if index is larger than this maximum
96C-----------------------------------------------
97C D u m m y A r g u m e n t s
98C-----------------------------------------------
99 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
100 INTEGER IOUT,NUVAR,ISKN(LISKN,*),IG,IGTYP,IGEO(*)
101 CHARACTER(LEN=NCHARTITLE)::TITR
102 my_real
103 . pargeo(*), geo(*)
104 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
105 INTEGER SET_U_PNU,SET_U_GEO
106 EXTERNAL set_u_pnu,set_u_geo
107 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
108C=======================================================================
109C-----------------------------------------------
110C C o m m o n B l o c k s
111C-----------------------------------------------
112#include "com04_c.inc"
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 INTEGER IERROR,IORDER,ISK,K
117 my_real
118 . xk,mp,qa,qb,alpcs,xorder,dist,pun,zstab,
119 . hmin,hmax,h_scal
120 INTEGER IFLG_H
121 my_real
122 . h_dilat_coeff,rflg_h
123 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
124C-----------------------------------------------
125C E x t e r n a l F u n c t i o n s
126C-----------------------------------------------
127 DATA pun/0.1/
128C-----------------------------------------------
129
130 nuvar=0
131 pargeo(1) = 0
132 xk=0.0
133 pargeo(2)=xk
134C front wave=1
135 pargeo(3) =1
136C-------
137 isk=0
138 iflg_h=0
139 iorder=-1
140 dist =zero
141 zstab =zero
142C
143C--------------------------------------------------
144C EXTRACT DATA (IS OPTION CRYPTED)
145C--------------------------------------------------
146 CALL hm_option_is_encrypted(is_encrypted)
147C--------------------------------------------------
148C EXTRACT DATAS (INTEGER VALUES)
149C--------------------------------------------------
150 CALL hm_get_intv('SKEW_CSID',isk,is_available,lsubmodel)
151 CALL hm_get_intv('h_1D',iflg_h,is_available,lsubmodel)
152 CALL hm_get_intv('ORDER',iorder,is_available,lsubmodel)
153C--------------------------------------------------
154C EXTRACT DATAS (REAL VALUES)
155C--------------------------------------------------
156 CALL hm_get_floatv('MASS',mp,is_available,lsubmodel,unitab)
157 CALL hm_get_floatv('qa',qa,is_available,lsubmodel,unitab)
158 CALL hm_get_floatv('qb',qb,is_available,lsubmodel,unitab)
159 CALL hm_get_floatv('ALPHA1',alpcs,is_available,lsubmodel,unitab)
160 CALL hm_get_floatv('h',dist,is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('Xi_Stab',zstab,is_available,lsubmodel,unitab)
162 CALL hm_get_floatv('hmin',hmin,is_available,lsubmodel,unitab)
163 CALL hm_get_floatv('hmax',hmax,is_available,lsubmodel,unitab)
164 CALL hm_get_floatv('h_scal',h_scal,is_available,lsubmodel,unitab)
165C----------------------
166C
167 WRITE(iout,1100) ig
168
169 IF(qa==zero)qa=two
170 IF(qb==zero)qb=one
171 IF (zstab>0) nspbuf=15
172C
173 IF (iflg_h == 3) THEN
174 IF(hmin==zero) hmin = zep2
175 IF(hmax==zero) hmax = two
176 IF(h_scal==zero) h_scal = onep2
177 ENDIF
178C
179 IF(isk /= 0)THEN
180 DO k=1,numskw
181 IF(isk == iskn(4,k+1)) THEN
182 pargeo(1)=(k+1)+pun
183 GO TO 100
184 ENDIF
185 ENDDO
186 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
187 . c1='PROPERTY',
188 . c2='PROPERTY',
189 . i1=ig,i2=isk,c3=titr)
190100 CONTINUE
191 ELSE
192 pargeo(1)=zero
193 k = 1
194 ENDIF
195C------
196C IF(NSPMD > 1 .AND. IORDER==1)THEN
197C CALL ANCMSG(MSGID=755,
198C . MSGTYPE=MSGERROR,
199C . ANMODE=ANINFO,
200C . C1='SPH CORRECTION ORDER 1')
201C END IF
202C
203 rflg_h = iflg_h
204C
205 IF (iflg_h==1) THEN
206 h_dilat_coeff = one
207 ELSEIF (iflg_h==2) THEN
208 h_dilat_coeff = zero
209 ELSE
210 h_dilat_coeff = third
211 ENDIF
212C
213 IF(is_encrypted)THEN
214 WRITE(iout,'(5X,A,//)')' CONFIDENTIAL DATA'
215 ELSE
216 IF(dist==zero)THEN
217 WRITE(iout,1000)mp,qa,qb,alpcs,zstab,isk,iorder
218 IF (iflg_h==3) THEN
219 WRITE(iout,1005)
220 ELSE
221 WRITE(iout,1004)
222 ENDIF
223 ELSE
224 WRITE(iout,1001)mp,qa,qb,alpcs,zstab,isk,iorder,dist
225 ENDIF
226 IF (iflg_h==1) THEN
227 WRITE(iout,1002)
228 ELSEIF (iflg_h==2) THEN
229 WRITE(iout,1003)
230 ELSEIF (iflg_h==3) THEN
231 WRITE(iout,1006) hmin,hmax,h_scal
232 END IF
233 ENDIF
234
235 IF(mp<=zero)THEN
236 CALL ancmsg(msgid=138,anmode=aninfo,msgtype=msgwarning,
237 . c1=titr,i1=ig)
238 mp=one
239 ENDIF
240C
241 ierror = set_u_geo(1,mp)
242 ierror = set_u_geo(2,qa)
243 ierror = set_u_geo(3,qb)
244 ierror = set_u_geo(4,alpcs)
245 xorder = iorder+em01
246 ierror = set_u_geo(5,xorder)
247 ierror = set_u_geo(6,dist)
248 ierror = set_u_geo(7,zstab)
249 ierror = set_u_geo(8,h_dilat_coeff)
250 ierror = set_u_geo(9,rflg_h)
251 ierror = set_u_geo(10,hmin)
252 ierror = set_u_geo(11,hmax)
253 ierror = set_u_geo(12,h_scal)
254C
255 geo(14)=qa
256 geo(15)=qb
257 IF (geo(16) /= zero .OR. geo(17) /= zero) THEN
258 igeo(33) = 1 ! ISVIS flag
259 ENDIF
260C
261 prop_tag(igtyp)%G_SIG = 6
262 prop_tag(igtyp)%G_VOL = 1
263 prop_tag(igtyp)%G_EINT = 1
264 prop_tag(igtyp)%G_QVIS = 1
265 prop_tag(igtyp)%L_SIG = 6
266 prop_tag(igtyp)%L_EINT = 1
267 prop_tag(igtyp)%L_VOL = 1
268 prop_tag(igtyp)%L_QVIS = 1
269C
270 RETURN
271C------
272 999 CONTINUE
273C WRITE(IOUT,*)' **ERROR IN SPH PROPERTY INPUT.'
274C IERR=IERR+1
275C CALL ARRET(2)
276 CALL ancmsg(msgid=401,
277 . msgtype=msgerror,
278 . anmode=aninfo,
279 . i1=ig,
280 . c2=titr,
281 . c1='SPH')
282 RETURN
283C------
284 1000 FORMAT(
285 & 5x,'PARTICLES MASS. . . . . . . . . . . . .=',1pg20.13/,
286 & 5x,'QA. . . . . . . . . . . . . . . . . . .=',1pg20.13/,
287 & 5x,'QB. . . . . . . . . . . . . . . . . . .=',1pg20.13/,
288 & 5x,'ALPCS . . . . . . . . . . . . . . . . .=',1pg20.13/,
289 & 5x,'coefficient wrt tensile instability . .=',1PG20.13/,
290 & 5X,'orthotropic initial skew system . . . .=',I10/,
291 & 5X,'formulation correction order. . . . . .=',I10/,
292 & 5X,'smoothing length automatically computed')
293 1001 FORMAT(
294 & 5X,'particles mass. . . . . . . . . . . . .=',1PG20.13/,
295 & 5X,'qa. . . . . . . . . . . . . . . . . . .=',1PG20.13/,
296 & 5X,'qb. . . . . . . . . . . . . . . . . . .=',1PG20.13/,
297 & 5X,'alpcs . . . . . . . . . . . . . . . . .=',1PG20.13/,
298 & 5X,'coefficient wrt tensile instability . .=',1PG20.13/,
299 & 5X,'orthotropic initial skew system . . . .=',I10/,
300 & 5X,'formulation correction order. . . . . .=',I10/,
301 & 5X,'smoothing length. . . . . . . . . . . .=',1PG20.13)
302 1002 FORMAT(
303 & 5X,'uniaxial dilatation of smoothing length')
304 1003 FORMAT(
305 & 5X,'constant smoothing length')
306 1004 FORMAT(
307 & 5X,'smoothing length computed from particle mass')
308 1005 FORMAT(
309 & 5X,'smoothing length computed from interparticle distance')
310 1006 FORMAT(
311 & 5X,'bounded dilatation of smoothing length'/,
312 & 5X,'minimum dilatation ratio . . . . . . . =',1PG20.13/,
313 & 5X,'maximum dilatation ratio . . . . . . . =',1PG20.13/,
314 & 5X,'smoothing length scaling factor. . . . =',1PG20.13)
315 1100 FORMAT(
316 & 5X,'sph property set'/,
317 & 5X,'property set number . . . . . . . . . .=',I10)
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
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
submodel_mod
Definition submodel_mod.F:712
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
set_u_pnu
integer function set_u_pnu(ivar, ip, k)
Definition uaccess.F:127
set_u_geo
integer function set_u_geo(ivar, a)
Definition uaccess.F:64