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 I,J,NIPMAX,I1,I2,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 CHARACTER(LEN=2) :: CH_OPTION
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. is_mdsvar == 0 .AND.
109 . is_ipt ==0 .AND. is_layer == 0 .AND. 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 IF(is_model_ply == 1 .OR. 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..AND.' IS_MDSVAR == 0
278.AND..AND. . IS_IPT ==0 IS_LAYER == 0 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.OR. IF(IS_MODEL_PLY == 1 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..AND.' IS_MDSVAR == 0
335.AND..AND. . IS_IPT ==0 IS_LAYER == 0 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.OR. IF(IS_MODEL_PLY == 1 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: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