OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_table2_0.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_table2_0 ../starter/source/tools/curve/hm_read_table2_0.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_table2 ../starter/source/tools/curve/hm_read_table.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.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!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.f
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!||--- uses -----------------------------------------------------
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!|| table_mod ../starter/share/modules1/table_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_table2_0(NTABLE0, TABLE ,L,NFUNCT,UNITAB, LSUBMODEL )
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE table_mod
45 USE message_mod
46 USE submodel_mod
47 USE hm_option_read_mod
48 USE unitab_mod
49 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER NTABLE0,NFUNCT,L
58 TYPE(ttable) TABLE(*)
59 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
60 TYPE(unit_type_), INTENT(in) :: UNITAB
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "units_c.inc"
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER ITYPE, IBID
69 INTEGER I, J, K, II, N, ID, NDIM, NX(4), NY,
70 . JREC, NPTS, STAT, IDS, LL, LX(2)
71 INTEGER,DIMENSION(:),ALLOCATABLE :: JPERM1,JPERM2
72 INTEGER,DIMENSION(:,:),ALLOCATABLE :: ITAG
73 INTEGER IERROR, NF
74 my_real bid, xk, xx, x1, x2, x234(3), yy, y1, y2, r, xmin, xmax,time, funct,scaley
75 my_real, DIMENSION(2) :: xd2
76 my_real, DIMENSION(:),ALLOCATABLE :: xv1, xstor1, xstor2
77 my_real,DIMENSION(:,:),ALLOCATABLE :: xv2
78 CHARACTER(LEN=NCHARTITLE) :: TITR
79 CHARACTER MESS*40
80 CHARACTER(LEN=NCHARFIELD) :: KEY
81 DATA mess/' FUNCTION & TABLE DEFINITION '/
82 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
83C======================================================================|
84! Initialization
85 is_encrypted = .false.
86 is_available = .false.
87 CALL hm_option_start('/TABLE/0')
88 DO i=1,ntable0
89 CALL hm_option_read_key(lsubmodel,
90 . option_titr = titr,
91 . option_id = id)
92 CALL hm_option_is_encrypted(is_encrypted)
93C-----------------------------------------------
94 nx(1) = 0
95 nx(2) = 0
96 nx(3) = 0
97 nx(4) = 0
98 CALL hm_get_intv('ORDER', ndim, is_available, lsubmodel)
99 IF(ndim/=1.AND.ndim/=2.AND.ndim/=3.AND.ndim/=4)THEN
100 CALL ancmsg(msgid=777,
101 . msgtype=msgerror,
102 . anmode=aninfo_blind_1,
103 . i1=ll,
104 . c1=titr)
105 END IF
106 IF(ndim > 0)CALL hm_get_intv('N1', nx(1), is_available, lsubmodel)
107 IF(ndim > 1)CALL hm_get_intv('N2', nx(2), is_available, lsubmodel)
108 IF(ndim > 2)CALL hm_get_intv('N3', nx(3), is_available, lsubmodel)
109 IF(ndim > 3)CALL hm_get_intv('N4', nx(4), is_available, lsubmodel)
110 IF(ndim==1)THEN
111 cycle
112 ENDIF
113 l=l+1
114 table(l)%NOTABLE=id
115 table(l)%NDIM=ndim
116 ALLOCATE(table(l)%X(ndim),stat=stat)
117 IF(stat/=0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
118 . c1='TABLE')
119
120 DO k=1,ndim
121 IF(nx(k) < 2)THEN
122 CALL ancmsg(msgid=778,
123 . msgtype=msgerror,
124 . anmode=aninfo_blind_1,
125 . i1=id,
126 . c1=titr,
127 . i2=k)
128 END IF !NX(K) < 2
129 ENDDO !K=1,NDIM
130 !ndim = 1
131 ALLOCATE(table(l)%X(1)%VALUES(nx(1)),stat=stat)
132 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
133 . msgtype=msgerror,
134 . c1='TABLE')
135C
136 ! read abscissa values for this parameter
137 DO n =1, nx(1)
138 CALL hm_get_float_array_index('temparray2d_N1', xk, n, is_available, lsubmodel, unitab)
139 table(l)%X(1)%VALUES(n)= xk
140 END DO
141 !ndim = 2
142 IF(ndim > 1 ) THEN
143 ALLOCATE(table(l)%X(2)%VALUES(nx(2)),stat=stat)
144 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
145 . msgtype=msgerror,
146 . c1='TABLE')
147 ! read abscissa values for this parameter
148 DO n =1, nx(2)
149 CALL hm_get_float_array_index('temparray2d_n2',XK,N,IS_AVAILABLE, LSUBMODEL, UNITAB)
150 TABLE(L)%X(2)%VALUES(N)= XK
151 END DO
152 IF(NDIM > 2 ) THEN
153 ALLOCATE(TABLE(L)%X(3)%VALUES(NX(3)),STAT=stat)
154 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
155 . MSGTYPE=MSGERROR,
156 . C1='table')
157 DO N =1, NX(3)
158 CALL HM_GET_FLOAT_ARRAY_INDEX('temparray2d_n3',XK,N,IS_AVAILABLE, LSUBMODEL, UNITAB)
159 TABLE(L)%X(3)%VALUES(N)= XK
160 END DO
161 IF(NDIM > 3 ) THEN
162 ALLOCATE(TABLE(L)%X(4)%VALUES(NX(4)),STAT=stat)
163 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
164 . MSGTYPE=MSGERROR,
165 . C1='table')
166 DO N =1, NX(4)
167 CALL HM_GET_FLOAT_ARRAY_INDEX('temparray2d_n4',XK,N,IS_AVAILABLE, LSUBMODEL, UNITAB)
168 TABLE(L)%X(4)%VALUES(N)= XK
169 END DO
170 ENDIF !NDIM > 3
171 ENDIF!(NDIM > 2 )
172 ENDIF !(NDIM > 1 )
173 ! number of ordinate values
174 NY=1
175 DO K=1,NDIM
176 NY=NY*SIZE(TABLE(L)%X(K)%VALUES)
177 END DO
178 ALLOCATE(TABLE(L)%Y,STAT=stat)
179
180 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
181 . MSGTYPE=MSGERROR,
182 . C1='table')
183
184 ALLOCATE(TABLE(L)%Y%VALUES(NY),STAT=stat)
185
186 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
187 . MSGTYPE=MSGERROR,
188 . C1='table')
189C
190 ! read ordinate values
191 DO N = 1, NY
192 CALL HM_GET_FLOAT_ARRAY_INDEX('eng_funct_yvalues',YY,N,IS_AVAILABLE, LSUBMODEL, UNITAB)
193 TABLE(L)%Y%VALUES(N)=YY
194 ENDDO !N = 1, NY
195
196
197 IF (IS_ENCRYPTED)THEN
198 WRITE(IOUT,'(a)')'confidential data'
199 ELSE
200 WRITE(IOUT,2100) TABLE(L)%NOTABLE, TABLE(L)%NDIM
201 DO K=1,TABLE(L)%NDIM
202 NX(K)=SIZE( TABLE(L)%X(K)%VALUES )
203 WRITE(IOUT,2200) K
204 WRITE(IOUT,2250) (TABLE(L)%X(K)%VALUES(N),N=1,NX(K))
205 END DO
206 NY=SIZE(TABLE(L)%Y%VALUES)
207 WRITE(IOUT,2300)
208 WRITE(IOUT,2350) (TABLE(L)%Y%VALUES(N),N=1,NY)
209 END IF
210 END DO
211 RETURN
212
213C-----------------------------------------------------------------
2142000 FORMAT(//
215 . ' tables'/
216 . ' ------'/
217 . ' number of tables . . . . . . . . . . =',I10/)
2182100 FORMAT(/' table id . . . . . . . . . . . . . . =',I10/
219 . ' number of parameters . . . . . . . . =',I10/)
2202200 FORMAT(/' values for PARAMETER number. . . . . .',I4,':'/)
2212250 FORMAT((3X,5(1X,G20.13))/)
2222300 FORMAT(/' ordinate values . . . . . . . . . . . :'/)
2232350 FORMAT((3X,5(1X,G20.13))/)
224 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_option_read_key
subroutine hm_option_read_key(lsubmodel, option_id, unit_id, submodel_index, submodel_id, option_titr, keyword1, keyword2, keyword3, keyword4, opt_pos)
Definition hm_option_read_key.F:249
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_table2_0
subroutine hm_read_table2_0(ntable0, table, l, nfunct, unitab, lsubmodel)
Definition hm_read_table2_0.F:41
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:712
table_mod
Definition table_mod.F:112
unitab_mod
Definition unitab_mod.F:513
ancmsg
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
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723
table_mod::ttable
Definition table_mod.F:125
unitab_mod::unit_type_
Definition unitab_mod.F:520