OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_read.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!|| h3d_read ../engine/source/output/h3d/h3d_build_fortran/h3d_read.F
25!||--- called by ------------------------------------------------------
26!|| freform ../engine/source/input/freform.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| create_h3d_input ../engine/source/output/h3d/h3d_build_fortran/create_h3d_input.F
31!|| fredec_8key_i ../engine/source/input/fredec_8key_i.F
32!|| wriusc2 ../engine/source/input/wriusc2.F
33!||--- uses -----------------------------------------------------
34!|| anim_mod ../common_source/modules/output/anim_mod.F
35!|| h3d_mod ../engine/share/modules/h3d_mod.F
36!|| message_mod ../engine/share/message_module/message_mod.F
37!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
38!|| sensor_mod ../common_source/modules/sensor_mod.F90
39!|| stack_mod ../engine/share/modules/stack_mod.F
40!||====================================================================
41 SUBROUTINE h3d_read(IKAD,KEY0,KH3D,NSLASH,H3D_DATA,SENSORS)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE stack_mod
47 USE h3d_mod
48 USE anim_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, N1, N2, N3, ITYP,IADG, J,NTITLE,IUS,
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
101c
102 irec = ikad(kcur)
103 DO l=1,nh3d
104 READ(iusc1,rec=irec,fmt='(A)')line
105 CALL fredec_8key_i(line,key2,key3,key4,key5,key6,key7,key8,nbc)
106
107 irec=irec+1
108 IF(key2=='DT ')THEN
109 h3d_data%TH3D = zero
110 CALL wriusc2(irec,1,key0(kcur))
111 READ(iusc2,*,err=310,END=320)H3D_DATA%TH3D0,H3D_DATA%DTH3D0,H3D_DATA%th3d_stop0
112 GOTO 320
113 310 READ(iusc2,*,err=320,END=320)H3D_DATA%th3d0
114 320 CONTINUE
115!
116 IF (h3d_data%DTH3D0 <= zero) THEN
117 CALL ancmsg(msgid=293,anmode=aninfo,c1='H3D',c2='H3D')
118 CALL arret(0)
119 ENDIF
120!
121 ELSEIF(key2=='SENSO')THEN
122 CALL wriusc2(irec,1,key0(kcur))
123 READ(iusc2,*,err=9990) sensors%ANIM_ID,sensors%ANIM_DT
124!
125 ELSEIF(key2=='LSENSOR')THEN
126 DO i=1,nbc
127 READ(iusc1,rec=irec+i-1,fmt='(A)',err=9990)carte
128 h3d_data%N_SENS_H3D = h3d_data%N_SENS_H3D + nvar(carte)
129 ENDDO
130 ALLOCATE(h3d_data%LSENS_H3D(h3d_data%N_SENS_H3D))
131 nbsens = 0
132 DO i=1,nbc
133 READ(iusc1,rec=irec+i-1,fmt='(a)',ERR=9990)CARTE
134 CALL WRIUSC2(IREC+I-1,1,KEY0(KCUR))
135 READ(IUSC2,*,ERR=9990,END=9990)
136 . (H3D_DATA%LSENS_H3D(J+NBSENS),J=1,NVAR(CARTE))
137 NBSENS = NBSENS + NVAR(CARTE)
138 ENDDO
139!
140 ELSEIF(KEY2=='compress')THEN
141 CALL WRIUSC2(IREC,1,KEY0(KCUR))
142 READ(IUSC2,*,ERR=9990)H3D_DATA%PERCENTAGE_ERROR
143!
144 ELSEIF(KEY2=='light') THEN
145 H3D_DATA%LIGHT = 1
146!
147 ELSEIF(KEY2=='comp_level')THEN
148 CALL WRIUSC2(IREC,1,KEY0(KCUR))
149 READ(IUSC2,*,ERR=9990)H3D_DATA%COMP_LEVEL
150 ELSEIF(KEY2=='title')THEN
151 H3D_DATA%N_TITLE = NBC
152 ALLOCATE(H3D_DATA%ITITLE(NBC))
153 ALLOCATE(H3D_DATA%TITLE(NBC))
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)H3D_DATA%ITITLE(I),H3D_DATA%TITLE(I)
158 ENDDO
159c
160c ELSEIF(KEY2=='GENE')THEN
161c CALL CREATE_H3D_GENE(IKAD,KCUR,K,NBC,KEY0,KEY2,KEY3)
162c
163 ELSEIF(KEY2=='rbody')THEN
164 IF(KEY3 == 'single_part') THEN
165 H3D_DATA%RBODY_SINGLE = 1
166 ELSE
167 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
168 . C1=KEY0(KCUR),C2=LINE(1:35))
169 CALL ARRET(0)
170 ENDIF
171 ELSEIF(KEY2=='rbe2')THEN
172 IF(KEY3 == 'single_part') THEN
173 H3D_DATA%RBE2_SINGLE = 1
174 ELSE
175 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
176 . C1=KEY0(KCUR),C2=LINE(1:35))
177 CALL ARRET(0)
178 ENDIF
179 ELSEIF(KEY2=='rbe3')THEN
180 IF(KEY3 == 'single_part') THEN
181 H3D_DATA%RBE3_SINGLE = 1
182 ELSE
183 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
184 . C1=KEY0(KCUR),C2=LINE(1:35))
185 CALL ARRET(0)
186 ENDIF
187C----- TMIN automatically created /w TMAX (/H3D/?/TENS/STRESS/TMAX ;/H3D/NODA/GPS/TMAX
188 ELSEIF(KEY5=='tmax.AND.'(KEY4=='stress.OR.'KEY4=='strain.AND.')KEY2/='beam')THEN
189 CALL CREATE_H3D_INPUT(H3D_DATA,IKAD,KCUR,IREC,NBC,KEY0,KEY2,KEY3,KEY4,KEY5,KEY6,KEY7,KEY8)
190 KEY5 = 'tmin'
191 CALL CREATE_H3D_INPUT(H3D_DATA,IKAD,KCUR,IREC,NBC,KEY0,KEY2,KEY3,KEY4,KEY5,KEY6,KEY7,KEY8)
192 ELSEIF(KEY4=='tmax.AND.'(KEY3=='gps.OR.'KEY3=='gpstrain'))THEN
193 CALL CREATE_H3D_INPUT(H3D_DATA,IKAD,KCUR,IREC,NBC,KEY0,KEY2,KEY3,KEY4,KEY5,KEY6,KEY7,KEY8)
194 KEY4 = 'tmin'
195 CALL CREATE_H3D_INPUT(H3D_DATA,IKAD,KCUR,IREC,NBC,KEY0,KEY2,KEY3,KEY4,KEY5,KEY6,KEY7,KEY8)
196 ELSEIF(KEY4=='tmax'.AND.key3=='PCONT2')THEN
197 key3 = 'MAXPCONT2'
198 key4 = 'NORMAL'
199 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
200 key4 = 'TANGENT'
201 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
202 key3 = 'MINPCONT2'
203 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
204 key4 = 'NORMAL'
205 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
206 ELSEIF(key2 == 'ELEM'.AND.(key3=='THICK' .OR. key3=='THIN')) THEN
207 keytmp = 'SOLID'
208 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
209 keytmp = 'SHELL'
210 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
211 ELSEIF(key3 == 'FAILURE' .OR. key3 == 'DAMG') THEN
212 IF (key4 == 'MEMB') key4 = 'NPT=MEMB'
213 IF (key5 == 'MEMB') key5 = 'NPT=MEMB'
214 IF (key6 == 'MEMB') key6 = 'NPT=MEMB'
215 IF (key7 == 'MEMB') key7 = 'NPT=MEMB'
216 IF (key8 == 'MEMB') key8 = 'NPT=MEMB'
217 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
218 IF (key5 == 'MODE=ALL') THEN
219 key5 = key6
220 key6 = key7
221 key7 = key8
222 key8 = ''
223 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
224 ENDIF
225 ELSEIF(key2 == 'ELEM'.AND.(key3=='VECT' .AND. key4=='PEXT')) THEN
226 keytmp = 'SOLID'
227 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
228 keytmp = 'SHELL'
229 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
230 ELSEIF(key3=='PEXT') THEN
231 IF(key2 == 'ELEM') THEN
232 keytmp = 'SOLID'
233 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
234 keytmp = 'SHELL'
235 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
236C---- add /VECT/PEXT
237 key3 = 'VECT'
238 key4 = 'PEXT'
239 keytmp = 'SOLID'
240 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
241 keytmp = 'SHELL'
242 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,keytmp,key3,key4,key5,key6,key7,key8)
243 ELSEIF(key2 == 'SHELL'.OR.key2 == 'SOLID') THEN
244 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
245 key3 = 'VECT'
246 key4 = 'PEXT'
247 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
248 ELSE
249 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
250 END IF
251 ELSEIF(key2=='SHELL'.AND.key3=='TENS'.AND.key4=='STRESS') THEN
252 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
253 IF(key5 == 'NPT=ALL') THEN
254 key5 = 'NPT=LOWER'
255 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
256 key5 = 'NPT=UPPER'
257 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
258 ELSEIF(key6 == 'NPT=ALL') THEN
259 key6 = 'NPT=LOWER'
260 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
261 key6 = 'NPT=UPPER'
262 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
263 END IF
264 ELSE
265 CALL create_h3d_input(h3d_data,ikad,kcur,irec,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
266 ENDIF
267 irec=irec+nbc
268 ENDDO
269C
270
271 RETURN
272C
273 9990 CONTINUE
274 CALL ancmsg(msgid=73,anmode=aninfo,
275 . c1=key0(kcur),c2=line(1:35))
276 CALL arret(0)
277 END
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
h3d_read
subroutine h3d_read(ikad, key0, kh3d, nslash, h3d_data, sensors)
Definition h3d_read.F:42
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
stack_mod
Definition stack_mod.F:72
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:889
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60