OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop02.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_prop02 ../starter/source/properties/truss/hm_read_prop02.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!||--- uses -----------------------------------------------------
31!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
35 SUBROUTINE hm_read_prop02(IGTYP ,IG , IGEO , GEO ,PROP_TAG ,
36 . UNITAB ,IDTITL,LSUBMODEL )
37C============================================================================
38C M o d u l e s
39C-----------------------------------------------
40 USE unitab_mod
41 USE elbuftag_mod
42 USE submodel_mod
43 USE message_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 "tablen_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
58 INTEGER
59 . igtyp , igeo(*)
60 my_real geo(*)
61
62 CHARACTER(LEN=NCHARTITLE)::IDTITL
63
64 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
65 TYPE(submodel_data) LSUBMODEL(*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, IG, J
70
72 . pun,gap
73 CHARACTER(LEN=NCHARTITLE) :: TITR
74 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
75C-----------------------------------------------
76C E x t e r n a l F u n c t i o n s
77C-----------------------------------------------
78 DATA pun/0.1/
79C=======================================================================
80C------------------------
81C TRUSS PROPERTY
82C------------------------
83C=======================================================================
84
85 is_encrypted = .false.
86 is_available = .false.
87
88C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
89 igeo( 1)=ig
90 igeo(11)=igtyp
91 geo(12) =igtyp+pun
92
93 CALL hm_get_floatv('AREA',geo(1),is_available,lsubmodel,unitab)
94 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
95 geo(2) = max(zero,gap)
96
97 IF(.NOT. is_encrypted)THEN
98 WRITE(iout,1200)ig,geo(1),geo(2)
99 ELSE
100 WRITE(iout,1299)ig
101 ENDIF
102
103 IF (geo(1)<=zero) THEN
104 CALL ancmsg(msgid=497,
105 . msgtype=msgerror,
106 . anmode=aninfo_blind_1,
107 . i1=ig,
108 . c1=idtitl,
109 . r1=geo(1))
110 ENDIF
111
112
113 prop_tag(igtyp)%G_FOR = 1
114 prop_tag(igtyp)%G_EINT = 1
115 prop_tag(igtyp)%G_LENGTH = 1 ! total length
116 prop_tag(igtyp)%G_AREA = 1
117 prop_tag(igtyp)%G_STRA = 1
118
119C-----------
120 RETURN
121C-----------
122 1200 FORMAT(
123 & 5x,'TRUSS PROPERTY SET'/,
124 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
125 & 5x,'TRUSS AREA. . . . . . . . . . . . . . .=',1pg20.13/,
126 & 5x,'TRUSS INITIAL GAP . . . . . . . . . . .=',1pg20.13//)
127 1299 FORMAT(
128 & 5x,'TRUSS PROPERTY SET'/,
129 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
130 & 5x,'CONFIDENTIAL DATA'//)
131C-----------
132
133 END
134
135
136
137
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_read_prop02(igtyp, ig, igeo, geo, prop_tag, unitab, idtitl, lsubmodel)
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
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