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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop36 (iout, nuvar, pargeo, unitab, iskn, ig, titr, igtyp, prop_tag, geo, lsubmodel, sub_id)
subroutine rini36 (nel, iout, iprop, ix, xl, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar)

Function/Subroutine Documentation

◆ hm_read_prop36()

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

Definition at line 39 of file hm_read_prop36.F.

41C-----------------------------------------------
42 USE unitab_mod
43 USE message_mod
44 USE elbuftag_mod
45 USE submodel_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "sphcom.inc"
57#include "tablen_c.inc"
58C----------+---------+---+---+--------------------------------------------
59C VAR | SIZE |TYP| RW| DEFINITION
60C----------+---------+---+---+--------------------------------------------
61C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
62C NUVAR | 1 | I | W | NUMBER OF USER ELEMENT VARIABLES
63C----------+---------+---+---+--------------------------------------------
64C PARGEO | * | F | W | 1)SKEW NUMBER
65C | | | | 2)STIFNESS FOR INTERFACE
66C | | | | 3)FRONT WAVE OPTION
67C | | | | 4)... not yet used
68C----------+---------+---+---+--------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
72 INTEGER IOUT,NUVAR,ISKN(LISKN,*),IG,IGTYP,SUB_ID
73 my_real geo(*),pargeo(*)
74 CHARACTER(LEN=NCHARTITLE)::TITR
75 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
76 INTEGER SET_U_PNU,SET_U_GEO,
77 . KFUNC,KUMAT,KUPROP
78 EXTERNAL set_u_pnu,set_u_geo
79 parameter(kfunc=29)
80 parameter(kumat=31)
81 parameter(kuprop=33)
82 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
83C=======================================================================
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER ISK,IUTYP,PID1,PID2,MID1,IERROR,K
88 my_real
89 . xk,area,ixx,iyy,izz,aa,ray,ry,rz
90 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
91C=======================================================================
92C
93 is_encrypted = .false.
94 is_available = .false.
95C--------------------------------------------------
96C EXTRACT DATA (IS OPTION CRYPTED)
97C--------------------------------------------------
98 CALL hm_option_is_encrypted(is_encrypted)
99C--------------------------------------------------
100C EXTRACT DATAS (INTEGER VALUES)
101C--------------------------------------------------
102 CALL hm_get_intv('P36_lutype',iutyp,is_available,lsubmodel)
103C--------------------------------------------------
104 IF(iutyp==1)THEN
105C-------------------------------------------------------
106C USER SUB TYPE 1 PROPERTY REFERENCED BY A SPRING PART
107C THIS PROPERTY REFERS TO 2 USER PROPERTIES
108C-------------------------------------------------------
109C--------------------------------------------------
110C EXTRACT DATAS (INTEGER VALUES)
111C--------------------------------------------------
112 CALL hm_get_intv('SKEW_CSID',isk,is_available,lsubmodel)
113 IF(isk == 0 .AND. sub_id /= 0 ) isk = lsubmodel(sub_id)%SKEW
114 CALL hm_get_intv('PROP_ID1',pid1,is_available,lsubmodel)
115 CALL hm_get_intv('PROP_ID2',pid2,is_available,lsubmodel)
116C--------------------------------------------------
117C EXTRACT DATAS (REAL VALUES)
118C--------------------------------------------------
119 CALL hm_get_floatv('Xk',xk,is_available,lsubmodel,unitab)
120C--------------------------------------------------
121 nuvar = 15
122C
123C PID1 and PID2 are USER property IDs
124C
125 ierror = set_u_pnu(1,pid1,kuprop)
126 ierror = set_u_pnu(2,pid2,kuprop)
127C
128 DO k=0,numskw+min(1,nspcond)*numsph+nsubmod
129 IF(isk == iskn(4,k+1)) THEN
130 isk=k+1
131 GO TO 100
132 ENDIF
133 ENDDO
134 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
135 . c1='PROPERTY',
136 . c2='PROPERTY',
137 . i1=ig,i2=isk,c3=titr)
138100 CONTINUE
139C
140 pargeo(1) = isk
141 pargeo(2) = xk
142C
143 IF(is_encrypted)THEN
144 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
145 ELSE
146 WRITE(iout,1000)iskn(4,isk),pid1,pid2,xk
147 ENDIF
148C
149 ELSEIF(iutyp==2)THEN
150C-------------------------------------------------------
151C USER SUB TYPE 2 PROPERTY REFERENCED BY A USER SUB TYPE 1 PROPERTY
152C THIS PROPERTY REFERS TO 1 USER MATERIAL
153C-------------------------------------------------------
154C--------------------------------------------------
155C EXTRACT DATAS (INTEGER VALUES)
156C--------------------------------------------------
157 CALL hm_get_intv('MAT_ID',mid1,is_available,lsubmodel)
158C--------------------------------------------------
159C EXTRACT DATAS (REAL VALUES)
160C--------------------------------------------------
161 CALL hm_get_floatv('AREA',area,is_available,lsubmodel,unitab)
162 CALL hm_get_floatv('IXX',ixx,is_available,lsubmodel,unitab)
163 CALL hm_get_floatv('IYY',iyy,is_available,lsubmodel,unitab)
164 CALL hm_get_floatv('IZZ',izz,is_available,lsubmodel,unitab)
165 CALL hm_get_floatv('RAY',ray,is_available,lsubmodel,unitab)
166C--------------------------------------------------
167C MID1 is a USER material ID
168 ierror = set_u_pnu(1,mid1,kumat)
169C
170 IF(ray==0.AND.area/=0) THEN
171 IF(ixx==0.OR.iyy==0.OR.izz==0) THEN
172 CALL ancmsg(msgid=640,
173 . msgtype=msgerror,
174 . anmode=aninfo_blind_1,
175 . i1=ig,
176 . c1=titr)
177 ENDIF
178 ENDIF
179C
180 IF ((area<=zero).AND.(ray<=zero)) THEN
181 WRITE(iout,*)' ** ERROR : PROPERTY INPUT '
182 IF(.NOT. is_encrypted)THEN
183 WRITE(iout,*)' AREA =',area,' R =',ray
184 ENDIF
185 ENDIF
186C
187 IF ((area<=zero).AND.(ray/=zero)) THEN
188 area=ray*ray*pi
189C
190 ixx=area*ray*ray*half
191 iyy=half*ixx
192
193 izz=iyy
194 ry=ray
195 rz=ray
196 ELSE
197C
198 ry=sqrt(four*iyy/area)
199 rz=sqrt(four*izz/area)
200 ENDIF
201C
202 aa = iutyp
203 ierror = set_u_geo(1,aa)
204 ierror = set_u_geo(2,area)
205 ierror = set_u_geo(3,ixx)
206 ierror = set_u_geo(4,iyy)
207 ierror = set_u_geo(5,izz)
208 ierror = set_u_geo(6,ry)
209 ierror = set_u_geo(7,rz)
210C
211 IF(is_encrypted)THEN
212 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
213 ELSE
214 WRITE(iout,2000)mid1,area,ixx,iyy,izz,ry,rz
215 ENDIF
216
217 ENDIF
218C
219 geo(25) = nuvar
220 prop_tag(igtyp)%G_EINT = 1
221 prop_tag(igtyp)%G_FOR = 3
222 prop_tag(igtyp)%G_MOM = 5
223 prop_tag(igtyp)%G_SKEW = 6
224 prop_tag(igtyp)%G_MASS = 1
225 prop_tag(igtyp)%G_V_REPCVT = 3 ! -- VITESSES REPERE CONVECTEE (V_REPCVT)
226 prop_tag(igtyp)%G_VR_REPCVT = 3 ! -- VITESSES REPERE CONVECTEE (VR_REPCVT)
227C if (IUTYP = 1 .or. NINT(GEO(25,I)) > 0 ) --> see lecg36.F
228 IF(nint(geo(25)) > 0) prop_tag(igtyp)%G_NUVAR = nint(geo(25))
229C
230 RETURN
231 999 CONTINUE
232 WRITE(iout,*)' **ERROR IN PROPERTY 36 INPUT'
233 RETURN
234 1000 FORMAT(
235 & 5x,' USER PROPERTY TYPE 1 (used by spring elements) ',/,
236 & 5x,' -------------------- ',//,
237 & 5x,'SKEW ID . . . . . . . . . . . . . . . .=',i10/
238 & 5x,'FIRST END TYPE 2 USER PROPERTY ID . . .=',i10/
239 & 5x,'SECOND END TYPE 2 USER PROPERTY ID. . .=',i10/
240 & 5x,'STIFFNESS FOR INTERFACE . . . . . . . .=',1pg20.13//)
241 2000 FORMAT(
242 & 5x,' USER PROPERTY TYPE 2 (used by property type 1) ',/,
243 & 5x,' -------------------- ',//,
244 & 5x,'USER MATERIAL ID. . . . . . . . . . . .=',i10/,
245 & 5x,'AREA. . . . . . . . . . . . . . . . . .=',1pg20.13/,
246 & 5x,'TORSION SECTION INERTIA . . . . . . . .=',1pg20.13/,
247 & 5x,'BENDING SECTION INERTIA IYY. . . . . . .=',1pg20.13/,
248 & 5x,'BENDING SECTION INERTIA IZZ. . . . . . .=',1pg20.13/,
249 & 5x,'BENDING SECTION RAYON RY . . . . . . .=',1pg20.13/,
250 & 5x,'BENDING SECTION RAYON RZ . . . . . . .=',1pg20.13//)
251 3000 FORMAT(
252 & 5x,'USER PROPERTY SET'/,
253 & 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
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
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
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
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

◆ rini36()

subroutine rini36 ( integer nel,
integer iout,
integer iprop,
integer, dimension(4,nel) ix,
xl,
mass,
xiner,
stifm,
stifr,
viscm,
viscr,
uvar,
integer nuvar )

Definition at line 267 of file hm_read_prop36.F.

270C-------------------------------------------------------------------------
271C This subroutine initialize springs using user properties.
272C-------------------------------------------------------------------------
273C----------+---------+---+---+--------------------------------------------
274C VAR | SIZE |TYP| RW| DEFINITION
275C----------+---------+---+---+--------------------------------------------
276C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
277C IPROP | 1 | I | R | PROPERTY NUMBER
278C----------+---------+---+---+--------------------------------------------
279C IX | 3*NEL | I | R | SPRING CONNECTIVITY
280C | IX(1,I) NODE 1 ID
281C | IX(2,I) NODE 2 ID
282C | IX(3,I) OPTIONAL NODE 3 ID
283C | IX(4,I) SPRING ID
284C XL | NEL | F | R | ELEMENT LENGTH
285C----------+---------+---+---+--------------------------------------------
286C MASS | NEL | F | W | ELEMENT MASS
287C XINER | NEL | F | W | ELEMENT INERTIA (SPHERICAL)
288C STIFM | NEL | F | W | ELEMENT STIFNESS (TIME STEP)
289C STIFR | NEL | F | W | ELEMENT ROTATION STIFNESS (TIME STEP)
290C VISCM | NEL | F | W | ELEMENT VISCOSITY (TIME STEP)
291C VISCR | NEL | F | W | ELEMENT ROTATION VISCOSITY (TIME STEP)
292C----------+---------+---+---+--------------------------------------------
293C UVAR |NUVAR*NEL| F | W | USER ELEMENT VARIABLES
294C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
295C----------+---------+---+---+--------------------------------------------
296C-------------------------------------------------------------------------
297C FUNCTION
298C-------------------------------------------------------------------------
299C INTEGER II = GET_U_PNU(I,IP,KK)
300C IFUNCI = GET_U_PNU(I,IP,KFUNC)
301C IPROPI = GET_U_PNU(I,IP,KPROP)
302C IMATI = GET_U_PNU(I,IP,KMAT)
303C I : VARIABLE INDEX(1 for first variable,...)
304C IP : PROPERTY NUMBER
305C KK : PARAMETER KFUNC,KMAT,KPROP
306C THIS FUNCTION RETURN THE USER STORED FUNCTION(IF KK=KFUNC),
307C MATERIAL(IF KK=KMAT) OR PROPERTY(IF KK=KPROP) NUMBERS.
308C SEE LECG29 FOR CORRESPONDING ID STORAGE.
309C-------------------------------------------------------------------------
310C INTEGER IFUNCI = GET_U_MNU(I,IM,KFUNC)
311C I : VARIABLE INDEX(1 for first function)
312C IM : MATERIAL NUMBER
313C KFUNC : ONLY FUNCTION ARE YET AVAILABLE.
314C THIS FUNCTION RETURN THE USER STORED FUNCTION NUMBERS(function
315C referred by users materials).
316C SEE LECM29 FOR CORRESPONDING ID STORAGE.
317C-------------------------------------------------------------------------
318C my_real PARAMI = GET_U_GEO(I,IP)
319C I : PARAMETER INDEX(1 for first parameter,...)
320C IP : PROPERTY NUMBER
321C THIS FUNCTION RETURN THE USER GEOMETRY PARAMETERS
322C-------------------------------------------------------------------------
323C my_real PARAMI = GET_U_MAT(I,IM)
324C I : PARAMETER INDEX(1 for first parameter,...)
325C IM : MATERIAL NUMBER
326C THIS FUNCTION RETURN THE USER MATERIAL PARAMETERS
327C NOTE: GET_U_MAT(0,IMAT) RETURN THE DENSITY
328C-------------------------------------------------------------------------
329C INTEGER MID = GET_U_PID(IP)
330C IP : PROPERTY NUMBER
331C THIS FUNCTION RETURN THE USER PROPERTY ID CORRESPONDING TO
332C USER PROPERTY NUMBER IP.
333C-------------------------------------------------------------------------
334C INTEGER PID = GET_U_MID(IM)
335C IM : MATERIAL NUMBER
336C THIS FUNCTION RETURN THE USER MATERIAL ID CORRESPONDING TO
337C USER MATERIAL NUMBER IM.
338C-------------------------------------------------------------------------
339C-----------------------------------------------
340C I m p l i c i t T y p e s
341C-----------------------------------------------
342#include "implicit_f.inc"
343C----------------------------------------------------------
344C D u m m y A r g u m e n t s a n d F u n c t i o n
345C----------------------------------------------------------
346 INTEGER IOUT,NUVAR,NEL,IPROP,
347 . IX(4,NEL) ,
348 . GET_U_PNU,GET_U_PID,GET_U_MID,GET_U_MNU,
349 . KFUNC,KMAT,KPROP
350 my_real
351 . xl(nel) ,mass(nel) ,xiner(nel) ,stifm(nel) ,
352 . stifr(nel),viscm(nel) ,viscr(nel),uvar(nuvar,*),
353 . get_u_mat,get_u_geo
354 EXTERNAL get_u_pnu,get_u_mnu,get_u_mat,get_u_geo,get_u_pid,get_u_mid
355 parameter(kfunc=29)
356 parameter(kmat=31)
357 parameter(kprop=33)
358C=======================================================================
359C L o c a l V a r i a b l e s
360C-----------------------------------------------
361 my_real
362 . fac,rho,area,ixx,iyy,izz,imyz,young,g,
363 . area1,ixx1,iyy1,izz1,rho1,young1,g1,
364 . area2,ixx2,iyy2,izz2,rho2,young2,g2,
365 . ry1,rz1,ry2,rz2,ry,rz,xl3,ktran,krot,
366 . k11,k22,k26,k33,k35,k44,k55,k5b,k66,k6c,
367 . dt1,dt2,xl2,atmp,ary,arz
368 INTEGER I,IUTYP,n0,
369 . IMAT1,IPROP1,IUTYP1,
370 . IMAT2,IPROP2,IUTYP2
371C-----------------------------------------------
372C
373 n0=11
374 iprop1 = get_u_pnu(1,iprop,kprop)
375 iprop2 = get_u_pnu(2,iprop,kprop)
376C
377C first end
378C
379 iutyp1 = nint(get_u_geo(1,iprop1))
380 WRITE(iout,*)' **VALUE OF IUTYP1',iutyp1
381 IF(iutyp1/=2)THEN
382 WRITE(iout,*)' **ERROR SPRING USER PROPERTY',
383 . get_u_pid(iprop),' REFERS TO WRONG USER PROPERTY',
384 . get_u_pid(iprop1)
385 ENDIF
386 area1 = get_u_geo(2,iprop1)
387 ixx1 = get_u_geo(3,iprop1)
388 iyy1 = get_u_geo(4,iprop1)
389 izz1 = get_u_geo(5,iprop1)
390 ry1 = get_u_geo(6,iprop1)
391 rz1 = get_u_geo(7,iprop1)
392 imat1 = get_u_pnu(1,iprop1,kmat)
393 young1 = get_u_mat(7,imat1)
394 g1 = get_u_mat(6,imat1)
395 rho1 = get_u_mat(0,imat1)
396C
397C second end
398C
399 iutyp2 = nint(get_u_geo(1,iprop2))
400 IF(iutyp2/=2)THEN
401 WRITE(iout,*)' **ERROR SPRING USER PROPERTY',
402 . get_u_pid(iprop),' REFERS TO WRONG USER PROPERTY',
403 . get_u_pid(iprop2)
404 ENDIF
405 area2 = get_u_geo(2,iprop2)
406 ixx2 = get_u_geo(3,iprop2)
407 iyy2 = get_u_geo(4,iprop2)
408 izz2 = get_u_geo(5,iprop2)
409 ry2 = get_u_geo(6,iprop2)
410 rz2 = get_u_geo(7,iprop2)
411C
412C SEE LECM29 FOR USER MATERIAL PARAMETER STORAGE (RHO IS ALWAYS AT 0)
413C
414 imat2 = get_u_pnu(1,iprop2,kmat)
415 young2 = get_u_mat(7,imat2)
416 g2 = get_u_mat(6,imat2)
417 rho2 = get_u_mat(0,imat2)
418C
419C MEAN VALUES
420C
421 area = half*(area1+area2)
422 rho = half*(rho1+rho2)
423 fac = area*rho
424 ixx = half*(ixx1+ixx2)
425 iyy = half*(iyy1+iyy2)
426 izz = half*(izz1+izz2)
427 ry = half*(ry1+ry2)
428 rz = half*(rz1+rz2)
429 imyz = max(iyy,izz)
430 young = half*(young1+young2)
431 g = half*(g1+g2)
432 atmp = young/max(em20,g*area)
433C--------------------------------------
434C ELEMENT CHECK
435C--------------------------------------
436 DO i=1,nel
437 IF(xl(i)==zero)THEN
438 WRITE(iout,*)' **ERROR ZERO LENGTH SPRING :'
439 ENDIF
440 ENDDO
441C--------------------------------------
442C ELEMENT INITIALIZATION
443C--------------------------------------
444 DO i=1,nel
445 mass(i) = xl(i)*fac
446 xiner(i) = xl(i)*rho*max(ixx,imyz+area*xl(i)*xl(i)/12)
447 uvar(n0,i) = zero
448 uvar(n0+1,i) = ep30
449 uvar(n0+2,i) = zero
450 uvar(n0+3,i) = zero
451 uvar(n0+4,i) = zero
452c---------------------------------------------
453C FOR NODAL AND ELEMENT TIME STEP COMPUTATION
454c---------------------------------------------
455 xl2 = xl(i)*xl(i)/12.
456 ary = one/(atmp+xl2/max(em20,iyy))
457 arz = one/(atmp+xl2/max(em20,izz))
458 ktran = max(area,ary,arz)/xl(i)
459 krot = 4. *max(iyy/xl(i),izz/xl(i))
460 stifm(i) = young*ktran
461 stifr(i) = max( g*ixx/xl(i),young*krot)
462 viscm(i) = 0.
463 viscr(i) = 0.
464 ENDDO
465C
466 RETURN
max
#define max(a, b)
Definition macros.h:21
get_u_pid
integer function get_u_pid(ip)
Definition uaccess.F:626
get_u_pnu
integer function get_u_pnu(ivar, ip, k)
Definition uaccess.F:482
get_u_mid
integer function get_u_mid(im)
Definition uaccess.F:668
get_u_mnu
integer function get_u_mnu(ivar, im, k)
Definition uaccess.F:565