FrontISTR  5.9.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(out) :: matval(:)
36 
37  integer(kind=kint) :: ipt
38  character(len=HECMW_NAME_LEN) :: data_fmt
39  character(len=256) :: s, fname
40 
41  fstr_ctrl_get_usermaterial = -1
42  mattype = usermaterial
43  nlgeom = updatelag !default value
44  nstatus = 1
45  if( fstr_ctrl_get_param_ex( ctrl, 'NSTATUS ', '# ', 0, 'I', nstatus )/= 0) return
46  if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ', '# ', 0, 'E', ipt )/= 0) return
47  if( ipt/=0 ) nlgeom = totallag
48 
49  fstr_ctrl_get_usermaterial = read_user_matl( ctrl, matval )
50  end function fstr_ctrl_get_usermaterial
51 
52  !----------------------------------------------------------------------
54  integer function fstr_ctrl_get_elasticity( ctrl, mattype, nlgeom, matval, dict )
55  integer(kind=kint), intent(in) :: ctrl
56  integer(kind=kint), intent(inout) :: mattype
57  integer(kind=kint), intent(out) :: nlgeom
58  real(kind=kreal),intent(out) :: matval(:)
59  type(dict_struct), pointer :: dict
60 
61  integer(kind=kint) :: i,j, rcode, depends, ipt, n
62  real(kind=kreal), allocatable :: fval(:,:)
63  character(len=HECMW_NAME_LEN) :: data_fmt
64  type( ttable ) :: mattable
65  logical :: isok
66  character(len=256) :: s
67 
68  fstr_ctrl_get_elasticity = -1
69  depends = 0
70  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
71  if( depends>1 ) depends=1 ! temperature depends only currently
72  if( depends > 3 ) stop "We cannot read dependencies>3 right now"
73  nlgeom = totallag !default value
74 
75  if( fstr_ctrl_get_param_ex( ctrl, 'CAUCHY ', '# ', 0, 'E', ipt )/= 0) return
76  if( ipt/=0 ) nlgeom = updatelag
77  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITESIMAL ', '# ', 0, 'E', ipt )/= 0) return
78  if( ipt/=0 ) nlgeom = infinitesimal
79 
80  ! for backward compatibility
81  if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ', '# ', 0, 'E', ipt )/= 0) return
82  if( ipt/=0 ) then
83  write(*,*) "Warning : !ELASTIC : parameter 'INFINITE' is deprecated." &
84  & // " Please use the replacement parameter 'INFINITESIMAL'"
85  nlgeom = infinitesimal
86  endif
87 
88  ipt=1
89  s = 'ISOTROPIC,ORTHOTROPIC,USER '
90  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
91 
92  n = fstr_ctrl_get_data_line_n( ctrl )
93  ! ISOTROPIC
94  if( ipt==1 ) then
95  allocate( fval(2+depends,n) )
96  if( depends==0 ) then
97  data_fmt = "RR "
98  block
99  real(kind=kreal) :: fval1(n), fval2(n)
100  fval1 = fval(1,:)
101  fval2 = fval(2,:)
102  fstr_ctrl_get_elasticity = &
103  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
104  fval(1,:) = fval1
105  fval(2,:) = fval2
106  end block
107  endif
108  if( depends==1 ) then
109  data_fmt = "RRR "
110  block
111  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
112  fval1 = fval(1,:)
113  fval2 = fval(2,:)
114  fval3 = fval(3,:)
115  fstr_ctrl_get_elasticity = &
116  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
117  fval(1,:) = fval1
118  fval(2,:) = fval2
119  fval(3,:) = fval3
120  end block
121  endif
122  if( fstr_ctrl_get_elasticity ==0 ) then
123  matval(m_youngs) = fval(1,1)
124  matval(m_poisson) = fval(2,1)
125  call init_table( mattable, depends, 2+depends,n, fval )
126  call dict_add_key( dict, mc_isoelastic, mattable )
127  ! call print_table( mattable, 6 ); pause
128  endif
129  mattype = elastic
130 
131  ! ORTHOTROPIC
132  else if( ipt==2 ) then
133  allocate( fval(9+depends,n) )
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(out) :: matval(:)
228 
229  integer(kind=kint) :: i,j, 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) :: i,j, 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  ipt = 1
415 
416  ! ISOTROPIC
417  if( ipt==1 ) then
418  n = fstr_ctrl_get_data_line_n( ctrl )
419  allocate( fval(2+depends,n) )
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(out) :: 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(out) :: 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  data_fmt = "RR "
552  block
553  real(kind=kreal) :: fval1(n), fval2(n)
554  fval1 = fval(1,:)
555  fval2 = fval(2,:)
556  fstr_ctrl_get_plasticity = &
557  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
558  fval(1,:) = fval1
559  fval(2,:) = fval2
560  end block
561  if( fstr_ctrl_get_plasticity ==0 ) then
562  matval(m_plconst1) = fval(1,1)
563  if(hipt==1) then
564  matval(m_plconst2) = fval(2,1)
565  else
566  matval(m_plconst2) = 0.d0
567  matval(m_plconst3) = fval(2,1)
568  endif
569  endif
570  case (2) ! multilinear approximation
571  allocate( fval(depends+2,n) )
572  if( depends==0 ) then
573  data_fmt = "RR "
574  block
575  real(kind=kreal) :: fval1(n), fval2(n)
576  fval1 = fval(1,:)
577  fval2 = fval(2,:)
578  fstr_ctrl_get_plasticity = &
579  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
580  fval(1,:) = fval1
581  fval(2,:) = fval2
582  end block
583  if( fstr_ctrl_get_plasticity ==0 ) then
584  if( fval(2,1)/=0.d0 ) then
585  print *, "Multilinear hardening: First plastic strain must be zero"
586  stop
587  endif
588  do i=1,n
589  if( fval(2,i)<0.0 ) &
590  stop "Multilinear hardening: Error in plastic strain definition"
591  enddo
592  call init_table( mttable,1, 2+depends, n, fval )
593  call dict_add_key( dict, mc_yield, mttable )
594 
595  endif
596  else ! depends==1
597  data_fmt = "RRR "
598  block
599  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
600  fval1 = fval(1,:)
601  fval2 = fval(2,:)
602  fval3 = fval(3,:)
603  fstr_ctrl_get_plasticity = &
604  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
605  fval(1,:) = fval1
606  fval(2,:) = fval2
607  fval(3,:) = fval3
608  end block
609  if( fstr_ctrl_get_plasticity ==0 ) then
610  call init_table( mttable,2, 2+depends,n, fval )
611  call dict_add_key( dict, mc_yield, mttable )
612  endif
613  endif
614  case (3, 4, 6) ! swift, Ramberg-Osgood, Combined
615  allocate( fval(3,1) )
616  data_fmt = "RRR "
617  block
618  real(kind=kreal) :: fval1(1), fval2(1), fval3(1)
619  fval1 = fval(1,:)
620  fval2 = fval(2,:)
621  fval3 = fval(3,:)
622  fstr_ctrl_get_plasticity = &
623  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
624  fval(1,:) = fval1
625  fval(2,:) = fval2
626  fval(3,:) = fval3
627  end block
628  if( fstr_ctrl_get_plasticity ==0 ) then
629  matval(m_plconst1) = fval(1,1)
630  matval(m_plconst2) = fval(2,1)
631  matval(m_plconst3) = fval(3,1)
632  endif
633  case default
634  print *, "Error in hardening definition!"
635  stop
636  end select
637  case (2, 3) ! Mohr-Coulomb, Drucker-Prager
638  select case (hipt)
639  case (1) ! linear hardening
640  allocate( fval(4,n) )
641  data_fmt = "RRrr "
642  fval(4,:) = -1.d0
643  block
644  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n)
645  fval1 = fval(1,:)
646  fval2 = fval(2,:)
647  fval3 = fval(3,:)
648  fval4 = fval(4,:)
649  fstr_ctrl_get_plasticity &
650  = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3, fval4 )
651  fval(1,:) = fval1
652  fval(2,:) = fval2
653  fval(3,:) = fval3
654  fval(4,:) = fval4
655  end block
656  if( fstr_ctrl_get_plasticity ==0 ) then
657  matval(m_plconst1) = fval(1,1) ! c
658  matval(m_plconst2) = fval(3,1) ! H
659  phi = fval(2,1)*pi/180.d0
660  if( fval(4,1) >= 0.d0 ) then
661  psi = fval(4,1)*pi/180.d0
662  else
663  psi = phi
664  endif
665  endif
666  case (2) ! multilinear hardening
667  if( depends>0 ) then
668  stop "Mohr-Coulomb and Drucker-Prager do not support temperature dependency"
669  endif
670  allocate( fval(2,n) )
671  data_fmt = "Rr "
672  fval(2,:) = -1.d0
673  block
674  real(kind=kreal) :: fval1(n), fval2(n)
675  fval1 = fval(1,:)
676  fval2 = fval(2,:)
677  fstr_ctrl_get_plasticity = &
678  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
679  fval(1,:) = fval1
680  fval(2,:) = fval2
681  end block
682  if( fstr_ctrl_get_plasticity ==0 ) then
683  phi =fval(1,1)*pi/180.d0
684  if( fval(2,1) >= 0.d0 ) then
685  psi = fval(2,1)*pi/180.d0
686  else
687  psi = phi
688  endif
689  if( fval(2,2)/=0.d0 ) then
690  print *, "Multilinear hardening: First plastic strain must be zero"
691  stop
692  endif
693  do i=2,n
694  if( fval(2,i)<0.0 ) &
695  stop "Multilinear hardening: Error in plastic strain definition"
696  enddo
697  call init_table( mttable,1, 2, n-1, fval(1:2,2:n) )
698  call dict_add_key( dict, mc_yield, mttable )
699  endif
700  end select
701  if( ipt==3 ) then ! Drucker-Prager
702  matval(m_plconst3) = 2.d0*sin(phi)/ ( sqrt(3.d0)*(3.d0+sin(phi)) ) ! eta
703  matval(m_plconst4) = 6.d0*cos(phi)/ ( sqrt(3.d0)*(3.d0+sin(phi)) ) ! xi
704  matval(m_plconst5) = 2.d0*sin(psi)/ ( sqrt(3.d0)*(3.d0+sin(psi)) ) ! etabar
705  else ! Mohr-Coulomb
706  matval(m_plconst3) = phi
707  matval(m_plconst4) = psi
708  endif
709 
710  case(4)
711  fstr_ctrl_get_plasticity = read_user_matl( ctrl, matval(101:200) )
712 
713  case default
714  stop "Yield function not supported"
715  end select
716 
717  if( allocated(fval) ) deallocate(fval)
718  call finalize_table( mttable )
719  end function fstr_ctrl_get_plasticity
720 
721 
722  !----------------------------------------------------------------------
724  integer function fstr_ctrl_get_viscoplasticity( ctrl, mattype, nlgeom, dict )
725  integer(kind=kint), intent(in) :: ctrl
726  integer(kind=kint), intent(inout) :: mattype
727  integer(kind=kint), intent(out) :: nlgeom
728  type(dict_struct), pointer :: dict
729 
730  integer(kind=kint) :: i,j, rcode, depends, ipt, n
731  real(kind=kreal), allocatable :: fval(:,:)
732  character(len=HECMW_NAME_LEN) :: data_fmt
733  type( ttable ) :: mattable
734  character(len=256) :: s
735 
736  fstr_ctrl_get_viscoplasticity = -1
737  depends = 0
738  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
739  if( depends>1 ) depends=1 ! temperature depends only currently
740  nlgeom = updatelag !default value
741  if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ', '# ', 0, 'E', ipt )/= 0) return
742  if( ipt/=0 ) nlgeom = totallag
743 
744  ipt=1
745  s = 'NORTON,USER '
746  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
747  ipt = 1
748 
749  ! NORTON
750  if( ipt==1 ) then
751  n = fstr_ctrl_get_data_line_n( ctrl )
752  allocate( fval(3+depends,n) )
753  if( depends==0 ) then
754  data_fmt = "RRR "
755  block
756  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
757  fval1 = fval(1,:)
758  fval2 = fval(2,:)
759  fval3 = fval(3,:)
760  fstr_ctrl_get_viscoplasticity = &
761  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
762  fval(1,:) = fval1
763  fval(2,:) = fval2
764  fval(3,:) = fval3
765  end block
766  endif
767  if( depends==1 ) then
768  data_fmt = "RRRR "
769  block
770  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n)
771  fval1 = fval(1,:)
772  fval2 = fval(2,:)
773  fval3 = fval(3,:)
774  fval4 = fval(4,:)
775  fstr_ctrl_get_viscoplasticity = &
776  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3, fval4 )
777  fval(1,:) = fval1
778  fval(2,:) = fval2
779  fval(3,:) = fval3
780  fval(4,:) = fval4
781  end block
782  endif
783  if( fstr_ctrl_get_viscoplasticity ==0 ) then
784  call init_table( mattable, depends, 3+depends,n, fval )
785  call dict_add_key( dict, mc_norton, mattable )
786  ! call print_table( mattable, 6 ); pause
787  endif
788  mattype = norton
789 
790  else
791  stop "ERROR: Material type not supported"
792 
793  endif
794 
795  call finalize_table( mattable )
796  if( allocated(fval) ) deallocate(fval)
797  end function fstr_ctrl_get_viscoplasticity
798 
799  !----------------------------------------------------------------------
801  integer function fstr_ctrl_get_density( ctrl, matval )
802  integer(kind=kint), intent(in) :: ctrl
803  real(kind=kreal),intent(out) :: matval(:)
804 
805  integer(kind=kint) :: i, rcode, depends
806  real(kind=kreal), allocatable :: fval(:,:)
807  character(len=HECMW_NAME_LEN) :: data_fmt
808 
809  data_fmt = "R "
810 
811  fstr_ctrl_get_density = -1
812 
813  depends = 0
814  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
815  if( depends>1 ) depends = 1 ! we consider temperature dependence only currently
816 
817  allocate( fval(1,depends+1) )
818  do i=2,1+depends
819  data_fmt = data_fmt //"R "
820  enddo
821  block
822  real(kind=kreal) :: fval1(depends+1)
823  fval1 = fval(1,:)
824  fstr_ctrl_get_density &
825  = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
826  fval(1,:) = fval1
827  end block
828  if( fstr_ctrl_get_density==0 ) matval(m_density) = fval(1,1)
829 
830  if( allocated(fval) ) deallocate(fval)
831 
832  end function fstr_ctrl_get_density
833 
834 
835  !----------------------------------------------------------------------
837  integer function fstr_ctrl_get_expansion_coeff( ctrl, matval, dict )
838  integer(kind=kint), intent(in) :: ctrl
839  real(kind=kreal),intent(out) :: matval(:)
840  type(dict_struct), pointer :: dict
841 
842  integer(kind=kint) :: i, n, rcode, depends, ipt
843  real(kind=kreal), allocatable :: fval(:,:)
844  type( ttable ) :: mttable
845  character(len=HECMW_NAME_LEN) :: data_fmt, ss
846 
847  data_fmt = "R "
848 
849  fstr_ctrl_get_expansion_coeff = -1
850  n = fstr_ctrl_get_data_line_n( ctrl )
851  if( n == 0 ) return ! fail in reading plastic
852 
853  ss = 'ISOTROPIC,ORTHOTROPIC '
854  ipt = 1 !default
855  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', ss, 0, 'P', ipt ) /= 0 ) return
856 
857  depends = 0
858  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
859  if( depends>1 ) depends = 1 ! we consider temperature dependence only currently
860 
861  if( ipt==1 ) then
862  allocate( fval(depends+1, n) )
863  do i=2,1+depends
864  data_fmt = data_fmt //"R "
865  enddo
866  if( depends==0 ) then
867  block
868  real(kind=kreal) :: fval1(n)
869  fval1 = fval(1,:)
870  fstr_ctrl_get_expansion_coeff = &
871  fstr_ctrl_get_data_array_ex( ctrl, "R ", fval1 )
872  fval(1,:) = fval1
873  end block
874  else
875  block
876  real(kind=kreal) :: fval1(n), fval2(n)
877  fval1 = fval(1,:)
878  fval2 = fval(2,:)
879  fstr_ctrl_get_expansion_coeff = &
880  fstr_ctrl_get_data_array_ex( ctrl, "RR ", fval1, fval2 )
881  fval(1,:) = fval1
882  fval(2,:) = fval2
883  end block
884  endif
885  if( fstr_ctrl_get_expansion_coeff==0 ) then
886  matval(m_exapnsion) = fval(1,1)
887  call init_table( mttable,depends, 1+depends, n, fval )
888  call dict_add_key( dict, mc_themoexp, mttable )
889  endif
890  else
891  allocate( fval(3+depends,n) )
892  do i=2,3+depends
893  data_fmt = trim(data_fmt) //"R "
894  enddo
895  if( depends==0 ) then
896  block
897  real(kind=kreal) :: fval1(n), fval2(n), fval3(n)
898  fval1 = fval(1,:)
899  fval2 = fval(2,:)
900  fval3 = fval(3,:)
901  fstr_ctrl_get_expansion_coeff = &
902  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3 )
903  fval(1,:) = fval1
904  fval(2,:) = fval2
905  fval(3,:) = fval3
906  end block
907  elseif( depends==1 ) then
908  block
909  real(kind=kreal) :: fval1(n), fval2(n), fval3(n), fval4(n)
910  fval1 = fval(1,:)
911  fval2 = fval(2,:)
912  fval3 = fval(3,:)
913  fval4 = fval(4,:)
914  fstr_ctrl_get_expansion_coeff = &
915  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2, fval3, fval4 )
916  fval(1,:) = fval1
917  fval(2,:) = fval2
918  fval(3,:) = fval3
919  fval(4,:) = fval4
920  end block
921  endif
922  if( fstr_ctrl_get_expansion_coeff==0 ) then
923  call init_table( mttable, depends, 3+depends,n, fval )
924  if( fstr_ctrl_get_expansion_coeff==0 ) call dict_add_key( dict, mc_orthoexp, mttable )
925  endif
926  endif
927 
928  call finalize_table( mttable )
929  if( allocated(fval) ) deallocate(fval)
930  end function fstr_ctrl_get_expansion_coeff
931 
932  !----------------------------------------------------------------------
934  integer function fstr_ctrl_get_rayleigh_damping( ctrl, matval, is_RD )
935  integer(kind=kint), intent(in) :: ctrl
936  real(kind=kreal), intent(out) :: matval(:)
937  !type(DICT_STRUCT), pointer :: dict
938  integer(kind=kint) :: rcode
939  real(kind=kreal) :: rm, rk
940  logical :: is_rd
941 
942  rcode = -1
943  is_rd = .false.
944 
945  rm = 0.0d0
946  rcode = fstr_ctrl_get_param_ex( ctrl, 'RM ', '# ', 0, 'R', rm)
947  if(rcode == 0)then
948  matval(m_damping_rm) = rm
949  is_rd = .true.
950  fstr_ctrl_get_rayleigh_damping = 0
951  else
952  fstr_ctrl_get_rayleigh_damping = -1
953  return
954  endif
955 
956  rk = 0.0d0
957  rcode = fstr_ctrl_get_param_ex( ctrl, 'RK ', '# ', 0, 'R', rk)
958  if(rcode == 0)then
959  matval(m_damping_rk) = rk
960  is_rd = .true.
961  fstr_ctrl_get_rayleigh_damping = 0
962  else
963  fstr_ctrl_get_rayleigh_damping = -1
964  return
965  endif
966  end function fstr_ctrl_get_rayleigh_damping
967 
968  integer function read_user_matl( ctrl, matval )
969  integer(kind=kint), intent(in) :: ctrl
970  real(kind=kreal),intent(out) :: matval(:)
971 
972  integer(kind=kint) :: n, i, j
973  real(kind=kreal) :: fval(10,10)
974 
975  read_user_matl = -1
976 
977  n = fstr_ctrl_get_data_line_n( ctrl )
978  if( n > 10 ) stop "Num of data lines for user-defined material exceeds 10"
979  fval =0.d0
980  block
981  real(kind=kreal) :: fval1(10), fval2(10), fval3(10), fval4(10), fval5(10), &
982  fval6(10), fval7(10), fval8(10), fval9(10), fval10(10)
983  fval1 = fval(1,:)
984  fval2 = fval(2,:)
985  fval3 = fval(3,:)
986  fval4 = fval(4,:)
987  fval5 = fval(5,:)
988  fval6 = fval(6,:)
989  fval7 = fval(7,:)
990  fval8 = fval(8,:)
991  fval9 = fval(9,:)
992  fval10 = fval(10,:)
993  if( fstr_ctrl_get_data_array_ex( ctrl, 'rrrrrrrrrr ', fval1, fval2, fval3, &
994  fval4, fval5, fval6, fval7, fval8, fval9, fval10 ) /= 0 ) return
995  fval(1,:) = fval1
996  fval(2,:) = fval2
997  fval(3,:) = fval3
998  fval(4,:) = fval4
999  fval(5,:) = fval5
1000  fval(6,:) = fval6
1001  fval(7,:) = fval7
1002  fval(8,:) = fval8
1003  fval(9,:) = fval9
1004  fval(10,:) = fval10
1005  end block
1006  do i=1,10
1007  do j=1,10
1008  matval((i-1)*10+j)=fval(j,i)
1009  enddo
1010  enddo
1011 
1012  read_user_matl = 0
1013  end function read_user_matl
1014 
1015  !----------------------------------------------------------------------
1017  integer function fstr_ctrl_get_fluid( ctrl, mattype, nlgeom, matval, dict )
1018  integer(kind=kint), intent(in) :: ctrl
1019  integer(kind=kint), intent(inout) :: mattype
1020  integer(kind=kint), intent(out) :: nlgeom
1021  real(kind=kreal),intent(out) :: matval(:)
1022  type(dict_struct), pointer :: dict
1023 
1024  integer(kind=kint) :: i,j, rcode, depends, ipt, n
1025  real(kind=kreal), allocatable :: fval(:,:)
1026  character(len=HECMW_NAME_LEN) :: data_fmt
1027  type( ttable ) :: mattable
1028  logical :: isok
1029  character(len=256) :: s
1030 
1031  fstr_ctrl_get_fluid = -1
1032  depends = 0
1033  rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
1034  if( depends>1 ) depends=1 ! temperature depends only currently
1035  if( depends > 3 ) stop "We cannot read dependencies>3 right now"
1036  nlgeom = totallag !default value
1037 
1038  ipt=1
1039  s = 'INCOMP_NEWTONIAN '
1040  if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ', s, 0, 'P', ipt ) /= 0 ) return
1041 
1042  n = fstr_ctrl_get_data_line_n( ctrl )
1043  ! ISOTROPIC
1044  if( ipt==1 ) then
1045  allocate( fval(1+depends,n) )
1046  if( depends==0 ) then
1047  data_fmt = "R "
1048  block
1049  real(kind=kreal) :: fval1(n)
1050  fval1 = fval(1,:)
1051  fstr_ctrl_get_fluid = &
1052  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
1053  fval(1,:) = fval1
1054  end block
1055  endif
1056  if( depends==1 ) then
1057  data_fmt = "RR "
1058  block
1059  real(kind=kreal) :: fval1(n), fval2(n)
1060  fval1 = fval(1,:)
1061  fval2 = fval(2,:)
1062  fstr_ctrl_get_fluid = &
1063  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1, fval2 )
1064  fval(1,:) = fval1
1065  fval(2,:) = fval2
1066  end block
1067  endif
1068  if( fstr_ctrl_get_fluid ==0 ) then
1069  matval(m_viscocity) = fval(1,1)
1070  call init_table( mattable, depends, 1+depends,n, fval )
1071  call dict_add_key( dict, mc_incomp_newtonian, mattable )
1072  ! call print_table( mattable, 6 ); pause
1073  endif
1074  mattype = incomp_newtonian
1075 
1076  else
1077  stop "ERROR: Material type not supported"
1078 
1079  endif
1080 
1081  call finalize_table( mattable )
1082  if( allocated(fval) ) deallocate(fval)
1083  end function fstr_ctrl_get_fluid
1084 
1085  !----------------------------------------------------------------------
1087  integer function fstr_ctrl_get_spring_d( ctrl, mattype, nlgeom, matval_i, dict )
1088  integer(kind=kint), intent(in) :: ctrl
1089  integer(kind=kint), intent(inout) :: mattype
1090  integer(kind=kint), intent(out) :: nlgeom
1091  integer(kind=kint), intent(out) :: matval_i(:)
1092  type(dict_struct), pointer :: dict
1093 
1094  integer(kind=kint) :: i,j, rcode, depends, ipt, n, dof1, dof2
1095  real(kind=kreal), allocatable :: fval(:,:)
1096  integer(kind=kint), allocatable :: ival(:,:)
1097  character(len=HECMW_NAME_LEN) :: data_fmt
1098  type( ttable ) :: mattable
1099  logical :: isok
1100  character(len=DICT_KEY_LENGTH) :: spkey
1101 
1102  fstr_ctrl_get_spring_d = -1
1103  depends = 0
1104  !rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
1105  !if( depends>1 ) depends=1 ! temperature depends only currently
1106  nlgeom = infinitesimal !default value
1107 
1108  n = fstr_ctrl_get_data_line_n( ctrl )
1109  allocate( fval(1+depends,n), ival(2,n) )
1110  if( depends==0 ) then
1111  data_fmt = "IIR "
1112  block
1113  integer(kind=kint) :: ival1(n), ival2(n)
1114  real(kind=kreal) :: fval1(n)
1115  ival1 = ival(1,:)
1116  ival2 = ival(2,:)
1117  fval1 = fval(1,:)
1118  fstr_ctrl_get_spring_d = &
1119  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival1, ival2, fval1 )
1120  ival(1,:) = ival1
1121  ival(2,:) = ival2
1122  fval(1,:) = fval1
1123  end block
1124  !else if( depends==1 ) then
1125  ! data_fmt = "IIRR "
1126  ! fstr_ctrl_get_SPRING_D = &
1127  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival(1,:), ival(2,:), fval(1,:), fval(2,:) )
1128  endif
1129  if( fstr_ctrl_get_spring_d ==0 ) then
1130  matval_i(m_spring_d_ndoffset+1) = n ! number of dof pairs
1131  do i=1,n
1132  matval_i(m_spring_d_ndoffset+2*i ) = ival(1,i) ! first dof
1133  matval_i(m_spring_d_ndoffset+2*i+1) = ival(2,i) ! second dof
1134  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1135  write(spkey,'(A,I0)') trim(mc_spring),i
1136  call dict_add_key( dict, trim(spkey), mattable )
1137  call finalize_table( mattable )
1138  enddo
1139  endif
1140 
1141  mattype = connector
1142  if( allocated(fval) ) deallocate(fval)
1143  if( allocated(ival) ) deallocate(ival)
1144  end function fstr_ctrl_get_spring_d
1145 
1146  !----------------------------------------------------------------------
1148  integer function fstr_ctrl_get_spring_a( ctrl, mattype, nlgeom, matval_i, dict )
1149  integer(kind=kint), intent(in) :: ctrl
1150  integer(kind=kint), intent(inout) :: mattype
1151  integer(kind=kint), intent(out) :: nlgeom
1152  integer(kind=kint), intent(out) :: matval_i(:)
1153  type(dict_struct), pointer :: dict
1154 
1155  integer(kind=kint) :: i,j, rcode, depends, ipt, n, dof1, dof2
1156  real(kind=kreal), allocatable :: fval(:,:)
1157  character(len=HECMW_NAME_LEN) :: data_fmt
1158  type( ttable ) :: mattable
1159  logical :: isok
1160  character(len=DICT_KEY_LENGTH) :: spkey
1161 
1162  fstr_ctrl_get_spring_a = -1
1163  depends = 0
1164  nlgeom = infinitesimal !default value
1165 
1166  n = fstr_ctrl_get_data_line_n( ctrl )
1167  allocate( fval(1+depends,n) )
1168  if( depends==0 ) then
1169  data_fmt = "R "
1170  block
1171  real(kind=kreal) :: fval1(n)
1172  fval1 = fval(1,:)
1173  fstr_ctrl_get_spring_a = &
1174  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
1175  fval(1,:) = fval1
1176  end block
1177  !else if( depends==1 ) then
1178  ! data_fmt = "IIRR "
1179  ! fstr_ctrl_get_SPRING_A = &
1180  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
1181  endif
1182  if( fstr_ctrl_get_spring_a ==0 ) then
1183  matval_i(m_spring_a_ndoffset+1) = 1 ! number of dof pairs
1184  do i=1,n
1185  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1186  write(spkey,'(A,A)') trim(mc_spring),'_A'
1187  call dict_add_key( dict, trim(spkey), mattable )
1188  call finalize_table( mattable )
1189  enddo
1190  endif
1191 
1192  mattype = connector
1193  if( allocated(fval) ) deallocate(fval)
1194  end function fstr_ctrl_get_spring_a
1195 
1196  !----------------------------------------------------------------------
1198  integer function fstr_ctrl_get_dashpot_d( ctrl, mattype, nlgeom, matval_i, dict )
1199  integer(kind=kint), intent(in) :: ctrl
1200  integer(kind=kint), intent(inout) :: mattype
1201  integer(kind=kint), intent(out) :: nlgeom
1202  integer(kind=kint), intent(out) :: matval_i(:)
1203  type(dict_struct), pointer :: dict
1204 
1205  integer(kind=kint) :: i,j, rcode, depends, ipt, n, dof1, dof2
1206  real(kind=kreal), allocatable :: fval(:,:)
1207  integer(kind=kint), allocatable :: ival(:,:)
1208  character(len=HECMW_NAME_LEN) :: data_fmt
1209  type( ttable ) :: mattable
1210  logical :: isok
1211  character(len=DICT_KEY_LENGTH) :: spkey
1212 
1213  fstr_ctrl_get_dashpot_d = -1
1214  depends = 0
1215  !rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES ', '# ', 0, 'I', depends )
1216  !if( depends>1 ) depends=1 ! temperature depends only currently
1217  nlgeom = infinitesimal !default value
1218 
1219  n = fstr_ctrl_get_data_line_n( ctrl )
1220  allocate( fval(1+depends,n), ival(2,n) )
1221  if( depends==0 ) then
1222  data_fmt = "IIR "
1223  block
1224  integer(kind=kint) :: ival1(n), ival2(n)
1225  real(kind=kreal) :: fval1(n)
1226  ival1 = ival(1,:)
1227  ival2 = ival(2,:)
1228  fval1 = fval(1,:)
1229  fstr_ctrl_get_dashpot_d = &
1230  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival1, ival2, fval1 )
1231  ival(1,:) = ival1
1232  ival(2,:) = ival2
1233  fval(1,:) = fval1
1234  end block
1235  !else if( depends==1 ) then
1236  ! data_fmt = "IIRR "
1237  ! fstr_ctrl_get_DASHPOT_D = &
1238  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, ival(1,:), ival(2,:), fval(1,:), fval(2,:) )
1239  endif
1240  if( fstr_ctrl_get_dashpot_d ==0 ) then
1241  matval_i(m_dashpot_d_ndoffset+1) = n
1242  do i=1,n
1243  matval_i(m_dashpot_d_ndoffset+2*i ) = ival(1,i) ! first dof
1244  matval_i(m_dashpot_d_ndoffset+2*i+1) = ival(2,i) ! second dof
1245  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1246  write(spkey,'(A,I0)') trim(mc_dashpot),i
1247  call dict_add_key( dict, trim(spkey), mattable )
1248  call finalize_table( mattable )
1249  enddo
1250  endif
1251 
1252  mattype = connector
1253  if( allocated(fval) ) deallocate(fval)
1254  if( allocated(ival) ) deallocate(ival)
1255  end function fstr_ctrl_get_dashpot_d
1256 
1257  !----------------------------------------------------------------------
1259  integer function fstr_ctrl_get_dashpot_a( ctrl, mattype, nlgeom, matval_i, dict )
1260  integer(kind=kint), intent(in) :: ctrl
1261  integer(kind=kint), intent(inout) :: mattype
1262  integer(kind=kint), intent(out) :: nlgeom
1263  integer(kind=kint), intent(out) :: matval_i(:)
1264  type(dict_struct), pointer :: dict
1265 
1266  integer(kind=kint) :: i,j, rcode, depends, ipt, n, dof1, dof2
1267  real(kind=kreal), allocatable :: fval(:,:)
1268  character(len=HECMW_NAME_LEN) :: data_fmt
1269  type( ttable ) :: mattable
1270  logical :: isok
1271  character(len=DICT_KEY_LENGTH) :: spkey
1272 
1273  fstr_ctrl_get_dashpot_a = -1
1274  depends = 0
1275  nlgeom = infinitesimal !default value
1276 
1277  n = fstr_ctrl_get_data_line_n( ctrl )
1278  allocate( fval(1+depends,n) )
1279  if( depends==0 ) then
1280  data_fmt = "R "
1281  block
1282  real(kind=kreal) :: fval1(n)
1283  fval1 = fval(1,:)
1284  fstr_ctrl_get_dashpot_a = &
1285  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval1 )
1286  fval(1,:) = fval1
1287  end block
1288  !else if( depends==1 ) then
1289  ! data_fmt = "IIRR "
1290  ! fstr_ctrl_get_DASHPOT_A = &
1291  ! fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
1292  endif
1293  if( fstr_ctrl_get_dashpot_a ==0 ) then
1294  matval_i(m_dashpot_a_ndoffset+1) = 1 ! number of dof pairs
1295  do i=1,n
1296  call init_table( mattable, depends, 1+depends, 1, fval(1,i:i) )
1297  write(spkey,'(A,A)') trim(mc_dashpot),'_A'
1298  call dict_add_key( dict, trim(spkey), mattable )
1299  call finalize_table( mattable )
1300  enddo
1301  endif
1302 
1303  mattype = connector
1304  if( allocated(fval) ) deallocate(fval)
1305  end function fstr_ctrl_get_dashpot_a
1306 
1307 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:1204
fstr_ctrl_get_data_line_n
int fstr_ctrl_get_data_line_n(int *ctrl)
Definition: fstr_ctrl_util.c:1227
fstr_ctrl_get_data_array_ex
int fstr_ctrl_get_data_array_ex(int *ctrl, const char *format,...)
Definition: fstr_ctrl_util.c:1330
fstr_ctrl_get_data_ex
int fstr_ctrl_get_data_ex(int *ctrl, int *line_no, const char *format,...)
Definition: fstr_ctrl_util.c:1293
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:1199
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:725
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:838
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:55
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:1260
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:802
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:1149
fstr_ctrl_material::fstr_ctrl_get_rayleigh_damping
integer function fstr_ctrl_get_rayleigh_damping(ctrl, matval, is_RD)
Read in !RAYLEIGH_DAMPING.
Definition: fstr_ctrl_material.f90:935
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:1018
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:1088
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:63
mmaterial::updatelag
integer(kind=kint), parameter updatelag
Definition: material.f90:15
m_table::ttable
Definition: ttable.f90:20