OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_gene_keyword.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_gene_keyword ../engine/source/output/h3d/input_list/h3d_gene_keyword.f
25!||--- called by ------------------------------------------------------
26!|| lech3d ../engine/source/output/h3d/h3d_build_fortran/lech3d.F
27!|| prelech3d ../engine/source/output/h3d/h3d_build_fortran/prelech3d.F90
28!||--- uses -----------------------------------------------------
29!|| h3d_mod ../engine/share/modules/h3d_mod.F
30!|| message_mod ../engine/share/message_module/message_mod.F
31!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.f90
32!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
33!||====================================================================
34 SUBROUTINE h3d_gene_keyword(KEY2_READ,KEY2,KEY3_READ,KEY3_GLOB,NB_KEY,CPT_KEY,MULTI_FVM,
35 . IS_MODEL_NPT,IS_MODEL_LAYER,IS_MODEL_PLY,IS_MDSVAR,IS_MDSVAR_DEF,
36 . IS_PLY_ALL,IS_LAYER_ALL,IS_IPT,IS_LAYER,IS_PLY,IS_ID)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE h3d_mod
42 USE multi_fvm_mod
43 USE names_and_titles_mod, ONLY: ncharline100,ncharkey
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER NB_KEY,CPT_KEY
52 CHARACTER(LEN=NCHARKEY) :: KEY2,KEY2_READ
53 CHARACTER(LEN=NCHARLINE100) :: KEY3_READ,KEY3_GLOB
54 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER II, IS_MODEL_NPT, IS_MODEL_LAYER, IS_MODEL_PLY,
59 . IS_MDSVAR,IS_MDSVAR_DEF,IS_PLY_ALL,IS_LAYER_ALL,IS_IPT,
60 . is_layer,is_ply,is_id
61
62c-----------------------------------------------
63 IF (key2_read == 'MASS') THEN
64c-----------------------------------------------
65 nb_key = 8
66 IF (cpt_key == 1) key2 = 'NODA'
67 IF (cpt_key == 1) key3_glob = 'MASS'
68 IF (cpt_key == 2) key2 = 'SHELL'
69 IF (cpt_key == 2) key3_glob = 'MASS'
70 IF (cpt_key == 3) key2 = 'SOLID'
71 IF (cpt_key == 3) key3_glob = 'MASS'
72 IF (cpt_key == 4) key2 = 'SPH'
73 IF (cpt_key == 4) key3_glob = 'MASS'
74 IF (cpt_key == 5) key2 = 'BEAM'
75 IF (cpt_key == 5) key3_glob = 'MASS'
76 IF (cpt_key == 6) key2 = 'SPRING'
77 IF (cpt_key == 6) key3_glob = 'MASS'
78 IF (cpt_key == 7) key2 = 'TRUSS'
79 IF (cpt_key == 7) key3_glob = 'MASS'
80 IF (cpt_key == 8) key2 = 'QUAD'
81 IF (cpt_key == 8) key3_glob = 'MASS'
82c-----------------------------------------------
83 ELSEIF (key2_read == 'SOLID') THEN
84c-----------------------------------------------
85 IF (key3_read == 'ORTHD') THEN
86 nb_key = 3
87 IF (cpt_key == 1) key3_glob = 'ORTHD/PSI'
88 IF (cpt_key == 2) key3_glob = 'ORTHD/THETA'
89 IF (cpt_key == 3) key3_glob = 'ORTHD/PHI'
90 ELSEIF (key3_read == 'MOM') THEN
91 nb_key = 7
92 IF (cpt_key == 1) key3_glob = 'MOMX'
93 IF (cpt_key == 2) key3_glob = 'MOMY'
94 IF (cpt_key == 3) key3_glob = 'MOMZ'
95 IF (cpt_key == 4) key3_glob = 'MOMXY'
96 IF (cpt_key == 5) key3_glob = 'MOMYZ'
97 IF (cpt_key == 6) key3_glob = 'MOMXZ'
98 IF (cpt_key == 7) key3_glob = '|MOM|'
99 ELSEIF (key3_read == 'VEL') THEN
100 nb_key = 7
101 IF (cpt_key == 1) key3_glob = 'VELX'
102 IF (cpt_key == 2) key3_glob = 'vely'
103 IF (CPT_KEY == 3) KEY3_GLOB = 'velz'
104 IF (CPT_KEY == 4) KEY3_GLOB = 'velxy'
105 IF (CPT_KEY == 5) KEY3_GLOB = 'velyz'
106 IF (CPT_KEY == 6) KEY3_GLOB = 'velxz'
107 IF (CPT_KEY == 7) KEY3_GLOB = '|vel|'
108 ELSEIF (KEY3_READ == 'mds.AND..AND.' IS_MDSVAR == 0
109.AND..AND. . IS_IPT ==0 IS_LAYER == 0 IS_PLY == 0) THEN
110 NB_KEY = IS_PLY_ALL+IS_LAYER_ALL+1
111 IF (CPT_KEY == 1) THEN
112 KEY3_GLOB = 'mds'
113 IS_MDSVAR = 1
114 IS_MDSVAR_DEF = 1
115.OR. IF(IS_MODEL_PLY == 1 IS_MODEL_LAYER == 1 )IS_LAYER_ALL = 1
116 ENDIF
117 ELSEIF (KEY3_READ == 'vfrac') THEN
118c create specific keywords for LAW151, number of present materials is not
119c known a priori
120 IF (MULTI_FVM%IS_USED) THEN
121 NB_KEY = MULTI_FVM%NBMAT
122 DO II = 1, NB_KEY
123 IF (CPT_KEY == II) THEN
124 WRITE(KEY3_GLOB, '(a,i0)') 'm151vfrac', II
125 ENDIF
126 ENDDO
127 ELSE
128 NB_KEY = 4
129 IF (CPT_KEY == 1) KEY3_GLOB = 'vfrac/1'
130 IF (CPT_KEY == 2) KEY3_GLOB = 'vfrac/2'
131 IF (CPT_KEY == 3) KEY3_GLOB = 'vfrac/3'
132 IF (CPT_KEY == 4) KEY3_GLOB = 'vfrac/4'
133 ENDIF
134 ELSE
135 NB_KEY = 1
136 KEY3_GLOB = KEY3_READ
137 ENDIF
138c-----------------------------------------------
139 ELSEIF (KEY2_READ == 'noda') THEN
140c-----------------------------------------------
141 IF (KEY3_READ == 'fopt') THEN
142 NB_KEY = 2
143 IF (CPT_KEY == 1) KEY3_GLOB = 'fopt/force'
144 IF (CPT_KEY == 2) KEY3_GLOB = 'fopt/moment'
145 ELSEIF (KEY3_READ == 'pcont') THEN
146 NB_KEY = 2
147 IF (CPT_KEY == 1) KEY3_GLOB = 'pcont/normal'
148 IF (CPT_KEY == 2) KEY3_GLOB = 'pcont/tangent'
149 ELSEIF (key3_read == 'PCONT/TMAX') THEN
150 nb_key = 2
151 IF (cpt_key == 1) key3_glob = 'MAXPCONT/NORMAL'
152 IF (cpt_key == 2) key3_glob = 'MAXPCONT/TANGENT'
153 ELSEIF (key3_read == 'PCONT2') THEN
154 nb_key = 2
155 IF (cpt_key == 1) key3_glob = 'PCONT2/NORMAL'
156 IF (cpt_key == 2) key3_glob = 'PCONT2/TANGENT'
157 ELSEIF (key3_read == 'PCONT2/TMAX') THEN
158 nb_key = 2
159 IF (cpt_key == 1) key3_glob = 'MAXPCONT2/NORMAL'
160 IF (cpt_key == 2) key3_glob = 'MAXPCONT2/TANGENT'
161 ELSEIF (key3_read == 'PCONT2/TMIN') THEN
162 nb_key = 2
163 IF (cpt_key == 1) key3_glob = 'MINPCONT2/NORMAL'
164 IF (cpt_key == 2) key3_glob = 'MINPCONT2/TANGENT'
165 ELSEIF (key3_read == 'DAMA2') THEN
166 nb_key = 2
167 IF (cpt_key == 1) key3_glob = 'DAMA2/NORMAL'
168 IF (cpt_key == 2) key3_glob = 'DAMA2/TANGENT'
169 ELSE
170 nb_key = 1
171 key3_glob = key3_read
172 ENDIF
173c-----------------------------------------------
174 ELSEIF (key2_read == 'QUAD') THEN
175 IF (key3_read == 'VFRAC') THEN
176c
177c create specific keywords for LAW151, number of present materials is not
178c known a priori
179c
180 IF (multi_fvm%IS_USED) THEN
181 nb_key = multi_fvm%NBMAT
182 DO ii = 1, nb_key
183 IF (cpt_key == ii) THEN
184 WRITE(key3_glob, '(A,I0)') 'M151VFRAC', ii
185 ENDIF
186 ENDDO
187 ELSE
188 nb_key = 4
189 IF (cpt_key == 1) key3_glob = 'VFRAC1'
190 IF (cpt_key == 2) key3_glob = 'VFRAC2'
191 IF (cpt_key == 3) key3_glob = 'VFRAC3'
192 IF (cpt_key == 4) key3_glob = 'VFRAC4'
193 ENDIF
194 ENDIF
195c-----------------------------------------------
196 ELSEIF (key2_read == 'ELEM') THEN
197 IF (key3_read == 'VFRAC') THEN
198c
199c create specific keywords for LAW151, number of present materials is not
200c known a priori
201c
202 IF (multi_fvm%IS_USED) THEN
203 nb_key = multi_fvm%NBMAT
204 DO ii = 1, nb_key
205 IF (cpt_key == ii) THEN
206 WRITE(key3_glob, '(A,I0)') 'M151VFRAC', ii
207 ENDIF
208 ENDDO
209 ELSE
210 nb_key = 4
211 IF (cpt_key == 1) key3_glob = 'VFRAC1'
212 IF (cpt_key == 2) key3_glob = 'VFRAC2'
213 IF (cpt_key == 3) key3_glob = 'VFRAC3'
214 IF (cpt_key == 4) key3_glob = 'VFRAC4'
215 ENDIF
216 ELSEIF (key3_read == 'PHASE_DENS') THEN
217 IF (multi_fvm%IS_USED) THEN
218 nb_key = multi_fvm%NBMAT
219 DO ii = 1, nb_key
220 IF (cpt_key == ii) THEN
221 WRITE(key3_glob, '(A,I0)') 'M151DENS', ii
222 ENDIF
223 ENDDO
224 ENDIF
225 ELSEIF (key3_read == 'PHASE_ENER') THEN
226 IF (multi_fvm%IS_USED) THEN
227 nb_key = multi_fvm%NBMAT
228 DO ii = 1, nb_key
229 IF (cpt_key == ii) THEN
230 WRITE(key3_glob, '(A,I0)') 'M151ENER', ii
231 ENDIF
232 ENDDO
233 ENDIF
234 ELSEIF (key3_read == 'PHASE_PRES') THEN
235 IF (multi_fvm%IS_USED) THEN
236 nb_key = multi_fvm%NBMAT
237 DO ii = 1, nb_key
238 IF (cpt_key == ii) THEN
239 WRITE(key3_glob, '(A,I0)') 'M151PRES', ii
240 ENDIF
241 ENDDO
242 ENDIF
243 ELSEIF (key3_read == 'ORTHD') THEN
244 nb_key = 3
245 IF (cpt_key == 1) key3_glob = 'ORTHD/PSI'
246 IF (cpt_key == 2) key3_glob = 'ORTHD/THETA'
247 IF (cpt_key == 3) key3_glob = 'ORTHD/PHI'
248 ELSEIF (key3_read == 'MOM') THEN
249 nb_key = 7
250 IF (cpt_key == 1) key3_glob = 'MOMX'
251 IF (cpt_key == 2) key3_glob = 'MOMY'
252 IF (cpt_key == 3) key3_glob = 'MOMZ'
253 IF (cpt_key == 4) key3_glob = 'MOMXY'
254 IF (cpt_key == 5) key3_glob = 'MOMYZ'
255 IF (cpt_key == 6) key3_glob = 'MOMXZ'
256 IF (cpt_key == 7) key3_glob = '|MOM|'
257 ELSEIF (key3_read == 'VEL') THEN
258 nb_key = 7
259 IF (cpt_key == 1) key3_glob = 'VELX'
260 IF (cpt_key == 2) key3_glob = 'VELY'
261 IF (cpt_key == 3) key3_glob = 'VELZ'
262 IF (cpt_key == 4) key3_glob = 'VELXY'
263 IF (cpt_key == 5) key3_glob = 'VELYZ'
264 IF (cpt_key == 6) key3_glob = 'VELXZ'
265 IF (cpt_key == 7) key3_glob = '|VEL|'
266 ELSEIF (key3_read == 'FORC') THEN
267 nb_key = 9
268 IF (cpt_key == 1) key3_glob = 'F1'
269 IF (cpt_key == 2) key3_glob = 'F2'
270 IF (cpt_key == 3) key3_glob = 'F3'
271 IF (cpt_key == 4) key3_glob = 'M11'
272 IF (cpt_key == 5) key3_glob = 'M21'
273 IF (cpt_key == 6) key3_glob = 'M31'
274 IF (cpt_key == 7) key3_glob = 'M12'
275 IF (cpt_key == 8) key3_glob = 'M22'
276 IF (cpt_key == 9) key3_glob = 'M32'
277 ELSEIF (key3_read == 'MDS' .AND. is_mdsvar == 0 .AND.
278 . is_ipt ==0 .AND. is_layer == 0 .AND. is_ply == 0) THEN
279 nb_key = is_ply_all+is_layer_all+1
280 IF (cpt_key == 1) THEN
281 key3_glob = 'MDS'
282 is_mdsvar = 1
283 is_mdsvar_def = 1
284 IF(is_model_ply == 1 .OR. is_model_layer == 1 )is_layer_all = 1
285 ENDIF
286 ENDIF
287c-----------------------------------------------
288
289c-----------------------------------------------
290c IF (KEY3_READ == 'KEYWORD') THEN
291c NB_KEY = 3
292c IF (CPT_KEY == 1) KEY3_GLOB = 'KEYWORD1'
293c IF (CPT_KEY == 2) KEY3_GLOB = 'KEYWORD2'
294c IF (CPT_KEY == 3) KEY3_GLOB = 'KEYWORD3'
295c-----------------------------------------------
296c ELSEIF (KEY3_READ(1:6) == 'VFRAC_') THEN
297c I1 = 0
298c I2 = 0
299c IF (KEY3_READ(8:9) == '->') THEN
300c READ (KEY3_READ(7:7),FMT='(I)'),I1
301c READ (KEY3_READ(10:11),FMT='(I2)'),I2
302c ELSEIF (KEY3_READ(9:10) == '->') THEN
303c READ (KEY3_READ(7:8),FMT='(I2)'),I1
304c READ (KEY3_READ(11:12),FMT='(I2)'),I2
305c ENDIF
306c NB_KEY = I2 - I1 +1
307c DO J=1,NB_KEY
308c IF (J+I1-1 <= 9) WRITE(CH_OPTION,'(I1)')J+I1-1
309c IF (J+I1-1 > 9) WRITE(CH_OPTION,'(I2)')J+I1-1
310c IF (CPT_KEY == J) KEY3_GLOB = 'VFRAC'//CH_OPTION
311c ENDDO
312c-----------------------------------------------
313 ELSEIF (key2_read == 'SHELL') THEN
314c-----------------------------------------------
315 IF (key3_read == 'VFRAC') THEN
316c
317c create specific keywords for LAW151, number of present materials is not
318c known a priori
319c
320 IF (multi_fvm%IS_USED) THEN
321 nb_key = multi_fvm%NBMAT
322 DO ii = 1, nb_key
323 IF (cpt_key == ii) THEN
324 WRITE(key3_glob, '(A,I0)') 'M151VFRAC', ii
325 ENDIF
326 ENDDO
327 ELSE
328 nb_key = 4
329 IF (cpt_key == 1) key3_glob = 'VFRAC1'
330 IF (cpt_key == 2) key3_glob = 'VFRAC2'
331 IF (cpt_key == 3) key3_glob = 'VFRAC3'
332 IF (cpt_key == 4) key3_glob = 'VFRAC4'
333 ENDIF
334 ELSEIF (key3_read == 'MDS' .AND. is_mdsvar == 0 .AND.
335 . is_ipt ==0 .AND. is_layer == 0 .AND. is_ply == 0) THEN
336 nb_key = is_ply_all+is_layer_all+1
337 IF (cpt_key == 1) THEN
338 key3_glob = 'MDS'
339 is_mdsvar = 1
340 is_mdsvar_def = 1
341 IF(is_model_ply == 1 .OR. is_model_layer == 1 )is_layer_all = 1
342 ENDIF
343 ENDIF
344c-----------------------------------------------
345 ELSEIF (key3_read == 'PHASE_DENS') THEN
346c-----------------------------------------------
347 IF (multi_fvm%IS_USED) THEN
348 nb_key = multi_fvm%NBMAT
349 DO ii = 1, nb_key
350 IF (cpt_key == ii) THEN
351 WRITE(key3_glob, '(A,I0)') 'M151DENS', ii
352 ENDIF
353 ENDDO
354 ENDIF
355c-----------------------------------------------
356 ELSEIF (key3_read == 'PHASE_ENER') THEN
357c-----------------------------------------------
358 IF (multi_fvm%IS_USED) THEN
359 nb_key = multi_fvm%NBMAT
360 DO ii = 1, nb_key
361 IF (cpt_key == ii) THEN
362 WRITE(key3_glob, '(A,I0)') 'M151ENER', ii
363 ENDIF
364 ENDDO
365 ENDIF
366c-----------------------------------------------
367 ELSEIF (key3_read == 'PHASE_PRES') THEN
368c-----------------------------------------------
369 IF (multi_fvm%IS_USED) THEN
370 nb_key = multi_fvm%NBMAT
371 DO ii = 1, nb_key
372 IF (cpt_key == ii) THEN
373 WRITE(key3_glob, '(A,I0)') 'M151PRES', ii
374 ENDIF
375 ENDDO
376 ENDIF
377c-----------------------------------------------
378 ELSEIF (key2_read == 'BEAM' .OR. key2_read == 'SPRING' .OR. key2_read == 'TRUSS') THEN
379c-----------------------------------------------
380 IF (key3_read == 'FORC') THEN
381 nb_key = 9
382 IF (cpt_key == 1) key3_glob = 'F1'
383 IF (cpt_key == 2) key3_glob = 'F2'
384 IF (cpt_key == 3) key3_glob = 'F3'
385 IF (cpt_key == 4) key3_glob = 'M11'
386 IF (cpt_key == 5) key3_glob = 'M21'
387 IF (cpt_key == 6) key3_glob = 'M31'
388 IF (cpt_key == 7) key3_glob = 'M12'
389 IF (cpt_key == 8) key3_glob = 'M22'
390 IF (cpt_key == 9) key3_glob = 'M32'
391 ELSE
392 nb_key = 1
393 key3_glob = key3_read
394 ENDIF
395 ELSE
396 nb_key = 1
397 key3_glob = key3_read
398 ENDIF
399c-----------------------------------------------
400 cpt_key = cpt_key + 1
401c-----------------------------------------------
402 END
h3d_gene_keyword
subroutine h3d_gene_keyword(key2_read, key2, key3_read, key3_glob, nb_key, cpt_key, multi_fvm, is_model_npt, is_model_layer, is_model_ply, is_mdsvar, is_mdsvar_def, is_ply_all, is_layer_all, is_ipt, is_layer, is_ply, is_id)
Definition h3d_gene_keyword.F:37
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