OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_table1_1.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_1 ../starter/source/tools/curve/hm_read_table1_1.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_1(NTABLE1,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 NTABLE, NTABLE1,L,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 I, K, N, NDIM, NX(4), NY,
74 . NPTS, STAT, LL,NPT,IPT
75 my_real time, funct
76 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
77 CHARACTER MESS*40
78 DATA mess/' FUNCTION & TABLE DEFINITION '/
79 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
80C======================================================================|
81 is_encrypted = .false.
82 is_available = .false.
83
84 CALL hm_option_start('/TABLE/1')
85 DO i=1,ntable1
86
87
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
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 CALL hm_get_intv('curverows', npt, is_available, lsubmodel) !size of X
107
108 IF(ndim==1)THEN
109 l=l+1
110 npts=npt
111 npc(nfunct+l+1)=ll
112 npc(l+1)=npc(l)
113
114 npts=0
115c read abscissa values
116 DO ipt = 1, npt
117 CALL hm_get_float_array_index('table2darray',time,2*ipt-1,is_available,lsubmodel,unitab)
118c read ordinate values
119 CALL hm_get_float_array_index('table2darray',funct,2*ipt,is_available,lsubmodel, unitab)
120 npts=npts+1
121 pld(npc(l+1))=time
122 IF(npts > 1 .AND. pld(npc(l+1)) <= pld(npc(l+1)-2))THEN
123 CALL ancmsg(msgid=156,
124 . msgtype=msgerror,
125 . anmode=aninfo_blind_1,
126 . i1=ll,
127 . c1=titr1,
128 . i2=npts,
129 . i3=npts-1)
130 ENDIF
131 npc(l+1)=npc(l+1)+1
132 pld(npc(l+1))=funct
133 npc(l+1)=npc(l+1)+1
134 ENDDO ! IPT
135
136C build table structure
137 table(l)%NOTABLE=ll
138 table(l)%NDIM =1
139 ALLOCATE(table(l)%X(1),stat=stat)
140 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
141 . msgtype=msgerror,
142 . c1='TABLE')
143 ALLOCATE(table(l)%X(1)%VALUES(npts),stat=stat)
144 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
145 . msgtype=msgerror,
146 . c1='TABLE')
147
148 ALLOCATE(table(l)%Y,stat=stat)
149 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
150 . msgtype=msgerror,
151 . c1='TABLE')
152 ALLOCATE(table(l)%Y%VALUES(npts),stat=stat)
153 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
154 . msgtype=msgerror,
155 . c1='TABLE')
156
157 DO n=1,npts
158 table(l)%X(1)%VALUES(n)=pld(npc(l)+2*n-2)
159 table(l)%Y%VALUES(n) =pld(npc(l)+2*n-1)
160 END DO
161C
162 IF (is_encrypted)THEN
163 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
164 ELSE
165 WRITE(iout,2100) table(l)%NOTABLE, table(l)%NDIM
166 DO k=1,table(l)%NDIM
167 nx(k)=SIZE( table(l)%X(k)%VALUES )
168 WRITE(iout,2200) k
169 WRITE(iout,2250) (table(l)%X(k)%VALUES(n),n=1,nx(k))
170 END DO
171 ny=SIZE(table(l)%Y%VALUES)
172 WRITE(iout,2300)
173 WRITE(iout,2350) (table(l)%Y%VALUES(n),n=1,ny)
174 END IF
175
176 endif!(NDIM==1)
177 ENDDO !I=1,NTABLE0
178
179 RETURN
180C-----------------------------------------------------------------
1812100 FORMAT(/' TABLE ID . . . . . . . . . . . . . . =',i10/
182 . ' NUMBER OF PARAMETERS . . . . . . . . =',i10/)
1832200 FORMAT(/' VALUES FOR PARAMETER NUMBER. . . . . .',i4,':'/)
1842250 FORMAT((3x,5(1x,g20.13))/)
1852300 FORMAT(/' ORDINATE VALUES . . . . . . . . . . . :'/)
1862350 FORMAT((3x,5(1x,g20.13))/)
187 END
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:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_table1_1
subroutine hm_read_table1_1(ntable1, ntable, table, nfunct, npc, pld, l, nom_opt, unitab, lsubmodel)
Definition hm_read_table1_1.F:43
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
submodel_mod
Definition submodel_mod.F:717
table_mod
Definition table_mod.F:113
unitab_mod
Definition unitab_mod.F:517
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:895
submodel_mod::submodel_data
Definition submodel_mod.F:728
table_mod::ttable
Definition table_mod.F:126
unitab_mod::unit_type_
Definition unitab_mod.F:524