OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_table1_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_table1_0 ../starter/source/tools/curve/hm_read_table1_0.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_table1 ../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_table1_0(NTABLE0, NTABLE, TABLE ,NFUNCT,
41 . NPC ,PLD, L,
42 . NOM_OPT,UNITAB, LSUBMODEL)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE table_mod
47 USE message_mod
48 USE submodel_mod
49 USE hm_option_read_mod
50 USE unitab_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER L,NTABLE,NTABLE0,NFUNCT,NPC(*)
60 my_real PLD(*)
61 TYPE(ttable) TABLE(*)
62 INTEGER NOM_OPT(LNOPT1,*)
63 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
64 TYPE (UNIT_TYPE_), INTENT(IN) :: UNITAB
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "scr17_c.inc"
69#include "units_c.inc"
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER ITYPE, IBID, NFUNCT0
74 INTEGER I, J, K, II, N, NDIM, NX(4), NY, JREC, NPTS, STAT, LL
75 INTEGER IERROR, NF, IDFUNC, NP
76 my_real bid, f5(5), time, funct
77 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
78 CHARACTER(LEN=NCHARFIELD) :: KEY
79 CHARACTER MESS*40
80 DATA mess/' FUNCTION & table definition '/
81 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
82C======================================================================|
83 IS_ENCRYPTED = .FALSE.
84 IS_AVAILABLE = .FALSE.
85
86 CALL HM_OPTION_START('/table/0')
87 DO I=1,NTABLE0
88 CALL HM_OPTION_READ_KEY(LSUBMODEL,
89 . OPTION_TITR = TITR,
90 . OPTION_ID = LL)
91 CALL HM_OPTION_IS_ENCRYPTED(IS_ENCRYPTED)
92C-----------------------------------------------
93 NX(1) = 0
94 NX(2) = 0
95 NX(3) = 0
96 NX(4) = 0
97 CALL HM_GET_INTV('order', NDIM, IS_AVAILABLE, LSUBMODEL)
98.AND..AND..AND. IF(NDIM/=1NDIM/=2NDIM/=3NDIM/=4)THEN
99 CALL ANCMSG(MSGID=777,
100 . MSGTYPE=MSGERROR,
101 . ANMODE=ANINFO_BLIND_1,
102 . I1=LL,
103 . C1=TITR)
104 END IF
105 IF(NDIM > 0)CALL HM_GET_INTV('n1', NX(1), IS_AVAILABLE, LSUBMODEL)
106 IF(NDIM==1)THEN
107 L=L+1
108 NPTS=NX(1)
109 NPC(NFUNCT+L+1)=LL
110 NPC(L+1)=NPC(L)
111c read abscissa values
112 DO N = 1, NPTS
113 CALL HM_GET_FLOAT_ARRAY_INDEX('temparray2d_n1',pld(NPC(L)+ 2*n-2),n,is_available, lsubmodel, unitab)
114 END DO
115c read ordinate values
116 DO n = 1, npts
117 CALL hm_get_float_array_index('ENG_FUNCT_yValues',pld(npc(l)+2*n-1),n,is_available,lsubmodel,unitab)
118 END DO
119 npc(l+1)=npc(l)+2*npts
120C build table structure
121 table(l)%NOTABLE=ll
122 table(l)%NDIM =1
123
124 ALLOCATE(table(l)%X(1),stat=stat)
125 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
126 . msgtype=msgerror,
127 . c1='TABLE')
128 ALLOCATE(table(l)%X(1)%VALUES(npts),stat=stat)
129 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
130 . msgtype=msgerror,
131 . c1='TABLE')
132
133 ALLOCATE(table(l)%Y,stat=stat)
134 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
135 . msgtype=msgerror,
136 . c1='TABLE')
137 ALLOCATE(table(l)%Y%VALUES(npts),stat=stat)
138 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
139 . msgtype=msgerror,
140 . c1='TABLE')
141
142 DO n=1,npts
143 table(l)%X(1)%VALUES(n)=pld(npc(l)+2*n-2)
144 table(l)%Y%VALUES(n) =pld(npc(l)+2*n-1)
145 END DO
146C
147 IF (is_encrypted)THEN
148 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
149 ELSE
150 WRITE(iout,2100) table(l)%NOTABLE, table(l)%NDIM
151 DO k=1,table(l)%NDIM
152 nx(k)=SIZE( table(l)%X(k)%VALUES )
153 WRITE(iout,2200) k
154 WRITE(iout,2250) (table(l)%X(k)%VALUES(n),n=1,nx(k))
155 END DO
156 ny=SIZE(table(l)%Y%VALUES)
157 WRITE(iout,2300)
158 WRITE(iout,2350) (table(l)%Y%VALUES(n),n=1,ny)
159 END if!(IS_ENCRYPTED > 0)
160 endif!(NDIM==1)
161 ENDDO !I=1,NTABLE0
162 RETURN
163C-----------------------------------------------------------------
1642000 FORMAT(//
165 . ' TABLES'/
166 . ' ------'/
167 . ' NUMBER OF TABLES . . . . . . . . . . =',i10/)
1682100 FORMAT(/' TABLE ID . . . . . . . . . . . . . . =',i10/
169 . ' NUMBER OF PARAMETERS . . . . . . . . =',i10/)
1702200 FORMAT(/' VALUES FOR PARAMETER NUMBER. . . . . .',i4,':'/)
1712250 FORMAT((3x,5(1x,g20.13))/)
1722300 FORMAT(/' ORDINATE VALUES . . . . . . . . . . . :'/)
1732350 FORMAT((3x,5(1x,g20.13))/)
174 END
if
if(complex_arithmetic) id
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_read_table1_0
subroutine hm_read_table1_0(ntable0, ntable, table, nfunct, npc, pld, l, nom_opt, unitab, lsubmodel)
Definition hm_read_table1_0.F:43
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
table_mod::ttable
Definition table_mod.F:125