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 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.AND..AND..AND. IF(NDIM/=1NDIM/=2NDIM/=3NDIM/=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))/)
my_real
#define my_real
Definition cppsort.cpp:32
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
id
initmumps id
Definition multiplerhs_example.m:4
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