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

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_read (ikad, key0, kh3d, nslash, h3d_data, sensors)

Function/Subroutine Documentation

◆ h3d_read()

subroutine h3d_read ( integer, dimension(0:*) ikad,
character, dimension(*) key0,
integer kh3d,
integer, dimension(*) nslash,
type (h3d_database) h3d_data,
type (sensors_), intent(inout) sensors )

Definition at line 41 of file h3d_read.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE stack_mod
47 USE h3d_mod
48 USE output_mod
49 USE sensor_mod
50 USE names_and_titles_mod, ONLY: ncharline100,ncharkey
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IKAD(0:*),KH3D,NSLASH(*)
59 CHARACTER KEY0(*)*5
60 TYPE (H3D_DATABASE) :: H3D_DATA
61 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "units_c.inc"
66#include "scr14_c.inc"
67C-----------------------------------------------
68C E x t e r n a l F u n c t i o n s
69C-----------------------------------------------
70 INTEGER NVAR
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I, NBC, L, KCUR, J,
75 . NH3D,IREC,NBSENS
76 CHARACTER TITLE*72, TITLE2*80, LINE*120
77 CHARACTER(LEN=NCHARKEY)::KEY2
78 CHARACTER(LEN=NCHARKEY)::KEY3
79 CHARACTER(LEN=NCHARKEY)::KEY4
80 CHARACTER(LEN=NCHARKEY)::KEY5
81 CHARACTER(LEN=NCHARKEY)::KEY6
82 CHARACTER(LEN=NCHARKEY)::KEY7
83 CHARACTER(LEN=NCHARKEY)::KEY8
84 CHARACTER(LEN=NCHARKEY)::KEYTMP
85 CHARACTER(LEN=NCHARLINE100)::CARTE
86C
87 my_real x0,y0,z0,vnx,vny,vnz,v0
88C-----------------------------------------------
89C S o u r c e L i n e s
90C-----------------------------------------------=
91 kcur = kh3d
92 nh3d = nslash(kcur)
93c
94 h3d_data%TH3D0 = zero
95 h3d_data%DTH3D0 = zero
96 h3d_data%TH3D_STOP0 = ep30
97 h3d_data%PERCENTAGE_ERROR = zero
98 h3d_data%COMP_LEVEL = 7
99 h3d_data%N_SENS_H3D = 0
100 h3d_data%LIGHT = 0
101 h3d_data%NB_H3D_FRAME = 0
102 h3d_data%DTH3D_FCT_ID = 0
103c
104 irec = ikad(kcur)
105 DO l=1,nh3d
106 READ(iusc1,rec=irec,fmt='(A)')line
107 CALL fredec_8key_i(line,key2,key3,key4,key5,key6,key7,key8,nbc)
108
109 irec=irec+1
110 IF(key2=='DT ')THEN
111 h3d_data%TH3D = zero
112 CALL wriusc2(irec,1,key0(kcur))
113 READ(iusc2,*,err=310,END=320)H3D_DATA%TH3D0,H3D_DATA%DTH3D0,H3D_DATA%TH3D_STOP0,H3D_DATA%NB_H3D_FRAME,H3D_DATA%dth3d_fct_id
114 GOTO 320
115 310 READ(iusc2,*,err=320,END=320)H3D_DATA%th3d0
116 320 CONTINUE
117!
118c DO I=1,NBC
119c READ(IUSC1,REC=IKAD(IKEY)+K+I-1,FMT='(A)',ERR=9990)CARTE
120c CALL WRIUSC2(IKAD(IKEY)+K+I-1,1,KEY0(IKEY))
121c READ(IUSC2,*,ERR=9990,END=9990) TIME_I,NB_FRAME_I,TILTLE_I
122c NFRAME=NFRAME+1
123c TIME_H3D_TAB( NFRAME) = TIME_I
124c NB_H3D_FRAME_TAB(NFRAME)=NB_FRAME_I
125c TITLE_H3D_TAB(NFRAME)=TILTLE_I
126c ENDDO
127!
128
129 IF (h3d_data%TH3D_STOP0 < zero) THEN
130 CALL ancmsg(msgid=304,anmode=aninfo,c1='H3D',c2='H3D')
131 CALL arret(0)
132 ELSEIF (h3d_data%TH3D_STOP0 == zero)THEN
133 h3d_data%TH3D_STOP0 = ep20
134 ELSE
135 h3d_data%TH3D_STOP0 = max(h3d_data%TH3D_STOP0, max(zero,h3d_data%TH3D0))
136 ENDIF
137!
138 IF (h3d_data%DTH3D0 <= zero.AND.h3d_data%DTH3D_FCT_ID==0.AND.h3d_data%NB_H3D_FRAME==0 )THEN
139 CALL ancmsg(msgid=293,anmode=aninfo,c1='H3D',c2='H3D')
140 CALL arret(0)
141 ENDIF
142!
143 ELSEIF(key2=='SENSO')THEN
144 CALL wriusc2(irec,1,key0(kcur))
145 READ(iusc2,*,err=9990) sensors%ANIM_ID,sensors%ANIM_DT
146!
147 ELSEIF(key2=='LSENSOR')THEN
148 DO i=1,nbc
149 READ(iusc1,rec=irec+i-1,fmt='(A)',err=9990)carte
150 h3d_data%N_SENS_H3D = h3d_data%N_SENS_H3D + nvar(carte)
151 ENDDO
152 ALLOCATE(h3d_data%LSENS_H3D(h3d_data%N_SENS_H3D))
153 nbsens = 0
154 DO i=1,nbc
155 READ(iusc1,rec=irec+i-1,fmt='(A)',err=9990)carte
156 CALL wriusc2(irec+i-1,1,key0(kcur))
157 READ(iusc2,*,err=9990,END=9990)
158 . (h3d_data%LSENS_H3D(j+nbsens),j=1,nvar(carte))
159 nbsens = nbsens + nvar(carte)
160 ENDDO
161!
162 ELSEIF(key2=='COMPRESS')THEN
163 CALL wriusc2(irec,1,key0(kcur))
164 READ(iusc2,*,err=9990)h3d_data%PERCENTAGE_ERROR
165!
166 ELSEIF(key2=='LIGHT') THEN
167 h3d_data%LIGHT = 1
168!
169 ELSEIF(key2=='COMP_LEVEL')THEN
170 CALL wriusc2(irec,1,key0(kcur))
171 READ(iusc2,*,err=9990)h3d_data%COMP_LEVEL
172 ELSEIF(key2=='TITLE')THEN
173 h3d_data%N_TITLE = nbc
174 ALLOCATE(h3d_data%ITITLE(nbc))
175 ALLOCATE(h3d_data%TITLE(nbc))
176 DO i=1,nbc
177 READ(iusc1,rec=irec+i-1,fmt='(A)',err=9990)carte
178 CALL wriusc2(irec+i-1,1,key0(kcur))
179 READ(iusc2,*,err=9990)h3d_data%ITITLE(i),h3d_data%TITLE(i)
180 ENDDO
181c
182c ELSEIF(KEY2=='GENE')THEN
183c CALL CREATE_H3D_GENE(IKAD,KCUR,K,NBC,KEY0,KEY2,KEY3)
184c
185 ELSEIF(key2=='RBODY')THEN
186 IF(key3 == 'SINGLE_PART') THEN
187 h3d_data%RBODY_SINGLE = 1
188 ELSE
189 CALL ancmsg(msgid=73,anmode=aninfo,
190 . c1=key0(kcur),c2=line(1:35))
191 CALL arret(0)
192 ENDIF
193 ELSEIF(key2=='RBE2')THEN
194 IF(key3 == 'SINGLE_PART') THEN
195 h3d_data%RBE2_SINGLE = 1
196 ELSE
197 CALL ancmsg(msgid=73,anmode=aninfo,
198 . c1=key0(kcur),c2=line(1:35))
199 CALL arret(0)
200 ENDIF
201 ELSEIF(key2=='RBE3')THEN
202 IF(key3 == 'SINGLE_PART') THEN
203 h3d_data%RBE3_SINGLE = 1
204 ELSE
205 CALL ancmsg(msgid=73,anmode=aninfo,
206 . c1=key0(kcur),c2=line(1:35))
207 CALL arret(0)
208 ENDIF
209C----- TMIN automatically created /w TMAX (/H3D/?/TENS/STRESS/TMAX ;/H3D/NODA/GPS/TMAX
210 ELSEIF(key5=='TMAX'.AND.(key4=='STRESS'.OR.key4=='STRAIN').AND.key2/='BEAM')THEN
211 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
212 key5 = 'TMIN'
213 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
214 ELSEIF(key4=='TMAX'.AND.(key3=='GPS'.OR.key3=='GPSTRAIN'))THEN
215 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
216 key4 = 'TMIN'
217 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
218 ELSEIF(key4=='TMAX'.AND.key3=='PCONT2')THEN
219 key3 = 'MAXPCONT2'
220 key4 = 'NORMAL'
221 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
222 key4 = 'TANGENT'
223 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
224 key3 = 'MINPCONT2'
225 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
226 key4 = 'NORMAL'
227 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
228 ELSEIF(key2 == 'ELEM'.AND.(key3=='THICK' .OR. key3=='THIN')) THEN
229 keytmp = 'SOLID'
230 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
231 keytmp = 'SHELL'
232 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
233 ELSEIF(key3 == 'FAILURE' .OR. key3 == 'DAMG') THEN
234 IF (key4 == 'MEMB') key4 = 'NPT=MEMB'
235 IF (key5 == 'MEMB') key5 = 'NPT=MEMB'
236 IF (key6 == 'MEMB') key6 = 'NPT=MEMB'
237 IF (key7 == 'MEMB') key7 = 'NPT=MEMB'
238 IF (key8 == 'MEMB') key8 = 'NPT=MEMB'
239 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
240 IF (key5 == 'MODE=ALL') THEN
241 key5 = key6
242 key6 = key7
243 key7 = key8
244 key8 = ''
245 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
246 ENDIF
247 ELSEIF(key2 == 'ELEM'.AND.(key3=='VECT' .AND. key4=='PEXT')) THEN
248 keytmp = 'SOLID'
249 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
250 keytmp = 'SHELL'
251 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
252 ELSEIF(key3=='PEXT') THEN
253 IF(key2 == 'ELEM') THEN
254 keytmp = 'SOLID'
255 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
256 keytmp = 'SHELL'
257 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
258C---- add /VECT/PEXT
259 key3 = 'VECT'
260 key4 = 'PEXT'
261 keytmp = 'SOLID'
262 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
263 keytmp = 'SHELL'
264 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
265 ELSEIF(key2 == 'SHELL'.OR.key2 == 'SOLID') THEN
266 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
267 key3 = 'VECT'
268 key4 = 'PEXT'
269 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
270 ELSE
271 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
272 END IF
273 ELSEIF(key2=='SHELL'.AND.key3=='TENS'.AND.key4=='STRESS') THEN
274 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
275 IF(key5 == 'NPT=ALL') THEN
276 key5 = 'NPT=LOWER'
277 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
278 key5 = 'NPT=UPPER'
279 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
280 ELSEIF(key6 == 'NPT=ALL') THEN
281 key6 = 'NPT=LOWER'
282 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
283 key6 = 'NPT=UPPER'
284 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
285 END IF
286 ELSE
287 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
288 ENDIF
289 irec=irec+nbc
290 ENDDO
291C
292
293 RETURN
294C
295 9990 CONTINUE
296 CALL ancmsg(msgid=73,anmode=aninfo,
297 . c1=key0(kcur),c2=line(1:35))
298 CALL arret(0)
my_real
#define my_real
Definition cppsort.cpp:32
create_h3d_input
subroutine create_h3d_input(h3d_data, ikad, ikey, irec, nbc, key0, key2, key3, key4, key5, key6, key7, key8)
Definition create_h3d_input.F:36
fredec_8key_i
subroutine fredec_8key_i(cart, key2, key3, key4, key5, key6, key7, key8, nbc)
Definition fredec_8key_i.F:35
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1007
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
stack_mod
Definition stack_mod.F:75
nvar
integer function nvar(text)
Definition nvar.F:32
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
arret
subroutine arret(nn)
Definition arret.F:86
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60