OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop36.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_prop36 ../starter/source/properties/spring/hm_read_prop36.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_prop_generic ../starter/source/properties/hm_read_prop_generic.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!|| set_u_geo ../starter/source/user_interface/uaccess.F
33!|| set_u_pnu ../starter/source/user_interface/uaccess.F
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_prop36(IOUT,NUVAR ,PARGEO, UNITAB,
40 . ISKN,IG,TITR,IGTYP,PROP_TAG,GEO,LSUBMODEL,SUB_ID)
41C-----------------------------------------------
42 USE unitab_mod
43 USE message_mod
44 USE elbuftag_mod
45 USE submodel_mod
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
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 ! -- VELOCITIES convected frameE (V_REPCVT)
226 prop_tag(igtyp)%G_VR_REPCVT = 3 ! -- VELOCITIES convected frameE (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 1000 FORMAT(
232 & 5x,' USER PROPERTY TYPE 1 (used by spring elements) ',/,
233 & 5x,' -------------------- ',//,
234 & 5x,'SKEW ID . . . . . . . . . . . . . . . .=',i10/
235 & 5x,'FIRST END TYPE 2 USER PROPERTY ID . . .=',i10/
236 & 5x,'SECOND END TYPE 2 USER PROPERTY ID. . .=',i10/
237 & 5x,'STIFFNESS FOR INTERFACE . . . . . . . .=',1pg20.13//)
238 2000 FORMAT(
239 & 5x,' USER PROPERTY TYPE 2 (used by property type 1) ',/,
240 & 5x,' -------------------- ',//,
241 & 5x,'USER MATERIAL ID. . . . . . . . . . . .=',i10/,
242 & 5x,'AREA. . . . . . . . . . . . . . . . . .=',1pg20.13/,
243 & 5x,'TORSION SECTION INERTIA . . . . . . . .=',1pg20.13/,
244 & 5x,'BENDING SECTION INERTIA IYY. . . . . . .=',1pg20.13/,
245 & 5x,'bending section inertia izz. . . . . . .=',1PG20.13/,
246 & 5X,'bending section rayon ry . . . . . . .=',1PG20.13/,
247 & 5X,'bending section rayon rz . . . . . . .=',1PG20.13//)
248 END
249!||====================================================================
250!|| rini36 ../starter/source/properties/spring/hm_read_prop36.F
251!||--- called by ------------------------------------------------------
252!|| rinit3 ../starter/source/elements/spring/rinit3.F
253!||--- calls -----------------------------------------------------
254!|| get_u_geo ../starter/source/user_interface/uaccess.F
255!|| get_u_mat ../starter/source/user_interface/uaccess.F
256!|| get_u_mid ../starter/source/user_interface/uaccess.F
257!|| get_u_mnu ../starter/source/user_interface/uaccess.F
258!|| get_u_pid ../starter/source/user_interface/uaccess.F
259!|| get_u_pnu ../starter/source/user_interface/uaccess.F
260!||====================================================================
261 SUBROUTINE RINI36(NEL ,IOUT ,IPROP ,
262 3 XL ,MASS ,XINER ,STIFM ,
263 4 STIFR ,VISCM ,VISCR ,UVAR ,NUVAR )
264C-------------------------------------------------------------------------
265C This subroutine initialize springs using user properties.
266C-------------------------------------------------------------------------
267C----------+---------+---+---+--------------------------------------------
268C VAR | SIZE |TYP| RW| DEFINITION
269C----------+---------+---+---+--------------------------------------------
270C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
271C IPROP | 1 | I | R | PROPERTY NUMBER
272C----------+---------+---+---+--------------------------------------------
273C IX | 3*NEL | I | R | SPRING CONNECTIVITY
274C | IX(1,I) NODE 1 ID
275C | IX(2,I) NODE 2 ID
276C | IX(3,I) OPTIONAL NODE 3 ID
277C | IX(4,I) SPRING ID
278C XL | NEL | F | R | ELEMENT LENGTH
279C----------+---------+---+---+--------------------------------------------
280C MASS | NEL | F | W | ELEMENT MASS
281C XINER | NEL | F | W | ELEMENT INERTIA (SPHERICAL)
282C STIFM | NEL | F | W | ELEMENT STIFNESS (TIME STEP)
283C STIFR | NEL | F | W | ELEMENT ROTATION STIFNESS (TIME STEP)
284C VISCM | NEL | F | W | ELEMENT VISCOSITY (TIME STEP)
285C VISCR | NEL | F | W | ELEMENT ROTATION VISCOSITY (TIME STEP)
286C----------+---------+---+---+--------------------------------------------
287C UVAR |NUVAR*NEL| F | W | USER ELEMENT VARIABLES
288C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
289C----------+---------+---+---+--------------------------------------------
290C-------------------------------------------------------------------------
291C FUNCTION
292C-------------------------------------------------------------------------
293C INTEGER II = GET_U_PNU(I,IP,KK)
294C IFUNCI = GET_U_PNU(I,IP,KFUNC)
295C IPROPI = GET_U_PNU(I,IP,KPROP)
296C IMATI = GET_U_PNU(I,IP,KMAT)
297C I : VARIABLE INDEX(1 for first variable,...)
298C IP : PROPERTY NUMBER
299C KK : PARAMETER KFUNC,KMAT,KPROP
300C THIS FUNCTION RETURN THE USER STORED FUNCTION(IF KK=KFUNC),
301C MATERIAL(IF KK=KMAT) OR PROPERTY(IF KK=KPROP) NUMBERS.
302C SEE LECG29 FOR CORRESPONDING ID STORAGE.
303C-------------------------------------------------------------------------
304C INTEGER IFUNCI = GET_U_MNU(I,IM,KFUNC)
305C I : VARIABLE INDEX(1 for first function)
306C IM : MATERIAL NUMBER
307C KFUNC : ONLY FUNCTION ARE YET AVAILABLE.
308C THIS FUNCTION RETURN THE USER STORED FUNCTION NUMBERS(function
309C referred by users materials).
310C SEE LECM29 FOR CORRESPONDING ID STORAGE.
311C-------------------------------------------------------------------------
312C my_real PARAMI = GET_U_GEO(I,IP)
313C I : PARAMETER INDEX(1 for first parameter,...)
314C IP : PROPERTY NUMBER
315C THIS FUNCTION RETURN THE USER GEOMETRY PARAMETERS
316C-------------------------------------------------------------------------
317C my_real PARAMI = GET_U_MAT(I,IM)
318C I : PARAMETER INDEX(1 for first parameter,...)
319C IM : MATERIAL NUMBER
320C THIS FUNCTION RETURN THE USER MATERIAL PARAMETERS
321C NOTE: GET_U_MAT(0,IMAT) RETURN THE DENSITY
322C-------------------------------------------------------------------------
323C INTEGER MID = GET_U_PID(IP)
324C IP : PROPERTY NUMBER
325C THIS FUNCTION RETURN THE USER PROPERTY ID CORRESPONDING TO
326C USER PROPERTY NUMBER IP.
327C-------------------------------------------------------------------------
328C INTEGER PID = GET_U_MID(IM)
329C IM : MATERIAL NUMBER
330C THIS FUNCTION RETURN THE USER MATERIAL ID CORRESPONDING TO
331C USER MATERIAL NUMBER IM.
332C-------------------------------------------------------------------------
333C-----------------------------------------------
334C I m p l i c i t T y p e s
335C-----------------------------------------------
336#include "implicit_f.inc"
337C----------------------------------------------------------
338C 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
339C----------------------------------------------------------
340 INTEGER IOUT,NUVAR,NEL,IPROP,
341 . GET_U_PNU,GET_U_PID,GET_U_MID,GET_U_MNU,
342 . KFUNC,KMAT,KPROP
343 my_real
344 . XL(NEL) ,MASS(NEL) ,XINER(NEL) ,STIFM(NEL) ,
345 . STIFR(NEL),VISCM(NEL) ,VISCR(NEL),UVAR(NUVAR,*),
346 . GET_U_MAT,GET_U_GEO
347 EXTERNAL GET_U_PNU,GET_U_MNU,GET_U_MAT,GET_U_GEO,GET_U_PID,GET_U_MID
348 PARAMETER (KFUNC=29)
349 PARAMETER (KMAT=31)
350 PARAMETER (KPROP=33)
351C=======================================================================
352C L o c a l V a r i a b l e s
353C-----------------------------------------------
354 my_real
355 . FAC,RHO,AREA,IXX,IYY,IZZ,IMYZ,YOUNG,G,
356 . AREA1,IXX1,IYY1,IZZ1,RHO1,YOUNG1,G1,
357 . AREA2,IXX2,IYY2,IZZ2,RHO2,YOUNG2,G2,
358 . RY1,RZ1,RY2,RZ2,RY,RZ,ktran,krot,
359 . XL2,ATMP,ARY,ARZ
360 INTEGER I,n0,
361 . IMAT1,IPROP1,IUTYP1,
362 . IMAT2,IPROP2,IUTYP2
363C-----------------------------------------------
364C
365 n0=11
366 IPROP1 = GET_U_PNU(1,IPROP,KPROP)
367 IPROP2 = GET_U_PNU(2,IPROP,KPROP)
368C
369C first end
370C
371 IUTYP1 = NINT(GET_U_GEO(1,IPROP1))
372 WRITE(IOUT,*)' **VALUE of iutyp1',IUTYP1
373 IF(IUTYP1/=2)THEN
374 WRITE(IOUT,*)' **error spring user property',
375 . get_u_pid(iprop),' REFERS TO WRONG USER PROPERTY',
376 . get_u_pid(iprop1)
377 ENDIF
378 area1 = get_u_geo(2,iprop1)
379 ixx1 = get_u_geo(3,iprop1)
380 iyy1 = get_u_geo(4,iprop1)
381 izz1 = get_u_geo(5,iprop1)
382 ry1 = get_u_geo(6,iprop1)
383 rz1 = get_u_geo(7,iprop1)
384 imat1 = get_u_pnu(1,iprop1,kmat)
385 young1 = get_u_mat(7,imat1)
386 g1 = get_u_mat(6,imat1)
387 rho1 = get_u_mat(0,imat1)
388C
389C second end
390C
391 iutyp2 = nint(get_u_geo(1,iprop2))
392 IF(iutyp2/=2)THEN
393 WRITE(iout,*)' **ERROR SPRING USER PROPERTY',
394 . get_u_pid(iprop),' REFERS TO WRONG USER PROPERTY',
395 . get_u_pid(iprop2)
396 ENDIF
397 area2 = get_u_geo(2,iprop2)
398 ixx2 = get_u_geo(3,iprop2)
399 iyy2 = get_u_geo(4,iprop2)
400 izz2 = get_u_geo(5,iprop2)
401 ry2 = get_u_geo(6,iprop2)
402 rz2 = get_u_geo(7,iprop2)
403C
404C SEE LECM29 FOR USER MATERIAL PARAMETER STORAGE (RHO IS ALWAYS AT 0)
405C
406 imat2 = get_u_pnu(1,iprop2,kmat)
407 young2 = get_u_mat(7,imat2)
408 g2 = get_u_mat(6,imat2)
409 rho2 = get_u_mat(0,imat2)
410C
411C MEAN VALUES
412C
413 area = half*(area1+area2)
414 rho = half*(rho1+rho2)
415 fac = area*rho
416 ixx = half*(ixx1+ixx2)
417 iyy = half*(iyy1+iyy2)
418 izz = half*(izz1+izz2)
419 ry = half*(ry1+ry2)
420 rz = half*(rz1+rz2)
421 imyz = max(iyy,izz)
422 young = half*(young1+young2)
423 g = half*(g1+g2)
424 atmp = young/max(em20,g*area)
425C--------------------------------------
426C ELEMENT CHECK
427C--------------------------------------
428 DO i=1,nel
429 IF(xl(i)==zero)THEN
430 WRITE(iout,*)' **ERROR ZERO LENGTH SPRING :'
431 ENDIF
432 ENDDO
433C--------------------------------------
434C ELEMENT INITIALIZATION
435C--------------------------------------
436 DO i=1,nel
437 mass(i) = xl(i)*fac
438 xiner(i) = xl(i)*rho*max(ixx,imyz+area*xl(i)*xl(i)/12)
439 uvar(n0,i) = zero
440 uvar(n0+1,i) = ep30
441 uvar(n0+2,i) = zero
442 uvar(n0+3,i) = zero
443 uvar(n0+4,i) = zero
444c---------------------------------------------
445C FOR NODAL AND ELEMENT TIME STEP COMPUTATION
446c---------------------------------------------
447 xl2 = xl(i)*xl(i)/12.
448 ary = one/(atmp+xl2/max(em20,iyy))
449 arz = one/(atmp+xl2/max(em20,izz))
450 ktran = max(area,ary,arz)/xl(i)
451 krot = 4. *max(iyy/xl(i),izz/xl(i))
452 stifm(i) = young*ktran
453 stifr(i) = max( g*ixx/xl(i),young*krot)
454 viscm(i) = 0.
455 viscr(i) = 0.
456 ENDDO
457C
458 RETURN
459 END
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine hm_read_prop36(iout, nuvar, pargeo, unitab, iskn, ig, titr, igtyp, prop_tag, geo, lsubmodel, sub_id)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
integer nsubmod
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
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:895
integer function get_u_pid(ip)
Definition uaccess.F:625
integer function get_u_pnu(ivar, ip, k)
Definition uaccess.F:481