FrontISTR  6.0.0
Large-scale structural analysis program with finit element method
fstr_ctrl_material.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
6 module fstr_ctrl_material
7  use hecmw
8  use mmaterial
9  use m_table
10  use fstr_ctrl_util_f
11  implicit none
12 
13  private :: read_user_matl
14 
15 contains
16 
17 
18  !----------------------------------------------------------------------
20  integer function fstr_ctrl_get_material( ctrl, matname )
21  integer(kind=kint), intent(in) :: ctrl
22  character(len=*), intent(out) :: matname
23 
24  matname=""
25  fstr_ctrl_get_material = fstr_ctrl_get_param_ex( ctrl, 'NAME ', '# ', 0, 'S', matname )
26  end function fstr_ctrl_get_material
27 
28  !----------------------------------------------------------------------
30  integer function fstr_ctrl_get_usermaterial( ctrl, mattype, nlgeom, nstatus, matval )
31  integer(kind=kint), intent(in) :: ctrl
32  integer(kind=kint), intent(inout) :: mattype
33  integer(kind=kint), intent(out) :: nlgeom
34  integer(kind=kint), intent(out) :: nstatus
35  real(kind=kreal),intent(inout) :: matval(:)
36 
37  integer(kind=kint) :: ipt
38 
39  fstr_ctrl_get_usermaterial = -1
40  mattype = usermaterial
41  nlgeom = updatelag !default value
42  nstatus = 1
43  if( fstr_ctrl_get_param_ex( ctrl, 'NSTATUS ', '# ', 0, 'I', nstatus )/= 0) return
44  if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ', '# ', 0, 'E', ipt )/= 0) return
45  if( ipt/=0 ) nlgeom = totallag
46 
47  fstr_ctrl_get_usermaterial = read_user_matl( ctrl, matval )
48  end function fstr_ctrl_get_usermaterial
49 
50  !----------------------------------------------------------------------
52  integer function fstr_ctrl_get_elasticity( ctrl, mattype, nlgeom, matval, dict )
53  integer(kind=kint), intent(in) :: ctrl
54  integer(kind=kint), intent(inout) :: mattype
55  integer(kind=kint), intent(out) :: nlgeom
56  real(kind=kreal),intent(inout) :: matval(:)
57  type(dict_struct), pointer :: dict
58 
59  integer(kind=kint) :: i, rcode, depends, ipt, n
60  real(kind=kreal), allocatable :: fval(:,:)
61  character(len=HECMW_NAME_LEN) :: data_fmt
62  type( ttable ) :: mattable
63  logical :: isok
64  character(len=256) :: s
65 
66  fstr_ctrl_get_elasticity = -1
67  depends = 0
68  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
69  if( depends>1 ) depends=1 ! temperature depends only currently
70  if( depends > 3 ) stop "We cannot read dependencies>3 right now"
71  nlgeom = totallag !default value
72 
73  if( fstr_ctrl_get_param_ex( ctrl, 'CAUCHY ', '# ', 0, 'E', ipt )/= 0) return
74  if( ipt/=0 ) nlgeom = updatelag
75  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITESIMAL ', '# ', 0, 'E', ipt )/= 0) return
76  if( ipt/=0 ) nlgeom = infinitesimal
77 
78  ! for backward compatibility
79  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ', '# ', 0, 'E', ipt )/= 0) return
80  if( ipt/=0 ) then
81  write(*,*) "Warning : !ELASTIC : parameter 'INFINITE' is deprecated." &
82  & // " Please use the replacement parameter 'INFINITESIMAL'"
83  nlgeom = infinitesimal
84  endif
85 
86  ipt=1
87  s = 'ISOTROPIC,ORTHOTROPIC,USER '
88  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
89 
90  n = fstr_ctrl_get_data_line_n( ctrl )
91  ! ISOTROPIC
92  if( ipt==1 ) then
93  allocate( fval(2+depends,n) )
94  fval =0.0d0
95  if( depends==0 ) then
96  data_fmt = "RR "
97  block
98  real(kind=kreal) :: fval1(n), fval2(n)
99  fval1 = fval(1,:)
100  fval2 = fval(2,:)
101  fstr_ctrl_get_elasticity = &
102  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
103  fval(1,:) = fval1
104  fval(2,:) = fval2
105  end block
106  endif
107  if( depends==1 ) then
108  data_fmt = "RRR "
109  block
110  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
111  fval1 = fval(1,:)
112  fval2 = fval(2,:)
113  fval3 = fval(3,:)
114  fstr_ctrl_get_elasticity = &
115  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
116  fval(1,:) = fval1
117  fval(2,:) = fval2
118  fval(3,:) = fval3
119  end block
120  endif
121  if( fstr_ctrl_get_elasticity ==0 ) then
122  matval(m_youngs) = fval(1,1)
123  matval(m_poisson) = fval(2,1)
124  call init_table( mattable, depends, 2+depends,n, fval )
125  call dict_add_key( dict, mc_isoelastic, mattable )
126  ! call print_table( mattable, 6 ); pause
127  endif
128  mattype = elastic
129 
130  ! ORTHOTROPIC
131  else if( ipt==2 ) then
132  allocate( fval(9+depends,n) )
133  fval =0.0d0
134  if( depends==0 ) then
135  data_fmt = "RRRRRRRRR "
136  block
137  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n), fval5(n), &
138  fval6(n), fval7(n), fval8(n), fval9(n)
139  fval1 = fval(1,:)
140  fval2 = fval(2,:)
141  fval3 = fval(3,:)
142  fval4 = fval(4,:)
143  fval5 = fval(5,:)
144  fval6 = fval(6,:)
145  fval7 = fval(7,:)
146  fval8 = fval(8,:)
147  fval9 = fval(9,:)
148  fstr_ctrl_get_elasticity = &
149  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, &
150  fval1, fval2, fval3, fval4, fval5, fval6, fval7, fval8, fval9 )
151  fval(1,:) = fval1
152  fval(2,:) = fval2
153  fval(3,:) = fval3
154  fval(4,:) = fval4
155  fval(5,:) = fval5
156  fval(6,:) = fval6
157  fval(7,:) = fval7
158  fval(8,:) = fval8
159  fval(9,:) = fval9
160  end block
161  else if( depends==1 ) then
162  data_fmt = "RRRRRRRRRR "
163  block
164  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n), fval5(n), &
165  fval6(n), fval7(n), fval8(n), fval9(n), fval10(n)
166  fval1 = fval(1,:)
167  fval2 = fval(2,:)
168  fval3 = fval(3,:)
169  fval4 = fval(4,:)
170  fval5 = fval(5,:)
171  fval6 = fval(6,:)
172  fval7 = fval(7,:)
173  fval8 = fval(8,:)
174  fval9 = fval(9,:)
175  fval10 = fval(10,:)
176  fstr_ctrl_get_elasticity = &
177  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, &
178  fval1, fval2, fval3, fval4, fval5, fval6, fval7, fval8, fval9, fval10 )
179  fval(1,:) = fval1
180  fval(2,:) = fval2
181  fval(3,:) = fval3
182  fval(4,:) = fval4
183  fval(5,:) = fval5
184  fval(6,:) = fval6
185  fval(7,:) = fval7
186  fval(8,:) = fval8
187  fval(9,:) = fval9
188  fval(10,:) = fval10
189  end block
190  endif
191  if( fstr_ctrl_get_elasticity ==0 ) then
192  isok = .true.
193  do i=1,n
194  if( fval(1,i)<=0.d0 .or. fval(2,i)<=0.d0 .or. fval(3,i)<=0.d0 .or. &
195  fval(7,i)<=0.d0 .or. fval(8,i)<=0.d0 .or. fval(9,i)<=0.d0 ) then
196  isok = .false.; fstr_ctrl_get_elasticity=1; exit
197  endif
198  enddo
199  if( isok ) then
200  call init_table( mattable, depends, 9+depends,n, fval )
201  call dict_add_key( dict, mc_orthoelastic, mattable )
202  mattype = mn_orthoelastic
203  endif
204  endif
205 
206  else if( ipt==3 ) then
207  fstr_ctrl_get_elasticity = read_user_matl( ctrl, matval(101:200))
208  mattype = userelastic
209  nlgeom = infinitesimal
210 
211  else
212  stop "ERROR: Material type not supported"
213 
214  endif
215 
216  call finalize_table( mattable )
217  if( allocated(fval) ) deallocate(fval)
218  end function fstr_ctrl_get_elasticity
219 
220 
221  !----------------------------------------------------------------------
223  integer function fstr_ctrl_get_hyperelastic( ctrl, mattype, nlgeom, matval )
224  integer(kind=kint), intent(in) :: ctrl
225  integer(kind=kint), intent(inout) :: mattype
226  integer(kind=kint), intent(out) :: nlgeom
227  real(kind=kreal),intent(inout) :: matval(:)
228 
229  integer(kind=kint) :: rcode, depends, ipt
230  real(kind=kreal), allocatable :: fval(:,:)
231  character(len=HECMW_NAME_LEN) :: data_fmt
232  character(len=256) :: s
233 
234  fstr_ctrl_get_hyperelastic = -1
235  depends = 0
236  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
237  if( depends > 3 ) stop "We cannot read dependencies>3 right now"
238  nlgeom = totallag !default value
239  if( fstr_ctrl_get_param_ex( ctrl, 'CAUCHY ', '# ', 0, 'E', ipt )/= 0) return
240  if( ipt/=0 ) nlgeom = updatelag
241 
242  ipt=1
243  s = 'NEOHOOKE,MOONEY-RIVLIN,ARRUDA-BOYCE,USER,MOONEY-RIVLIN-ANISO '
244  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
245 
246  ! NEOHOOKE
247  if( ipt==1 ) then
248  allocate( fval(2,depends+1) )
249  fval =0.0d0
250  if( depends==0 ) then
251  data_fmt = "RR "
252  block
253  real(kind=kreal) :: fval1(depends+1), fval2(depends+1)
254  fval1 = fval(1,:)
255  fval2 = fval(2,:)
256  fstr_ctrl_get_hyperelastic = &
257  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
258  fval(1,:) = fval1
259  fval(2,:) = fval2
260  end block
261  endif
262  if( fstr_ctrl_get_hyperelastic ==0 ) then
263  if( fval(2,1)==0.d0 ) stop "We cannot deal with incompressible material currently"
264  matval(m_plconst1) = fval(1,1)
265  matval(m_plconst2) = 0.d0
266  matval(m_plconst3) = fval(2,1)
267  ! matval(M_YOUNGS) = fval(1,1)
268  ! matval(M_POISSON) = fval(2,1)
269  endif
270  mattype = neohooke
271 
272  ! MOONEY
273  else if( ipt==2 ) then
274  allocate( fval(3,depends+1) )
275  fval =0.0d0
276  if( depends==0 ) then
277  data_fmt = "RRR "
278  block
279  real(kind=kreal) :: fval1(depends+1), fval2(depends+1), fval3(depends+1)
280  fval1 = fval(1,:)
281  fval2 = fval(2,:)
282  fval3 = fval(3,:)
283  fstr_ctrl_get_hyperelastic = &
284  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
285  fval(1,:) = fval1
286  fval(2,:) = fval2
287  fval(3,:) = fval3
288  end block
289  endif
290  if( fstr_ctrl_get_hyperelastic ==0 ) then
291  matval(m_plconst1) = fval(1,1)
292  matval(m_plconst2) = fval(2,1)
293  matval(m_plconst3) = fval(3,1)
294  endif
295  mattype = mooneyrivlin
296 
297  ! ARRUDA
298  else if( ipt==3 ) then
299  allocate( fval(3,depends+1) )
300  fval =0.0d0
301  if( depends==0 ) then
302  data_fmt = "RRR "
303  block
304  real(kind=kreal) :: fval1(depends+1), fval2(depends+1), fval3(depends+1)
305  fval1 = fval(1,:)
306  fval2 = fval(2,:)
307  fval3 = fval(3,:)
308  fstr_ctrl_get_hyperelastic = &
309  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
310  fval(1,:) = fval1
311  fval(2,:) = fval2
312  fval(3,:) = fval3
313  end block
314  endif
315  if( fstr_ctrl_get_hyperelastic ==0 ) then
316  matval(m_plconst1) = fval(1,1)
317  matval(m_plconst2) = fval(2,1)
318  matval(m_plconst3) = fval(3,1)
319  endif
320  mattype = arrudaboyce
321 
322  else if( ipt==4 ) then !User
323  fstr_ctrl_get_hyperelastic = read_user_matl( ctrl, matval(101:200))
324  mattype = userhyperelastic
325 
326  ! MOONEY-ORTHO
327  else if( ipt==5 ) then
328  allocate( fval(10,depends+1) )
329  fval =0.0d0
330  if( depends==0 ) then
331  data_fmt = "RRRRRrrrrr "
332  block
333  real(kind=kreal) :: fval1(depends+1), fval2(depends+1), fval3(depends+1), fval4(depends+1), fval5(depends+1), &
334  fval6(depends+1), fval7(depends+1), fval8(depends+1), fval9(depends+1), fval10(depends+1)
335  fval1 = fval(1,:)
336  fval2 = fval(2,:)
337  fval3 = fval(3,:)
338  fval4 = fval(4,:)
339  fval5 = fval(5,:)
340  fval6 = fval(6,:)
341  fval7 = fval(7,:)
342  fval8 = fval(8,:)
343  fval9 = fval(9,:)
344  fval10 = fval(10,:)
345  fstr_ctrl_get_hyperelastic = &
346  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, &
347  fval1, fval2, fval3, fval4, fval5, fval6, fval7, fval8, fval9, fval10 )
348  fval(1,:) = fval1
349  fval(2,:) = fval2
350  fval(3,:) = fval3
351  fval(4,:) = fval4
352  fval(5,:) = fval5
353  fval(6,:) = fval6
354  fval(7,:) = fval7
355  fval(8,:) = fval8
356  fval(9,:) = fval9
357  fval(10,:) = fval10
358  end block
359  endif
360  if( fstr_ctrl_get_hyperelastic ==0 ) then
361  matval(m_plconst1) = fval(1,1)
362  matval(m_plconst2) = fval(2,1)
363  matval(m_plconst3) = fval(3,1)
364  matval(m_plconst4) = fval(4,1)
365  matval(m_plconst5) = fval(5,1)
366  matval(m_plconst6) = fval(6,1)
367  matval(m_plconst7) = fval(7,1)
368  matval(m_plconst8) = fval(8,1)
369  matval(m_plconst9) = fval(9,1)
370  matval(m_plconst10) = fval(10,1)
371  endif
372  mattype = mooneyrivlin_aniso
373 
374  endif
375 
376  if( allocated(fval) ) deallocate(fval)
377  end function fstr_ctrl_get_hyperelastic
378 
379 
380  !----------------------------------------------------------------------
382  integer function fstr_ctrl_get_viscoelasticity( ctrl, mattype, nlgeom, dict )
383  integer(kind=kint), intent(in) :: ctrl
384  integer(kind=kint), intent(inout) :: mattype
385  integer(kind=kint), intent(out) :: nlgeom
386  type(dict_struct), pointer :: dict
387 
388  integer(kind=kint) :: rcode, depends, ipt, n
389  real(kind=kreal), allocatable :: fval(:,:)
390  character(len=HECMW_NAME_LEN) :: data_fmt
391  type( ttable ) :: mattable
392  character(len=256) :: s
393 
394  fstr_ctrl_get_viscoelasticity = -1
395  depends = 0
396  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
397  if( depends>1 ) depends=1 ! temperature depends only currently
398  !depends = 0
399  nlgeom = totallag !default value
400  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITESIMAL ', '# ', 0, 'E', ipt )/= 0) return
401  if( ipt/=0 ) nlgeom = infinitesimal
402 
403  ! for backward compatibility
404  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ', '# ', 0, 'E', ipt )/= 0) return
405  if( ipt/=0 ) then
406  write(*,*) "Warning : !VISCOELASTIC : parameter 'INFINITE' is deprecated." &
407  & // " Please use the replacement parameter 'INFINITESIMAL'"
408  nlgeom = infinitesimal
409  endif
410 
411  ipt=1
412  s = 'ISOTROPIC,USER '
413  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
414 
415  ! ISOTROPIC
416  if( ipt==1 ) then
417  n = fstr_ctrl_get_data_line_n( ctrl )
418  allocate( fval(2+depends,n) )
419  fval =0.0d0
420  if( depends==0 ) then
421  data_fmt = "RR "
422  block
423  real(kind=kreal) :: fval1(n), fval2(n)
424  fval1 = fval(1,:)
425  fval2 = fval(2,:)
426  fstr_ctrl_get_viscoelasticity = &
427  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
428  fval(1,:) = fval1
429  fval(2,:) = fval2
430  end block
431  if( fval(2,1)==0.d0 ) stop "Error in defining viscoelasticity: Relaxation time cannot be zero!"
432  endif
433  if( depends==1 ) then
434  data_fmt = "RRR "
435  block
436  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
437  fval1 = fval(1,:)
438  fval2 = fval(2,:)
439  fval3 = fval(3,:)
440  fstr_ctrl_get_viscoelasticity = &
441  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
442  fval(1,:) = fval1
443  fval(2,:) = fval2
444  fval(3,:) = fval3
445  end block
446  endif
447  if( fstr_ctrl_get_viscoelasticity ==0 ) then
448  call init_table( mattable, 1, 2+depends,n, fval )
449  call dict_add_key( dict, mc_viscoelastic, mattable )
450  ! call print_table( mattable, 6 ); pause
451  endif
452  mattype = viscoelastic
453 
454  else
455  stop "ERROR: Material type not supported"
456 
457  endif
458 
459  call finalize_table( mattable )
460  if( allocated(fval) ) deallocate(fval)
461  end function fstr_ctrl_get_viscoelasticity
462 
463 
465  integer function fstr_ctrl_get_trs( ctrl, mattype, matval )
466  integer(kind=kint), intent(in) :: ctrl
467  integer(kind=kint), intent(inout) :: mattype
468  real(kind=kreal),intent(inout) :: matval(:)
469 
470  integer :: ipt
471  character(len=256) :: s
472 
473  ipt=1
474  s = 'WLF,ARRHENIUS '
475  if( fstr_ctrl_get_param_ex( ctrl, 'DEFINITION ', s, 0, 'P', ipt ) /= 0 ) return
476 
477  fstr_ctrl_get_trs &
478  = fstr_ctrl_get_data_ex( ctrl, 1, "RRR ", matval(1), matval(2), matval(3) )
479  if( fstr_ctrl_get_trs/=0 ) return
480  mattype = mattype+ipt
481 
482  end function fstr_ctrl_get_trs
483 
484 
485  !----------------------------------------------------------------------
487  integer function fstr_ctrl_get_plasticity( ctrl, mattype, nlgeom, matval, mattable, dict )
488  integer(kind=kint), intent(in) :: ctrl
489  integer(kind=kint), intent(inout) :: mattype
490  integer(kind=kint), intent(out) :: nlgeom
491  real(kind=kreal),intent(inout) :: matval(:)
492  real(kind=kreal), pointer :: mattable(:)
493  type(dict_struct), pointer :: dict
494 
495  integer(kind=kint) :: i, n, rcode, depends, ipt, hipt
496  real(kind=kreal), allocatable :: fval(:,:)
497  real(kind=kreal) :: phi, psi
498  character(len=HECMW_NAME_LEN) :: data_fmt
499  character(len=256) :: s
500  type( ttable ) :: mttable
501  real(kind=kreal), parameter :: pi=3.14159265358979d0
502 
503  fstr_ctrl_get_plasticity = -1
504  ipt = 0; hipt = 0
505 
506  depends = 0
507  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
508  if( depends>1 ) depends = 1 ! we consider temperature dependence only currently
509  if( depends > 3 ) stop "We cannot read dependencies>3 right now"
510  nlgeom = updatelag !default value
511  if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ', '# ', 0, 'E', ipt )/= 0) return
512  ! rcode = fstr_ctrl_get_param_ex( ctrl, 'FILE ', '# ', 0, 'S', fname )
513  if( ipt/=0 ) nlgeom = totallag
514  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITESIMAL ', '# ', 0, 'E', ipt )/= 0) return
515  if( ipt/=0 ) nlgeom = infinitesimal
516 
517  ! for backward compatibility
518  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ', '# ', 0, 'E', ipt )/= 0) return
519  if( ipt/=0 ) then
520  write(*,*) "Warning : !PLASTIC : parameter 'INFINITE' is deprecated." &
521  & // " Please use the replacement parameter 'INFINITESIMAL'"
522  nlgeom = infinitesimal
523  endif
524 
525  call setdigit( 1, 1, mattype )
526  call setdigit( 2, 2, mattype )
527 
528  ! hardening
529  s = 'BILINEAR,MULTILINEAR,SWIFT,RAMBERG-OSGOOD,KINEMATIC,COMBINED '
530  if( fstr_ctrl_get_param_ex( ctrl, 'HARDEN ', s , 0, 'P', hipt ) /= 0 ) return
531  if( hipt==0 ) hipt=1 ! default: linear hardening
532  call setdigit( 5, hipt-1, mattype )
533 
534  ! yield function
535  s = 'MISES,MOHR-COULOMB,DRUCKER-PRAGER,USER '
536  call setdigit( 2, 2, mattype )
537  if( fstr_ctrl_get_param_ex( ctrl, 'YIELD ', s , 0, 'P', ipt ) /= 0 ) return
538  if( ipt==0 ) ipt=1 ! default: mises yield function
539  call setdigit( 4, ipt-1, mattype )
540 
541  n = fstr_ctrl_get_data_line_n( ctrl )
542  if( n == 0 ) return ! fail in reading plastic
543  if( hipt==2 .and. n<2 ) return ! not enough data
544  if( ( ipt==2 .or. ipt==3 ) .and. hipt>2 ) hipt = 1
545 
546  select case (ipt)
547  case (1) !Mises
548  select case (hipt)
549  case (1,5) ! linear hardening, kinematic hardening
550  allocate( fval(2,n) )
551  fval =0.0d0
552  data_fmt = "RR "
553  block
554  real(kind=kreal) :: fval1(n), fval2(n)
555  fval1 = fval(1,:)
556  fval2 = fval(2,:)
557  fstr_ctrl_get_plasticity = &
558  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
559  fval(1,:) = fval1
560  fval(2,:) = fval2
561  end block
562  if( fstr_ctrl_get_plasticity ==0 ) then
563  matval(m_plconst1) = fval(1,1)
564  if(hipt==1) then
565  matval(m_plconst2) = fval(2,1)
566  else
567  matval(m_plconst2) = 0.d0
568  matval(m_plconst3) = fval(2,1)
569  endif
570  endif
571  case (2) ! multilinear approximation
572  allocate( fval(depends+2,n) )
573  fval =0.0d0
574  if( depends==0 ) then
575  data_fmt = "RR "
576  block
577  real(kind=kreal) :: fval1(n), fval2(n)
578  fval1 = fval(1,:)
579  fval2 = fval(2,:)
580  fstr_ctrl_get_plasticity = &
581  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
582  fval(1,:) = fval1
583  fval(2,:) = fval2
584  end block
585  if( fstr_ctrl_get_plasticity ==0 ) then
586  if( fval(2,1)/=0.d0 ) then
587  print *, "Multilinear hardening: First plastic strain must be zero"
588  stop
589  endif
590  do i=1,n
591  if( fval(2,i)<0.0 ) &
592  stop "Multilinear hardening: Error in plastic strain definition"
593  enddo
594  call init_table( mttable,1, 2+depends, n, fval )
595  call dict_add_key( dict, mc_yield, mttable )
596 
597  endif
598  else ! depends==1
599  data_fmt = "RRR "
600  block
601  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
602  fval1 = fval(1,:)
603  fval2 = fval(2,:)
604  fval3 = fval(3,:)
605  fstr_ctrl_get_plasticity = &
606  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
607  fval(1,:) = fval1
608  fval(2,:) = fval2
609  fval(3,:) = fval3
610  end block
611  if( fstr_ctrl_get_plasticity ==0 ) then
612  call init_table( mttable,2, 2+depends,n, fval )
613  call dict_add_key( dict, mc_yield, mttable )
614  endif
615  endif
616  case (3, 4, 6) ! swift, Ramberg-Osgood, Combined
617  allocate( fval(3,1) )
618  fval =0.0d0
619  data_fmt = "RRR "
620  block
621  real(kind=kreal) :: fval1(1), fval2(1), fval3(1)
622  fval1 = fval(1,:)
623  fval2 = fval(2,:)
624  fval3 = fval(3,:)
625  fstr_ctrl_get_plasticity = &
626  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
627  fval(1,:) = fval1
628  fval(2,:) = fval2
629  fval(3,:) = fval3
630  end block
631  if( fstr_ctrl_get_plasticity ==0 ) then
632  matval(m_plconst1) = fval(1,1)
633  matval(m_plconst2) = fval(2,1)
634  matval(m_plconst3) = fval(3,1)
635  endif
636  case default
637  print *, "Error in hardening definition!"
638  stop
639  end select
640  case (2, 3) ! Mohr-Coulomb, Drucker-Prager
641  select case (hipt)
642  case (1) ! linear hardening
643  allocate( fval(4,n) )
644  fval =0.0d0
645  data_fmt = "RRrr "
646  fval(4,:) = -1.d0
647  block
648  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n)
649  fval1 = fval(1,:)
650  fval2 = fval(2,:)
651  fval3 = fval(3,:)
652  fval4 = fval(4,:)
653  fstr_ctrl_get_plasticity &
654  = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3, fval4 )
655  fval(1,:) = fval1
656  fval(2,:) = fval2
657  fval(3,:) = fval3
658  fval(4,:) = fval4
659  end block
660  if( fstr_ctrl_get_plasticity ==0 ) then
661  matval(m_plconst1) = fval(1,1) ! c
662  matval(m_plconst2) = fval(3,1) ! H
663  phi = fval(2,1)*pi/180.d0
664  if( fval(4,1) >= 0.d0 ) then
665  psi = fval(4,1)*pi/180.d0
666  else
667  psi = phi
668  endif
669  endif
670  case (2) ! multilinear hardening
671  if( depends>0 ) then
672  stop "Mohr-Coulomb and Drucker-Prager do not support temperature dependency"
673  endif
674  allocate( fval(2,n) )
675  fval =0.0d0
676  data_fmt = "Rr "
677  fval(2,:) = -1.d0
678  block
679  real(kind=kreal) :: fval1(n), fval2(n)
680  fval1 = fval(1,:)
681  fval2 = fval(2,:)
682  fstr_ctrl_get_plasticity = &
683  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
684  fval(1,:) = fval1
685  fval(2,:) = fval2
686  end block
687  if( fstr_ctrl_get_plasticity ==0 ) then
688  phi =fval(1,1)*pi/180.d0
689  if( fval(2,1) >= 0.d0 ) then
690  psi = fval(2,1)*pi/180.d0
691  else
692  psi = phi
693  endif
694  if( fval(2,2)/=0.d0 ) then
695  print *, "Multilinear hardening: First plastic strain must be zero"
696  stop
697  endif
698  do i=2,n
699  if( fval(2,i)<0.0 ) &
700  stop "Multilinear hardening: Error in plastic strain definition"
701  enddo
702  call init_table( mttable,1, 2, n-1, fval(1:2,2:n) )
703  call dict_add_key( dict, mc_yield, mttable )
704  endif
705  end select
706  if( ipt==3 ) then ! Drucker-Prager
707  matval(m_plconst3) = 2.d0*sin(phi)/ ( sqrt(3.d0)*(3.d0+sin(phi)) ) ! eta
708  matval(m_plconst4) = 6.d0*cos(phi)/ ( sqrt(3.d0)*(3.d0+sin(phi)) ) ! xi
709  matval(m_plconst5) = 2.d0*sin(psi)/ ( sqrt(3.d0)*(3.d0+sin(psi)) ) ! etabar
710  else ! Mohr-Coulomb
711  matval(m_plconst3) = phi
712  matval(m_plconst4) = psi
713  endif
714 
715  case(4)
716  fstr_ctrl_get_plasticity = read_user_matl( ctrl, matval(101:200) )
717 
718  case default
719  stop "Yield function not supported"
720  end select
721 
722  if( allocated(fval) ) deallocate(fval)
723  call finalize_table( mttable )
724  end function fstr_ctrl_get_plasticity
725 
726 
727  !----------------------------------------------------------------------
729  integer function fstr_ctrl_get_viscoplasticity( ctrl, mattype, nlgeom, dict )
730  integer(kind=kint), intent(in) :: ctrl
731  integer(kind=kint), intent(inout) :: mattype
732  integer(kind=kint), intent(out) :: nlgeom
733  type(dict_struct), pointer :: dict
734 
735  integer(kind=kint) :: rcode, depends, ipt, n
736  real(kind=kreal), allocatable :: fval(:,:)
737  character(len=HECMW_NAME_LEN) :: data_fmt
738  type( ttable ) :: mattable
739  character(len=256) :: s
740 
741  fstr_ctrl_get_viscoplasticity = -1
742  depends = 0
743  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
744  if( depends>1 ) depends=1 ! temperature depends only currently
745  nlgeom = updatelag !default value
746  if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ', '# ', 0, 'E', ipt )/= 0) return
747  if( ipt/=0 ) nlgeom = totallag
748  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITESIMAL ', '# ', 0, 'E', ipt )/= 0) return
749  if( ipt/=0 ) nlgeom = infinitesimal
750 
751  ipt=1
752  s = 'NORTON,USER '
753  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
754 
755  ! NORTON
756  if( ipt==1 ) then
757  n = fstr_ctrl_get_data_line_n( ctrl )
758  allocate( fval(3+depends,n) )
759  fval =0.0d0
760  if( depends==0 ) then
761  data_fmt = "RRR "
762  block
763  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
764  fval1 = fval(1,:)
765  fval2 = fval(2,:)
766  fval3 = fval(3,:)
767  fstr_ctrl_get_viscoplasticity = &
768  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
769  fval(1,:) = fval1
770  fval(2,:) = fval2
771  fval(3,:) = fval3
772  end block
773  endif
774  if( depends==1 ) then
775  data_fmt = "RRRR "
776  block
777  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n)
778  fval1 = fval(1,:)
779  fval2 = fval(2,:)
780  fval3 = fval(3,:)
781  fval4 = fval(4,:)
782  fstr_ctrl_get_viscoplasticity = &
783  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3, fval4 )
784  fval(1,:) = fval1
785  fval(2,:) = fval2
786  fval(3,:) = fval3
787  fval(4,:) = fval4
788  end block
789  endif
790  if( fstr_ctrl_get_viscoplasticity ==0 ) then
791  call init_table( mattable, depends, 3+depends,n, fval )
792  call dict_add_key( dict, mc_norton, mattable )
793  ! call print_table( mattable, 6 ); pause
794  endif
795  mattype = norton
796 
797  else
798  stop "ERROR: Material type not supported"
799 
800  endif
801 
802  call finalize_table( mattable )
803  if( allocated(fval) ) deallocate(fval)
804  end function fstr_ctrl_get_viscoplasticity
805 
806  !----------------------------------------------------------------------
808  integer function fstr_ctrl_get_density( ctrl, matval )
809  integer(kind=kint), intent(in) :: ctrl
810  real(kind=kreal),intent(inout) :: matval(:)
811 
812  integer(kind=kint) :: i, rcode, depends
813  real(kind=kreal), allocatable :: fval(:,:)
814  character(len=HECMW_NAME_LEN) :: data_fmt
815 
816  data_fmt = "R "
817 
818  fstr_ctrl_get_density = -1
819 
820  depends = 0
821  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
822  if( depends>1 ) depends = 1 ! we consider temperature dependence only currently
823 
824  allocate( fval(1,depends+1) )
825  fval =0.0d0
826  do i=2,1+depends
827  data_fmt = data_fmt //"R "
828  enddo
829  block
830  real(kind=kreal) :: fval1(depends+1)
831  fval1 = fval(1,:)
832  fstr_ctrl_get_density &
833  = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
834  fval(1,:) = fval1
835  end block
836  if( fstr_ctrl_get_density==0 ) matval(m_density) = fval(1,1)
837 
838  if( allocated(fval) ) deallocate(fval)
839 
840  end function fstr_ctrl_get_density
841 
842 
843  !----------------------------------------------------------------------
845  integer function fstr_ctrl_get_expansion_coeff( ctrl, matval, dict )
846  integer(kind=kint), intent(in) :: ctrl
847  real(kind=kreal),intent(inout) :: matval(:)
848  type(dict_struct), pointer :: dict
849 
850  integer(kind=kint) :: i, n, rcode, depends, ipt
851  real(kind=kreal), allocatable :: fval(:,:)
852  type( ttable ) :: mttable
853  character(len=HECMW_NAME_LEN) :: data_fmt, ss
854 
855  data_fmt = "R "
856 
857  fstr_ctrl_get_expansion_coeff = -1
858  n = fstr_ctrl_get_data_line_n( ctrl )
859  if( n == 0 ) return ! fail in reading plastic
860 
861  ss = 'ISOTROPIC,ORTHOTROPIC '
862  ipt = 1 !default
863  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', ss, 0, 'P', ipt ) /= 0 ) return
864 
865  depends = 0
866  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
867  if( depends>1 ) depends = 1 ! we consider temperature dependence only currently
868 
869  if( ipt==1 ) then
870  allocate( fval(depends+1, n) )
871  fval =0.0d0
872  do i=2,1+depends
873  data_fmt = data_fmt //"R "
874  enddo
875  if( depends==0 ) then
876  block
877  real(kind=kreal) :: fval1(n)
878  fval1 = fval(1,:)
879  fstr_ctrl_get_expansion_coeff = &
880  fstr_ctrl_get_data_array_ex( ctrl, "R ", fval1 )
881  fval(1,:) = fval1
882  end block
883  else
884  block
885  real(kind=kreal) :: fval1(n), fval2(n)
886  fval1 = fval(1,:)
887  fval2 = fval(2,:)
888  fstr_ctrl_get_expansion_coeff = &
889  fstr_ctrl_get_data_array_ex( ctrl, "RR ", fval1, fval2 )
890  fval(1,:) = fval1
891  fval(2,:) = fval2
892  end block
893  endif
894  if( fstr_ctrl_get_expansion_coeff==0 ) then
895  matval(m_expansion) = fval(1,1)
896  call init_table( mttable,depends, 1+depends, n, fval )
897  call dict_add_key( dict, mc_themoexp, mttable )
898  endif
899  else
900  allocate( fval(3+depends,n) )
901  fval =0.0d0
902  do i=2,3+depends
903  data_fmt = trim(data_fmt) //"R "
904  enddo
905  if( depends==0 ) then
906  block
907  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
908  fval1 = fval(1,:)
909  fval2 = fval(2,:)
910  fval3 = fval(3,:)
911  fstr_ctrl_get_expansion_coeff = &
912  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
913  fval(1,:) = fval1
914  fval(2,:) = fval2
915  fval(3,:) = fval3
916  end block
917  elseif( depends==1 ) then
918  block
919  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n)
920  fval1 = fval(1,:)
921  fval2 = fval(2,:)
922  fval3 = fval(3,:)
923  fval4 = fval(4,:)
924  fstr_ctrl_get_expansion_coeff = &
925  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3, fval4 )
926  fval(1,:) = fval1
927  fval(2,:) = fval2
928  fval(3,:) = fval3
929  fval(4,:) = fval4
930  end block
931  endif
932  if( fstr_ctrl_get_expansion_coeff==0 ) then
933  call init_table( mttable, depends, 3+depends,n, fval )
934  if( fstr_ctrl_get_expansion_coeff==0 ) call dict_add_key( dict, mc_orthoexp, mttable )
935  endif
936  endif
937 
938  call finalize_table( mttable )
939  if( allocated(fval) ) deallocate(fval)
940  end function fstr_ctrl_get_expansion_coeff
941 
942  !----------------------------------------------------------------------
953  integer function fstr_ctrl_get_rayleigh_damping( ctrl, matval, is_RD )
954  integer(kind=kint), intent(in) :: ctrl
955  real(kind=kreal), intent(inout) :: matval(:)
956  logical, intent(out) :: is_rd
957  integer(kind=kint) :: ipt
958  real(kind=kreal) :: rm, rk
959  character(len=HECMW_NAME_LEN) :: type_list
960 
961  fstr_ctrl_get_rayleigh_damping = -1
962  is_rd = .false.
963 
964  ! --- option TYPE: damping model selection (only RAYLEIGH supported) ---
965  type_list = 'RAYLEIGH '
966  ipt = 1 ! default
967  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', type_list, 0, 'P', ipt ) /= 0 ) return
968 
969  ! --- data line: Rm (mass-proportional), Rk (stiffness-proportional) ---
970  rm = 0.0d0
971  rk = 0.0d0
972  if( fstr_ctrl_get_data_ex( ctrl, 1, 'rr ', rm, rk ) /= 0 ) return
973 
974  matval(m_damping_rm) = rm
975  matval(m_damping_rk) = rk
976  is_rd = .true.
977  fstr_ctrl_get_rayleigh_damping = 0
978  end function fstr_ctrl_get_rayleigh_damping
979 
980  integer function read_user_matl( ctrl, matval )
981  integer(kind=kint), intent(in) :: ctrl
982  real(kind=kreal),intent(inout) :: matval(:)
983 
984  integer(kind=kint) :: n, i, j
985  real(kind=kreal) :: fval(10,10)
986 
987  read_user_matl = -1
988 
989  n = fstr_ctrl_get_data_line_n( ctrl )
990  if( n > 10 ) stop "Num of data lines for user-defined material exceeds 10"
991  fval =0.d0
992  block
993  real(kind=kreal) :: fval1(10), fval2(10), fval3(10), fval4(10), fval5(10), &
994  fval6(10), fval7(10), fval8(10), fval9(10), fval10(10)
995  fval1 = fval(1,:)
996  fval2 = fval(2,:)
997  fval3 = fval(3,:)
998  fval4 = fval(4,:)
999  fval5 = fval(5,:)
1000  fval6 = fval(6,:)
1001  fval7 = fval(7,:)
1002  fval8 = fval(8,:)
1003  fval9 = fval(9,:)
1004  fval10 = fval(10,:)
1005  if( fstr_ctrl_get_data_array_ex( ctrl, 'rrrrrrrrrr ', fval1, fval2, fval3, &
1006  fval4, fval5, fval6, fval7, fval8, fval9, fval10 ) /= 0 ) return
1007  fval(1,:) = fval1
1008  fval(2,:) = fval2
1009  fval(3,:) = fval3
1010  fval(4,:) = fval4
1011  fval(5,:) = fval5
1012  fval(6,:) = fval6
1013  fval(7,:) = fval7
1014  fval(8,:) = fval8
1015  fval(9,:) = fval9
1016  fval(10,:) = fval10
1017  end block
1018  do i=1,10
1019  do j=1,10
1020  matval((i-1)*10+j)=fval(j,i)
1021  enddo
1022  enddo
1023 
1024  read_user_matl = 0
1025  end function read_user_matl
1026 
1027  !----------------------------------------------------------------------
1029  integer function fstr_ctrl_get_fluid( ctrl, mattype, nlgeom, matval, dict )
1030  integer(kind=kint), intent(in) :: ctrl
1031  integer(kind=kint), intent(inout) :: mattype
1032  integer(kind=kint), intent(out) :: nlgeom
1033  real(kind=kreal),intent(inout) :: matval(:)
1034  type(dict_struct), pointer :: dict
1035 
1036  integer(kind=kint) :: rcode, depends, ipt, n
1037  real(kind=kreal), allocatable :: fval(:,:)
1038  character(len=HECMW_NAME_LEN) :: data_fmt
1039  type( ttable ) :: mattable
1040  character(len=256) :: s
1041 
1042  fstr_ctrl_get_fluid = -1
1043  depends = 0
1044  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
1045  if( depends>1 ) depends=1 ! temperature depends only currently
1046  if( depends > 3 ) stop "We cannot read dependencies>3 right now"
1047  nlgeom = totallag !default value
1048 
1049  ipt=1
1050  s = 'INCOMP_NEWTONIAN '
1051  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
1052 
1053  n = fstr_ctrl_get_data_line_n( ctrl )
1054  ! ISOTROPIC
1055  if( ipt==1 ) then
1056  allocate( fval(1+depends,n) )
1057  fval =0.0d0
1058  if( depends==0 ) then
1059  data_fmt = "R "
1060  block
1061  real(kind=kreal) :: fval1(n)
1062  fval1 = fval(1,:)
1063  fstr_ctrl_get_fluid = &
1064  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
1065  fval(1,:) = fval1
1066  end block
1067  endif
1068  if( depends==1 ) then
1069  data_fmt = "RR "
1070  block
1071  real(kind=kreal) :: fval1(n), fval2(n)
1072  fval1 = fval(1,:)
1073  fval2 = fval(2,:)
1074  fstr_ctrl_get_fluid = &
1075  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
1076  fval(1,:) = fval1
1077  fval(2,:) = fval2
1078  end block
1079  endif
1080  if( fstr_ctrl_get_fluid ==0 ) then
1081  matval(m_viscocity) = fval(1,1)
1082  call init_table( mattable, depends, 1+depends,n, fval )
1083  call dict_add_key( dict, mc_incomp_newtonian, mattable )
1084  ! call print_table( mattable, 6 ); pause
1085  endif
1086  mattype = incomp_newtonian
1087 
1088  else
1089  stop "ERROR: Material type not supported"
1090 
1091  endif
1092 
1093  call finalize_table( mattable )
1094  if( allocated(fval) ) deallocate(fval)
1095  end function fstr_ctrl_get_fluid
1096 
1097  !----------------------------------------------------------------------
1099  integer function fstr_ctrl_get_spring_d( ctrl, mattype, nlgeom, matval_i, dict )
1100  integer(kind=kint), intent(in) :: ctrl
1101  integer(kind=kint), intent(inout) :: mattype
1102  integer(kind=kint), intent(out) :: nlgeom
1103  integer(kind=kint), intent(inout) :: matval_i(:)
1104  type(dict_struct), pointer :: dict
1105 
1106  integer(kind=kint) :: i, depends, n
1107  real(kind=kreal), allocatable :: fval(:,:)
1108  integer(kind=kint), allocatable :: ival(:,:)
1109  character(len=HECMW_NAME_LEN) :: data_fmt
1110  type( ttable ) :: mattable
1111  character(len=DICT_KEY_LENGTH) :: spkey
1112 
1113  fstr_ctrl_get_spring_d = -1
1114  depends = 0
1115  nlgeom = infinitesimal !default value
1116 
1117  n = fstr_ctrl_get_data_line_n( ctrl )
1118  allocate( fval(1+depends,n), ival(2,n) )
1119  fval =0.0d0
1120  ival =0
1121  if( depends==0 ) then
1122  data_fmt = "IIR "
1123  block
1124  integer(kind=kint) :: ival1(n), ival2(n)
1125  real(kind=kreal) :: fval1(n)
1126  ival1 = ival(1,:)
1127  ival2 = ival(2,:)
1128  fval1 = fval(1,:)
1129  fstr_ctrl_get_spring_d = &
1130  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival1, ival2, fval1 )
1131  ival(1,:) = ival1
1132  ival(2,:) = ival2
1133  fval(1,:) = fval1
1134  end block
1135  !else if( depends==1 ) then
1136  ! data_fmt = "IIRR "
1137  ! fstr_ctrl_get_SPRING_D = &
1138  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival(1,:), ival(2,:), fval(1,:), fval(2,:) )
1139  endif
1140  if( fstr_ctrl_get_spring_d ==0 ) then
1141  matval_i(m_spring_d_ndoffset+1) = n ! number of dof pairs
1142  do i=1,n
1143  matval_i(m_spring_d_ndoffset+2*i ) = ival(1,i) ! first dof
1144  matval_i(m_spring_d_ndoffset+2*i+1) = ival(2,i) ! second dof
1145  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1146  write(spkey,'(A,I0)') trim(mc_spring),i
1147  call dict_add_key( dict, trim(spkey), mattable )
1148  call finalize_table( mattable )
1149  enddo
1150  endif
1151 
1152  mattype = connector
1153  if( allocated(fval) ) deallocate(fval)
1154  if( allocated(ival) ) deallocate(ival)
1155  end function fstr_ctrl_get_spring_d
1156 
1157  !----------------------------------------------------------------------
1159  integer function fstr_ctrl_get_spring_a( ctrl, mattype, nlgeom, matval_i, dict )
1160  integer(kind=kint), intent(in) :: ctrl
1161  integer(kind=kint), intent(inout) :: mattype
1162  integer(kind=kint), intent(out) :: nlgeom
1163  integer(kind=kint), intent(inout) :: matval_i(:)
1164  type(dict_struct), pointer :: dict
1165 
1166  integer(kind=kint) :: i, depends, n
1167  real(kind=kreal), allocatable :: fval(:,:)
1168  character(len=HECMW_NAME_LEN) :: data_fmt
1169  type( ttable ) :: mattable
1170  character(len=DICT_KEY_LENGTH) :: spkey
1171 
1172  fstr_ctrl_get_spring_a = -1
1173  depends = 0
1174  nlgeom = infinitesimal !default value
1175 
1176  n = fstr_ctrl_get_data_line_n( ctrl )
1177  allocate( fval(1+depends,n) )
1178  fval =0.0d0
1179  if( depends==0 ) then
1180  data_fmt = "R "
1181  block
1182  real(kind=kreal) :: fval1(n)
1183  fval1 = fval(1,:)
1184  fstr_ctrl_get_spring_a = &
1185  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
1186  fval(1,:) = fval1
1187  end block
1188  !else if( depends==1 ) then
1189  ! data_fmt = "IIRR "
1190  ! fstr_ctrl_get_SPRING_A = &
1191  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
1192  endif
1193  if( fstr_ctrl_get_spring_a ==0 ) then
1194  matval_i(m_spring_a_ndoffset+1) = 1 ! number of dof pairs
1195  do i=1,n
1196  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1197  write(spkey,'(A,A)') trim(mc_spring),'_A'
1198  call dict_add_key( dict, trim(spkey), mattable )
1199  call finalize_table( mattable )
1200  enddo
1201  endif
1202 
1203  mattype = connector
1204  if( allocated(fval) ) deallocate(fval)
1205  end function fstr_ctrl_get_spring_a
1206 
1207  !----------------------------------------------------------------------
1209  integer function fstr_ctrl_get_dashpot_d( ctrl, mattype, nlgeom, matval_i, dict )
1210  integer(kind=kint), intent(in) :: ctrl
1211  integer(kind=kint), intent(inout) :: mattype
1212  integer(kind=kint), intent(out) :: nlgeom
1213  integer(kind=kint), intent(inout) :: matval_i(:)
1214  type(dict_struct), pointer :: dict
1215 
1216  integer(kind=kint) :: i, depends, n
1217  real(kind=kreal), allocatable :: fval(:,:)
1218  integer(kind=kint), allocatable :: ival(:,:)
1219  character(len=HECMW_NAME_LEN) :: data_fmt
1220  type( ttable ) :: mattable
1221  character(len=DICT_KEY_LENGTH) :: spkey
1222 
1223  fstr_ctrl_get_dashpot_d = -1
1224  depends = 0
1225  nlgeom = infinitesimal !default value
1226 
1227  n = fstr_ctrl_get_data_line_n( ctrl )
1228  allocate( fval(1+depends,n), ival(2,n) )
1229  fval =0.0d0
1230  ival =0
1231  if( depends==0 ) then
1232  data_fmt = "IIR "
1233  block
1234  integer(kind=kint) :: ival1(n), ival2(n)
1235  real(kind=kreal) :: fval1(n)
1236  ival1 = ival(1,:)
1237  ival2 = ival(2,:)
1238  fval1 = fval(1,:)
1239  fstr_ctrl_get_dashpot_d = &
1240  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival1, ival2, fval1 )
1241  ival(1,:) = ival1
1242  ival(2,:) = ival2
1243  fval(1,:) = fval1
1244  end block
1245  !else if( depends==1 ) then
1246  ! data_fmt = "IIRR "
1247  ! fstr_ctrl_get_DASHPOT_D = &
1248  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival(1,:), ival(2,:), fval(1,:), fval(2,:) )
1249  endif
1250  if( fstr_ctrl_get_dashpot_d ==0 ) then
1251  matval_i(m_dashpot_d_ndoffset+1) = n
1252  do i=1,n
1253  matval_i(m_dashpot_d_ndoffset+2*i ) = ival(1,i) ! first dof
1254  matval_i(m_dashpot_d_ndoffset+2*i+1) = ival(2,i) ! second dof
1255  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1256  write(spkey,'(A,I0)') trim(mc_dashpot),i
1257  call dict_add_key( dict, trim(spkey), mattable )
1258  call finalize_table( mattable )
1259  enddo
1260  endif
1261 
1262  mattype = connector
1263  if( allocated(fval) ) deallocate(fval)
1264  if( allocated(ival) ) deallocate(ival)
1265  end function fstr_ctrl_get_dashpot_d
1266 
1267  !----------------------------------------------------------------------
1269  integer function fstr_ctrl_get_dashpot_a( ctrl, mattype, nlgeom, matval_i, dict )
1270  integer(kind=kint), intent(in) :: ctrl
1271  integer(kind=kint), intent(inout) :: mattype
1272  integer(kind=kint), intent(out) :: nlgeom
1273  integer(kind=kint), intent(inout) :: matval_i(:)
1274  type(dict_struct), pointer :: dict
1275 
1276  integer(kind=kint) :: i, depends, n
1277  real(kind=kreal), allocatable :: fval(:,:)
1278  character(len=HECMW_NAME_LEN) :: data_fmt
1279  type( ttable ) :: mattable
1280  character(len=DICT_KEY_LENGTH) :: spkey
1281 
1282  fstr_ctrl_get_dashpot_a = -1
1283  depends = 0
1284  nlgeom = infinitesimal !default value
1285 
1286  n = fstr_ctrl_get_data_line_n( ctrl )
1287  allocate( fval(1+depends,n) )
1288  fval =0.0d0
1289  if( depends==0 ) then
1290  data_fmt = "R "
1291  block
1292  real(kind=kreal) :: fval1(n)
1293  fval1 = fval(1,:)
1294  fstr_ctrl_get_dashpot_a = &
1295  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
1296  fval(1,:) = fval1
1297  end block
1298  !else if( depends==1 ) then
1299  ! data_fmt = "IIRR "
1300  ! fstr_ctrl_get_DASHPOT_A = &
1301  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
1302  endif
1303  if( fstr_ctrl_get_dashpot_a ==0 ) then
1304  matval_i(m_dashpot_a_ndoffset+1) = 1 ! number of dof pairs
1305  do i=1,n
1306  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1307  write(spkey,'(A,A)') trim(mc_dashpot),'_A'
1308  call dict_add_key( dict, trim(spkey), mattable )
1309  call finalize_table( mattable )
1310  enddo
1311  endif
1312 
1313  mattype = connector
1314  if( allocated(fval) ) deallocate(fval)
1315  end function fstr_ctrl_get_dashpot_a
1316 
1317 end module fstr_ctrl_material
fstr_ctrl_get_param_ex
int fstr_ctrl_get_param_ex(int *ctrl, const char *param_name, const char *value_list, int *necessity, char *type, void *val)
Definition: fstr_ctrl_util.c:1221
fstr_ctrl_get_data_line_n
int fstr_ctrl_get_data_line_n(int *ctrl)
Definition: fstr_ctrl_util.c:1244
fstr_ctrl_get_data_array_ex
int fstr_ctrl_get_data_array_ex(int *ctrl, const char *format,...)
Definition: fstr_ctrl_util.c:1347
fstr_ctrl_get_data_ex
int fstr_ctrl_get_data_ex(int *ctrl, int *line_no, const char *format,...)
Definition: fstr_ctrl_util.c:1310
fstr_ctrl_util_f::fstr_ctrl_get_data_line_n
Definition: fstr_ctrl_util_f.f90:108
fstr_ctrl_material
This module manages read in of various material properties.
Definition: fstr_ctrl_material.f90:6
fstr_ctrl_material::fstr_ctrl_get_dashpot_d
integer function fstr_ctrl_get_dashpot_d(ctrl, mattype, nlgeom, matval_i, dict)
Read in !DASHPOT_D.
Definition: fstr_ctrl_material.f90:1210
fstr_ctrl_material::fstr_ctrl_get_hyperelastic
integer function fstr_ctrl_get_hyperelastic(ctrl, mattype, nlgeom, matval)
Read in !HYPERELASTIC.
Definition: fstr_ctrl_material.f90:224
fstr_ctrl_material::fstr_ctrl_get_viscoelasticity
integer function fstr_ctrl_get_viscoelasticity(ctrl, mattype, nlgeom, dict)
Read in !VISCOELASTIC.
Definition: fstr_ctrl_material.f90:383
fstr_ctrl_material::fstr_ctrl_get_viscoplasticity
integer function fstr_ctrl_get_viscoplasticity(ctrl, mattype, nlgeom, dict)
Read in !CREEP.
Definition: fstr_ctrl_material.f90:730
fstr_ctrl_material::fstr_ctrl_get_usermaterial
integer function fstr_ctrl_get_usermaterial(ctrl, mattype, nlgeom, nstatus, matval)
Read in !USER_MATERIAL.
Definition: fstr_ctrl_material.f90:31
fstr_ctrl_material::fstr_ctrl_get_expansion_coeff
integer function fstr_ctrl_get_expansion_coeff(ctrl, matval, dict)
Read in !EXPANSION_COEFF.
Definition: fstr_ctrl_material.f90:846
fstr_ctrl_material::fstr_ctrl_get_trs
integer function fstr_ctrl_get_trs(ctrl, mattype, matval)
Read in !TRS.
Definition: fstr_ctrl_material.f90:466
fstr_ctrl_material::fstr_ctrl_get_elasticity
integer function fstr_ctrl_get_elasticity(ctrl, mattype, nlgeom, matval, dict)
Read in !ELASTIC.
Definition: fstr_ctrl_material.f90:53
fstr_ctrl_material::fstr_ctrl_get_plasticity
integer function fstr_ctrl_get_plasticity(ctrl, mattype, nlgeom, matval, mattable, dict)
Read in !PLASTIC.
Definition: fstr_ctrl_material.f90:488
fstr_ctrl_material::fstr_ctrl_get_dashpot_a
integer function fstr_ctrl_get_dashpot_a(ctrl, mattype, nlgeom, matval_i, dict)
Read in !DASHPOT_A.
Definition: fstr_ctrl_material.f90:1270
fstr_ctrl_material::fstr_ctrl_get_material
integer function fstr_ctrl_get_material(ctrl, matname)
Read in !MATERIAL.
Definition: fstr_ctrl_material.f90:21
fstr_ctrl_material::fstr_ctrl_get_density
integer function fstr_ctrl_get_density(ctrl, matval)
Read in !DENSITY.
Definition: fstr_ctrl_material.f90:809
fstr_ctrl_material::fstr_ctrl_get_spring_a
integer function fstr_ctrl_get_spring_a(ctrl, mattype, nlgeom, matval_i, dict)
Read in !SPRING_A.
Definition: fstr_ctrl_material.f90:1160
fstr_ctrl_material::fstr_ctrl_get_rayleigh_damping
integer function fstr_ctrl_get_rayleigh_damping(ctrl, matval, is_RD)
Read in !DAMPING (element-wise Rayleigh damping)
Definition: fstr_ctrl_material.f90:954
fstr_ctrl_material::fstr_ctrl_get_fluid
integer function fstr_ctrl_get_fluid(ctrl, mattype, nlgeom, matval, dict)
Read in !FLUID.
Definition: fstr_ctrl_material.f90:1030
fstr_ctrl_material::fstr_ctrl_get_spring_d
integer function fstr_ctrl_get_spring_d(ctrl, mattype, nlgeom, matval_i, dict)
Read in !SPRING_D.
Definition: fstr_ctrl_material.f90:1100
fstr_ctrl_util_f
Definition: fstr_ctrl_util_f.f90:1
hecmw
Definition: hecmw.f90:6
m_table
This module provides data structure table which would be dictionaried afterwards.
Definition: ttable.f90:7
mmaterial
This module summarizes all information of material properties.
Definition: material.f90:6
mmaterial::totallag
integer(kind=kint), parameter totallag
Definition: material.f90:14
mmaterial::infinitesimal
integer(kind=kint), parameter infinitesimal
Definition: material.f90:13
mmaterial::usermaterial
integer(kind=kint), parameter usermaterial
Definition: material.f90:66
mmaterial::updatelag
integer(kind=kint), parameter updatelag
Definition: material.f90:15
m_table::ttable
Definition: ttable.f90:20