OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lech3d.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!|| lech3d ../engine/source/output/h3d/h3d_build_fortran/lech3d.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| create_h3d_1d_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_1d_scalar.F
31!|| create_h3d_1d_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_1d_tensor.F
32!|| create_h3d_1d_torsor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_1d_torsor.F
33!|| create_h3d_1d_vector ../engine/source/output/h3d/h3d_build_fortran/create_h3d_1d_vector.F
34!|| create_h3d_arg_keyword ../engine/source/output/h3d/h3d_build_fortran/create_h3d_arg_keyword.F
35!|| create_h3d_input ../engine/source/output/h3d/h3d_build_fortran/create_h3d_input.F
36!|| create_h3d_nodal_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_nodal_scalar.F
37!|| create_h3d_nodal_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_nodal_tensor.F
38!|| create_h3d_nodal_vector ../engine/source/output/h3d/h3d_build_fortran/create_h3d_nodal_vector.F
39!|| create_h3d_parts ../engine/source/output/h3d/h3d_build_fortran/create_h3d_parts.F
40!|| create_h3d_parts_all ../engine/source/output/h3d/h3d_build_fortran/create_h3d_parts_all.F
41!|| create_h3d_quad_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_quad_scalar.F
42!|| create_h3d_quad_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_quad_tensor.F
43!|| create_h3d_quad_vector ../engine/source/output/h3d/h3d_build_fortran/create_h3d_quad_vector.F
44!|| create_h3d_shell_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_shell_scalar.F
45!|| create_h3d_shell_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_shell_tensor.F
46!|| create_h3d_shell_vector ../engine/source/output/h3d/h3d_build_fortran/create_h3d_shell_vector.F
47!|| create_h3d_skin_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_skin_scalar.F
48!|| create_h3d_skin_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_skin_tensor.F
49!|| create_h3d_skin_vector ../engine/source/output/h3d/h3d_build_fortran/create_h3d_skin_vector.F
50!|| create_h3d_solid_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_solid_scalar.F
51!|| create_h3d_solid_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_solid_tensor.f
52!|| create_h3d_solid_vector ../engine/source/output/h3d/h3d_build_fortran/create_h3d_solid_vector.F
53!|| create_h3d_sph_scalar ../engine/source/output/h3d/h3d_build_fortran/create_h3d_sph_scalar.F
54!|| create_h3d_sph_tensor ../engine/source/output/h3d/h3d_build_fortran/create_h3d_sph_tensor.F
55!|| finter ../engine/source/tools/curve/finter.F
56!|| h3d_gene_keyword ../engine/source/output/h3d/input_list/h3d_gene_keyword.F
57!|| h3d_list_1d_scalar ../engine/source/output/h3d/input_list/h3d_list_1d_scalar.F
58!|| h3d_list_1d_tensor ../engine/source/output/h3d/input_list/h3d_list_1d_tensor.f
59!|| h3d_list_1d_torsor ../engine/source/output/h3d/input_list/h3d_list_1d_torsor.F
60!|| h3d_list_1d_vector ../engine/source/output/h3d/input_list/h3d_list_1d_vector.F
61!|| h3d_list_nodal_scalar ../engine/source/output/h3d/input_list/h3d_list_noda_scalar.F
62!|| h3d_list_nodal_tensor ../engine/source/output/h3d/input_list/h3d_list_noda_tensor.F
63!|| h3d_list_nodal_vector ../engine/source/output/h3d/input_list/h3d_list_noda_vector.F
64!|| h3d_list_quad_scalar ../engine/source/output/h3d/input_list/h3d_list_quad_scalar.F
65!|| h3d_list_quad_tensor ../engine/source/output/h3d/input_list/h3d_list_quad_tensor.F
66!|| h3d_list_quad_vector ../engine/source/output/h3d/input_list/h3d_list_quad_vector.F
67!|| h3d_list_shell_scalar ../engine/source/output/h3d/input_list/h3d_list_shell_scalar.F
68!|| h3d_list_shell_tensor ../engine/source/output/h3d/input_list/h3d_list_shell_tensor.F
69!|| h3d_list_shell_vector ../engine/source/output/h3d/input_list/h3d_list_shell_vector.F
70!|| h3d_list_solid_scalar ../engine/source/output/h3d/input_list/h3d_list_solid_scalar.F
71!|| h3d_list_solid_tensor ../engine/source/output/h3d/input_list/h3d_list_solid_tensor.F
72!|| h3d_list_solid_vector ../engine/source/output/h3d/input_list/h3d_list_solid_vector.f
73!|| h3d_list_sph_scalar ../engine/source/output/h3d/input_list/h3d_list_sph_scalar.F
74!|| h3d_list_sph_tensor ../engine/source/output/h3d/input_list/h3d_list_sph_tensor.F
75!|| h3d_skin_dim ../engine/source/output/h3d/h3d_results/h3d_skin_ixskin.F
76!|| initbuf ../engine/share/resol/initbuf.F
77!||--- uses -----------------------------------------------------
78!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
79!|| groupdef_mod ../common_source/modules/groupdef_mod.F
80!|| h3d_inc_mod ../engine/share/modules/h3d_inc_mod.F
81!|| h3d_mod ../engine/share/modules/h3d_mod.F
82!|| initbuf_mod ../engine/share/resol/initbuf.F
83!|| loads_mod ../common_source/modules/loads/loads_mod.F90
84!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.f90
85!|| message_mod ../engine/share/message_module/message_mod.f
86!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
87!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
88!|| output_mod ../common_source/modules/output/output_mod.F90
89!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
90!|| stack_mod ../engine/share/modules/stack_mod.F
91!|| tri7box ../engine/share/modules/tri7box.F
92!||====================================================================
93 SUBROUTINE lech3d(OUTPUT,GEO,IGEO,IPM,IPART,H3D_DATA,MULTI_FVM,IPARI,IPARG,TAG_SKINS6,
94 . MDS_LABEL,MDS_OUTPUT_TABLE,MDS_NMAT,MAX_DEPVAR,MDS_NDEPSVAR,
95 . ELBUF_STR,STACK,IBCL,ILOADP,LLOADP,LOADS,MAT_PARAM,PBLAST,
96 . IGRPART,NPC,TF,SNPC,STF)
97C-----------------------------------------------
98C M o d u l e s
99C-----------------------------------------------
100 USE initbuf_mod
101 USE message_mod
102 USE stack_mod
103 USE h3d_mod
104 USE multi_fvm_mod
105 USE elbufdef_mod
106 USE h3d_inc_mod
107 USE loads_mod
108 USE names_and_titles_mod, ONLY: ncharline100,ncharkey
109 USE matparam_def_mod
110 USE tri7box
111 USE pblast_mod
112 USE groupdef_mod
113 USE output_mod, only : output_
114C-----------------------------------------------
115C I m p l i c i t T y p e s
116C-----------------------------------------------
117#include "implicit_f.inc"
118C-----------------------------------------------
119C C o m m o n B l o c k s
120C-----------------------------------------------
121#include "com04_c.inc"
122#include "com08_c.inc"
123#include "param_c.inc"
124#include "scr17_c.inc"
125#include "task_c.inc"
126#include "com01_c.inc"
127#include "spmd_c.inc"
128#include "vect01_c.inc"
129
130C-----------------------------------------------
131C D u m m y A r g u m e n t s
132C-----------------------------------------------
133 type(output_), intent(inout) :: OUTPUT
134 my_real GEO(NPROPG,NUMGEO)
135 INTEGER IGEO(NPROPGI,NUMGEO),IPART(LIPART1,*),IPM(NPROPMI,NUMMAT),IPARI(NPARI,*),
136 . iparg(nparg,ngroup),tag_skins6(*),mds_output_table(max_depvar,mds_nmat),mds_nmat,
137 . max_depvar,mds_ndepsvar(*),ibcl(*),iloadp(*),lloadp(*)
138 TYPE (H3D_DATABASE) :: H3D_DATA
139 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
140 CHARACTER*64 MDS_LABEL(1024,MDS_NMAT)
141 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_STR
142 TYPE (STACK_PLY) :: STACK
143 TYPE (LOADS_), INTENT(IN) :: LOADS
144 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
145 TYPE (PBLAST_) :: PBLAST
146 TYPE(group_) ,DIMENSION(NGRPART) ,INTENT(IN) :: IGRPART
147 INTEGER ,INTENT(IN) :: SNPC,STF
148 INTEGER ,INTENT(IN) :: NPC(SNPC)
149 my_real ,INTENT(IN) :: tf(stf)
150C-----------------------------------------------
151C L o c a l V a r i a b l e s
152C-----------------------------------------------
153 INTEGER I, J, JMAX, K, L, M, O, P, Q, R, CPT, NIP_MAX, NLAY_MAX, NPLY_MAX, NUVAR_MAX, ID_INPUT, N1, N2,
154 .
155 . NB_INTEGER,N,IR_MAX,IS_MAX,IT_MAX,
156 . nb_all,is_char_key2,is_char_key3,is_char_key4,is_char_key5,is_char_key6,is_char_key7,is_char_key8,
157 . is_empty_key2,is_empty_key3,is_empty_key4,is_empty_key5,is_empty_key6,is_empty_key7,is_empty_key8,
158 . is_ply_key4,is_ply_key5,is_ply_key6,is_ply_key7,is_ply_key8,is_all,is_upper,is_lower,is_def,
159 . is_layer_key4,is_layer_key5,is_layer_key6,is_layer_key7,is_layer_key8,is_ipt_key4,is_ipt_key5,
160 . is_ipt_key6,is_ipt_key7,is_ipt_key8,
161 . is_gauss_key4,is_gauss_key5,is_gauss_key6,is_gauss_key7,is_gauss_key8,is_ply,is_layer,is_ipt,is_gauss,
162 . is_ply_all,is_layer_all,is_layer_lower,is_layer_upper,is_layer_memb,is_layer_bend,
163 . is_ipt_all,is_ipt_lower,is_ipt_upper,is_ipt_memb,is_ipt_bend,
164 . is_gauss_all,ply,layer,ipt,gauss,iok_h3dkey,iok_h3dkey_combination,cpt_h3d,iuvar,is_uvar,
165 . is_uvar_all,is_uvar_key4,is_uvar_key5,is_uvar_key6,is_uvar_key7,is_uvar_key8,
166 . id_ply(numgeo+numply),mat_ply(numgeo+numply),
167 . ipt_ply(numgeo+numply),is_scalar,is_vector,is_tensor,is_torsor,
168 . ir,is_ir,is_ir_all,is_ir_lower,is_ir_upper ,
169 . is,is_is,is_is_all,is_is_lower,is_is_upper ,
170 . it,is_it,is_it_all,is_it_lower,is_it_upper,
171 . nb_key,cpt_key,nbmax,is_inter,inter,ninter_max,is_inter_all,ninterskid,is_sking,
172 . ishell_npt_check,icstr,nptr,npts,nptt,is_corner_data,ish_npt0,
173 . is_mdsvar_def,nmdsvar_max,is_mdsvar,is_mdsvar_all,imdsvar,
174 . is_model_npt,is_model_ply,is_model_layer,iskind,iouter,ipext,
175 . is_id,id,id_max,is_id_all,n19,ifail,cpt_irup,
176 . is_mode,mode,mode_max,is_mode_all,nfail,nip_ply_max,nip_elem_max,
177 . ityp,id_def,nbc,dum,ndef,is_memb,ok,dtfct,jj
178 INTEGER MLW, NEL, NG, JTURB, NLAY, NUVAR, IMAT, ISUBSTACK, ID_PLY_TMP
179 INTEGER CPT_MOD,NMOD,CPT_LAWID,SIZE_INPUT
180 INTEGER IERROR ! Error value from Allocate
181
182 INTEGER LENR ! Size of Remote interface receive values
183
184 INTEGER IBID1,IBID2,IBID3,IBID4
185
186 CHARACTER(LEN=NCHARKEY)::KEY0
187 CHARACTER(LEN=NCHARKEY)::KEY2
188 CHARACTER(LEN=NCHARKEY)::KEY3
189 CHARACTER(LEN=NCHARKEY)::KEY4
190 CHARACTER(LEN=NCHARKEY)::KEY5
191 CHARACTER(LEN=NCHARKEY)::KEY6
192 CHARACTER(LEN=NCHARKEY)::KEY7
193 CHARACTER(LEN=NCHARKEY)::KEY8
194 CHARACTER(LEN=NCHARKEY)::KEY2_READ
195 CHARACTER(LEN=NCHARLINE100)::KEY3_READ
196 CHARACTER(LEN=NCHARLINE100)::KEY3_GLOB
197
198 CHARACTER*64 MDS_LABEL_TMP
199
200 INTEGER, DIMENSION(:), ALLOCATABLE ::
201 . layer_input,ipt_input,ply_input,uvar_input,gauss_input,
202 . ir_input,is_input,it_input,is_available_key,inter_input,
203 . mdsvar_input,mdsvar_input1,mdsvar_input_tmp,mdsvar_input1_tmp,
204 . mdsvar_input2,mdsvar_input2_tmp,id_mat_mds,index_mat_mds,ids_input,
205 . irup_id_all,modes_input,irup_h3d
206c
207 TYPE (H3D_KEYWORD) H3D_KEYWORD_SHELL, H3D_KEYWORD_SOLID, H3D_KEYWORD_QUAD, H3D_KEYWORD_ONED
208c
209 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_NODAL_SCALAR
210 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_NODAL_VECTOR
211 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_NODAL_TENSOR
212 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_ONED_SCALAR
213 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_ONED_VECTOR
214 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_ONED_TENSOR
215 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_ONED_TORSOR
216 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SHELL_SCALAR
217 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SHELL_VECTOR
218 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SHELL_TENSOR
219 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SOLID_SCALAR
220 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SOLID_VECTOR
221 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SOLID_TENSOR
222 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SPH_SCALAR
223 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_SPH_TENSOR
224 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_QUAD_SCALAR
225 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_QUAD_VECTOR
226 TYPE (H3D_KEYWORD), DIMENSION(:), ALLOCATABLE :: H3D_KEYWORD_QUAD_TENSOR
227
228 TYPE (H3D_NUMBER_OF_KEY) :: H3D_NUM_KEY
229
230
231
232 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IS_LAYER_MAT
233 LOGICAL :: FOUND
234 CHARACTER*64 TEST_CHAIN
235 CHARACTER(LEN=NCHARTITLE), DIMENSION(:), ALLOCATABLE :: FAIL_NAME
236 CHARACTER(LEN=NCHARTITLE), DIMENSION(:,:), ALLOCATABLE :: MODNAME
237 my_real dydx
238 my_real,EXTERNAL :: finter
239C=========================================================================
240 IF(h3d_data%NB_H3D_FRAME >0.AND.h3d_data%DTH3D_FCT_ID==0) THEN
241 IF(h3d_data%TH3D_STOP0 >zero.AND.h3d_data%TH3D_STOP0 /= ep20.AND.h3d_data%TH3D0 > zero) THEN
242 h3d_data%DTH3D0 = (h3d_data%TH3D_STOP0 - h3d_data%TH3D0) / h3d_data%NB_H3D_FRAME
243 ELSEIF(h3d_data%TH3D_STOP0 >zero.AND. h3d_data%TH3D_STOP0 /= ep20) THEN
244 h3d_data%DTH3D0 = (h3d_data%TH3D_STOP0-tt) / h3d_data%NB_H3D_FRAME
245 ELSEIF(h3d_data%TH3D0 >zero) THEN
246 h3d_data%DTH3D0 = (tstop-h3d_data%TH3D0) / h3d_data%NB_H3D_FRAME
247 ELSE
248 h3d_data%DTH3D0 = (tstop-tt) / h3d_data%NB_H3D_FRAME
249 ENDIF
250
251 IF (h3d_data%DTH3D0 <= zero) THEN
252 CALL ancmsg(msgid=293,anmode=aninfo,c1='H3D',c2='H3D')
253 CALL arret(0)
254 ENDIF
255 ENDIF
256
257 ok = 0
258 dtfct = 0
259 IF (h3d_data%DTH3D_FCT_ID > 0) THEN
260 DO jj=1,nfunct
261 IF(h3d_data%DTH3D_FCT_ID == npc(nfunct+2+jj-1)) THEN
262 dtfct=jj
263 ok = 1
264 EXIT
265 ENDIF
266 ENDDO
267 IF (ok == 0) THEN
268 CALL ancmsg(msgid=315,
269 . msgtype=msgerror,
270 . anmode=aninfo_blind_1,
271 . c1='H3D',
272 . i2=h3d_data%DTH3D_FCT_ID)
273 ENDIF
274 IF (ok >0) h3d_data%DTH3D_FCT_ID = dtfct
275
276 IF(h3d_data%DTH3D_FCT_ID > 0) THEN
277 h3d_data%DTH3D0 = finter(h3d_data%DTH3D_FCT_ID,zero,npc,tf,dydx)
278 ENDIF
279
280 IF (h3d_data%DTH3D0 <= zero) THEN
281 CALL ancmsg(msgid=293,anmode=aninfo,c1='H3D',c2='H3D')
282 CALL arret(0)
283 ENDIF
284 ENDIF
285
286 IF(h3d_data%TH3D0 /= zero) h3d_data%TH3D = h3d_data%TH3D0
287 IF(h3d_data%TH3D_STOP0/=zero .AND. h3d_data%TH3D_STOP0 /= ep20) h3d_data%TH3D_STOP = h3d_data%TH3D_STOP0
288 IF(h3d_data%DTH3D0 > zero) h3d_data%DTH3D= h3d_data%DTH3D0
289 IF(h3d_data%DTH3D <= zero) THEN
290 h3d_data%TH3D = ep30
291 h3d_data%TH3D_STOP = zero
292 ENDIF
293 IF (h3d_data%TH3D < tt-dt2 .AND. h3d_data%DTH3D > zero) h3d_data%TH3D = h3d_data%TH3D
294 . + int((tt-dt2-h3d_data%TH3D)/h3d_data%DTH3D)*h3d_data%DTH3D
295 IF (h3d_data%TH3D < tt-dt2)h3d_data%TH3D = h3d_data%TH3D+h3d_data%DTH3D
296 output%DATA%H3D_HAS_NODA_PEXT = 0
297C=========================================================================
298 ibid1 = 0
299 ibid2 = 0
300 ibid3 = 0
301 ibid4 = 0
302 cpt_lawid = 0
303 cpt_mod = 0
304 id_max = 0
305 ir_max = 0
306 is_max = 0
307 it_max = 0
308 mode_max = 0
309 nip_max = 0
310 nip_elem_max = 0
311 nply_max = 0
312 nmdsvar_max = 0
313 nuvar_max = 0
314 ALLOCATE(modname(1,1))
315 modname(1,1) = ' '
316 ish_npt0 = 0
317
318c
319 h3d_data%IPART_SELECT = 0
320 is_scalar = 0
321 is_vector = 0
322 is_tensor = 0
323 nb_integer = 0
324 nb_all = 0
325 is_sking = 0
326 nlay_max = 0
327 cpt_irup = 0
328
329 ALLOCATE(h3d_data%N_SKID_INTER(ninter))
330 h3d_data%N_SKID_INTER(1:ninter) = 0
331 ninterskid = 0
332
333 ALLOCATE(h3d_data%N_CSE_FRIC_INTER(ninter))
334 h3d_data%N_CSE_FRIC_INTER(1:ninter) = 0
335 output%DATA%NINEFRIC = 0
336 mds_label_tmp=' '
337C--------------------------------------------------
338C ALLOCATE / INIT KEYWORD LISTS
339C--------------------------------------------------
340 nbmax = 1000
341 ALLOCATE(h3d_keyword_nodal_scalar(nbmax))
342 h3d_keyword_nodal_scalar(1:nbmax)%KEY3=''
343 h3d_keyword_nodal_scalar(1:nbmax)%KEY4=''
344 h3d_keyword_nodal_scalar(1:nbmax)%KEY5=''
345 h3d_keyword_nodal_scalar(1:nbmax)%KEY6=''
346 h3d_keyword_nodal_scalar(1:nbmax)%COMMENT=''
347 ALLOCATE(h3d_keyword_nodal_vector(nbmax))
348 h3d_keyword_nodal_vector(1:nbmax)%KEY3=''
349 h3d_keyword_nodal_vector(1:nbmax)%KEY4=''
350 h3d_keyword_nodal_vector(1:nbmax)%KEY5=''
351 h3d_keyword_nodal_vector(1:nbmax)%KEY6=''
352 h3d_keyword_nodal_vector(1:nbmax)%COMMENT=''
353 ALLOCATE(h3d_keyword_nodal_tensor(nbmax))
354 h3d_keyword_nodal_tensor(1:nbmax)%KEY3=''
355 h3d_keyword_nodal_tensor(1:nbmax)%KEY4=''
356 h3d_keyword_nodal_tensor(1:nbmax)%KEY5=''
357 h3d_keyword_nodal_tensor(1:nbmax)%KEY6=''
358 h3d_keyword_nodal_tensor(1:nbmax)%COMMENT=''
359 ALLOCATE(h3d_keyword_oned_scalar(nbmax))
360 h3d_keyword_oned_scalar(1:nbmax)%KEY3=''
361 h3d_keyword_oned_scalar(1:nbmax)%KEY4=''
362 h3d_keyword_oned_scalar(1:nbmax)%KEY5=''
363 h3d_keyword_oned_scalar(1:nbmax)%KEY6=''
364 h3d_keyword_oned_scalar(1:nbmax)%COMMENT=''
365 ALLOCATE(h3d_keyword_oned_vector(nbmax))
366 h3d_keyword_oned_vector(1:nbmax)%KEY3=''
367 h3d_keyword_oned_vector(1:nbmax)%KEY4=''
368 h3d_keyword_oned_vector(1:nbmax)%KEY5=''
369 h3d_keyword_oned_vector(1:nbmax)%KEY6=''
370 h3d_keyword_oned_vector(1:nbmax)%COMMENT=''
371 ALLOCATE(h3d_keyword_oned_tensor(nbmax))
372 h3d_keyword_oned_tensor(1:nbmax)%KEY3=''
373 h3d_keyword_oned_tensor(1:nbmax)%KEY4=''
374 h3d_keyword_oned_tensor(1:nbmax)%KEY5=''
375 h3d_keyword_oned_tensor(1:nbmax)%KEY6=''
376 h3d_keyword_oned_tensor(1:nbmax)%COMMENT=''
377 ALLOCATE(h3d_keyword_oned_torsor(nbmax))
378 h3d_keyword_oned_torsor(1:nbmax)%KEY3=''
379 h3d_keyword_oned_torsor(1:nbmax)%KEY4=''
380 h3d_keyword_oned_torsor(1:nbmax)%KEY5=''
381 h3d_keyword_oned_torsor(1:nbmax)%KEY6=''
382 h3d_keyword_oned_torsor(1:nbmax)%COMMENT=''
383 ALLOCATE(h3d_keyword_shell_scalar(nbmax))
384 h3d_keyword_shell_scalar(1:nbmax)%KEY3=''
385 h3d_keyword_shell_scalar(1:nbmax)%KEY4=''
386 h3d_keyword_shell_scalar(1:nbmax)%KEY5=''
387 h3d_keyword_shell_scalar(1:nbmax)%KEY6=''
388 h3d_keyword_shell_scalar(1:nbmax)%COMMENT=''
389 ALLOCATE(h3d_keyword_shell_vector(nbmax))
390 h3d_keyword_shell_vector(1:nbmax)%KEY3=''
391 h3d_keyword_shell_vector(1:nbmax)%KEY4=''
392 h3d_keyword_shell_vector(1:nbmax)%KEY5=''
393 h3d_keyword_shell_vector(1:nbmax)%KEY6=''
394 h3d_keyword_shell_vector(1:nbmax)%COMMENT=''
395 ALLOCATE(h3d_keyword_shell_tensor(nbmax))
396 h3d_keyword_shell_tensor(1:nbmax)%KEY3=''
397 h3d_keyword_shell_tensor(1:nbmax)%KEY4=''
398 h3d_keyword_shell_tensor(1:nbmax)%KEY5=''
399 h3d_keyword_shell_tensor(1:nbmax)%KEY6=''
400 h3d_keyword_shell_tensor(1:nbmax)%COMMENT=''
401 ALLOCATE(h3d_keyword_solid_scalar(nbmax))
402 h3d_keyword_solid_scalar(1:nbmax)%KEY3=''
403 h3d_keyword_solid_scalar(1:nbmax)%KEY4=''
404 h3d_keyword_solid_scalar(1:nbmax)%KEY5=''
405 h3d_keyword_solid_scalar(1:nbmax)%KEY6=''
406 h3d_keyword_solid_scalar(1:nbmax)%COMMENT=''
407 ALLOCATE(h3d_keyword_solid_vector(nbmax))
408 h3d_keyword_solid_vector(1:nbmax)%KEY3=''
409 h3d_keyword_solid_vector(1:nbmax)%KEY4=''
410 h3d_keyword_solid_vector(1:nbmax)%KEY5=''
411 h3d_keyword_solid_vector(1:nbmax)%KEY6=''
412 h3d_keyword_solid_vector(1:nbmax)%COMMENT=''
413 ALLOCATE(h3d_keyword_solid_tensor(nbmax))
414 h3d_keyword_solid_tensor(1:nbmax)%KEY3=''
415 h3d_keyword_solid_tensor(1:nbmax)%KEY4=''
416 h3d_keyword_solid_tensor(1:nbmax)%KEY5=''
417 h3d_keyword_solid_tensor(1:nbmax)%KEY6=''
418 h3d_keyword_solid_tensor(1:nbmax)%COMMENT=''
419 ALLOCATE(h3d_keyword_sph_scalar(nbmax))
420 h3d_keyword_sph_scalar(1:nbmax)%KEY3=''
421 h3d_keyword_sph_scalar(1:nbmax)%KEY4=''
422 h3d_keyword_sph_scalar(1:nbmax)%KEY5=''
423 h3d_keyword_sph_scalar(1:nbmax)%KEY6=''
424 h3d_keyword_sph_scalar(1:nbmax)%COMMENT=''
425 ALLOCATE(h3d_keyword_sph_tensor(nbmax))
426 h3d_keyword_sph_tensor(1:nbmax)%KEY3=''
427 h3d_keyword_sph_tensor(1:nbmax)%KEY4=''
428 h3d_keyword_sph_tensor(1:nbmax)%KEY5=''
429 h3d_keyword_sph_tensor(1:nbmax)%KEY6=''
430 h3d_keyword_sph_tensor(1:nbmax)%COMMENT=''
431 ALLOCATE(h3d_keyword_quad_scalar(nbmax))
432 h3d_keyword_quad_scalar(1:nbmax)%KEY3=''
433 h3d_keyword_quad_scalar(1:nbmax)%KEY4=''
434 h3d_keyword_quad_scalar(1:nbmax)%KEY5=''
435 h3d_keyword_quad_scalar(1:nbmax)%KEY6=''
436 h3d_keyword_quad_scalar(1:nbmax)%COMMENT=''
437 ALLOCATE(h3d_keyword_quad_vector(nbmax))
438 h3d_keyword_quad_vector(1:nbmax)%KEY3=''
439 h3d_keyword_quad_vector(1:nbmax)%KEY4=''
440 h3d_keyword_quad_vector(1:nbmax)%KEY5=''
441 h3d_keyword_quad_vector(1:nbmax)%KEY6=''
442 h3d_keyword_quad_vector(1:nbmax)%COMMENT=''
443 ALLOCATE(h3d_keyword_quad_tensor(nbmax))
444 h3d_keyword_quad_tensor(1:nbmax)%KEY3=''
445 h3d_keyword_quad_tensor(1:nbmax)%KEY4=''
446 h3d_keyword_quad_tensor(1:nbmax)%KEY5=''
447 h3d_keyword_quad_tensor(1:nbmax)%KEY6=''
448 h3d_keyword_quad_tensor(1:nbmax)%COMMENT=''
449c
450 ALLOCATE(id_mat_mds(max(1,mds_nmat)))
451 id_mat_mds(1:max(1,mds_nmat)) = 0
452 ALLOCATE(index_mat_mds(max(1,mds_nmat)))
453 index_mat_mds(1:max(1,mds_nmat)) = 0
454C--------------------------------------------------
455C BUILD KEYWORD LISTS
456C--------------------------------------------------
457 CALL h3d_list_nodal_scalar(output,h3d_keyword_nodal_scalar, geo, h3d_num_key%NODAL_SCALAR)
458C
459 CALL h3d_list_nodal_vector(h3d_keyword_nodal_vector, geo, h3d_num_key%NODAL_VECTOR)
460C
461 CALL h3d_list_nodal_tensor(h3d_keyword_nodal_tensor, geo ,h3d_num_key%NODAL_TENSOR)
462C
463 CALL h3d_list_1d_scalar(h3d_keyword_oned_scalar, geo, h3d_num_key%ONED_SCALAR)
464C
465 CALL h3d_list_1d_vector(h3d_keyword_oned_vector, geo, h3d_num_key%ONED_VECTOR)
466C
467 CALL h3d_list_1d_tensor(h3d_keyword_oned_tensor, geo, h3d_num_key%ONED_TENSOR)
468C
469 CALL h3d_list_1d_torsor(h3d_keyword_oned_torsor, geo, h3d_num_key%ONED_TORSOR)
470C
471 CALL h3d_list_shell_scalar(h3d_keyword_shell_scalar, geo, igeo, multi_fvm, h3d_num_key%SHELL_SCALAR)
472C
473 CALL h3d_list_shell_vector(h3d_keyword_shell_vector, geo, igeo, h3d_num_key%SHELL_VECTOR)
474C
475 CALL h3d_list_shell_tensor(h3d_keyword_shell_tensor, geo, igeo, h3d_num_key%SHELL_TENSOR)
476C
477 CALL h3d_list_solid_scalar(h3d_keyword_solid_scalar, geo, igeo, multi_fvm, h3d_num_key%SOLID_SCALAR)
478C
479 CALL h3d_list_solid_vector(h3d_keyword_solid_vector, geo, igeo, h3d_num_key%SOLID_VECTOR)
480C
481 CALL h3d_list_solid_tensor(h3d_keyword_solid_tensor, geo, igeo, h3d_num_key%SOLID_TENSOR)
482C
483 CALL h3d_list_sph_scalar(h3d_keyword_sph_scalar, geo, igeo, h3d_num_key%SPH_SCALAR)
484C
485 CALL h3d_list_sph_tensor(h3d_keyword_sph_tensor, geo, igeo, h3d_num_key%SPH_TENSOR)
486C
487 CALL h3d_list_quad_scalar(h3d_keyword_quad_scalar, geo, igeo, multi_fvm, h3d_num_key%QUAD_SCALAR)
488C
489 CALL h3d_list_quad_tensor(h3d_keyword_quad_tensor, geo, igeo, h3d_num_key%QUAD_TENSOR)
490C
491 CALL h3d_list_quad_vector(h3d_keyword_quad_vector, geo, igeo, h3d_num_key%QUAD_VECTOR)
492C--------------------------------------------------
493C BUILD DEFAULT OUTPUTS FOR SPH
494C--------------------------------------------------
495 IF ((numsphg > 0).and.(h3d_data%DTH3D0 > zero)) THEN
496 ndef = 2
497C Check if /H3D/SPH/DIAMETER is already defined in input file
498 DO id_input=1,h3d_data%N_INPUT_H3D
499 key2 = h3d_data%INPUT_LIST(id_input)%KEY2
500 key3 = h3d_data%INPUT_LIST(id_input)%KEY3
501 IF ((key2=='ELEM').or.(key2=='SPH').AND.(key3=='DIAMETER')) ndef = 1
502 ENDDO
503 DO id_def=1,ndef
504 nbc = 0
505 key2 = 'SPH'
506 IF (id_def==1) THEN
507 key3 = 'NEIGHBOURS'
508 ELSEIF (id_def==2) THEN
509 key3 = 'DIAMETER'
510 ENDIF
511 key4 =''
512 key5 =''
513 key6 =''
514 key7 =''
515 key8 =''
516 CALL create_h3d_input(h3d_data,dum,dum,dum,nbc,key0,key2,key3,key4,key5,key6,key7,key8)
517 ENDDO
518 ENDIF
519C--------------------------------------------------
520C BUILD OUTPUTS
521C--------------------------------------------------
522 iouter=0
523 ipext=0
524 DO id_input=1,h3d_data%N_INPUT_H3D
525c
526 cpt_h3d = 0
527 iok_h3dkey = 0
528 iok_h3dkey_combination = 0
529 key3_glob = ''
530c
531 key2 = h3d_data%INPUT_LIST(id_input)%KEY2
532 key3 = h3d_data%INPUT_LIST(id_input)%KEY3
533 key4 = h3d_data%INPUT_LIST(id_input)%KEY4
534 key5 = h3d_data%INPUT_LIST(id_input)%KEY5
535 key6 = h3d_data%INPUT_LIST(id_input)%KEY6
536 key7 = h3d_data%INPUT_LIST(id_input)%KEY7
537 key8 = h3d_data%INPUT_LIST(id_input)%KEY8
538c
539 is_char_key2 = 1
540 is_empty_key2 = 1
541 is_char_key3 = 1
542 is_empty_key3 = 1
543 is_char_key4 = 1
544 is_empty_key4 = 1
545 is_char_key5 = 1
546 is_empty_key5 = 1
547 is_char_key6 = 1
548 is_empty_key6 = 1
549 is_char_key7 = 1
550 is_empty_key7 = 1
551 is_char_key8 = 1
552 is_empty_key8 = 1
553 ply = 0
554 is_ply = 0
555 is_ply_all = 0
556 is_ply_key4 = 0
557 is_ply_key5 = 0
558 is_ply_key6 = 0
559 is_ply_key7 = 0
560 is_ply_key8 = 0
561 layer = 0
562 is_layer = 0
563 is_layer_lower = 0
564 is_layer_upper = 0
565 is_layer_memb = 0
566 is_layer_bend = 0
567 is_layer_all = 0
568 is_layer_key4 = 0
569 is_layer_key5 = 0
570 is_layer_key6 = 0
571 is_layer_key7 = 0
572 is_layer_key8 = 0
573 ipt = 0
574 is_ipt = 0
575 is_ipt_lower = 0
576 is_ipt_upper = 0
577 is_ipt_memb = 0
578 is_ipt_bend = 0
579 is_ipt_all = 0
580 is_ipt_key4 = 0
581 is_ipt_key5 = 0
582 is_ipt_key6 = 0
583 is_ipt_key7 = 0
584 is_ipt_key8 = 0
585 gauss = 0
586 is_gauss = 0
587 is_gauss_all = 0
588 is_gauss_key4 = 0
589 is_gauss_key5 = 0
590 is_gauss_key6 = 0
591 is_gauss_key7 = 0
592 is_gauss_key8 = 0
593 iuvar = 0
594 is_uvar = 0
595 is_uvar_all = 0
596 is_uvar_key4 = 0
597 is_uvar_key5 = 0
598 is_uvar_key6 = 0
599 is_uvar_key7 = 0
600 is_uvar_key8 = 0
601 inter = 0
602 is_inter = 0
603 is_inter_all = 0
604 is_corner_data = 0
605 imdsvar = 0
606 is_mdsvar = 0
607 is_mdsvar_all = 0
608 is_mdsvar_def = 0
609 IF ( key3=='PEXT'.OR.key4=='PEXT') ipext=1
610 IF ( key4=='OUTER'.OR.key5=='OUTER') iouter=1
611C--------------------------------------------------
612C SEARCH '=' character
613C--------------------------------------------------
614 DO i=1,ncharkey
615 IF ( key3(i:i) == '=' ) is_char_key3 = 0
616 IF ( key3(i:i) /= ' ' ) is_empty_key3 = 0
617 IF ( key4(i:i) == '=' ) is_char_key4 = 0
618 IF ( key4(i:i) /= ' ' ) is_empty_key4 = 0
619 IF ( key5(i:i) == '=' ) is_char_key5 = 0
620 IF ( key5(i:i) /= ' ' ) is_empty_key5 = 0
621 IF ( key6(i:i) == '=' ) is_char_key6 = 0
622 IF ( key6(i:i) /= ' ' ) is_empty_key6 = 0
623 IF ( key7(i:i) == '=' ) is_char_key7 = 0
624 IF ( key7(i:i) /= ' ' ) is_empty_key7 = 0
625 IF ( key8(i:i) == '=' ) is_char_key8 = 0
626 IF ( key8(i:i) /= ' ' ) is_empty_key8 = 0
627 ENDDO
628C--------------------------------------------------
629C Read PLY= I/ALL
630C--------------------------------------------------
631 is_all = 1
632 is_lower = 0
633 is_upper = 0
634 is_def = 0
635 is_memb = 0
636 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
637 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
638 . 'PLY' ,3 ,is_ply ,ply ,
639 . is_ply_all ,ibid1 ,ibid2 ,is_def ,
640 . ibid3 ,is_memb ,ibid4 )
641C--------------------------------------------------
642C Read LAYER= I/ALL/LOWER/UPPER
643C--------------------------------------------------
644 is_all = 1
645 is_lower = 1
646 is_upper = 1
647 is_def = 0
648 is_memb = 0
649 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
650 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
651 . 'LAYER' ,5 ,is_layer ,layer ,
652 . is_layer_all,is_layer_lower,is_layer_upper ,is_def ,
653 . ibid1 ,is_memb ,ibid2 )
654C--------------------------------------------------
655C Read NPT= I/ALL/LOWER/UPPER/MEMB
656C--------------------------------------------------
657 is_all = 1
658 is_lower = 1
659 is_upper = 1
660 is_def = 0
661 is_memb = 1
662 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
663 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
664 . 'NPT' ,3 ,is_ipt ,ipt ,
665 . is_ipt_all ,is_ipt_lower,is_ipt_upper,is_def ,
666 . ibid1 ,is_memb ,is_ipt_memb)
667C--------------------------------------------------
668C Read UVAR= I/ALL/DEF
669C--------------------------------------------------
670 is_all = 1
671 is_lower = 0
672 is_upper = 0
673 is_def = 0
674 is_memb = 0
675 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
676 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
677 . 'UVAR' ,4 ,is_uvar ,iuvar ,
678 . is_uvar_all,ibid1 ,ibid2 ,is_def ,
679 . ibid3 ,is_memb ,ibid4 )
680C--------------------------------------------------
681C Read MDS_VAR= I/ALL/DEF
682C--------------------------------------------------
683 is_all = 1
684 is_lower = 0
685 is_upper = 0
686 is_def = 1
687 is_memb = 0
688 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
689 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
690 . 'MDS_VAR' ,7 ,is_mdsvar ,imdsvar ,
691 . is_mdsvar_all,ibid1 ,ibid2 ,is_def ,
692 . is_mdsvar_def,is_memb ,ibid3 )
693C--------------------------------------------------
694C Read IR= I/ALL/LOWER/UPPER
695C--------------------------------------------------
696 is_all = 1
697 is_lower = 1
698 is_upper = 1
699 is_def = 0
700 is_memb = 0
701 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
702 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
703 . 'IR' ,2 ,is_ir ,ir ,
704 . is_ir_all ,is_ir_lower ,is_ir_upper,is_def ,
705 . ibid1 ,is_memb ,ibid2 )
706C--------------------------------------------------
707C Read IS= I/ALL/LOWER/UPPER
708C--------------------------------------------------
709 is_all = 1
710 is_lower = 1
711 is_upper = 1
712 is_def = 0
713 is_memb = 0
714 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
715 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
716 . 'IS' ,2 ,is_is ,is ,
717 . is_is_all ,is_is_lower ,is_is_upper ,is_def ,
718 . ibid1 ,is_memb ,ibid2 )
719C--------------------------------------------------
720C Read IT= I/ALL/LOWER/UPPER
721C--------------------------------------------------
722 is_all = 1
723 is_lower = 1
724 is_upper = 1
725 is_def = 0
726 is_memb = 0
727 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
728 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
729 . 'IT' ,2 ,is_it ,it ,
730 . is_it_all ,is_it_lower ,is_it_upper ,is_def ,
731 . ibid1 ,is_memb ,ibid2 )
732C--------------------------------------------------
733C Read INTER= I/ALL
734C--------------------------------------------------
735 is_all = 1
736 is_lower = 0
737 is_upper = 0
738 is_def = 0
739 is_memb = 0
740 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
741 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
742 . 'INTER' ,5 ,is_inter ,inter ,
743 . is_inter_all,ibid1 ,ibid2 ,is_def ,
744 . ibid3 ,is_memb ,ibid4 )
745C--------------------------------------------------
746C Read ID= I/ALL
747C--------------------------------------------------
748 is_all = 1
749 is_lower = 0
750 is_upper = 0
751 is_def = 0
752 is_memb = 0
753 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
754 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
755 . 'ID' ,2 ,is_id ,id ,
756 . is_id_all ,ibid1 ,ibid2 ,is_def ,
757 . ibid3 ,is_memb ,ibid4 )
758C--------------------------------------------------
759C Read MODE= I/ALL
760C--------------------------------------------------
761 is_all = 1
762 is_lower = 0
763 is_upper = 0
764 is_def = 0
765 is_memb = 0
766 CALL create_h3d_arg_keyword(key2 ,key3 ,key4 ,key5 ,key6 ,
767 . key7 ,key8 ,is_all ,is_lower ,is_upper ,
768 . 'MODE' ,4 ,is_mode ,mode ,
769 . is_mode_all,ibid1 ,ibid2 ,is_def ,
770 . ibid3 ,is_memb ,ibid4 )
771C--------------------------------------------------
772 cpt = 0
773 IF ( is_char_key3 == 1 .AND. is_empty_key3 == 0) THEN
774 DO i=1,ncharkey
775 IF ( key3(i:i) /= ' ' ) THEN
776 cpt = cpt + 1
777 key3_glob(cpt:cpt) = key3(i:i)
778 ENDIF
779 ENDDO
780 ENDIF
781 IF ( is_char_key4 == 1 .AND. is_empty_key4 == 0 ) THEN
782 cpt = cpt + 1
783 key3_glob(cpt:cpt) = '/'
784 DO i=1,ncharkey
785 IF ( key4(i:i) /= ' ' ) THEN
786 cpt = cpt + 1
787 key3_glob(cpt:cpt) = key4(i:i)
788 ENDIF
789 ENDDO
790 ENDIF
791 IF ( is_char_key5 == 1 .AND. is_empty_key5 == 0 ) THEN
792 cpt = cpt + 1
793 key3_glob(cpt:cpt) = '/'
794 DO i=1,ncharkey
795 IF ( key5(i:i) /= ' ' ) THEN
796 cpt = cpt + 1
797 key3_glob(cpt:cpt) = key5(i:i)
798 ENDIF
799 ENDDO
800 ENDIF
801 IF ( is_char_key6 == 1 .AND. is_empty_key6 == 0 ) THEN
802 cpt = cpt + 1
803 key3_glob(cpt:cpt) = '/'
804 DO i=1,ncharkey
805 IF ( key6(i:i) /= ' ' ) THEN
806 cpt = cpt + 1
807 key3_glob(cpt:cpt) = key6(i:i)
808 ENDIF
809 ENDDO
810 ENDIF
811 IF ( is_char_key7 == 1 .AND. is_empty_key7 == 0 ) THEN
812 cpt = cpt + 1
813 key3_glob(cpt:cpt) = '/'
814 DO i=1,ncharkey
815 IF ( key7(i:i) /= ' ' ) THEN
816 cpt = cpt + 1
817 key3_glob(cpt:cpt) = key7(i:i)
818 ENDIF
819 ENDDO
820 ENDIF
821 IF ( is_char_key8 == 1 .AND. is_empty_key8 == 0 ) THEN
822 cpt = cpt + 1
823 key3_glob(cpt:cpt) = '/'
824 DO i=1,ncharkey
825 IF ( key8(i:i) /= ' ' ) THEN
826 cpt = cpt + 1
827 key3_glob(cpt:cpt) = key8(i:i)
828 ENDIF
829 ENDDO
830 ENDIF
831c
832 is_model_npt = 0
833 is_model_layer = 0
834 is_model_ply = 0
835 DO k=1,numgeo
836 IF(igeo(11,k) == 9 .OR. igeo(11,k) == 11 .OR. igeo(11,k) == 16)
837 . is_model_npt = 1
838 IF(igeo(11,k) == 10 .OR. igeo(11,k) == 11 .OR. igeo(11,k) == 16)
839 . is_model_layer = 1
840 IF(igeo(11,k) == 17 .OR. igeo(11,k) == 51 .OR. igeo(11,k) == 52)
841 . is_model_ply = 1
842 ENDDO
843C
844 cpt = 0
845 DO k=1,nummat
846 IF (ipm(2,k) == 200) THEN
847 cpt = cpt + 1
848 id_mat_mds(cpt) = ipm(1,k)
849 index_mat_mds(cpt) = k
850 ENDIF
851 ENDDO
852C--------------------------------------------------
853c KEYWORD MANAGEMENT
854C--------------------------------------------------
855 nb_key = 1
856 cpt_key = 1
857 key3_read = key3_glob
858 key2_read = key2
859 ishell_npt_check = 0
860 DO WHILE (cpt_key <= nb_key)
861 CALL h3d_gene_keyword(key2_read,key2,key3_read,key3_glob,nb_key,cpt_key,multi_fvm,
862 . is_model_npt,is_model_layer,is_model_ply,is_mdsvar,is_mdsvar_def,
863 . is_ply_all,is_layer_all,is_ipt,is_layer,is_ply,is_id)
864 ishell_npt_check = 0
865C--------------------------------------------------
866 IF(key2 == 'PART') THEN
867C--------------------------------------------------
868 CALL create_h3d_parts(h3d_data,id_input,ipart,igrpart)
869 h3d_data%IPART_SELECT = 1
870 iok_h3dkey_combination = 1
871 iok_h3dkey = 1
872 ENDIF
873C--------------------------------------------------
874 IF(key2 == 'NODA') THEN
875c Input for each interface
876 ninter_max = 0
877 IF (is_inter_all == 1) ninter_max = ninter
878 ALLOCATE (inter_input(max(1,ninter_max)))
879 ALLOCATE (is_available_key(max(1,ninter_max)))
880C--------------------------------------------------
881 jmax=max(h3d_num_key%NODAL_SCALAR, h3d_num_key%NODAL_VECTOR, h3d_num_key%NODAL_TENSOR)
882 DO j=1,jmax
883c Input for each interface
884 cpt_h3d = 0
885 is_scalar = 0
886 is_vector = 0
887 is_tensor = 0
888 IF ( key3_glob == h3d_keyword_nodal_scalar(j)%KEY3) is_scalar = 1
889 IF ( key3_glob == h3d_keyword_nodal_vector(j)%KEY3) is_vector = 1
890 IF ( key3_glob == h3d_keyword_nodal_tensor(j)%KEY3) is_tensor = 1
891 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1) iok_h3dkey = 1
892C--------------------------
893 IF ( is_scalar == 1 ) THEN
894 IF(h3d_keyword_nodal_scalar(j)%IS_INTER /= 0 ) THEN
895 IF(is_inter_all == 0 )THEN
896 cpt_h3d = cpt_h3d + 1
897 inter_input(cpt_h3d) = 0
898 is_available_key(cpt_h3d) = 1
899 IF(h3d_keyword_nodal_scalar(j)%IS_INTER == 1) THEN
900 IF(inter /= 0) THEN
901 DO k=1,ninter
902 IF(ipari(15,k) == inter) THEN
903c H3D_DATA%OUTPUT_LIST(I)%INTER = K
904 inter_input(cpt_h3d) = k
905 IF(key3_glob(1:4) == 'SKID' ) THEN
906 ninterskid = ninterskid +1
907 h3d_data%N_SCAL_SKID = ninterskid
908 h3d_data%N_SKID_INTER(k) = ninterskid
909 ELSEIF(key3_glob(1:8) == 'CSE_FRIC' ) THEN
910 IF(output%DATA%NINEFRIC == 0) output%DATA%NINEFRIC = output%DATA%NINEFRIC +1
911 h3d_data%N_SCAL_CSE_FRICINT = output%DATA%NINEFRIC
912 h3d_data%N_CSE_FRIC_INTER(k) = output%DATA%NINEFRIC
913 ENDIF
914 ENDIF
915 ENDDO
916 ELSE
917 h3d_data%N_SCAL_CSE_FRIC = 1
918 ENDIF
919 ENDIF
920 ELSE
921 IF(ninter_max /= 0)THEN
922 output%DATA%NINEFRIC = 0
923 DO k=1,ninter_max
924 IF(key3_glob(1:4) == 'SKID' ) THEN
925 cpt_h3d = cpt_h3d + 1
926c
927 inter_input(cpt_h3d) = k
928 is_available_key(cpt_h3d) = 1
929 h3d_data%N_SKID_INTER(k) = k
930 ELSEIF(key3_glob(1:8) == 'CSE_FRIC' ) THEN
931 n19 = ipari(71,k)
932 IF(n19 <= 0) THEN
933 IF(h3d_data%N_CSE_FRIC_INTER(k) ==0) THEN
934 output%DATA%NINEFRIC = output%DATA%NINEFRIC +1
935 cpt_h3d = cpt_h3d + 1
936c
937 inter_input(cpt_h3d) = k
938 is_available_key(cpt_h3d) = 1
939 h3d_data%N_CSE_FRIC_INTER(k) = k
940 ENDIF
941 ELSEIF(n19 > 0 ) THEN
942 IF(h3d_data%N_CSE_FRIC_INTER(n19) ==0) THEN
943 output%DATA%NINEFRIC = output%DATA%NINEFRIC +1
944 cpt_h3d = cpt_h3d + 1
945c
946 inter_input(cpt_h3d) = n19
947 is_available_key(cpt_h3d) = 1
948 h3d_data%N_CSE_FRIC_INTER(k) = n19
949 ELSE
950 h3d_data%N_CSE_FRIC_INTER(k) = n19
951 ENDIF
952 ENDIF
953 ENDIF
954 ENDDO
955 IF(key3_glob(1:4) == 'SKID' ) h3d_data%N_SCAL_SKID = ninter
956 IF(key3_glob(1:8) == 'CSE_FRIC' ) h3d_data%N_SCAL_CSE_FRICINT = output%DATA%NINEFRIC
957 ENDIF
958 ENDIF
959 ELSE
960 cpt_h3d = cpt_h3d + 1
961 inter_input(cpt_h3d) = 0
962
963 is_available_key(cpt_h3d) = 1
964 ENDIF
965 IF(key3_glob(1:4) == 'PEXT')THEN
966 output%DATA%H3D_HAS_NODA_PEXT = 1
967 ENDIF
968 ENDIF
969 IF ( is_scalar == 1 ) THEN
970 DO k=1,cpt_h3d
971 IF (is_available_key(k) == 1 .AND. is_scalar == 1) THEN
972 CALL create_h3d_nodal_scalar(h3d_data,h3d_keyword_nodal_scalar(j)%ID,id_input,
973 . trim(h3d_keyword_nodal_scalar(j)%TEXT1),len_trim(h3d_keyword_nodal_scalar(j)%TEXT1),
974 . h3d_keyword_nodal_scalar(j)%COMMENT,80,ipart,key3_glob,
975 . inter_input(k),igrpart)
976 iok_h3dkey_combination = 1
977 ENDIF
978 ENDDO
979 ELSE
980 IF ( key3_glob == h3d_keyword_nodal_vector(j)%KEY3 ) THEN
981 CALL create_h3d_nodal_vector(h3d_data,h3d_keyword_nodal_vector(j)%ID,id_input,
982 . trim(h3d_keyword_nodal_vector(j)%TEXT1),
983 . len_trim(h3d_keyword_nodal_vector(j)%TEXT1),
984 . h3d_keyword_nodal_vector(j)%COMMENT,80,ipart,key3_glob,
985 . igrpart)
986 iok_h3dkey_combination = 1
987 ENDIF
988 IF ( key3_glob == h3d_keyword_nodal_tensor(j)%KEY3 ) THEN
989 CALL create_h3d_nodal_tensor(h3d_data,h3d_keyword_nodal_tensor(j)%ID,id_input,
990 . trim(h3d_keyword_nodal_tensor(j)%TEXT1),
991 . len_trim(h3d_keyword_nodal_tensor(j)%TEXT1),
992 . h3d_keyword_nodal_tensor(j)%COMMENT,80,ipart,key3_glob,
993 . igrpart)
994 iok_h3dkey_combination = 1
995 ENDIF
996 ENDIF
997C-----------------------------
998 ENDDO
999
1000 DEALLOCATE (inter_input)
1001 DEALLOCATE (is_available_key)
1002 ENDIF
1003C--------------------------------------------------
1004c IF(KEY2 == 'VECT') THEN
1005C--------------------------------------------------
1006c DO J=1,100
1007c IF ( KEY3_GLOB == H3D_KEYWORD_NODAL_VECTOR(J)%KEY3 ) THEN
1008c CALL CREATE_H3D_NODAL_VECTOR(H3D_DATA,H3D_KEYWORD_NODAL_VECTOR(J)%ID,ID_INPUT,
1009c . H3D_KEYWORD_NODAL_VECTOR(J)%TEXT1,50,IPART,KEY3_GLOB)
1010c IOK_H3DKEY_COMBINATION = 1
1011c ENDIF
1012c ENDDO
1013c ENDIF
1014C--------------------------------------------------
1015 IF(key2 == 'SHELL' .OR. key2 =='ELEM'.OR. key2 =='SOLID' .OR.
1016 . key2 == 'BRICK' .OR. key2 =='QUAD'.OR. key2 =='BEAM ' .OR.
1017 . key2 == 'SPRING'.OR. key2 =='TRUSS'.OR. key2 =='SPH') THEN
1018C--------------------------------------------------
1019 nlay_max = 0
1020 nip_max = 0
1021 nply_max = 0
1022 nuvar_max = 0
1023 nmdsvar_max = 0
1024 mode_max = 0
1025 nip_ply_max = 0
1026 nip_elem_max = 0
1027C
1028 ! LAYER=ALL
1029 IF (is_layer_all == 1) THEN
1030 DO k=1,numgeo
1031 IF(igeo(11,k) == 10 .OR. igeo(11,k) == 11 .OR. igeo(11,k) == 16) THEN
1032 nlay_max = max(nlay_max,igeo(4,k))
1033 ELSEIF(igeo(11,k) == 20 .OR. igeo(11,k) == 21 .OR. igeo(11,k) == 22) THEN
1034 nlay_max = max(nlay_max,max(1,igeo(30,k)))
1035 ENDIF
1036 ENDDO
1037 ENDIF
1038C
1039 ! NPT=ALL
1040 ish_npt0 = 0
1041 DO k=1,numgeo
1042 IF(igeo(11,k) == 1 .OR. igeo(11,k) == 9) THEN
1043 nip_elem_max = max(nip_elem_max,igeo(4,k))
1044 IF (igeo(4,k)==0) THEN
1045 ish_npt0=1
1046 nip_elem_max = nip_elem_max + 1
1047 ENDIF
1048 ELSEIF(igeo(11,k) == 18)THEN
1049 nip_elem_max = max(nip_elem_max,igeo(3,k))
1050 ENDIF
1051 ENDDO
1052 IF(is_ipt_all == 1 .AND. nip_elem_max == 0) ishell_npt_check = 1
1053C
1054 ! PLY=ALL
1055 id_ply(1:numgeo+numply) = 0
1056 ipt_ply(1:numgeo+numply) = 0
1057 mat_ply(1:numgeo+numply) = 0
1058 IF (is_ply_all == 1) THEN
1059 DO k=1,numgeo
1060 IF(igeo(11,k) == 19) THEN
1061 nply_max = nply_max + 1
1062 id_ply(nply_max) = igeo(1,k)
1063 ipt_ply(nply_max) = igeo(4,k)
1064 mat_ply(nply_max) = igeo(101,k)
1065 nip_ply_max = max(nip_ply_max,igeo(44,k))
1066 ENDIF
1067 ENDDO
1068 DO k=1,numply
1069 nply_max = nply_max + 1
1070 id_ply(nply_max) = ply_info(1,k)
1071 ipt_ply(nply_max) = ply_info(2,k)
1072 mat_ply(nply_max) = ply_info(3,k)
1073 nip_ply_max = max(nip_ply_max,ply_info(2,k))
1074 ENDDO
1075 !< Convert internal mat_id to user mat_id
1076 DO k=1,nply_max
1077 DO imat=1,nummat
1078 IF (mat_ply(k) == imat) THEN
1079 mat_ply(k) = mat_param(imat)%MAT_ID
1080 EXIT
1081 ENDIF
1082 ENDDO
1083 ENDDO
1084 ENDIF
1085 nip_max = max(nip_elem_max,nip_ply_max)
1086C
1087 IF (is_uvar_all == 1) THEN
1088 DO k=1,nummat
1089 nuvar_max = max(nuvar_max,ipm(8,k))
1090 ENDDO
1091 ENDIF
1092 IF (is_mdsvar_all == 1) THEN
1093 IF(key3_glob(1:3) == 'MDS' ) THEN
1094 DO k=1,mds_nmat
1095 nmdsvar_max = nmdsvar_max + mds_ndepsvar(k)
1096 ENDDO
1097 ENDIF
1098 ENDIF
1099
1100 IF (is_mdsvar_def == 1) THEN
1101 IF(key3_glob(1:3) == 'MDS' ) THEN
1102 DO k=1,mds_nmat
1103 DO l=1,mds_ndepsvar(k)
1104 nmdsvar_max = nmdsvar_max+mds_output_table(l,k)
1105 ENDDO
1106 ENDDO
1107 ENDIF
1108 ENDIF
1109
1110 ir_max = 0
1111 IF (is_ir_all == 1) THEN
1112 DO k=1,numgeo
1113 IF(igeo(11,k) == 6 .OR. igeo(11,k) == 14 .OR. igeo(11,k) == 20 .OR.
1114 . igeo(11,k) == 21 .OR. igeo(11,k) == 22) THEN
1115 IF(igeo(4,k) == 1 .OR. igeo(10,k)==15) THEN
1116 ir_max = 1
1117 ELSEIF(igeo(4,k) == 8) THEN
1118 ir_max = 2
1119 ELSE
1120 nptr=max(2,igeo(4,k)/100)
1121 ir_max = max(ir_max,nptr)
1122 ENDIF
1123 IF(n2d/=0) THEN
1124 IF(igeo(4,k) == 4) THEN
1125 ir_max = 2
1126 ELSE
1127 ir_max = 1
1128 ENDIF
1129 ENDIF
1130 ELSEIF(igeo(11,k) == 43)THEN
1131 ir_max = max(ir_max,4)
1132 ENDIF
1133 ENDDO
1134 ENDIF
1135
1136 is_max = 0
1137 IF (is_is_all == 1) THEN
1138 DO k=1,numgeo
1139 IF(igeo(11,k) == 6 .OR. igeo(11,k) == 14 .OR. igeo(11,k) == 20 .OR.
1140 . igeo(11,k) == 21 .OR. igeo(11,k) == 22) THEN
1141C------------- thick-shell Isolid=15
1142 IF(igeo(10,k)==15) THEN
1143 is_max = max(is_max,igeo(4,k))
1144 ELSEIF(igeo(4,k) == 1) THEN
1145 is_max = 1
1146 ELSEIF(igeo(4,k) == 8) THEN
1147 is_max = 2
1148 ELSE
1149 npts=max(2,mod(igeo(4,k)/10,10))
1150 is_max = max(is_max,npts)
1151 ENDIF
1152 IF(n2d/=0) THEN
1153 IF(igeo(4,k) == 4) THEN
1154 is_max = 2
1155 ELSE
1156 is_max = 1
1157 ENDIF
1158 ENDIF
1159 ELSEIF(igeo(11,k) == 43)THEN
1160 is_max = max(is_max,1)
1161 ENDIF
1162 ENDDO
1163 ENDIF
1164
1165 it_max = 0
1166 IF (is_it_all == 1) THEN
1167 DO k=1,numgeo
1168 IF(igeo(11,k) == 6 .OR. igeo(11,k) == 14 .OR. igeo(11,k) == 20 .OR.
1169 . igeo(11,k) == 21 .OR. igeo(11,k) == 22) THEN
1170 IF(igeo(4,k) == 1 .OR. igeo(10,k)==15) THEN
1171 it_max = 1
1172 ELSEIF(igeo(4,k) == 8) THEN
1173 it_max = 2
1174 ELSE
1175 nptt=max(2,mod(igeo(4,k),10))
1176 it_max = max(it_max,nptt)
1177 ENDIF
1178 ELSEIF(igeo(11,k) == 43)THEN
1179 it_max = max(it_max,1)
1180 ENDIF
1181 IF(n2d/=0) THEN
1182 it_max = 1
1183 ENDIF
1184 ENDDO
1185 ENDIF
1186C----special case for thick-shell Isolid=14 :
1187 IF ((is_ir_all + is_is_all+is_it_all)>0) THEN
1188 DO k=1,numgeo
1189 IF(igeo(10,k)==14.AND. (igeo(11,k) == 20 .OR.
1190 . igeo(11,k) == 21 .OR. igeo(11,k) == 22)) THEN
1191 icstr= igeo(14,k)
1192 npt = igeo(4,k)
1193 nptr=npt/100
1194 npts=mod(npt/10,10)
1195 nptt=mod(npt,10)
1196 SELECT CASE (icstr)
1197 CASE(100)
1198 IF (nptt==0) nptt= igeo(15,k)
1199 CASE(10)
1200 IF (npts==0) npts= igeo(15,k)
1201 CASE(1)
1202 IF (nptr==0) nptr= igeo(15,k)
1203 END SELECT
1204 IF (is_ir_all == 1) ir_max = max(ir_max,nptr)
1205 IF (is_is_all == 1) is_max = max(is_max,npts)
1206 IF (is_it_all == 1) it_max = max(it_max,nptt)
1207 ENDIF
1208 ENDDO
1209 END IF ! IF ((IS_IR_ALL + IS_IS_ALL+IS_IT_ALL)>0)
1210
1211!----special case for tet10 :
1212 IF (numels10g>0) THEN
1213 IF (is_ir_all == 1) ir_max = max(ir_max,2)
1214 IF (is_is_all == 1) is_max = max(is_max,2)
1215 IF (is_it_all == 1) it_max = max(it_max,2)
1216 END IF
1217c
1218 id_max = 0
1219 IF (is_id_all == 1) THEN
1220 DO k=1,nummat
1221 IF (ipm(2,k) == 36) THEN
1222 id_max = 1
1223 ELSEIF (ipm(2,k) == 78) THEN
1224 id_max = 3
1225 ELSEIF (ipm(2,k) == 87) THEN
1226 id_max = 4
1227 ENDIF
1228 ENDDO
1229 ENDIF
1230c
1231 cpt_mod = 0
1232 cpt_lawid = 0
1233 cpt_irup = 0
1234c
1235 !=====================================================================================
1236 ! /H3D/ELEM/FAILURE definition
1237 !=====================================================================================
1238 IF (key3_glob(1:7) == 'FAILURE') THEN
1239c
1240 ! Initialization of Mode flag for title
1241 cpt_mod = 0
1242c
1243 ! If MODE output is specified by user
1244 IF ((is_mode > 0).OR.(is_mode_all > 0)) THEN
1245c
1246 ! All failure IDs are asked by user
1247 IF (is_id_all > 0) THEN
1248c
1249 ! First count of the failure models with IDs and number of modes
1250 IF (ALLOCATED(modname)) DEALLOCATE(modname)
1251 IF (ALLOCATED(fail_name)) DEALLOCATE(fail_name)
1252 IF (ALLOCATED(irup_id_all)) DEALLOCATE(irup_id_all)
1253 cpt_irup = 0
1254 DO imat = 1,nummat
1255 nfail = mat_param(imat)%NFAIL
1256 IF (nfail > 0) THEN
1257 DO j = 1,nfail
1258 nmod = mat_param(imat)%FAIL(j)%NMOD
1259 IF (mat_param(imat)%FAIL(j)%FAIL_ID > 0 .AND. nmod > 0) THEN
1260 cpt_irup = cpt_irup + 1
1261 cpt_mod = max(cpt_mod,nmod)
1262 ENDIF
1263 ENDDO
1264 ENDIF
1265 ENDDO
1266c
1267 ! Second count to save IDs and failure model names
1268 ALLOCATE(fail_name(cpt_irup))
1269 ALLOCATE(irup_id_all(cpt_irup))
1270 ALLOCATE(modname(cpt_irup,cpt_mod))
1271 irup_id_all(1:cpt_irup) = 0
1272 cpt_irup = 0
1273 cpt_mod = 0
1274 DO imat = 1,nummat
1275 nfail = mat_param(imat)%NFAIL
1276 IF (nfail > 0) THEN
1277 DO j = 1,nfail
1278 nmod = mat_param(imat)%FAIL(j)%NMOD
1279 IF (mat_param(imat)%FAIL(j)%FAIL_ID > 0) THEN
1280 cpt_irup = cpt_irup + 1
1281 IF (nmod > 0) THEN
1282 fail_name(cpt_irup) = mat_param(imat)%FAIL(j)%KEYWORD
1283 irup_id_all(cpt_irup) = mat_param(imat)%FAIL(j)%FAIL_ID
1284 modname(cpt_irup,1:nmod) = mat_param(imat)%FAIL(j)%MODE(1:nmod)
1285 IF (is_mode_all > 0) THEN
1286 cpt_mod = max(cpt_mod,nmod)
1287 ELSEIF (is_mode > 0) THEN
1288 cpt_mod = 1
1289 ENDIF
1290 ENDIF
1291 ENDIF
1292 ENDDO
1293 ENDIF
1294 ENDDO
1295c
1296 ! Maximal number of IDs
1297 id_max = cpt_irup
1298c
1299 !< If no failure model is found with ID, print error message
1300 IF (cpt_irup == 0) THEN
1301 IF (ispmd == 0) THEN
1302 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1303 . trim(key3),"/",trim(key4),"/",
1304 . trim(key5),"/",trim(key6)
1305 CALL ancmsg(msgid=311,
1306 . anmode=aninfo,
1307 . c1=test_chain)
1308 CALL arret(2)
1309 ENDIF
1310 ENDIF
1311c
1312 ! Maximal number of Modes
1313 mode_max = cpt_mod
1314c
1315 !< If no different modes for the failure model, print error message
1316 IF (cpt_mod == 0) THEN
1317 IF (ispmd == 0) THEN
1318 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1319 . trim(key3),"/",trim(key4),"/",
1320 . trim(key5),"/",trim(key6)
1321 CALL ancmsg(msgid=312,
1322 . anmode=aninfo,
1323 . c1=test_chain,
1324 . c2=fail_name(1))
1325 CALL arret(2)
1326 ENDIF
1327 ENDIF
1328c
1329 ! Only a specific failure ID is asked by the user
1330 ELSEIF (is_id > 0) THEN
1331 ! Recover the number of modes and their names
1332 IF (ALLOCATED(modname)) DEALLOCATE(modname)
1333 IF (ALLOCATED(fail_name)) DEALLOCATE(fail_name)
1334 DO imat = 1,nummat
1335 nfail = mat_param(imat)%NFAIL
1336 IF (nfail > 0) THEN
1337 DO j = 1,nfail
1338 IF (mat_param(imat)%FAIL(j)%FAIL_ID == id) THEN
1339 nmod = mat_param(imat)%FAIL(j)%NMOD
1340 IF (nmod > 0) THEN
1341 ALLOCATE(modname(1,nmod))
1342 modname(1,1:nmod) = mat_param(imat)%FAIL(j)%MODE(1:nmod)
1343 IF (is_mode_all > 0) THEN
1344 mode_max = nmod
1345 ELSEIF (is_mode > 0) THEN
1346 mode_max = 1
1347 ENDIF
1348 cpt_mod = 1
1349 ENDIF
1350 ALLOCATE(fail_name(1))
1351 fail_name(1) = mat_param(imat)%FAIL(j)%KEYWORD
1352 cpt_irup = 1
1353 ENDIF
1354 ENDDO
1355 ENDIF
1356 ENDDO
1357c
1358 !< If no failure model is found with ID, print error message
1359 IF (cpt_irup == 0) THEN
1360 IF (ispmd == 0) THEN
1361 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1362 . trim(key3),"/",trim(key4),"/",
1363 . trim(key5),"/",trim(key6)
1364 CALL ancmsg(msgid=309,
1365 . anmode=aninfo,
1366 . c1=test_chain,
1367 . i1=id)
1368 CALL arret(2)
1369 ENDIF
1370 ENDIF
1371c
1372 !< No different modes for the failure model
1373 IF (cpt_mod == 0) THEN
1374 IF (ispmd == 0) THEN
1375 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1376 . trim(key3),"/",trim(key4),"/",
1377 . trim(key5),"/",trim(key6)
1378 CALL ancmsg(msgid=310,
1379 . anmode=aninfo,
1380 . c1=test_chain,
1381 . c2=fail_name(1),
1382 . i1=id)
1383 CALL arret(2)
1384 ENDIF
1385 ENDIF
1386 ENDIF
1387c
1388 ! Otherwise, classic global damage variable only
1389 ELSE
1390 ! All failure IDs are asked by user
1391 IF (is_id_all > 0) THEN
1392c
1393 ! First count of the failure models with IDs
1394 IF (ALLOCATED(fail_name)) DEALLOCATE(fail_name)
1395 IF (ALLOCATED(irup_id_all)) DEALLOCATE(irup_id_all)
1396 cpt_irup = 0
1397 DO imat = 1,nummat
1398 nfail = mat_param(imat)%NFAIL
1399 IF (nfail > 0) THEN
1400 DO j = 1,nfail
1401 IF (mat_param(imat)%FAIL(j)%FAIL_ID > 0) THEN
1402 cpt_irup = cpt_irup + 1
1403 ENDIF
1404 ENDDO
1405 ENDIF
1406 ENDDO
1407c
1408 ! Second count to save IDs and failure model names
1409 ALLOCATE(fail_name(cpt_irup))
1410 ALLOCATE(irup_id_all(cpt_irup))
1411 irup_id_all(1:cpt_irup) = 0
1412 cpt_irup = 0
1413 DO imat = 1,nummat
1414 nfail = mat_param(imat)%NFAIL
1415 IF (nfail > 0) THEN
1416 DO j = 1,nfail
1417 IF (mat_param(imat)%FAIL(j)%FAIL_ID > 0) THEN
1418 cpt_irup = cpt_irup + 1
1419 fail_name(cpt_irup) = mat_param(imat)%FAIL(j)%KEYWORD
1420 irup_id_all(cpt_irup) = mat_param(imat)%FAIL(j)%FAIL_ID
1421 ENDIF
1422 ENDDO
1423 ENDIF
1424 ENDDO
1425c
1426 ! Maximal number of IDs
1427 id_max = cpt_irup
1428c
1429 !< If no failure model is found with ID, print error message
1430 IF (cpt_irup == 0) THEN
1431 IF (ispmd == 0) THEN
1432 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1433 . trim(key3),"/",trim(key4),"/",
1434 . trim(key5),"/",trim(key6)
1435 CALL ancmsg(msgid=311,
1436 . anmode=aninfo,
1437 . c1=test_chain)
1438 CALL arret(2)
1439 ENDIF
1440 ENDIF
1441c
1442 ! Only a specific failure ID is asked by the user
1443 ELSEIF (is_id > 0) THEN
1444c
1445 ! Look for failure criterion ID among materials
1446 cpt_irup = 0
1447 IF (ALLOCATED(fail_name)) DEALLOCATE(fail_name)
1448 DO imat = 1,nummat
1449 nfail = mat_param(imat)%NFAIL
1450 IF (nfail > 0) THEN
1451 DO j = 1,nfail
1452 IF (mat_param(imat)%FAIL(j)%FAIL_ID == id) THEN
1453 ALLOCATE(fail_name(1))
1454 cpt_irup = 1
1455 fail_name(1) = mat_param(imat)%FAIL(j)%KEYWORD
1456 ENDIF
1457 ENDDO
1458 ENDIF
1459 ENDDO
1460c
1461 !< If no failure model is found with ID, print error message
1462 IF (cpt_irup == 0) THEN
1463 IF (ispmd == 0) THEN
1464 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1465 . trim(key3),"/",trim(key4),"/",
1466 . trim(key5),"/",trim(key6)
1467 CALL ancmsg(msgid=309,
1468 . anmode=aninfo,
1469 . c1=test_chain,
1470 . i1=id)
1471 CALL arret(2)
1472 ENDIF
1473 ENDIF
1474c
1475 ENDIF
1476 ENDIF
1477 ENDIF
1478 !=====================================================================================
1479c
1480 !=====================================================================================
1481 ! /H3D/ELEM/DAMG output definition
1482 !=====================================================================================
1483 ! -> Output Definition modes
1484 IF ((key3_glob(1:4) == 'DAMG').AND.((is_mode > 0).OR.(is_mode_all > 0))) THEN
1485 ! Only available if the ID of the material law is given by user
1486 cpt_mod = 0
1487 cpt_lawid = 0
1488 ! -> Specific ID given by user
1489 IF (is_id > 0) THEN
1490 ! Recover the number of modes and their names
1491 IF (ALLOCATED(modname)) DEALLOCATE(modname)
1492 DO imat = 1,nummat
1493 IF (mat_param(imat)%MAT_ID == id) THEN
1494 cpt_lawid = 1
1495 nmod = mat_param(imat)%NMOD
1496 ALLOCATE(modname(1,nmod))
1497 modname(1,1:nmod) = mat_param(imat)%MODE(1:nmod)
1498 mlw = mat_param(imat)%ILAW
1499 IF (is_mode_all > 0) THEN
1500 mode_max = nmod
1501 ELSEIF (is_mode > 0) THEN
1502 mode_max = 1
1503 ENDIF
1504 IF ((nmod > 0).AND.(mode <= nmod)) cpt_mod = 1
1505 ENDIF
1506 ENDDO
1507 !< Error message if no material law is found with ID
1508 IF (cpt_lawid == 0) THEN
1509 IF (ispmd == 0) THEN
1510 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1511 . trim(key3),"/",trim(key4),"/",
1512 . trim(key5),"/",trim(key6)
1513 CALL ancmsg(
1514 . msgid=313,
1515 . c1=test_chain,
1516 . i1=id,
1517 . anmode=aninfo)
1518 CALL arret(2)
1519 ENDIF
1520 ENDIF
1521 !< Error message if no mode is found
1522 IF (cpt_mod == 0) THEN
1523 IF (ispmd == 0) THEN
1524 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1525 . trim(key3),"/",trim(key4),"/",
1526 . trim(key5),"/",trim(key6)
1527 CALL ancmsg(
1528 . msgid=314,
1529 . c1=test_chain,
1530 . i1=mlw,
1531 . i2=id,
1532 . anmode=aninfo)
1533 CALL arret(2)
1534 ENDIF
1535 ENDIF
1536 ! Otherwise, printing error message
1537 ELSE
1538 IF (ispmd == 0) THEN
1539 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1540 . trim(key3),"/",trim(key4),"/",
1541 . trim(key5),"/",trim(key6)
1542 CALL ancmsg(
1543 . msgid=306,
1544 . c1=test_chain,
1545 . anmode=aninfo)
1546 CALL arret(2)
1547 ENDIF
1548 ENDIF
1549 ! -> ID only output definition
1550 ELSEIF ((key3_glob(1:4) == 'DAMG').AND.(is_id > 0)) THEN
1551 cpt_lawid = 0
1552 DO imat = 1,nummat
1553 IF (mat_param(imat)%MAT_ID == id) THEN
1554 mlw = mat_param(imat)%ILAW
1555 cpt_lawid = 1
1556 ENDIF
1557 ENDDO
1558 IF (cpt_lawid == 0) THEN
1559 IF (ispmd == 0) THEN
1560 WRITE(test_chain,'(10A)') "/H3D/",trim(key2),"/",
1561 . trim(key3),"/",trim(key4),"/",
1562 . trim(key5),"/",trim(key6)
1563 CALL ancmsg(
1564 . msgid=313,
1565 . c1=test_chain,
1566 . i1=id,
1567 . anmode=aninfo)
1568 CALL arret(2)
1569 ENDIF
1570 ENDIF
1571 ENDIF
1572 !=====================================================================================
1573c
1574 !< SIZE of each input array (+1 for global integration shell to add lower layer output)
1575 size_input = max(1,nlay_max)*max(1,nip_max)*max(1,nply_max)*max(1,nuvar_max)*
1576 . max(1,ir_max)*max(1,is_max)*max(1,it_max)*max(1,nmdsvar_max)*max(1,id_max)*
1577 . max(1,mode_max)+1
1578 ALLOCATE (layer_input(size_input))
1579 ALLOCATE (ipt_input(size_input))
1580 ALLOCATE (ply_input(size_input))
1581 ALLOCATE (uvar_input(size_input))
1582 ALLOCATE (gauss_input(size_input))
1583 ALLOCATE (ir_input(size_input))
1584 ALLOCATE (is_input(size_input))
1585 ALLOCATE (it_input(size_input))
1586 ALLOCATE (is_available_key(size_input))
1587 ALLOCATE (mdsvar_input(size_input))
1588 ALLOCATE (mdsvar_input1(size_input))
1589 ALLOCATE (mdsvar_input2(size_input))
1590 ALLOCATE (ids_input(size_input))
1591 ALLOCATE (irup_h3d(size_input))
1592 ALLOCATE (modes_input(size_input))
1593C--------------------------------------------------
1594 cpt = 0
1595 ALLOCATE (mdsvar_input_tmp(max(1,nmdsvar_max)))
1596 ALLOCATE (mdsvar_input1_tmp(max(1,nmdsvar_max)))
1597 ALLOCATE (mdsvar_input2_tmp(max(1,nmdsvar_max)))
1598
1599 layer_input(:) = 0
1600 ipt_input(:) = 0
1601 ply_input(:) = 0
1602 uvar_input(:) = 0
1603 gauss_input(:) = 0
1604 ir_input(:) = 0
1605 is_input(:) = 0
1606 it_input(:) = 0
1607 is_available_key(:) = 0
1608 mdsvar_input(:) = 0
1609 mdsvar_input1(:) = 0
1610 mdsvar_input2(:) = 0
1611 irup_h3d(:) = 0
1612 ids_input(:) = 0
1613 modes_input(:) = 0
1614
1615 IF (is_mdsvar_all == 1) THEN
1616 IF(key3_glob(1:3) == 'MDS' ) THEN
1617 DO k=1,mds_nmat
1618 DO l=1,mds_ndepsvar(k)
1619 cpt = cpt + 1
1620 mdsvar_input_tmp(cpt) = k
1621 mdsvar_input1_tmp(cpt) = l
1622 mdsvar_input2_tmp(cpt) = id_mat_mds(k)
1623 ENDDO
1624 ENDDO
1625 ENDIF
1626 ENDIF
1627 IF (is_mdsvar_def == 1) THEN
1628 IF(key3_glob(1:3) == 'MDS' ) THEN
1629 DO k=1,mds_nmat
1630 DO l=1,mds_ndepsvar(k)
1631 IF(mds_output_table(l,k) /= 0) THEN
1632 cpt = cpt + 1
1633 mdsvar_input_tmp(cpt) = k
1634 mdsvar_input1_tmp(cpt) = l
1635 mdsvar_input2_tmp(cpt) = id_mat_mds(k)
1636 ENDIF
1637 ENDDO
1638 ENDDO
1639 ENDIF
1640 ENDIF
1641 cpt = 0
1642C
1643 ENDIF
1644C
1645 IF(.NOT.ALLOCATED(is_layer_mat))ALLOCATE(is_layer_mat(max(1,nummat),max(1,nlay_max)))
1646 is_layer_mat(1:max(1,nummat),max(1,nlay_max)) = 0
1647C
1648 IF(is_mdsvar == 1) THEN
1649
1650 DO ng=1,ngroup
1651
1652 CALL initbuf(iparg ,ng ,
1653 2 mlw ,nel ,nft ,iad ,ity ,
1654 3 npt ,jale ,ismstr ,jeul ,jturb ,
1655 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
1656 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
1657 6 irep ,iint ,igtyp ,israt ,isrot ,
1658 7 icsen ,isorth ,isorthg ,ifailure,jsms )
1659
1660 nlay = elbuf_str(ng)%NLAY
1661 isubstack = iparg(71,ng)
1662 DO j=1,nlay
1663 nuvar = elbuf_str(ng)%BUFLY(j)%NVAR_MAT
1664 IF(iuvar <= nuvar) THEN
1665 id_ply_tmp = 0
1666 IF (igtyp == 17 .OR. igtyp == 51) THEN
1667 id_ply_tmp = igeo(1,stack%IGEO(2+j,isubstack))
1668 ELSEIF (igtyp == 52) THEN
1669 id_ply_tmp = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
1670 ENDIF
1671c
1672 imat = elbuf_str(ng)%BUFLY(j)%IMAT
1673c
1674 is_layer_mat(imat,j) = 1
1675c
1676 ENDIF
1677 ENDDO
1678 ENDDO
1679 ENDIF
1680C--------------------------------------------------
1681 IF(key2 == 'SHELL' .OR. key2 =='ELEM') THEN
1682C--------------------------------------------------
1683
1684 jmax=max(h3d_num_key%SHELL_SCALAR, h3d_num_key%SHELL_VECTOR, h3d_num_key%SHELL_TENSOR)
1685 DO j=1,jmax
1686 cpt_h3d = 0
1687 is_scalar = 0
1688 is_vector = 0
1689 is_tensor = 0
1690 IF ( key3_glob == h3d_keyword_shell_scalar(j)%KEY3) is_scalar = 1
1691 IF ( key3_glob == h3d_keyword_shell_vector(j)%KEY3) is_vector = 1
1692 IF ( key3_glob == h3d_keyword_shell_tensor(j)%KEY3) is_tensor = 1
1693 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1) iok_h3dkey = 1
1694
1695 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1 ) THEN
1696 IF(is_scalar == 1) h3d_keyword_shell = h3d_keyword_shell_scalar(j)
1697 IF(is_vector == 1) h3d_keyword_shell = h3d_keyword_shell_vector(j)
1698 IF(is_tensor == 1) h3d_keyword_shell = h3d_keyword_shell_tensor(j)
1699 IF(h3d_keyword_shell%IS_LAYER /= 0 .OR.
1700 . h3d_keyword_shell%IS_IPT /= 0 .OR.
1701 . h3d_keyword_shell%IS_PLY /= 0 .OR.
1702 . h3d_keyword_shell%IS_UVAR /= 0 .OR.
1703 . h3d_keyword_shell%IS_MDSVAR /= 0 .OR.
1704 . h3d_keyword_shell%IS_ID /= 0 .OR.
1705 . h3d_keyword_shell%IS_MODE /= 0 ) THEN
1706C
1707 IF(is_layer_all == 0 .AND. is_ipt_all == 0 .AND. is_ply_all == 0 .AND. is_uvar_all == 0 .AND.
1708 . is_mdsvar_all == 0 .AND. is_mdsvar_def ==0 .AND. is_id_all ==0 .AND. is_mode_all ==0)THEN
1709
1710 cpt_h3d = cpt_h3d + 1
1711 layer_input(cpt_h3d) = -1
1712 ipt_input(cpt_h3d) = -1
1713 ids_input(cpt_h3d) = -1
1714 ply_input(cpt_h3d) = -1
1715 uvar_input(cpt_h3d)= -1
1716 gauss_input(cpt_h3d) = -1
1717 mdsvar_input(cpt_h3d)= -1
1718 mdsvar_input1(cpt_h3d)= -1
1719 mdsvar_input2(cpt_h3d)= -1
1720 modes_input(cpt_h3d)= -1
1721 is_available_key(cpt_h3d) = 1
1722
1723 IF(h3d_keyword_shell%IS_LAYER == 1) THEN
1724 IF(layer /= 0) layer_input(cpt_h3d) = layer
1725 IF(is_layer_lower == 1) layer_input(cpt_h3d) = -2
1726 IF(is_layer_upper == 1) layer_input(cpt_h3d) = -3
1727 ENDIF
1728
1729 IF(h3d_keyword_shell%IS_IPT == 1) THEN
1730 IF(ipt /= 0) ipt_input(cpt_h3d) = ipt
1731 IF(is_ipt_lower == 1 )ipt_input(cpt_h3d) = -2
1732 IF(is_ipt_upper == 1 )ipt_input(cpt_h3d) = -3
1733 IF(is_ipt_memb == 1 )ipt_input(cpt_h3d) = -4
1734 ENDIF
1735
1736 IF(h3d_keyword_shell%IS_PLY == 1) THEN
1737 IF(ply /= 0) ply_input(cpt_h3d) = ply
1738 ENDIF
1739
1740 IF(h3d_keyword_shell%IS_UVAR == 1) THEN
1741 IF(iuvar /= 0) uvar_input(cpt_h3d) = iuvar
1742 ENDIF
1743
1744 IF(h3d_keyword_shell%IS_ID == 1) THEN
1745 IF(id /= 0) ids_input(cpt_h3d) = id
1746 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
1747 irup_h3d(cpt_h3d) = 1
1748 ENDIF
1749 ENDIF
1750
1751 IF(h3d_keyword_shell%IS_MDSVAR == 1) THEN
1752 IF(imdsvar /= 0) THEN
1753 mdsvar_input(cpt_h3d) = ((imdsvar-1) * mds_nmat /nmdsvar_max)+1
1754 mdsvar_input1(cpt_h3d) = imdsvar-(mdsvar_input(cpt_h3d)-1)*nmdsvar_max/mds_nmat
1755 mdsvar_input2(cpt_h3d) = id_mat_mds(mdsvar_input(cpt_h3d))
1756 ENDIF
1757 ENDIF
1758
1759 IF(h3d_keyword_shell%IS_MODE == 1) THEN
1760 IF(mode /= 0) modes_input(cpt_h3d) = mode
1761 ENDIF
1762
1763 ELSE
1764 IF(nlay_max + max(1,nip_max) + nply_max + nuvar_max + nmdsvar_max + id_max + mode_max /= 0)THEN
1765 DO k=1,max(1,is_layer_all*max(nlay_max,1))
1766 DO l=1,max(1,is_ipt_all*max(nip_max,1))
1767 DO m=1,max(1,is_ply_all*max(nply_max,1))
1768 DO n=1,max(1,is_uvar_all*max(nuvar_max,1))
1769 DO o=1,max(1,max(is_mdsvar_all,is_mdsvar_def)*max(nmdsvar_max,1))
1770 DO p=1,max(1,is_id_all*max(id_max,1))
1771 DO q=1,max(1,is_mode_all*max(mode_max,1))
1772
1773 !< Check if the current output exist for failure/damage
1774 !< witch stack composite properties using plys
1775 ! -> Failure criteria case
1776 IF (key3_glob(1:7) == "FAILURE") THEN
1777 IF (nply_max > 0) THEN
1778 found = .false.
1779 DO imat = 1,nummat
1780 !< Check if the material ID is the same as the ply material ID
1781 IF (mat_param(imat)%MAT_ID == mat_ply(m)) THEN
1782 !< Number of ply failure criteria
1783 nfail = mat_param(imat)%NFAIL
1784 IF (nfail > 0) THEN
1785 !< Loop over ply failure criteria IDs
1786 DO ifail = 1,nfail
1787 IF (is_id_all == 1) THEN
1788 IF (mat_param(imat)%FAIL(ifail)%FAIL_ID == irup_id_all(p)) THEN
1789 found = .true.
1790 ENDIF
1791 ELSE
1792 IF (mat_param(imat)%FAIL(ifail)%FAIL_ID == id) THEN
1793 found = .true.
1794 ENDIF
1795 ENDIF
1796 ENDDO
1797 ENDIF
1798 ENDIF
1799 ENDDO
1800 !< If the combination of ply and failure ID is not found
1801 !< in the material list, skip this output
1802 IF (.NOT.found) cycle
1803 ENDIF
1804 ! -> Coupled damage model case
1805 ELSEIF (key3_glob(1:4) == "DAMG") THEN
1806 IF ((nply_max > 0).AND.(id > 0)) THEN
1807 !< If the ply ID is not the same as the material ID, skip this output
1808 IF (id /= mat_ply(m)) cycle
1809 ENDIF
1810 ENDIF
1811
1812 cpt_h3d = cpt_h3d + 1
1813c
1814 layer_input(cpt_h3d) = -1
1815 IF (nlay_max /= 0 .AND. is_layer_all == 1) layer_input(cpt_h3d) = k
1816 IF (is_layer_all == 0 .AND. layer >= 1) layer_input(cpt_h3d) = layer
1817c
1818 ipt_input(cpt_h3d) = -1
1819 IF (nip_elem_max > 0) THEN
1820 IF (is_ipt_all == 1) ipt_input(cpt_h3d) = l
1821 IF (is_ipt_all == 0 .AND. ipt >= 1) ipt_input(cpt_h3d) = ipt
1822 IF (is_ipt_lower == 1) ipt_input(cpt_h3d) = -2
1823 IF (is_ipt_upper == 1) ipt_input(cpt_h3d) = -3
1824 IF (is_ipt_memb == 1) ipt_input(cpt_h3d) = -4
1825 ENDIF
1826c
1827 ply_input(cpt_h3d) = -1
1828 IF (nply_max /= 0 .AND. is_ply_all == 1) THEN
1829 ply_input(cpt_h3d) = id_ply(m)
1830 IF (is_ipt_all == 1) THEN
1831 ipt_input(cpt_h3d) = l
1832 ELSEIF (is_ipt_all == 0 .AND. ipt >= 1) THEN
1833 ipt_input(cpt_h3d) = ipt
1834 ELSEIF (is_ipt_lower == 1) THEN
1835 ipt_input(cpt_h3d) = -2
1836 ELSEIF (is_ipt_upper == 1) THEN
1837 ipt_input(cpt_h3d) = -3
1838 ELSEIF (is_ipt_memb == 1) THEN
1839 ipt_input(cpt_h3d) = -4
1840 ELSE
1841 ipt_input(cpt_h3d) = -1
1842 ENDIF
1843 ELSEIF (is_ply_all == 0 .AND. ply >= 1) THEN
1844 ply_input(cpt_h3d) = ply
1845 IF (is_ipt_all == 1) THEN
1846 ipt_input(cpt_h3d) = l
1847 ELSEIF (is_ipt_all == 0 .AND. ipt >= 1) THEN
1848 ipt_input(cpt_h3d) = ipt
1849 ELSEIF (is_ipt_lower == 1) THEN
1850 ipt_input(cpt_h3d) = -2
1851 ELSEIF (is_ipt_upper == 1) THEN
1852 ipt_input(cpt_h3d) = -3
1853 ELSEIF (is_ipt_memb == 1) THEN
1854 ipt_input(cpt_h3d) = -4
1855 ELSE
1856 ipt_input(cpt_h3d) = -1
1857 ENDIF
1858 ENDIF
1859c
1860 uvar_input(cpt_h3d) = -1
1861 IF (nuvar_max /= 0 .AND. is_uvar_all == 1) THEN
1862 uvar_input(cpt_h3d) = n
1863 ENDIF
1864 IF (is_uvar_all == 0 .AND. iuvar >= 1) uvar_input(cpt_h3d) = iuvar
1865
1866 mdsvar_input(cpt_h3d) = -1
1867 mdsvar_input1(cpt_h3d) = -1
1868 IF (nmdsvar_max /= 0 .AND. is_mdsvar_all == 1 .AND.
1869 . key3_glob(1:3) == 'MDS' .AND. mds_nmat /= 0) THEN
1870 mdsvar_input(cpt_h3d) = ((o-1) * mds_nmat /nmdsvar_max)+1
1871 mdsvar_input1(cpt_h3d) = o-(mdsvar_input(cpt_h3d)-1)*nmdsvar_max/mds_nmat
1872 mdsvar_input2(cpt_h3d) = id_mat_mds(mdsvar_input(cpt_h3d))
1873 ENDIF
1874
1875 IF (is_mdsvar_all == 0 .AND. is_mdsvar_def == 0 .AND. imdsvar >= 1)THEN
1876 mdsvar_input(cpt_h3d) = mdsvar_input_tmp(o)
1877 mdsvar_input1(cpt_h3d) = mdsvar_input1_tmp(o)
1878 mdsvar_input2(cpt_h3d) = mdsvar_input2_tmp(o)
1879 ENDIF
1880
1881 IF (nmdsvar_max /= 0 .AND. is_mdsvar_def == 1 .AND.
1882 . key3_glob(1:3) == 'MDS' .AND. mds_nmat /= 0) THEN
1883 mdsvar_input(cpt_h3d) = mdsvar_input_tmp(o)
1884 mdsvar_input1(cpt_h3d) = mdsvar_input1_tmp(o)
1885 mdsvar_input2(cpt_h3d) = mdsvar_input2_tmp(o)
1886 ENDIF
1887
1888 ids_input(cpt_h3d) = -1
1889 IF (is_id_all == 1) ids_input(cpt_h3d) = p
1890 IF (is_id_all == 0 .AND. id >= 1) ids_input(cpt_h3d) = id
1891
1892
1893 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
1894 IF (is_id_all == 1) THEN
1895 ids_input(cpt_h3d) = irup_id_all(p)
1896 irup_h3d(cpt_h3d) = p
1897 ELSE
1898 irup_h3d(cpt_h3d) = 1
1899 ENDIF
1900 ENDIF
1901
1902 modes_input(cpt_h3d) = -1
1903 IF (is_mode_all == 1) modes_input(cpt_h3d) = q
1904 IF (is_mode_all == 0 .AND. mode >= 1) modes_input(cpt_h3d) = mode
1905c
1906 gauss_input(cpt_h3d) = -1
1907c
1908 is_available_key(cpt_h3d) = 1
1909 IF( is_ply_all == 1) THEN
1910 IF (l > ipt_ply(m) ) is_available_key(cpt_h3d) = 0
1911 ENDIF
1912 IF(layer_input(cpt_h3d) /= -1) ish_npt0=0
1913
1914 IF (is_layer_all == 1 .AND. k > 0 .AND. mdsvar_input(cpt_h3d) > 0) THEN
1915 IF(is_layer_mat(index_mat_mds(mdsvar_input(cpt_h3d)),k) == 0) THEN
1916 layer_input(cpt_h3d) = -1
1917 ipt_input(cpt_h3d) = -1
1918 ids_input(cpt_h3d) = -1
1919 ply_input(cpt_h3d) = -1
1920 uvar_input(cpt_h3d)= -1
1921 gauss_input(cpt_h3d) = -1
1922 mdsvar_input(cpt_h3d)= -1
1923 mdsvar_input1(cpt_h3d)= -1
1924 mdsvar_input2(cpt_h3d)= -1
1925 modes_input(cpt_h3d)= -1
1926 is_available_key(cpt_h3d) = 1
1927c
1928 cpt_h3d = cpt_h3d - 1
1929 ENDIF
1930 ENDIF
1931c
1932 ENDDO
1933 ENDDO
1934 ENDDO
1935 ENDDO
1936 ENDDO
1937 ENDDO
1938 ENDDO
1939C-----------IPT=ALL w/ NPT=0 add lower
1940 IF ((ish_npt0 == 1).AND.(key3_glob(1:7) /= 'FAILURE')
1941 . .AND.(key3_glob(1:4) /= 'DAMG')) THEN
1942 IF (ipt_input(cpt_h3d)==1) ipt_input(cpt_h3d)=-2
1943 cpt_h3d = cpt_h3d + 1
1944 layer_input(cpt_h3d) = -1
1945 ipt_input(cpt_h3d) = -3
1946 ids_input(cpt_h3d) = -1
1947 ply_input(cpt_h3d) = -1
1948 uvar_input(cpt_h3d) = -1
1949 gauss_input(cpt_h3d) = -1
1950 is_available_key(cpt_h3d) = 1
1951 mdsvar_input(cpt_h3d) = -1
1952 mdsvar_input1(cpt_h3d) = -1
1953 mdsvar_input2(cpt_h3d) = -1
1954 modes_input(cpt_h3d)= -1
1955 ENDIF
1956 ENDIF
1957C
1958 ENDIF
1959
1960 ELSEIF(h3d_keyword_shell%IS_LAYER == 0 .AND. is_layer == 0 .AND.
1961 . h3d_keyword_shell%IS_IPT == 0 .AND. is_ipt == 0 .AND.
1962 . h3d_keyword_shell%IS_PLY == 0 .AND. is_ply == 0 .AND.
1963 . h3d_keyword_shell%IS_UVAR == 0 .AND. is_uvar == 0.AND.
1964 . h3d_keyword_shell%IS_MDSVAR == 0 .AND. is_mdsvar == 0 .AND.
1965 . h3d_keyword_shell%IS_ID == 0 .AND. is_id == 0 .AND.
1966 . h3d_keyword_shell%IS_MODE == 0 ) THEN
1967 cpt_h3d = cpt_h3d + 1
1968 layer_input(cpt_h3d) = -1
1969 ipt_input(cpt_h3d) = -1
1970 ply_input(cpt_h3d) = -1
1971 ids_input(cpt_h3d) = -1
1972 uvar_input(cpt_h3d)= -1
1973 mdsvar_input(cpt_h3d)= -1
1974 mdsvar_input1(cpt_h3d)= -1
1975 mdsvar_input2(cpt_h3d)= -1
1976 gauss_input(cpt_h3d) = -1
1977 modes_input(cpt_h3d)= -1
1978 is_available_key(cpt_h3d) = 1
1979 ENDIF
1980 ENDIF
1981c
1982 DO k=1,cpt_h3d
1983
1984 IF (is_available_key(k) == 1 .AND. is_scalar == 1) THEN
1985 IF (is_mdsvar ==1) mds_label_tmp = mds_label(mdsvar_input1(k), mdsvar_input(k))
1986
1987 IF (h3d_keyword_shell_scalar(j)%IS_SKIN == 1 ) THEN
1988 CALL create_h3d_skin_scalar(h3d_data,h3d_keyword_shell_scalar(j)%ID,id_input,
1989 . trim(h3d_keyword_shell_scalar(j)%TEXT1),len_trim(h3d_keyword_shell_scalar(j)%TEXT1),
1990 . h3d_keyword_shell_scalar(j)%COMMENT,80,ipart,key3_glob,
1991 . layer_input(k),ir_input(k),is_input(k),it_input(k),
1992 . uvar_input(k),igrpart)
1993 is_sking = 1
1994 ELSE
1995c
1996 ! ---------------------------------------------------------------------------------------------
1997 ! /H3D/ELEM/FAILURE Specific output name
1998 ! ---------------------------------------------------------------------------------------------
1999 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2000 test_chain = ''
2001 IF (cpt_mod > 0) THEN
2002 WRITE(test_chain,'(A,A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; ",
2003 . trim(modname(irup_h3d(k),modes_input(k)))
2004 ELSE
2005 WRITE(test_chain,'(A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; Failure index"
2006 ENDIF
2007 h3d_keyword_shell_scalar(j)%TEXT1 = test_chain
2008 ENDIF
2009c
2010 ! ---------------------------------------------------------------------------------------------
2011 ! /H3D/ELEM/DAMG Specific output name
2012 ! ---------------------------------------------------------------------------------------------
2013 IF ((key3_glob(1:4) == 'DAMG').AND.(cpt_mod > 0)) THEN
2014 test_chain = ''
2015 WRITE(test_chain,'(A,I3,A,A)') "Damage: LAW",mlw,"; ",trim(modname(1,modes_input(k)))
2016 h3d_keyword_shell_scalar(j)%TEXT1 = test_chain
2017 ELSEIF ((key3_glob(1:4) == 'DAMG').AND.(cpt_lawid > 0)) THEN
2018 test_chain = ''
2019 WRITE(test_chain,'(A,I3,A)') "Damage: LAW",mlw,"; Damage index"
2020 h3d_keyword_shell_scalar(j)%TEXT1 = test_chain
2021 ELSEIF ((key3_glob(1:4) == 'DAMG').AND.(cpt_mod == 0).AND.(cpt_lawid == 0)) THEN
2022 h3d_keyword_shell_scalar(j)%TEXT1 = "Damage:Damage index"
2023 ENDIF
2024c
2025 CALL create_h3d_shell_scalar(h3d_data,h3d_keyword_shell_scalar(j)%ID,n1,n2,id_input,
2026 . trim(h3d_keyword_shell_scalar(j)%TEXT1),len_trim(h3d_keyword_shell_scalar(j)%TEXT1),
2027 . h3d_keyword_shell_scalar(j)%COMMENT,80,ipart,key3_glob,
2028 . layer_input(k),ipt_input(k),ply_input(k),gauss_input(k),uvar_input(k),
2029 . mdsvar_input(k),mdsvar_input1(k),mdsvar_input2(k),
2030 . mds_label_tmp,30,ids_input(k),modes_input(k),igrpart)
2031 END IF
2032 iok_h3dkey_combination = 1
2033 ELSEIF (is_available_key(k) == 1 .AND. is_vector == 1) THEN
2034 IF (h3d_keyword_shell_vector(j)%IS_SKIN == 1 ) THEN
2035 CALL create_h3d_skin_vector(h3d_data,h3d_keyword_shell_vector(j)%ID,id_input,
2036 . trim(h3d_keyword_shell_vector(j)%TEXT1),
2037 . len_trim(h3d_keyword_shell_vector(j)%TEXT1),
2038 . h3d_keyword_shell_vector(j)%COMMENT,80,ipart,key3_glob,
2039 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2040 . uvar_input(k),igrpart )
2041 is_sking = 1
2042 ELSE
2043 CALL create_h3d_shell_vector(h3d_data,h3d_keyword_shell_vector(j)%ID,n1,n2,id_input,
2044 . trim(h3d_keyword_shell_vector(j)%TEXT1),len_trim(h3d_keyword_shell_vector(j)%TEXT1),
2045 . h3d_keyword_shell_vector(j)%COMMENT,80,ipart,key3_glob,
2046 . layer_input(k),ipt_input(k),ply_input(k),gauss_input(k),uvar_input(k),igrpart)
2047 END IF
2048 iok_h3dkey_combination = 1
2049
2050 ELSEIF (is_available_key(k) == 1 .AND. is_tensor == 1) THEN
2051 CALL create_h3d_shell_tensor(h3d_data,id_input,trim(h3d_keyword_shell_tensor(j)%TEXT1),
2052 . len_trim(h3d_keyword_shell_tensor(j)%TEXT1),
2053 . h3d_keyword_shell_tensor(j)%COMMENT,80,ipart,key3_glob,
2054 . layer_input(k),ipt_input(k),ply_input(k),gauss_input(k),
2055 . uvar_input(k),ids_input(k),igrpart)
2056 iok_h3dkey_combination = 1
2057 ENDIF
2058 ENDDO
2059
2060 ENDDO
2061 ENDIF
2062C--------------------------------------------------
2063 IF(key2 == 'SOLID' .OR. key2 == 'BRICK' .OR.key2 =='ELEM') THEN
2064C--------------------------------------------------
2065 jmax=max(h3d_num_key%SOLID_SCALAR, h3d_num_key%SOLID_VECTOR, h3d_num_key%SOLID_TENSOR)
2066 DO j=1,jmax
2067 cpt_h3d = 0
2068 is_scalar = 0
2069 is_vector = 0
2070 is_tensor = 0
2071 IF ( key3_glob == h3d_keyword_solid_scalar(j)%KEY3) is_scalar = 1
2072 IF ( key3_glob == h3d_keyword_solid_vector(j)%KEY3) is_vector = 1
2073 IF ( key3_glob == h3d_keyword_solid_tensor(j)%KEY3) is_tensor = 1
2074 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1) iok_h3dkey = 1
2075
2076 is_corner_data = h3d_keyword_solid_tensor(j)%IS_CORNER_DATA
2077
2078 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1 ) THEN
2079
2080 IF(is_scalar == 1) h3d_keyword_solid = h3d_keyword_solid_scalar(j)
2081 IF(is_vector == 1) h3d_keyword_solid = h3d_keyword_solid_vector(j)
2082 IF(is_tensor == 1) h3d_keyword_solid = h3d_keyword_solid_tensor(j)
2083
2084 IF(h3d_keyword_solid%IS_LAYER /= 0 .OR.
2085 . h3d_keyword_solid%IS_IR /= 0 .OR.
2086 . h3d_keyword_solid%IS_IS /= 0 .OR.
2087 . h3d_keyword_solid%IS_IT /= 0 .OR.
2088 . h3d_keyword_solid%IS_UVAR /= 0 .OR.
2089 . h3d_keyword_solid%IS_MDSVAR /= 0 .OR.
2090 . h3d_keyword_solid%IS_ID /= 0 .OR.
2091 . h3d_keyword_solid%IS_MODE /= 0) THEN
2092
2093 IF(is_layer_all == 0 .AND. is_ir_all == 0 .AND. is_is_all == 0 .AND.
2094 . is_it_all == 0 .AND. is_uvar_all == 0 .AND. is_mdsvar_all == 0 .AND.
2095 . is_mdsvar_def ==0 .AND. is_id_all == 0 .AND. is_mode_all == 0)THEN
2096
2097 cpt_h3d = cpt_h3d + 1
2098 layer_input(cpt_h3d) = -1
2099 uvar_input(cpt_h3d)= -1
2100 mdsvar_input(cpt_h3d)= -1
2101 mdsvar_input1(cpt_h3d)= -1
2102 mdsvar_input2(cpt_h3d)= -1
2103 ir_input(cpt_h3d) = -1
2104 is_input(cpt_h3d) = -1
2105 it_input(cpt_h3d) = -1
2106 ids_input(cpt_h3d) = -1
2107 gauss_input(cpt_h3d) = -1
2108 is_available_key(cpt_h3d) = 1
2109 modes_input(cpt_h3d) = -1
2110
2111 IF(h3d_keyword_solid%IS_LAYER == 1) THEN
2112 IF(layer /= 0) layer_input(cpt_h3d) = layer
2113 IF(is_layer_lower == 1) layer_input(cpt_h3d) = -2
2114 IF(is_layer_upper == 1) layer_input(cpt_h3d) = -3
2115 ENDIF
2116
2117 IF(h3d_keyword_solid%IS_IPT == 1) THEN
2118 IF(ipt /= 0) ipt_input(cpt_h3d) = ipt
2119 IF(is_ipt_lower == 1) ipt_input(cpt_h3d) = -2
2120 IF(is_ipt_upper == 1) ipt_input(cpt_h3d) = -3
2121 IF(is_ipt_memb == 1) ipt_input(cpt_h3d) = -4
2122 ENDIF
2123
2124 IF(h3d_keyword_solid%IS_UVAR == 1) THEN
2125 IF(iuvar /= 0) uvar_input(cpt_h3d) = iuvar
2126 ENDIF
2127
2128 IF(h3d_keyword_solid%IS_MDSVAR == 1) THEN
2129 IF(imdsvar /= 0) THEN
2130 mdsvar_input(cpt_h3d) = ((imdsvar-1) * mds_nmat /nmdsvar_max)+1
2131 mdsvar_input1(cpt_h3d) = imdsvar-(mdsvar_input(cpt_h3d)-1)*nmdsvar_max/mds_nmat
2132 mdsvar_input2(cpt_h3d) = id_mat_mds(mdsvar_input(cpt_h3d))
2133 ENDIF
2134 ENDIF
2135
2136 IF(h3d_keyword_solid%IS_IR == 1) THEN
2137 IF(ir /= 0) ir_input(cpt_h3d) = ir
2138 ENDIF
2139
2140 IF(h3d_keyword_solid%IS_IS == 1) THEN
2141 IF(is /= 0) is_input(cpt_h3d) = is
2142 ENDIF
2143
2144 IF(h3d_keyword_solid%IS_IT == 1) THEN
2145 IF(it /= 0) it_input(cpt_h3d) = it
2146 ENDIF
2147
2148 IF(h3d_keyword_solid%IS_ID == 1) THEN
2149 IF(id /= 0) ids_input(cpt_h3d) = id
2150 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2151 irup_h3d(cpt_h3d) = 1
2152 ENDIF
2153 ENDIF
2154
2155 IF(h3d_keyword_solid%IS_MODE == 1) THEN
2156 IF(mode /= 0) modes_input(cpt_h3d) = mode
2157 ENDIF
2158
2159 ELSE
2160C------ LAYER is not available for /SOLID/TENS/ in manuel, might be removed in the loop
2161 IF(nlay_max + ir_max + is_max + it_max + nuvar_max + nmdsvar_max + id_max + mode_max /= 0)THEN
2162 DO k=1,max(1,is_layer_all*max(nlay_max,1))
2163 DO l=1,max(1,is_uvar_all*max(nuvar_max,1))
2164 DO m=1,max(1,is_ir_all*max(ir_max,1))
2165 DO n=1,max(1,is_is_all*max(is_max,1))
2166 DO o=1,max(1,is_it_all*max(it_max,1))
2167 DO p=1,max(1,max(is_mdsvar_all,is_mdsvar_def)*max(nmdsvar_max,1))
2168 DO q=1,max(1,is_id_all*max(id_max,1))
2169 DO r=1,max(1,is_mode_all*max(mode_max,1))
2170 cpt_h3d = cpt_h3d + 1
2171c
2172 layer_input(cpt_h3d) = -1
2173 IF (nlay_max /= 0 .AND. is_layer_all == 1) layer_input(cpt_h3d) = k
2174c
2175 uvar_input(cpt_h3d) = -1
2176 IF(h3d_keyword_solid%IS_UVAR == 1 .AND. iuvar > 0) uvar_input(cpt_h3d) = iuvar
2177 IF (nuvar_max /= 0 .AND. is_uvar_all == 1) uvar_input(cpt_h3d) = l
2178
2179 mdsvar_input(cpt_h3d) = -1
2180 mdsvar_input1(cpt_h3d) = -1
2181 mdsvar_input2(cpt_h3d) = -1
2182 IF (nmdsvar_max /= 0 .AND. is_mdsvar_all == 1 .AND.
2183 . key3_glob(1:3) == 'MDS' .AND. mds_nmat /= 0) THEN
2184 mdsvar_input(cpt_h3d) = mdsvar_input_tmp(p)
2185 mdsvar_input1(cpt_h3d) = mdsvar_input1_tmp(p)
2186 mdsvar_input2(cpt_h3d) = mdsvar_input2_tmp(p)
2187 ENDIF
2188c
2189 IF (is_mdsvar_all == 0 .AND. imdsvar >= 1) mdsvar_input(cpt_h3d) = imdsvar
2190
2191
2192 IF (nmdsvar_max /= 0 .AND. is_mdsvar_def == 1 .AND.
2193 . key3_glob(1:3) == 'MDS' .AND. mds_nmat /= 0) THEN
2194 mdsvar_input(cpt_h3d) = mdsvar_input_tmp(p)
2195 mdsvar_input1(cpt_h3d) = mdsvar_input1_tmp(p)
2196 mdsvar_input2(cpt_h3d) = mdsvar_input2_tmp(p)
2197 ENDIF
2198
2199 ir_input(cpt_h3d) = -1
2200 IF(h3d_keyword_solid%IS_IR == 1 .AND. ir > 0) ir_input(cpt_h3d) = ir
2201 IF (ir_max /= 0 .AND. is_ir_all == 1) ir_input(cpt_h3d) = m
2202
2203 is_input(cpt_h3d) = -1
2204 IF(h3d_keyword_solid%IS_IS == 1 .AND. is > 0) is_input(cpt_h3d) = is
2205 IF (is_max /= 0 .AND. is_is_all == 1) is_input(cpt_h3d) = n
2206
2207 it_input(cpt_h3d) = -1
2208 IF(h3d_keyword_solid%IS_IT == 1 .AND. it > 0) it_input(cpt_h3d) = it
2209 IF (it_max /= 0 .AND. is_it_all == 1) it_input(cpt_h3d) = o
2210c
2211 ids_input(cpt_h3d) = -1
2212 IF (is_id_all == 1) ids_input(cpt_h3d) = q
2213 IF (is_id_all == 0 .AND. id >= 1) ids_input(cpt_h3d) = id
2214
2215 modes_input(cpt_h3d) = -1
2216 IF (is_mode_all == 1) modes_input(cpt_h3d) = r
2217 IF (is_mode_all == 0 .AND. mode >= 1) modes_input(cpt_h3d) = mode
2218
2219 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2220 IF (is_id_all == 1) THEN
2221 ids_input(cpt_h3d) = irup_id_all(q)
2222 irup_h3d(cpt_h3d) = q
2223 ELSE
2224 irup_h3d(cpt_h3d) = 1
2225 ENDIF
2226 ENDIF
2227 gauss_input(cpt_h3d) = -1
2228c
2229 is_available_key(cpt_h3d) = 1
2230c
2231 ENDDO
2232 ENDDO
2233 ENDDO
2234 ENDDO
2235 ENDDO
2236 ENDDO
2237 ENDDO
2238 ENDDO
2239 ENDIF
2240 ENDIF
2241
2242 ELSEIF(h3d_keyword_solid%IS_LAYER == 0 .AND. is_layer == 0 .AND.
2243 . h3d_keyword_solid%IS_IR == 0 .AND. is_ir == 0 .AND.
2244 . h3d_keyword_solid%IS_IS == 0 .AND. is_is == 0 .AND.
2245 . h3d_keyword_solid%IS_IT == 0 .AND. is_it == 0 .AND.
2246 . h3d_keyword_solid%IS_UVAR == 0 .AND. is_uvar == 0 .AND.
2247 . h3d_keyword_solid%IS_MDSVAR == 0 .AND. is_mdsvar == 0 .AND.
2248 . h3d_keyword_solid%IS_ID == 0 .AND. is_id == 0 .AND.
2249 . h3d_keyword_solid%IS_MODE == 0 ) THEN
2250 cpt_h3d = cpt_h3d + 1
2251 layer_input(cpt_h3d) = -1
2252 uvar_input(cpt_h3d)= -1
2253 mdsvar_input(cpt_h3d)= -1
2254 mdsvar_input1(cpt_h3d)= -1
2255 mdsvar_input2(cpt_h3d)= -1
2256 gauss_input(cpt_h3d) = -1
2257 ir_input(cpt_h3d) = -1
2258 is_input(cpt_h3d) = -1
2259 it_input(cpt_h3d) = -1
2260 ids_input(cpt_h3d) = -1
2261 modes_input(cpt_h3d) = -1
2262 is_available_key(cpt_h3d) = 1
2263 ENDIF
2264 ENDIF
2265c
2266 DO k=1,cpt_h3d
2267 IF (is_available_key(k) == 1 .AND. is_scalar == 1) THEN
2268 IF (h3d_keyword_solid_scalar(j)%IS_SKIN == 1 ) THEN
2269 CALL create_h3d_skin_scalar(h3d_data,h3d_keyword_solid_scalar(j)%ID,id_input,
2270 . trim(h3d_keyword_solid_scalar(j)%TEXT1),len_trim(h3d_keyword_solid_scalar(j)%TEXT1),
2271 . h3d_keyword_solid_scalar(j)%COMMENT,80,ipart,key3_glob,
2272 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2273 . uvar_input(k),igrpart)
2274 is_sking = 1
2275 ELSE
2276 IF (is_mdsvar ==1) mds_label_tmp = mds_label(mdsvar_input1(k), mdsvar_input(k))
2277c
2278 ! ---------------------------------------------------------------------------------------------
2279 ! /H3D/ELEM/FAILURE Specific output name
2280 ! ---------------------------------------------------------------------------------------------
2281 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2282 test_chain = ''
2283 IF (cpt_mod > 0) THEN
2284 WRITE(test_chain,'(A,A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; ",
2285 . trim(modname(irup_h3d(k),modes_input(k)))
2286 ELSE
2287 WRITE(test_chain,'(A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; Failure index"
2288 ENDIF
2289 h3d_keyword_solid_scalar(j)%TEXT1 = test_chain
2290 ENDIF
2291c
2292 ! ---------------------------------------------------------------------------------------------
2293 ! /H3D/ELEM/DAMG Specific output name
2294 ! ---------------------------------------------------------------------------------------------
2295 IF ((key3_glob(1:4) == 'DAMG').AND.(cpt_mod > 0)) THEN
2296 test_chain = ''
2297 WRITE(test_chain,'(A,I3,A,A)') "Damage: LAW",mlw,"; ",trim(modname(1,modes_input(k)))
2298 h3d_keyword_solid_scalar(j)%TEXT1 = test_chain
2299 ELSEIF ((key3_glob(1:4) == 'DAMG').AND.(cpt_lawid > 0)) THEN
2300 test_chain = ''
2301 WRITE(test_chain,'(A,I3,A)') "Damage: LAW",mlw,"; Damage index"
2302 h3d_keyword_solid_scalar(j)%TEXT1 = test_chain
2303 ELSEIF ((key3_glob(1:4) == 'DAMG').AND.(cpt_mod == 0).AND.(cpt_lawid == 0)) THEN
2304 h3d_keyword_solid_scalar(j)%TEXT1 = "Damage:Damage index"
2305 ENDIF
2306c
2307 CALL create_h3d_solid_scalar(h3d_data,h3d_keyword_solid_scalar(j)%ID,id_input,
2308 . trim(h3d_keyword_solid_scalar(j)%TEXT1),len_trim(h3d_keyword_solid_scalar(j)%TEXT1),
2309 . h3d_keyword_solid_scalar(j)%COMMENT,80,ipart,key3_glob,
2310 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2311 . uvar_input(k),mdsvar_input(k),mdsvar_input1(k),
2312 . mdsvar_input2(k),mds_label_tmp,30,ids_input(k),modes_input(k),igrpart)
2313 END IF
2314 iok_h3dkey_combination = 1
2315 ELSEIF (is_available_key(k) == 1 .AND. is_vector == 1) THEN
2316 IF (h3d_keyword_solid_vector(j)%IS_SKIN == 1 ) THEN
2317 CALL create_h3d_skin_vector(h3d_data,h3d_keyword_solid_vector(j)%ID,id_input,
2318 . trim(h3d_keyword_solid_vector(j)%TEXT1),
2319 . len_trim(h3d_keyword_solid_vector(j)%TEXT1),
2320 . h3d_keyword_solid_vector(j)%COMMENT,80,ipart,key3_glob,
2321 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2322 . uvar_input(k) ,igrpart)
2323 is_sking = 1
2324 ELSE
2325 CALL create_h3d_solid_vector(h3d_data,h3d_keyword_solid_vector(j)%ID,id_input,
2326 . trim(h3d_keyword_solid_vector(j)%TEXT1),len_trim(h3d_keyword_solid_vector(j)%TEXT1),
2327 . h3d_keyword_solid_vector(j)%COMMENT,80,ipart,key3_glob,
2328 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2329 . uvar_input(k),igrpart)
2330 END IF
2331 iok_h3dkey_combination = 1
2332 ELSEIF (is_available_key(k) == 1 .AND. is_tensor == 1) THEN
2333 IF (h3d_keyword_solid_tensor(j)%IS_SKIN == 1 ) THEN
2334 CALL create_h3d_skin_tensor(h3d_data,h3d_keyword_solid_tensor(j)%ID,id_input,
2335 . trim(h3d_keyword_solid_tensor(j)%TEXT1),
2336 . len_trim(h3d_keyword_solid_tensor(j)%TEXT1),
2337 . h3d_keyword_solid_tensor(j)%COMMENT,80,ipart,key3_glob,
2338 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2339 . uvar_input(k),igrpart)
2340 is_sking = 1
2341 ELSE
2342 CALL create_h3d_solid_tensor(h3d_data,h3d_keyword_solid_tensor(j)%ID,id_input,
2343 . trim(h3d_keyword_solid_tensor(j)%TEXT1),len_trim(h3d_keyword_solid_tensor(j)%TEXT1),
2344 . h3d_keyword_solid_tensor(j)%COMMENT,80,ipart,key3_glob,
2345 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2346 . uvar_input(k) ,is_corner_data,ids_input(k),igrpart)
2347 END IF
2348 iok_h3dkey_combination = 1
2349C-----------------
2350 ENDIF
2351 ENDDO
2352 ENDDO
2353 ENDIF
2354C--------------------------------------------------
2355 IF(key2 == 'SPH' .OR. key2 =='ELEM') THEN
2356C--------------------------------------------------
2357 jmax=max(h3d_num_key%SPH_SCALAR, h3d_num_key%SPH_TENSOR)
2358 DO j=1,jmax
2359 is_scalar = 0
2360 is_tensor = 0
2361 IF ( key3_glob == h3d_keyword_sph_scalar(j)%KEY3) is_scalar = 1
2362 IF ( key3_glob == h3d_keyword_sph_tensor(j)%KEY3) is_tensor = 1
2363 IF ( is_scalar == 1 .OR. is_tensor == 1) iok_h3dkey = 1
2364 cpt_h3d = 0
2365 IF (h3d_keyword_sph_scalar(j)%IS_ID /= 0 .OR.
2366 . h3d_keyword_sph_scalar(j)%IS_MODE /= 0) THEN
2367 IF (is_id_all == 0 .AND. is_mode_all ==0) THEN
2368 cpt_h3d = cpt_h3d + 1
2369
2370 ids_input(cpt_h3d) = -1
2371 IF (h3d_keyword_sph_scalar(j)%IS_ID == 1) THEN
2372 IF (id /= 0) ids_input(cpt_h3d) = id
2373 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2374 irup_h3d(cpt_h3d) = 1
2375 ENDIF
2376 ENDIF
2377
2378 modes_input(cpt_h3d) = -1
2379 IF(h3d_keyword_sph_scalar(j)%IS_MODE == 1) THEN
2380 IF(mode /= 0) modes_input(cpt_h3d) = mode
2381 ENDIF
2382
2383 ELSE
2384
2385 IF ((id_max + mode_max /=0)) THEN
2386 DO q=1,max(1,is_id_all*max(id_max,1))
2387 DO r=1,max(1,is_mode_all*max(mode_max,1))
2388 cpt_h3d = cpt_h3d + 1
2389 ids_input(cpt_h3d) = -1
2390
2391 IF (is_id_all == 1) ids_input(cpt_h3d) = q
2392 IF (is_id_all == 0 .AND. id >= 1) ids_input(cpt_h3d) = id
2393 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2394 IF (is_id_all == 1) THEN
2395 ids_input(cpt_h3d) = irup_id_all(q)
2396 irup_h3d(cpt_h3d) = q
2397 ELSE
2398 irup_h3d(cpt_h3d) = 1
2399 ENDIF
2400 ENDIF
2401
2402 modes_input(cpt_h3d)= -1
2403 IF (is_mode_all == 1) modes_input(cpt_h3d) = r
2404 IF (is_mode_all == 0 .AND. mode >= 1) modes_input(cpt_h3d) = mode
2405
2406 ENDDO
2407 ENDDO
2408 ENDIF
2409 ENDIF
2410 ELSEIF(h3d_keyword_sph_scalar(j)%IS_ID == 0 .AND. is_id == 0 .AND.
2411 . h3d_keyword_sph_scalar(j)%IS_MODE == 0) THEN
2412 cpt_h3d = cpt_h3d + 1
2413 ids_input(cpt_h3d) = -1
2414 modes_input(cpt_h3d)= -1
2415 ENDIF
2416
2417 IF ( key3_glob == h3d_keyword_sph_scalar(j)%KEY3 )THEN
2418
2419 ! ---------------------------------------------------------------------------------------------
2420 ! /H3D/ELEM/FAILURE Specific output name
2421 ! ---------------------------------------------------------------------------------------------
2422 IF((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2423 DO k=1,cpt_h3d
2424 test_chain = ''
2425 IF (cpt_mod > 0) THEN
2426 WRITE(test_chain,'(A,A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; ",
2427 . trim(modname(irup_h3d(k),modes_input(k)))
2428 ELSE
2429 WRITE(test_chain,'(A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; Failure index"
2430 ENDIF
2431 h3d_keyword_sph_scalar(j)%TEXT1 = test_chain
2432 CALL create_h3d_sph_scalar(h3d_data,h3d_keyword_sph_scalar(j)%ID,id_input,
2433 . trim(h3d_keyword_sph_scalar(j)%TEXT1),len_trim(h3d_keyword_sph_scalar(j)%TEXT1),
2434 . h3d_keyword_sph_scalar(j)%COMMENT,80,ipart,key3_glob,
2435 . iuvar,ids_input(k),modes_input(k),igrpart)
2436 ENDDO
2437 ELSE
2438 CALL create_h3d_sph_scalar(h3d_data,h3d_keyword_sph_scalar(j)%ID,id_input,
2439 . trim(h3d_keyword_sph_scalar(j)%TEXT1),len_trim(h3d_keyword_sph_scalar(j)%TEXT1),
2440 . h3d_keyword_sph_scalar(j)%COMMENT,80,ipart,key3_glob,
2441 . iuvar,ids_input(1),modes_input(1),igrpart)
2442 ENDIF
2443 iok_h3dkey_combination = 1
2444 ENDIF
2445c
2446 IF ( key3_glob == h3d_keyword_sph_tensor(j)%KEY3 )THEN
2447
2448 CALL create_h3d_sph_tensor(h3d_data,h3d_keyword_sph_tensor(j)%ID,id_input,
2449 . trim(h3d_keyword_sph_tensor(j)%TEXT1),len_trim(h3d_keyword_sph_tensor(j)%TEXT1),
2450 . h3d_keyword_sph_tensor(j)%COMMENT,80,ipart,key3_glob,igrpart)
2451 iok_h3dkey_combination = 1
2452 ENDIF
2453 ENDDO
2454 ENDIF
2455C--------------------------------------------------
2456 IF(key2 == 'BEAM' .OR. key2 == 'SPRING' .OR. key2 == 'TRUSS' .OR. key2 =='ELEM') THEN
2457C--------------------------------------------------
2458 jmax=max(h3d_num_key%ONED_SCALAR, h3d_num_key%ONED_VECTOR, h3d_num_key%ONED_TENSOR,
2459 . h3d_num_key%ONED_TORSOR)
2460 DO j=1,jmax
2461 cpt_h3d = 0
2462 is_scalar = 0
2463 is_vector = 0
2464 is_tensor = 0
2465 is_torsor = 0
2466 IF ( key3_glob == h3d_keyword_oned_scalar(j)%KEY3 ) is_scalar = 1
2467 IF ( key3_glob == h3d_keyword_oned_vector(j)%KEY3 ) is_vector = 1
2468 IF ( key3_glob == h3d_keyword_oned_tensor(j)%KEY3 ) is_tensor = 1
2469 IF ( key3_glob == h3d_keyword_oned_torsor(j)%KEY3 ) is_torsor = 1
2470 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_torsor == 1 .OR. is_tensor == 1) iok_h3dkey = 1
2471C
2472C
2473 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1 .OR. is_torsor == 1 ) THEN
2474
2475 IF (is_scalar == 1 ) h3d_keyword_oned = h3d_keyword_oned_scalar(j)
2476 IF (is_vector == 1 ) h3d_keyword_oned = h3d_keyword_oned_vector(j)
2477 IF (is_tensor == 1 ) h3d_keyword_oned = h3d_keyword_oned_tensor(j)
2478 IF (is_torsor == 1 ) h3d_keyword_oned = h3d_keyword_oned_torsor(j)
2479
2480 IF ( h3d_keyword_oned%IS_IPT /= 0 ) THEN
2481C
2482 IF ( is_ipt_all == 0 ) THEN
2483 cpt_h3d = cpt_h3d + 1
2484 ipt_input(cpt_h3d) = -1
2485 is_available_key(cpt_h3d) = 1
2486 IF ( h3d_keyword_oned%IS_IPT == 1 ) THEN
2487 IF ( ipt /= 0 ) ipt_input(cpt_h3d) = ipt
2488 ENDIF
2489 ELSE ! IF ( IS_IPT_ALL == 0 )
2490 IF ( nip_max /= 0 ) THEN
2491 DO l=1,max(1,is_ipt_all*max(nip_max,1))
2492 cpt_h3d = cpt_h3d + 1
2493 ipt_input(cpt_h3d) = -1
2494 IF ( nip_max /= 0 .AND. is_ipt_all == 1 ) ipt_input(cpt_h3d) = l
2495 IF (is_ipt_all == 0 .AND. ipt >= 1) ipt_input(cpt_h3d) = ipt
2496 is_available_key(cpt_h3d) = 1
2497 ENDDO
2498 ENDIF
2499 ENDIF ! IF ( IS_IPT_ALL == 0 )
2500 ELSEIF ( h3d_keyword_oned%IS_IPT == 0 .AND. is_ipt == 0 ) THEN
2501 cpt_h3d = cpt_h3d + 1
2502 ipt_input(cpt_h3d) = -1
2503 is_available_key(cpt_h3d) = 1
2504 ENDIF ! IF ( H3D_KEYWORD_ONED%IS_IPT /= 0 )
2505 ENDIF ! IF ( IS_SCALAR == 1 .OR. IS_VECTOR == 1 .OR. IS_TENSOR == 1 .OR. IS_TORSOR == 1 )
2506c
2507 DO k=1,cpt_h3d
2508 IF (is_available_key(k) == 1 .AND. is_scalar == 1) THEN
2509 CALL create_h3d_1d_scalar(h3d_data,h3d_keyword_oned_scalar(j)%ID,id_input,
2510 . trim(h3d_keyword_oned_scalar(j)%TEXT1),
2511 . len_trim(h3d_keyword_oned_scalar(j)%TEXT1),
2512 . h3d_keyword_oned_scalar(j)%COMMENT,80,ipart,key3_glob,ipt_input(k),igrpart)
2513 iok_h3dkey_combination = 1
2514 ELSEIF (is_available_key(k) == 1 .AND. is_vector == 1) THEN
2515 CALL create_h3d_1d_vector(h3d_data,h3d_keyword_oned_vector(j)%ID,id_input,
2516 . trim(h3d_keyword_oned_vector(j)%TEXT1),
2517 . len_trim(h3d_keyword_oned_vector(j)%TEXT1),
2518 . h3d_keyword_oned_vector(j)%COMMENT,80,ipart,key3_glob,igrpart)
2519 iok_h3dkey_combination = 1
2520 ELSEIF (is_available_key(k) == 1 .AND. is_tensor == 1) THEN
2521 CALL create_h3d_1d_tensor(h3d_data,h3d_keyword_oned_tensor(j)%ID,id_input,
2522 . trim(h3d_keyword_oned_tensor(j)%TEXT1),
2523 . len_trim(h3d_keyword_oned_tensor(j)%TEXT1),
2524 . h3d_keyword_oned_tensor(j)%COMMENT,80,ipart,key3_glob,ipt_input(k),igrpart)
2525 iok_h3dkey_combination = 1
2526 ELSEIF (is_available_key(k) == 1 .AND. is_torsor == 1) THEN
2527 CALL create_h3d_1d_torsor(h3d_data,h3d_keyword_oned_torsor(j)%ID,id_input,
2528 . trim(h3d_keyword_oned_torsor(j)%TEXT1),len_trim(h3d_keyword_oned_torsor(j)%TEXT1),
2529 . h3d_keyword_oned_torsor(j)%COMMENT,80,ipart,key3_glob,igrpart)
2530 iok_h3dkey_combination = 1
2531 ENDIF
2532 ENDDO ! DO K=1,CPT_H3D
2533c
2534 ENDDO
2535 ENDIF
2536C--------------------------------------------------
2537 IF(key2 == 'QUAD' .OR. key2 =='ELEM') THEN
2538C--------------------------------------------------
2539 jmax=max(h3d_num_key%QUAD_SCALAR, h3d_num_key%QUAD_VECTOR, h3d_num_key%QUAD_TENSOR)
2540 DO j=1,jmax
2541 cpt_h3d = 0
2542 is_scalar = 0
2543 is_vector = 0
2544 is_tensor = 0
2545 IF ( key3_glob == h3d_keyword_quad_scalar(j)%KEY3) is_scalar = 1
2546 IF ( key3_glob == h3d_keyword_quad_vector(j)%KEY3) is_vector = 1
2547 IF ( key3_glob == h3d_keyword_quad_tensor(j)%KEY3) is_tensor = 1
2548 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1) iok_h3dkey = 1
2549
2550 IF ( is_scalar == 1 .OR. is_vector == 1 .OR. is_tensor == 1 ) THEN
2551 IF(is_scalar == 1) h3d_keyword_quad = h3d_keyword_quad_scalar(j)
2552 IF(is_vector == 1) h3d_keyword_quad = h3d_keyword_quad_vector(j)
2553 IF(is_tensor == 1) h3d_keyword_quad = h3d_keyword_quad_tensor(j)
2554 IF(h3d_keyword_quad%IS_LAYER /= 0 .OR.
2555 . h3d_keyword_quad%IS_IR /= 0 .OR.
2556 . h3d_keyword_quad%IS_IS /= 0 .OR.
2557 . h3d_keyword_quad%IS_IT /= 0 .OR.
2558 . h3d_keyword_quad%IS_UVAR /= 0 .OR.
2559 . h3d_keyword_quad%IS_ID /= 0 .OR.
2560 . h3d_keyword_quad%IS_MODE /= 0 ) THEN
2561 IF(is_layer_all == 0 .AND. is_ir_all == 0 .AND. is_is_all == 0 .AND.
2562 . is_it_all == 0 .AND. is_uvar_all == 0 .AND. is_id_all ==0 .AND.
2563 . is_mode_all == 0)THEN
2564
2565 cpt_h3d = cpt_h3d + 1
2566 layer_input(cpt_h3d) = -1
2567 uvar_input(cpt_h3d)= -1
2568 mdsvar_input(cpt_h3d)= -1
2569 mdsvar_input1(cpt_h3d)= -1
2570 mdsvar_input2(cpt_h3d)= -1
2571 ir_input(cpt_h3d) = -1
2572 is_input(cpt_h3d) = -1
2573 it_input(cpt_h3d) = -1
2574 gauss_input(cpt_h3d) = -1
2575 is_available_key(cpt_h3d) = 1
2576
2577 IF(h3d_keyword_quad%IS_LAYER == 1) THEN
2578 IF(layer /= 0) layer_input(cpt_h3d) = layer
2579 IF(is_layer_lower == 1) layer_input(cpt_h3d) = -2
2580 IF(is_layer_upper == 1) layer_input(cpt_h3d) = -3
2581 ENDIF
2582
2583 IF(h3d_keyword_quad%IS_IPT == 1) THEN
2584 IF(ipt /= 0) ipt_input(cpt_h3d) = ipt
2585 IF(is_ipt_lower == 1) ipt_input(cpt_h3d) = -2
2586 IF(is_ipt_upper == 1) ipt_input(cpt_h3d) = -3
2587 ENDIF
2588
2589 IF(h3d_keyword_quad%IS_UVAR == 1) THEN
2590 IF(iuvar /= 0) uvar_input(cpt_h3d) = iuvar
2591 ENDIF
2592
2593 IF(h3d_keyword_quad%IS_IR == 1) THEN
2594 IF(ir /= 0) ir_input(cpt_h3d) = ir
2595 ENDIF
2596
2597 IF(h3d_keyword_quad%IS_IS == 1) THEN
2598 IF(is /= 0) is_input(cpt_h3d) = is
2599 ENDIF
2600
2601 IF(h3d_keyword_quad%IS_IT == 1) THEN
2602 IF(it /= 0) it_input(cpt_h3d) = it
2603 ENDIF
2604
2605 IF(h3d_keyword_quad%IS_ID == 1) THEN
2606 IF(id /= 0) ids_input(cpt_h3d) = id
2607 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2608 irup_h3d(cpt_h3d) = 1
2609 ENDIF
2610 ENDIF
2611
2612 IF(h3d_keyword_quad%IS_MODE == 1) THEN
2613 IF (mode /= 0) modes_input(cpt_h3d) = mode
2614 ENDIF
2615
2616 ELSE
2617 IF(nlay_max + ir_max + is_max + it_max + nuvar_max + id_max + mode_max /= 0)THEN
2618 DO k=1,max(1,is_layer_all*max(nlay_max,1))
2619 DO l=1,max(1,is_uvar_all*max(nuvar_max,1))
2620 DO m=1,max(1,is_ir_all*max(ir_max,1))
2621 DO n=1,max(1,is_is_all*max(is_max,1))
2622 DO o=1,max(1,is_it_all*max(it_max,1))
2623 DO p=1,max(1,is_id_all*max(id_max,1))
2624 DO q=1,max(1,is_mode_all*max(mode_max,1))
2625 cpt_h3d = cpt_h3d + 1
2626c
2627 layer_input(cpt_h3d) = -1
2628 IF (nlay_max /= 0 .AND. is_layer_all == 1) layer_input(cpt_h3d) = k
2629c
2630 uvar_input(cpt_h3d) = -1
2631 IF (nuvar_max /= 0 .AND. is_uvar_all == 1) uvar_input(cpt_h3d) = l
2632
2633 ir_input(cpt_h3d) = -1
2634 IF (ir_max /= 0 .AND. is_ir_all == 1) ir_input(cpt_h3d) = m
2635
2636 is_input(cpt_h3d) = -1
2637 IF (is_max /= 0 .AND. is_is_all == 1) is_input(cpt_h3d) = n
2638
2639 it_input(cpt_h3d) = -1
2640 IF (it_max /= 0 .AND. is_it_all == 1) it_input(cpt_h3d) = o
2641
2642 ids_input(cpt_h3d) = -1
2643 IF(id /= 0) ids_input(cpt_h3d) = id
2644 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2645 IF (is_id_all == 1) THEN
2646 ids_input(cpt_h3d) = irup_id_all(p)
2647 irup_h3d(cpt_h3d) = p
2648 ELSE
2649 irup_h3d(cpt_h3d) = 1
2650 ENDIF
2651 ENDIF
2652
2653 modes_input(cpt_h3d) = -1
2654 IF (is_mode_all == 1) modes_input(cpt_h3d) = q
2655 IF (is_mode_all == 0 .AND. mode >= 1) modes_input(cpt_h3d) = mode
2656c
2657 gauss_input(cpt_h3d) = -1
2658c
2659 is_available_key(cpt_h3d) = 1
2660c
2661 ENDDO
2662 ENDDO
2663 ENDDO
2664 ENDDO
2665 ENDDO
2666 ENDDO
2667 ENDDO
2668 ENDIF
2669 ENDIF
2670
2671 ELSEIF(h3d_keyword_quad%IS_LAYER == 0 .AND. is_layer == 0 .AND.
2672 . h3d_keyword_quad%IS_IR == 0 .AND. is_ir == 0 .AND.
2673 . h3d_keyword_quad%IS_IS == 0 .AND. is_is == 0 .AND.
2674 . h3d_keyword_quad%IS_IT == 0 .AND. is_it == 0 .AND.
2675 . h3d_keyword_quad%IS_UVAR == 0 .AND. is_uvar == 0 .AND.
2676 . h3d_keyword_quad%IS_ID == 0 .AND. is_id == 0 .AND.
2677 . h3d_keyword_quad%IS_MODE == 0) THEN
2678 cpt_h3d = cpt_h3d + 1
2679 layer_input(cpt_h3d) = -1
2680 uvar_input(cpt_h3d)= -1
2681 mdsvar_input(cpt_h3d)= -1
2682 mdsvar_input1(cpt_h3d)= -1
2683 mdsvar_input2(cpt_h3d)= -1
2684 gauss_input(cpt_h3d) = -1
2685 ir_input(cpt_h3d) = -1
2686 is_input(cpt_h3d) = -1
2687 it_input(cpt_h3d) = -1
2688 ids_input(cpt_h3d) = -1
2689 modes_input(cpt_h3d) = -1
2690 is_available_key(cpt_h3d) = 1
2691 ENDIF
2692 ENDIF
2693
2694 DO k=1,cpt_h3d
2695 IF (is_available_key(k) == 1 .AND. is_scalar == 1)THEN
2696c
2697 ! ---------------------------------------------------------------------------------------------
2698 ! /H3D/ELEM/FAILURE Specific output name
2699 ! ---------------------------------------------------------------------------------------------
2700 IF ((key3_glob(1:7) == 'FAILURE').AND.(cpt_irup > 0)) THEN
2701 test_chain = ''
2702 IF (cpt_mod > 0) THEN
2703 WRITE(test_chain,'(A,A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; ",
2704 . trim(modname(irup_h3d(k),modes_input(k)))
2705 ELSE
2706 WRITE(test_chain,'(A,A,A)') "Failure:",trim(fail_name(irup_h3d(k))),"; Failure index"
2707 ENDIF
2708 h3d_keyword_quad_scalar(j)%TEXT1 = test_chain
2709 ENDIF
2710c
2711 CALL create_h3d_quad_scalar(h3d_data,id_input,
2712 . trim(h3d_keyword_quad_scalar(j)%TEXT1),
2713 . len_trim(h3d_keyword_quad_scalar(j)%TEXT1),
2714 . h3d_keyword_quad_scalar(j)%COMMENT,80,ipart,key3_glob,
2715 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2716 . uvar_input(k),ids_input(k),modes_input(k),igrpart)
2717 iok_h3dkey_combination = 1
2718 ENDIF
2719
2720 IF (is_available_key(k) == 1 .AND. is_vector == 1)THEN
2721
2722 CALL create_h3d_quad_vector(h3d_data,id_input,
2723 . trim(h3d_keyword_quad_vector(j)%TEXT1),
2724 . len_trim(h3d_keyword_quad_vector(j)%TEXT1),
2725 . h3d_keyword_quad_vector(j)%COMMENT,80,ipart,key3_glob,
2726 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2727 . uvar_input(k),igrpart )
2728 iok_h3dkey_combination = 1
2729 ENDIF
2730
2731 IF (is_available_key(k) == 1 .AND. is_tensor == 1)THEN
2732
2733 CALL create_h3d_quad_tensor(h3d_data,h3d_keyword_quad_tensor(j)%ID,id_input,
2734 . trim(h3d_keyword_quad_tensor(j)%TEXT1),
2735 . len_trim(h3d_keyword_quad_tensor(j)%TEXT1),
2736 . h3d_keyword_quad_tensor(j)%COMMENT,80,ipart,key3_glob,
2737 . layer_input(k),ir_input(k),is_input(k),it_input(k),
2738 . uvar_input(k),igrpart )
2739 iok_h3dkey_combination = 1
2740 ENDIF
2741 ENDDO
2742 ENDDO
2743 ENDIF
2744
2745C--------------------------------------------------
2746 IF(key2 == 'SHELL' .OR. key2 =='ELEM'.OR. key2 =='SOLID' .OR.
2747 . key2 == 'BRICK' .OR. key2 =='QUAD'.OR. key2 =='BEAM ' .OR.
2748 . key2 == 'SPRING'.OR. key2 =='TRUSS'.OR.key2 =='SPH') THEN
2749C--------------------------------------------------
2750 DEALLOCATE (layer_input)
2751 DEALLOCATE (ipt_input)
2752 DEALLOCATE (ply_input)
2753 DEALLOCATE (uvar_input)
2754 DEALLOCATE (gauss_input)
2755 DEALLOCATE (ir_input)
2756 DEALLOCATE (is_input)
2757 DEALLOCATE (it_input)
2758 DEALLOCATE (ids_input)
2759 DEALLOCATE (irup_h3d)
2760 DEALLOCATE (is_available_key)
2761 DEALLOCATE (mdsvar_input)
2762 DEALLOCATE (mdsvar_input1)
2763 DEALLOCATE (mdsvar_input2)
2764 DEALLOCATE (mdsvar_input_tmp)
2765 DEALLOCATE (mdsvar_input1_tmp)
2766 DEALLOCATE (mdsvar_input2_tmp)
2767 DEALLOCATE (modes_input)
2768 ENDIF
2769 IF (ALLOCATED(is_layer_mat)) DEALLOCATE (is_layer_mat)
2770C--------------------------------------------------
2771 IF (iok_h3dkey == 0 .AND. ishell_npt_check == 0) THEN
2772 IF (ispmd == 0) CALL ancmsg(msgid=275,c1='/H3D/'//key2//'/'//key3//'/'//key4//'/'//KEY5//'/'//KEY6,
2773 . ANMODE=ANINFO)
2774 IF (ISPMD == 0) CALL ARRET(2)
2775 ENDIF
2776.AND. IF (IOK_H3DKEY_COMBINATION == 0 ISHELL_NPT_CHECK == 0) THEN
2777 IF (ISPMD == 0) CALL ANCMSG(MSGID=317,c1='/h3d/'//KEY2//'/'//KEY3//'/'//KEY4//'/'//KEY5//'/'//KEY6,
2778 . ANMODE=ANINFO_BLIND)
2779 ENDIF
2780 ENDDO
2781 ENDDO
2782c
2783 IF( H3D_DATA%IPART_SELECT == 0 ) CALL CREATE_H3D_PARTS_ALL(H3D_DATA,IPART)
2784C=========================================================================
2785 CPT = 0
2786 DO I=1,H3D_DATA%N_OUTP_H3D
2787 IF (H3D_DATA%OUTPUT_LIST(I)%OK == 1) THEN
2788 CPT = CPT + 1
2789 H3D_DATA%OUTPUT_LIST(I)%N_OUTP = CPT + 2
2790 ELSE
2791 H3D_DATA%OUTPUT_LIST(I)%N_OUTP = 0
2792 ENDIF
2793 ENDDO
2794 IF (IS_SKING > 0) THEN
2795 ISKIND=0
2796 IF (IOUTER==1) ISKIND=ISKIND+1
2797 IF (IPEXT==1) ISKIND=ISKIND+2
2798 CALL H3D_SKIN_DIM(IPARG ,NUMSKIN, NUMSKING,TAG_SKINS6,
2799 . IBCL ,ILOADP ,LLOADP ,LOADS ,
2800 . NUMSKINP0,NUMSKINP,ISKIND,PBLAST )
2801 END IF
2802c For debug purpose
2803c DO I=1,H3D_DATA%N_OUTP_H3D
2804c DO J=1,H3D_DATA%OUTPUT_LIST(I)%N_H3D_PART_LIST
2805c print *,'liste des parts',H3D_DATA%OUTPUT_LIST(I)%H3D_PART_LIST(J)
2806c ENDDO
2807c ENDDO
2808C
2809 H3D_DATA%N_SCAL_CSE_FRICINT = OUTPUT%DATA%NINEFRIC
2810 IF (H3D_DATA%N_SCAL_CSE_FRICINT > 0)THEN
2811 ! Allocate INTERFACE Remote EFRICFI Array
2812 DO I=1,NINTER
2813 ITYP = IPARI(7,I)
2814.OR..OR..OR. IF(ITYP==7ITYP==10ITYP==11
2815.AND..OR..OR. + (ITYP==17IPARI(33,I)==0)ITYP==20
2816.OR..OR..OR. + ITYP==22ITYP==23ITYP==24
2817 + ITYP==25)THEN
2818
2819 IF(H3D_DATA%N_CSE_FRIC_INTER(I) >0) THEN
2820 LENR=0
2821 DO P = 1, NSPMD
2822 LENR = LENR + NSNFI(I)%P(P)
2823 ENDDO
2824 IERROR = 0
2825 ALLOCATE(EFRICFI(I)%P(LENR),STAT=IERROR)
2826 IF(IERROR/=0) THEN
2827 CALL ANCMSG(MSGID=20,ANMODE=ANINFO)
2828 CALL ARRET(2)
2829 ENDIF
2830 EFRICFI(I)%P(1:LENR)=ZERO
2831 ENDIF
2832 ENDIF
2833 ENDDO
2834 ENDIF
2835
2836 IF (H3D_DATA%N_SCAL_CSE_FRIC > 0)THEN
2837 ! Allocate INTERFACE Remote EFRICGFI Array
2838 DO I=1,NINTER
2839 ITYP = IPARI(7,I)
2840.OR..OR..OR. IF(ITYP==7ITYP==10ITYP==11
2841.AND..OR..OR. + (ITYP==17IPARI(33,I)==0)ITYP==20
2842.OR..OR..OR. + ITYP==22ITYP==23ITYP==24
2843 + ITYP==25)THEN
2844 LENR=0
2845 DO P = 1, NSPMD
2846 LENR = LENR + NSNFI(I)%P(P)
2847 ENDDO
2848 IERROR = 0
2849 ALLOCATE(EFRICGFI(I)%P(LENR),STAT=IERROR)
2850 IF(IERROR/=0) THEN
2851 CALL ANCMSG(MSGID=20,ANMODE=ANINFO)
2852 CALL ARRET(2)
2853 ENDIF
2854 EFRICGFI(I)%P(1:LENR)=ZERO
2855 ENDIF
2856 ENDDO
2857 ENDIF
2858C
2859 DEALLOCATE(H3D_KEYWORD_NODAL_SCALAR)
2860 DEALLOCATE(H3D_KEYWORD_NODAL_VECTOR)
2861 DEALLOCATE(H3D_KEYWORD_NODAL_TENSOR)
2862 DEALLOCATE(H3D_KEYWORD_ONED_SCALAR)
2863 DEALLOCATE(H3D_KEYWORD_ONED_VECTOR)
2864 DEALLOCATE(H3D_KEYWORD_ONED_TENSOR)
2865 DEALLOCATE(H3D_KEYWORD_ONED_TORSOR)
2866 DEALLOCATE(H3D_KEYWORD_SHELL_SCALAR)
2867 DEALLOCATE(H3D_KEYWORD_SHELL_VECTOR)
2868 DEALLOCATE(H3D_KEYWORD_SHELL_TENSOR)
2869 DEALLOCATE(H3D_KEYWORD_SOLID_SCALAR)
2870 DEALLOCATE(H3D_KEYWORD_SOLID_VECTOR)
2871 DEALLOCATE(H3D_KEYWORD_SOLID_TENSOR)
2872 DEALLOCATE(H3D_KEYWORD_SPH_SCALAR)
2873 DEALLOCATE(H3D_KEYWORD_SPH_TENSOR)
2874 DEALLOCATE(H3D_KEYWORD_QUAD_SCALAR)
2875 DEALLOCATE(H3D_KEYWORD_QUAD_VECTOR)
2876 DEALLOCATE(H3D_KEYWORD_QUAD_TENSOR)
2877 DEALLOCATE(ID_MAT_MDS)
2878 IF (ALLOCATED(IRUP_ID_ALL)) DEALLOCATE (IRUP_ID_ALL)
2879C
2880 RETURN
2881 END
create_h3d_1d_scalar
subroutine create_h3d_1d_scalar(h3d_data, id_1d_scalar, id_input, text1, stext1, comment, scomment, ipart, key3_glob, ipt, igrpart)
Definition create_h3d_1d_scalar.F:38
create_h3d_1d_tensor
subroutine create_h3d_1d_tensor(h3d_data, id_1d_tensor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, ipt, igrpart)
Definition create_h3d_1d_tensor.F:38
create_h3d_1d_torsor
subroutine create_h3d_1d_torsor(h3d_data, id_1d_torsor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, igrpart)
Definition create_h3d_1d_torsor.F:38
create_h3d_1d_vector
subroutine create_h3d_1d_vector(h3d_data, id_1d_vector, id_input, text1, stext1, comment, scomment, ipart, key3_glob, igrpart)
Definition create_h3d_1d_vector.F:38
create_h3d_arg_keyword
subroutine create_h3d_arg_keyword(key2, key3, key4, key5, key6, key7, key8, is_all, is_lower, is_upper, arg, s_arg, is_arg, value, is_arg_all, is_arg_lower, is_arg_upper, is_def, is_arg_def, is_memb, is_arg_memb)
Definition create_h3d_arg_keyword.F:40
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
create_h3d_nodal_scalar
subroutine create_h3d_nodal_scalar(h3d_data, id_nodal_scalar, id_input, text1, stext1, comment, scomment, ipart, key3_glob, inter, igrpart)
Definition create_h3d_nodal_scalar.F:38
create_h3d_nodal_tensor
subroutine create_h3d_nodal_tensor(h3d_data, id_nodal_tensor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, igrpart)
Definition create_h3d_nodal_tensor.F:38
create_h3d_nodal_vector
subroutine create_h3d_nodal_vector(h3d_data, id_nodal_vector, id_input, text1, stext1, comment, scomment, ipart, key3_glob, igrpart)
Definition create_h3d_nodal_vector.F:38
create_h3d_parts
subroutine create_h3d_parts(h3d_data, id_input, ipart, igrpart)
Definition create_h3d_parts.F:35
create_h3d_quad_scalar
subroutine create_h3d_quad_scalar(h3d_data, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, id, mode, igrpart)
Definition create_h3d_quad_scalar.F:39
create_h3d_quad_tensor
subroutine create_h3d_quad_tensor(h3d_data, id_quad_tensor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, igrpart)
Definition create_h3d_quad_tensor.F:38
create_h3d_quad_vector
subroutine create_h3d_quad_vector(h3d_data, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, igrpart)
Definition create_h3d_quad_vector.F:38
create_h3d_shell_scalar
subroutine create_h3d_shell_scalar(h3d_data, id_shell_scalar, n1, n2, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ipt, ply, gauss, iuvar, idmds, ivarmds, id_mat_mds, mds_label, smds_label, id, mode, igrpart)
Definition create_h3d_shell_scalar.F:41
create_h3d_shell_tensor
subroutine create_h3d_shell_tensor(h3d_data, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ipt, ply, gauss, iuvar, id, igrpart)
Definition create_h3d_shell_tensor.F:40
create_h3d_shell_vector
subroutine create_h3d_shell_vector(h3d_data, id_shell_vector, n1, n2, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ipt, ply, gauss, iuvar, igrpart)
Definition create_h3d_shell_vector.F:39
create_h3d_skin_scalar
subroutine create_h3d_skin_scalar(h3d_data, id_solid_scalar, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, igrpart)
Definition create_h3d_skin_scalar.F:39
create_h3d_skin_tensor
subroutine create_h3d_skin_tensor(h3d_data, id_solid_tensor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, igrpart)
Definition create_h3d_skin_tensor.F:39
create_h3d_skin_vector
subroutine create_h3d_skin_vector(h3d_data, id_skin_vector, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, igrpart)
Definition create_h3d_skin_vector.F:38
create_h3d_solid_scalar
subroutine create_h3d_solid_scalar(h3d_data, id_solid_scalar, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, idmds, ivarmds, id_mat_mds, mds_label, smds_label, id, mode, igrpart)
Definition create_h3d_solid_scalar.F:41
create_h3d_solid_tensor
subroutine create_h3d_solid_tensor(h3d_data, id_solid_tensor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, is_corner_data, id, igrpart)
Definition create_h3d_solid_tensor.F:39
create_h3d_solid_vector
subroutine create_h3d_solid_vector(h3d_data, id_solid_vector, id_input, text1, stext1, comment, scomment, ipart, key3_glob, layer, ir, is, it, iuvar, igrpart)
Definition create_h3d_solid_vector.F:39
create_h3d_sph_scalar
subroutine create_h3d_sph_scalar(h3d_data, id_sph_scalar, id_input, text1, stext1, comment, scomment, ipart, key3_glob, iuvar, id, mode, igrpart)
Definition create_h3d_sph_scalar.F:39
create_h3d_sph_tensor
subroutine create_h3d_sph_tensor(h3d_data, id_sph_tensor, id_input, text1, stext1, comment, scomment, ipart, key3_glob, igrpart)
Definition create_h3d_sph_tensor.F:38
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_list_1d_scalar
subroutine h3d_list_1d_scalar(h3d_keyword_oned_scalar, geo, nkey)
Definition h3d_list_1d_scalar.F:32
h3d_list_1d_tensor
subroutine h3d_list_1d_tensor(h3d_keyword_oned_tensor, geo, nkey)
Definition h3d_list_1d_tensor.F:32
h3d_list_1d_torsor
subroutine h3d_list_1d_torsor(h3d_keyword_oned_torsor, geo, nkey)
Definition h3d_list_1d_torsor.F:32
h3d_list_1d_vector
subroutine h3d_list_1d_vector(h3d_keyword_oned_vector, geo, nkey)
Definition h3d_list_1d_vector.F:32
h3d_list_nodal_scalar
subroutine h3d_list_nodal_scalar(output, h3d_keyword_nodal_scalar, geo, nkey)
Definition h3d_list_noda_scalar.F:33
h3d_list_nodal_tensor
subroutine h3d_list_nodal_tensor(h3d_keyword_nodal_tensor, geo, nkey)
Definition h3d_list_noda_tensor.F:32
h3d_list_nodal_vector
subroutine h3d_list_nodal_vector(h3d_keyword_nodal_vector, geo, nkey)
Definition h3d_list_noda_vector.F:32
h3d_list_quad_scalar
subroutine h3d_list_quad_scalar(h3d_keyword_quad_scalar, geo, igeo, multi_fvm, nkey)
Definition h3d_list_quad_scalar.F:34
h3d_list_quad_tensor
subroutine h3d_list_quad_tensor(h3d_keyword_quad_tensor, geo, igeo, nkey)
Definition h3d_list_quad_tensor.F:33
h3d_list_quad_vector
subroutine h3d_list_quad_vector(h3d_keyword_quad_vector, geo, igeo, nkey)
Definition h3d_list_quad_vector.F:32
h3d_list_shell_scalar
subroutine h3d_list_shell_scalar(h3d_keyword_shell_scalar, geo, igeo, multi_fvm, nkey)
Definition h3d_list_shell_scalar.F:34
h3d_list_shell_tensor
subroutine h3d_list_shell_tensor(h3d_keyword_shell_tensor, geo, igeo, nkey)
Definition h3d_list_shell_tensor.F:33
h3d_list_shell_vector
subroutine h3d_list_shell_vector(h3d_keyword_shell_vector, geo, igeo, nkey)
Definition h3d_list_shell_vector.F:32
h3d_list_solid_scalar
subroutine h3d_list_solid_scalar(h3d_keyword_solid_scalar, geo, igeo, multi_fvm, nkey)
Definition h3d_list_solid_scalar.F:33
h3d_list_solid_tensor
subroutine h3d_list_solid_tensor(h3d_keyword_solid_tensor, geo, igeo, nkey)
Definition h3d_list_solid_tensor.F:32
h3d_list_solid_vector
subroutine h3d_list_solid_vector(h3d_keyword_solid_vector, geo, igeo, nkey)
Definition h3d_list_solid_vector.F:32
h3d_list_sph_scalar
subroutine h3d_list_sph_scalar(h3d_keyword_sph_scalar, geo, igeo, nkey)
Definition h3d_list_sph_scalar.F:32
h3d_list_sph_tensor
subroutine h3d_list_sph_tensor(h3d_keyword_sph_tensor, geo, igeo, nkey)
Definition h3d_list_sph_tensor.F:32
lech3d
subroutine lech3d(output, geo, igeo, ipm, ipart, h3d_data, multi_fvm, ipari, iparg, tag_skins6, mds_label, mds_output_table, mds_nmat, max_depvar, mds_ndepsvar, elbuf_str, stack, ibcl, iloadp, lloadp, loads, mat_param, pblast, igrpart, npc, tf, snpc, stf)
Definition lech3d.F:97
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_mod
Definition h3d_mod.F:311
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
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
stack_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_mod.F:133
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
groupdef_mod::group_
Definition groupdef_mod.F:706