OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_h3d_input.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 create_h3d_input (h3d_data, ikad, ikey, irec, nbc, key0, key2, key3, key4, key5, key6, key7, key8)

Function/Subroutine Documentation

◆ create_h3d_input()

subroutine create_h3d_input ( type (h3d_database) h3d_data,
integer, dimension(0:*) ikad,
integer ikey,
integer irec,
integer nbc,
character, dimension(*) key0,
character(len=ncharkey) key2,
character(len=ncharkey) key3,
character(len=ncharkey) key4,
character(len=ncharkey) key5,
character(len=ncharkey) key6,
character(len=ncharkey) key7,
character(len=ncharkey) key8 )

Definition at line 35 of file create_h3d_input.F.

36C-----------------------------------------------
37C D e s c r i p t i o n
38C-----------------------------------------------
39C This subroutine is activating flags which are used by Engine
40C to make allocation or specific calculatations.
41C Example :
42C H3D_DATA%N_VECT_CONT = 1
43C means /H3D/ELEM/VECT/CONT is defined and
44C specific calculation & storage are requested
45C to output this result
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE h3d_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"
55#include "units_c.inc"
56#include "scr14_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (H3D_DATABASE) :: H3D_DATA
61 INTEGER IKAD(0:*),IKEY,IREC
62 INTEGER NBC
63 CHARACTER KEY0(*)*5
64 CHARACTER(LEN=NCHARKEY) :: KEY2, KEY3, KEY4, KEY5,KEY6,KEY7,KEY8
65C-----------------------------------------------
66C E x t e r n a l F u n c t i o n s
67C-----------------------------------------------
68 INTEGER NVAR
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 CHARACTER(LEN=NCHARLINE100):: CARTE,CARTE1,KEY3_GLOB
73 INTEGER I,J,L,N_H3D_PART,CPT,
74 . IS_CHAR_KEY3,IS_CHAR_KEY4,IS_CHAR_KEY5,IS_CHAR_KEY6,IS_CHAR_KEY7,IS_CHAR_KEY8,
75 . IS_EMPTY_KEY3,IS_EMPTY_KEY4,IS_EMPTY_KEY5,IS_EMPTY_KEY6,IS_EMPTY_KEY7,IS_EMPTY_KEY8
76C=========================================================================
77 h3d_data%N_INPUT_H3D = h3d_data%N_INPUT_H3D + 1
78 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY2 = key2
79 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY3 = key3
80 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY4 = key4
81 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY5 = key5
82 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY6 = key6
83 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY7 = key7
84 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY8 = key8
85
86
87 n_h3d_part = 0
88 DO j=1,nbc
89 READ(iusc1,rec=irec+j-1,fmt='(A)',err=999)carte
90 n_h3d_part=n_h3d_part + nvar(carte)
91 ENDDO
92c
93 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%NB_PART = n_h3d_part
94 IF (n_h3d_part /= 0 )
95 . ALLOCATE(h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%PART_LIST(n_h3d_part))
96c
97 n_h3d_part = 0
98 DO j=1,nbc
99 READ(iusc1,rec=irec+j-1,fmt='(A)',err=999)carte
100 CALL wriusc2(irec+j-1,1,key0(ikey))
101 READ(iusc2,*,err=999,END=999)
102 . (h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%PART_LIST(n_h3d_part + l),l=1,nvar(carte))
103 n_h3d_part=n_h3d_part + nvar(carte)
104 ENDDO
105c DO J=1,N_H3D_PART
106c print *,'ds la construct du read_input',H3D_DATA%INPUT_LIST(H3D_DATA%N_INPUT_H3D)%PART_LIST(J)
107c ENDDO
108c
109C--------------------------------------------------
110C SEARCH Keywords for Activation of some output computation
111C--------------------------------------------------
112 is_char_key3 = 1
113 is_empty_key3 = 1
114 is_char_key4 = 1
115 is_empty_key4 = 1
116 is_char_key5 = 1
117 is_empty_key5 = 1
118 is_char_key6 = 1
119 is_empty_key6 = 1
120 is_char_key7 = 1
121 is_empty_key7 = 1
122 is_char_key8 = 1
123 is_empty_key8 = 1
124 key3_glob = ''
125 DO i=1,ncharkey
126 IF ( key3(i:i) == '=' ) is_char_key3 = 0
127 IF ( key3(i:i) /= ' ' ) is_empty_key3 = 0
128 IF ( key4(i:i) == '=' ) is_char_key4 = 0
129 IF ( key4(i:i) /= ' ' ) is_empty_key4 = 0
130 IF ( key5(i:i) == '=' ) is_char_key5 = 0
131 IF ( key5(i:i) /= ' ' ) is_empty_key5 = 0
132 IF ( key6(i:i) == '=' ) is_char_key6 = 0
133 IF ( key6(i:i) /= ' ' ) is_empty_key6 = 0
134 IF ( key7(i:i) == '=' ) is_char_key7 = 0
135 IF ( key7(i:i) /= ' ' ) is_empty_key7 = 0
136 IF ( key8(i:i) == '=' ) is_char_key8 = 0
137 IF ( key8(i:i) /= ' ' ) is_empty_key8 = 0
138 ENDDO
139C--------------------------------------------------
140 cpt = 0
141 IF ( is_char_key3 == 1 .AND. is_empty_key3 == 0) THEN
142 DO i=1,ncharkey
143 IF ( key3(i:i) /= ' ' ) THEN
144 cpt = cpt + 1
145 key3_glob(cpt:cpt) = key3(i:i)
146 ENDIF
147 ENDDO
148 ENDIF
149 IF ( is_char_key4 == 1 .AND. is_empty_key4 == 0 ) THEN
150 cpt = cpt + 1
151 key3_glob(cpt:cpt) = '/'
152 DO i=1,ncharkey
153 IF ( key4(i:i) /= ' ' ) THEN
154 cpt = cpt + 1
155 key3_glob(cpt:cpt) = key4(i:i)
156 ENDIF
157 ENDDO
158 ENDIF
159 IF ( is_char_key5 == 1 .AND. is_empty_key5 == 0 ) THEN
160 cpt = cpt + 1
161 key3_glob(cpt:cpt) = '/'
162 DO i=1,ncharkey
163 IF ( key5(i:i) /= ' ' ) THEN
164 cpt = cpt + 1
165 key3_glob(cpt:cpt) = key5(i:i)
166 ENDIF
167 ENDDO
168 ENDIF
169 IF ( is_char_key6 == 1 .AND. is_empty_key6 == 0 ) THEN
170 cpt = cpt + 1
171 key3_glob(cpt:cpt) = '/'
172 DO i=1,ncharkey
173 IF ( key6(i:i) /= ' ' ) THEN
174 cpt = cpt + 1
175 key3_glob(cpt:cpt) = key6(i:i)
176 ENDIF
177 ENDDO
178 ENDIF
179 IF ( is_char_key7 == 1 .AND. is_empty_key7 == 0 ) THEN
180 cpt = cpt + 1
181 key3_glob(cpt:cpt) = '/'
182 DO i=1,ncharkey
183 IF ( key7(i:i) /= ' ' ) THEN
184 cpt = cpt + 1
185 key3_glob(cpt:cpt) = key7(i:i)
186 ENDIF
187 ENDDO
188 ENDIF
189 IF ( is_char_key8 == 1 .AND. is_empty_key8 == 0 ) THEN
190 cpt = cpt + 1
191 key3_glob(cpt:cpt) = '/'
192 DO i=1,ncharkey
193 IF ( key8(i:i) /= ' ' ) THEN
194 cpt = cpt + 1
195 key3_glob(cpt:cpt) = key8(i:i)
196 ENDIF
197 ENDDO
198 ENDIF
199C--------------------------------------------------
200 IF(key2 == 'NODA') THEN
201c scalar
202 IF (key3_glob == 'DT') h3d_data%N_SCAL_DT = 1
203 IF (key3_glob == 'DMASS') h3d_data%N_SCAL_DMAS = 1
204 IF (key3_glob == 'DINER') h3d_data%N_SCAL_DINER = 1
205 IF (key3_glob == 'DAMA2') h3d_data%N_SCAL_DAMA2 = 1
206 IF (key3_glob == 'SKID_LINE') h3d_data%N_SCAL_SKID = 1
207 IF (key3_glob == 'STIFR') h3d_data%N_SCAL_STIFR = 1
208 IF (key3_glob == 'STIF') h3d_data%N_SCAL_STIFN = 1
209 IF (key3_glob == 'CSE_FRICG') h3d_data%N_SCAL_CSE_FRIC = 1
210 IF (key3_glob == 'CSE_FRIC') h3d_data%N_SCAL_CSE_FRICINT = 1
211c vector
212 IF (key3_glob == 'CONT'.OR.key3_glob == 'CONT/TMAX') h3d_data%N_VECT_CONT = 1
213 IF (key3_glob == 'CONT/TMAX') h3d_data%N_VECT_CONT_MAX = 1
214 IF (key3_glob == 'FINT') h3d_data%N_VECT_FINT = 1
215 IF (key3_glob == 'FEXT') h3d_data%N_VECT_FEXT = 1
216 IF (key3_glob == 'PCONT'.OR.key3_glob == 'PCONT/TMAX') h3d_data%N_VECT_PCONT = 1
217 IF (key3_glob == 'PCONT/TMAX') h3d_data%N_VECT_PCONT_MAX = 1
218 IF (key3_glob == 'CONT2'.OR.key3_glob == 'CONT2/TMAX'.OR.
219 . key3_glob == 'CONT2/TMIN') h3d_data%N_VECT_CONT2 = 1
220 IF (key3_glob == 'PCONT2'.OR.key3_glob == 'PCONT2/TMAX'.OR.
221 . key3_glob == 'PCONT2/TMIN' .OR.key3_glob == 'MAXPCONT2/NORMAL')
222 . h3d_data%N_VECT_PCONT2 = 1
223 IF (key3_glob == 'CONT2/TMAX') h3d_data%N_VECT_CONT2_MAX = 1
224 IF (key3_glob == 'CONT2/TMIN') h3d_data%N_VECT_CONT2_MIN = 1
225 IF (key3_glob == 'PCONT2/TMAX'.OR.key3_glob == 'MAXPCONT2/NORMAL')
226 . h3d_data%N_VECT_PCONT2_MAX = 1
227 IF (key3_glob == 'PCONT2/TMIN'.OR.key3_glob == 'MINPCONT2/NORMAL')
228 . h3d_data%N_VECT_PCONT2_MIN = 1
229 IF (key3_glob == 'CONT2/MOMENT') h3d_data%N_VECT_CONT2M = 1
230 IF (key3_glob == 'DROT') h3d_data%N_VECT_DROT = 1
231 IF (key3_glob == 'DXANC') h3d_data%N_VECT_DXANC = 1
232 IF (key3_glob == 'FREAC') h3d_data%N_VECT_FREAC = 1
233 IF (key3_glob == 'MREAC') h3d_data%N_VECT_MREAC = 1
234 IF (key3_glob == 'CLUST/FORCE') h3d_data%N_VECT_CLUST_FORCE = 1
235 IF (key3_glob == 'CLUST/MOM') h3d_data%N_VECT_CLUST_MOM = 1
236 ENDIF
237
238 IF(key2 == "ELEM" .OR. key2 == 'SOLID' .OR. key2 == 'QUAD')THEN
239 IF (key3_glob == 'VECT/CONT') h3d_data%N_VECT_CONT = 1
240 IF (key3_glob == 'VECT/ACC') h3d_data%N_VECT_ACC = 1
241 IF (key3_glob == 'TENS/EPSDOT') iepsdot = 1
242 IF (key3_glob == 'VORTX') h3d_data%SOL_SCAL_VORTX = 1
243 IF (key3_glob == 'VORTY') h3d_data%SOL_SCAL_VORTY = 1
244 IF (key3_glob == 'VORTZ') h3d_data%SOL_SCAL_VORTZ = 1
245 IF (key3_glob == 'VORT') THEN
246 h3d_data%SOL_SCAL_VORTX = 1
247 h3d_data%SOL_SCAL_VORTY = 1
248 h3d_data%SOL_SCAL_VORTZ = 1
249 ENDIF
250 ENDIF
251c
252 IF(key2 == 'SHELL') THEN
253c scalar
254 IF (key3_glob == 'ERROR/THICK') h3d_data%SH_SCAL_ERR_THK = 1
255c tensor
256 IF (key3_glob == 'TENS/EPSDOT') iepsdot = 1
257 ENDIF
258c
259 IF(key2 == 'SPRING' .OR. key2 == 'BEAM' .OR. key2 == 'TRUSS' ) THEN
260 IF (key3_glob == 'FORC') h3d_data%UND_FORC = 1
261 ENDIF
262c
263 ! Just for STRAIN
264 IF (key2 == 'QUAD') THEN
265c tensor
266 IF (key3_glob == 'TENS/STRAIN') h3d_data%STRAIN = 1
267 ENDIF
268C--------------------------------------------------
269
270c
271 RETURN
272 999 print *,'error lecture'
273 CALL arret(0)
h3d_mod
Definition h3d_mod.F:308
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
nvar
integer function nvar(text)
Definition nvar.F:32
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60