OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_table2_0.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_table2_0 (ntable0, table, l, nfunct, unitab, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_table2_0()

subroutine hm_read_table2_0 ( integer ntable0,
type(ttable), dimension(*) table,
integer l,
integer nfunct,
type(unit_type_), intent(in) unitab,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 40 of file hm_read_table2_0.F.

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 I, K, N, ID, NDIM, NX(4), NY, STAT
69 my_real xk, yy
70 CHARACTER(LEN=NCHARTITLE) :: TITR
71 CHARACTER MESS*40
72 DATA mess/' FUNCTION & TABLE DEFINITION '/
73 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
74C======================================================================|
75! Initialization
76 is_encrypted = .false.
77 is_available = .false.
78 CALL hm_option_start('/TABLE/0')
79 DO i=1,ntable0
80 CALL hm_option_read_key(lsubmodel,
81 . option_titr = titr,
82 . option_id = id)
83 CALL hm_option_is_encrypted(is_encrypted)
84C-----------------------------------------------
85 nx(1) = 0
86 nx(2) = 0
87 nx(3) = 0
88 nx(4) = 0
89 CALL hm_get_intv('ORDER', ndim, is_available, lsubmodel)
90 IF(ndim/=1.AND.ndim/=2.AND.ndim/=3.AND.ndim/=4)THEN
91 CALL ancmsg(msgid=777,
92 . msgtype=msgerror,
93 . anmode=aninfo_blind_1,
94 . i1=id,
95 . c1=titr)
96 END IF
97 IF(ndim > 0)CALL hm_get_intv('N1', nx(1), is_available, lsubmodel)
98 IF(ndim > 1)CALL hm_get_intv('N2', nx(2), is_available, lsubmodel)
99 IF(ndim > 2)CALL hm_get_intv('N3', nx(3), is_available, lsubmodel)
100 IF(ndim > 3)CALL hm_get_intv('N4', nx(4), is_available, lsubmodel)
101 IF(ndim==1)THEN
102 cycle
103 ENDIF
104 l=l+1
105 table(l)%NOTABLE=id
106 table(l)%NDIM=ndim
107 ALLOCATE(table(l)%X(ndim),stat=stat)
108 IF(stat/=0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
109 . c1='TABLE')
110
111 DO k=1,ndim
112 IF(nx(k) < 2)THEN
113 CALL ancmsg(msgid=778,
114 . msgtype=msgerror,
115 . anmode=aninfo_blind_1,
116 . i1=id,
117 . c1=titr,
118 . i2=k)
119 END IF !NX(K) < 2
120 ENDDO !K=1,NDIM
121 !ndim = 1
122 ALLOCATE(table(l)%X(1)%VALUES(nx(1)),stat=stat)
123 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
124 . msgtype=msgerror,
125 . c1='TABLE')
126C
127 ! read abscissa values for this parameter
128 DO n =1, nx(1)
129 CALL hm_get_float_array_index('temparray2d_N1', xk, n, is_available, lsubmodel, unitab)
130 table(l)%X(1)%VALUES(n)= xk
131 END DO
132 !ndim = 2
133 IF(ndim > 1 ) THEN
134 ALLOCATE(table(l)%X(2)%VALUES(nx(2)),stat=stat)
135 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
136 . msgtype=msgerror,
137 . c1='TABLE')
138 ! read abscissa values for this parameter
139 DO n =1, nx(2)
140 CALL hm_get_float_array_index('temparray2d_N2',xk,n,is_available, lsubmodel, unitab)
141 table(l)%X(2)%VALUES(n)= xk
142 END DO
143 IF(ndim > 2 ) THEN
144 ALLOCATE(table(l)%X(3)%VALUES(nx(3)),stat=stat)
145 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
146 . msgtype=msgerror,
147 . c1='TABLE')
148 DO n =1, nx(3)
149 CALL hm_get_float_array_index('temparray2d_N3',xk,n,is_available, lsubmodel, unitab)
150 table(l)%X(3)%VALUES(n)= xk
151 END DO
152 IF(ndim > 3 ) THEN
153 ALLOCATE(table(l)%X(4)%VALUES(nx(4)),stat=stat)
154 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
155 . msgtype=msgerror,
156 . c1='TABLE')
157 DO n =1, nx(4)
158 CALL hm_get_float_array_index('temparray2d_N4',xk,n,is_available, lsubmodel, unitab)
159 table(l)%X(4)%VALUES(n)= xk
160 END DO
161 ENDIF !NDIM > 3
162 endif!(NDIM > 2 )
163 ENDIF !(ndim > 1 )
164 ! number of ordinate values
165 ny=1
166 DO k=1,ndim
167 ny=ny*SIZE(table(l)%X(k)%VALUES)
168 END DO
169 ALLOCATE(table(l)%Y,stat=stat)
170
171 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
172 . msgtype=msgerror,
173 . c1='TABLE')
174
175 ALLOCATE(table(l)%Y%VALUES(ny),stat=stat)
176
177 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
178 . msgtype=msgerror,
179 . c1='TABLE')
180C
181 ! read ordinate values
182 DO n = 1, ny
183 CALL hm_get_float_array_index('ENG_FUNCT_yValues',yy,n,is_available, lsubmodel, unitab)
184 table(l)%Y%VALUES(n)=yy
185 ENDDO !N = 1, NY
186
187
188 IF (is_encrypted)THEN
189 WRITE(iout,'(A)')'CONFIDENTIAL DATA'
190 ELSE
191 WRITE(iout,2100) table(l)%NOTABLE, table(l)%NDIM
192 DO k=1,table(l)%NDIM
193 nx(k)=SIZE( table(l)%X(k)%VALUES )
194 WRITE(iout,2200) k
195 WRITE(iout,2250) (table(l)%X(k)%VALUES(n),n=1,nx(k))
196 END DO
197 ny=SIZE(table(l)%Y%VALUES)
198 WRITE(iout,2300)
199 WRITE(iout,2350) (table(l)%Y%VALUES(n),n=1,ny)
200 END IF
201 END DO
202 RETURN
203
204C-----------------------------------------------------------------
2052100 FORMAT(/' TABLE ID . . . . . . . . . . . . . . =',i10/
206 . ' NUMBER OF PARAMETERS . . . . . . . . =',i10/)
2072200 FORMAT(/' VALUES FOR PARAMETER NUMBER. . . . . .',i4,':'/)
2082250 FORMAT((3x,5(1x,g20.13))/)
2092300 FORMAT(/' ORDINATE VALUES . . . . . . . . . . . :'/)
2102350 FORMAT((3x,5(1x,g20.13))/)
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: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_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
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