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 IG
70
72 . pun,gap
73 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
74C-----------------------------------------------
75C E x t e r n a l F u n c t i o n s
76C-----------------------------------------------
77 DATA pun/0.1/
78C=======================================================================
79C------------------------
80C TRUSS PROPERTY
81C------------------------
82C=======================================================================
83
84 is_encrypted = .false.
85 is_available = .false.
86
87C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
88 igeo( 1)=ig
89 igeo(11)=igtyp
90 geo(12) =igtyp+pun
91
92 CALL hm_get_floatv('AREA',geo(1),is_available,lsubmodel,unitab)
93 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
94 geo(2) = max(zero,gap)
95
96 IF(.NOT. is_encrypted)THEN
97 WRITE(iout,1200)ig,geo(1),geo(2)
98 ELSE
99 WRITE(iout,1299)ig
100 ENDIF
101
102 IF (geo(1)<=zero) THEN
103 CALL ancmsg(msgid=497,
104 . msgtype=msgerror,
105 . anmode=aninfo_blind_1,
106 . i1=ig,
107 . c1=idtitl,
108 . r1=geo(1))
109 ENDIF
110
111
112 prop_tag(igtyp)%G_FOR = 1
113 prop_tag(igtyp)%G_EINT = 1
114 prop_tag(igtyp)%G_LENGTH = 1 ! total length
115 prop_tag(igtyp)%G_AREA = 1
116 prop_tag(igtyp)%G_STRA = 1
117
118C-----------
119 RETURN
120C-----------
121 1200 FORMAT(
122 & 5x,'TRUSS PROPERTY SET'/,
123 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
124 & 5x,'TRUSS AREA. . . . . . . . . . . . . . .=',1pg20.13/,
125 & 5x,'TRUSS INITIAL GAP . . . . . . . . . . .=',1pg20.13//)
126 1299 FORMAT(
127 & 5x,'TRUSS PROPERTY SET'/,
128 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
129 & 5x,'CONFIDENTIAL DATA'//)
130C-----------
131
132 END
133
134
135
136
#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:895
program starter
Definition starter.F:39