1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19      subroutine umat(stress,statev,ddsdde,sse,spd,scd,
20     &  rpl,ddsddt,drplde,drpldt,
21     &  stran,dstran,time,dtime,temp,dtemp,predef,dpred,cmname,
22     &  ndi,nshr,ntens,nstatv,props,nprops,coords,drot,pnewdt,
23     &  celent,dfgrd0,dfgrd1,noel,npt,layer,kspt,kstep,kinc)
24!
25!     here, an ABAQUS umat routine can be inserted
26!
27!     note that reals should be double precision (REAL*8)
28!
29      implicit none
30!
31      character*80 cmname
32!
33      integer ndi,nshr,ntens,nstatv,nprops,noel,npt,layer,kspt,
34     &  kstep,kinc
35!
36      real*8 stress(ntens),statev(nstatv),
37     &  ddsdde(ntens,ntens),ddsddt(ntens),drplde(ntens),
38     &  stran(ntens),dstran(ntens),time(2),celent,
39     &  props(nprops),coords(3),drot(3,3),dfgrd0(3,3),dfgrd1(3,3),
40     &  sse,spd,scd,rpl,drpldt,dtime,temp,dtemp,predef,dpred,
41     &  pnewdt
42!
43!     START EXAMPLE LINEAR ELASTIC MATERIAL
44!
45      integer i,j
46      real*8 e,un,al,um,am1,am2
47!
48c      write(*,*) 'noel,npt ',noel,npt
49c      write(*,*) 'stress ',(stress(i),i=1,6)
50c      write(*,*) 'stran ',(stran(i),i=1,6)
51c      write(*,*) 'dstran ',(dstran(i),i=1,6)
52c      write(*,*) 'drot ',((drot(i,j),i=1,3),j=1,3)
53      e=props(1)
54      un=props(2)
55      al=un*e/(1.d0+un)/(1.d0-2.d0*un)
56      um=e/2.d0/(1.d0+un)
57      am1=al+2.d0*um
58      am2=um
59!
60!     stress
61!
62      stress(1)=stress(1)+am1*dstran(1)+al*(dstran(2)+dstran(3))
63      stress(2)=stress(2)+am1*dstran(2)+al*(dstran(1)+dstran(3))
64      stress(3)=stress(3)+am1*dstran(3)+al*(dstran(1)+dstran(2))
65      stress(4)=stress(4)+am2*dstran(4)
66      stress(5)=stress(5)+am2*dstran(5)
67      stress(6)=stress(6)+am2*dstran(6)
68!
69!     stiffness
70!
71      do i=1,6
72         do j=1,6
73            ddsdde(i,j)=0.d0
74         enddo
75      enddo
76      ddsdde(1,1)=al+2.d0*um
77      ddsdde(1,2)=al
78      ddsdde(2,1)=al
79      ddsdde(2,2)=al+2.d0*um
80      ddsdde(1,3)=al
81      ddsdde(3,1)=al
82      ddsdde(2,3)=al
83      ddsdde(3,2)=al
84      ddsdde(3,3)=al+2.d0*um
85      ddsdde(4,4)=um
86      ddsdde(5,5)=um
87      ddsdde(6,6)=um
88!
89!     END EXAMPLE LINEAR ELASTIC MATERIAL
90!
91      return
92      end
93