OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop23.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_prop23 ../starter/source/properties/spring/hm_read_prop23.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.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!||--- uses -----------------------------------------------------
33!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_prop23(GEO,IGEO,IG,IGTYP,UNITAB,
38 . ISKN,TITR,LSUBMODEL,PROP_TAG,SUB_INDEX)
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
190 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 hm_read_prop23(geo, igeo, ig, igtyp, unitab, iskn, titr, lsubmodel, prop_tag, sub_index)
#define min(a, b)
Definition macros.h:20
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:889