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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop23 (geo, igeo, ig, igtyp, unitab, iskn, titr, lsubmodel, prop_tag, sub_index)

Function/Subroutine Documentation

◆ hm_read_prop23()

subroutine hm_read_prop23 ( geo,
integer, dimension(npropgi) igeo,
integer ig,
integer igtyp,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
character(len=nchartitle) titr,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(prop_tag_), dimension(0:maxprop) prop_tag,
integer, intent(in) sub_index )

Definition at line 37 of file hm_read_prop23.F.

39C-----------------------------------------------
40 USE unitab_mod
41 USE message_mod
42 USE submodel_mod
43 USE elbuftag_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "units_c.inc"
53#include "param_c.inc"
54#include "com04_c.inc"
55#include "sphcom.inc"
56#include "tablen_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
61 INTEGER IGEO(NPROPGI),ISKN(LISKN,*),IG,IGTYP
62 INTEGER, INTENT(IN) :: SUB_INDEX
63 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
64C REAL
66 . geo(npropg)
67 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
68 CHARACTER(LEN=NCHARTITLE)::TITR
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER ITYPE,ID_SKEW,ID_SENS,ISFLAG,K
73C REAL
75 . inertia,vol_air,pun
76 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
77C-----------------------------------------------
78C E x t e r n a l F u n c t i o n s
79C-----------------------------------------------
80 DATA pun/0.1/
81C=======================================================================
82C
83 is_encrypted = .false.
84 is_available = .false.
85C
86 igeo(1)=ig
87 igeo(11)=igtyp
88 geo(12) =igtyp+pun
89C
90C--------------------------------------------------
91C EXTRACT DATA (IS OPTION CRYPTED)
92C--------------------------------------------------
93 CALL hm_option_is_encrypted(is_encrypted)
94C--------------------------------------------------
95C EXTRACT DATAS (INTEGER VALUES)
96C--------------------------------------------------
97 CALL hm_get_intv('Imass',itype,is_available,lsubmodel)
98 CALL hm_get_intv('SKEW_CSID',id_skew,is_available,lsubmodel)
99 IF(id_skew == 0 .AND. sub_index /= 0 ) id_skew = lsubmodel(sub_index)%SKEW
100 CALL hm_get_intv('ISENSOR',id_sens,is_available,lsubmodel)
101 CALL hm_get_intv('ISFLAG',isflag,is_available,lsubmodel)
102C--------------------------------------------------
103C EXTRACT DATAS (REAL VALUES)
104C--------------------------------------------------
105C Default value of Imass is 2
106 IF (itype==0) itype = 2
107C
108 CALL hm_get_floatv('INERTIA',inertia,is_available,lsubmodel,unitab)
109 IF (itype == 1) THEN
110 CALL hm_get_floatv('AREA',vol_air,is_available,lsubmodel,unitab)
111 ELSE
112 CALL hm_get_floatv('Volume',vol_air,is_available,lsubmodel,unitab)
113 ENDIF
114C
115!----------------
116! verification
117! -----------
118C
119 DO k = 0,numskw+min(1,nspcond)*numsph+nsubmod
120 IF (id_skew == iskn(4,k+1)) THEN
121 id_skew = k+1
122 GO TO 100
123 ENDIF
124 ENDDO
125 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
126 . c1='PROPERTY',
127 . c2='PROPERTY',
128 . i1=igeo(1),i2=id_skew,c3=titr)
129100 CONTINUE
130C
131 IF (isflag == 1) id_sens=-id_sens
132C
133 igeo(2)= id_skew
134 igeo(3)= id_sens
135 igeo(4)= itype
136 igeo(5)= isflag
137C
138 geo(1) = vol_air
139 geo(2) = inertia
140C
141 prop_tag(igtyp)%G_EINT = 1
142 prop_tag(igtyp)%G_FOR = 3
143 prop_tag(igtyp)%G_MOM = 3
144 prop_tag(igtyp)%G_LENGTH = 3
145 prop_tag(igtyp)%G_FOREP = 3
146 prop_tag(igtyp)%G_MOMEP = 3
147 prop_tag(igtyp)%G_LENGTH_ERR = 3
148 prop_tag(igtyp)%G_SKEW = 3
149 prop_tag(igtyp)%G_SKEW_ERR = 3
150 prop_tag(igtyp)%G_E6 = 6
151 prop_tag(igtyp)%G_DEFINI = 6
152 prop_tag(igtyp)%G_FORINI = 6
153 prop_tag(igtyp)%G_RUPTCRIT = 1
154C----
155 IF(is_encrypted)THEN
156 WRITE(iout,1000)ig
157 1000 FORMAT(
158 & 5x,'SPRING PROPERTY SET'/,
159 & 5x,'-------------------'/,
160 & 5x,'property set number . . . . . . . . . .=',I10/,
161 & 5X,'confidential data'//)
162 ELSE
163 IF(ITYPE == 1) THEN
164 WRITE(IOUT,1700)IG,VOL_AIR,INERTIA,ISKN(4,ID_SKEW),ABS(ID_SENS),ISFLAG
165 ELSE
166 WRITE(IOUT,1800)IG,VOL_AIR,INERTIA,ISKN(4,ID_SKEW),ABS(ID_SENS),ISFLAG
167 ENDIF
168 ENDIF
169C------------------------
170 RETURN
171c-----------
172 1700 FORMAT(
173 & 5X,'spring property set(beam type)'/,
174 & 5X,'property set number . . . . . . . . . .=',I10/,
175 & 5X,'spring area . . . . . . . . . . . . . .=',1PG20.13/,
176 & 5X,'spring inertia. . . . . . . . . . . . .=',1PG20.13/,
177 & 5X,'skew frame id . . . . . . . . . . . . .=',I10/,
178 & 5X,'sensor number(0:not used). . . . . . .=',I10/,
179 & 5X,'sensor flag(0:activ 1:deact 2:both). .=',I10/)
180 1800 FORMAT(
181 & 5X,'spring property set(beam type)'/,
182 & 5X,'property set number . . . . . . . . . .=',I10/,
183 & 5X,'spring volume . . . . . . . . . . . . .=',1PG20.13/,
184 & 5X,'spring inertia. . . . . . . . . . . . .=',1PG20.13/,
185 & 5X,'skew frame id . . . . . . . . . . . . .=',I10/,
186 & 5X,'sensor number(0:not used). . . . . . .=',I10/,
187 & 5X,'sensor flag(0:activ 1:deact 2:both). .=',I10/)
188c-----------
189 RETURN
#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)
#define min(a, b)
Definition macros.h:20
initmumps id
integer, parameter nchartitle
integer nsubmod
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