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_main(amat,iel,iint,kode,elconloc,emec,emec0, 20 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 21 & icmd,ielas,mi,nstate_,xstateini,xstate,stre,stiff, 22 & iorien,pgauss,orab,pnewdt,istep,iinc,ipkon,nmethod, 23 & iperturb,depvisc,eloc,nlgeom_undo) 24! 25! calculates stiffness and stresses for a user defined material 26! law 27! 28 implicit none 29! 30 character*80 amat,amatloc 31! 32 integer ithermal(*),icmd,kode,ielas,iel,iint,nstate_,mi(*),iorien, 33 & istep,iinc,ipkon(*),nmethod,iperturb(*),nlgeom_undo 34! 35 real*8 elconloc(*),stiff(21),emec(6),emec0(6),beta(6),stre(6), 36 & vj,t1l,dtime,xkl(3,3),xikl(3,3),vij,pgauss(3),orab(7,*), 37 & time,ttime,pnewdt,depvisc,eloc(6) 38! 39 real*8 xstate(nstate_,mi(1),*),xstateini(nstate_,mi(1),*) 40! 41 42 if(amat(1:8).eq.'ABAQUSNL') then 43 44 amatloc(1:72)=amat(9:80) 45 amatloc(73:80)=' ' 46 call umat_abaqusnl(amatloc,iel,iint,kode,elconloc,emec, 47 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 48 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 49 & iorien,pgauss,orab,istep,iinc,pnewdt,nmethod,iperturb) 50 51 elseif(amat(1:9).eq.'@ABAQUSNL') then 52! 53 call umat_abaqusnl(amat,iel,iint,kode,elconloc,emec, 54 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 55 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 56 & iorien,pgauss,orab,istep,iinc,pnewdt,nmethod,iperturb) 57! 58 elseif(amat(1:6).eq.'ABAQUS') then 59! 60 amatloc(1:74)=amat(7:80) 61 amatloc(75:80)=' ' 62 call umat_abaqus(amatloc,iel,iint,kode,elconloc,emec, 63 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 64 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 65 & iorien,pgauss,orab,istep,iinc,pnewdt,nmethod,iperturb) 66! 67 elseif(amat(1:7).eq.'@ABAQUS') then 68 69 call umat_abaqus(amat,iel,iint,kode,elconloc,emec, 70 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 71 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 72 & iorien,pgauss,orab,istep,iinc,pnewdt,nmethod,iperturb) 73! 74 elseif(amat(1:10).eq.'ANISO_PLAS') then 75! 76 amatloc(1:70)=amat(11:80) 77 amatloc(71:80)=' ' 78 call umat_aniso_plas(amatloc, 79 & iel,iint,kode,elconloc,emec,emec0, 80 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 81 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 82 & iorien,pgauss,orab,nmethod,pnewdt) 83! 84 elseif(amat(1:11).eq.'ANISO_CREEP') then 85! 86 amatloc(1:69)=amat(12:80) 87 amatloc(70:80)=' ' 88 call umat_aniso_creep(amatloc, 89 & iel,iint,kode,elconloc,emec,emec0, 90 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 91 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 92 & iorien,pgauss,orab,nmethod,pnewdt,depvisc) 93! 94 elseif(amat(1:10).eq.'CIARLET_EL') then 95! 96 amatloc(1:70)=amat(11:80) 97 amatloc(71:80)=' ' 98 call umat_ciarlet_el(amatloc, 99 & iel,iint,kode,elconloc,emec, 100 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 101 & icmd,ielas,mi(1), 102 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 103! 104 elseif(amat(1:16).eq.'COMPRESSION_ONLY') then 105! 106 amatloc(1:64)=amat(17:80) 107 amatloc(65:80)=' ' 108 call umat_compression_only(amatloc, 109 & iel,iint,kode,elconloc,emec, 110 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 111 & icmd,ielas,mi(1), 112 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 113! 114 elseif(amat(1:13).eq.'ELASTIC_FIBER') then 115! 116 amatloc(1:67)=amat(14:80) 117 amatloc(68:80)=' ' 118 call umat_elastic_fiber(amat(14:80), 119 & iel,iint,kode,elconloc,emec,emec0, 120 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 121 & icmd,ielas,mi(1), 122 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 123! 124 elseif(amat(1:12).eq.'LIN_EL_COROT') then 125! 126 amatloc(1:68)=amat(13:80) 127 amatloc(69:80)=' ' 128 call umat_lin_el_corot(amatloc,iel,iint,kode, 129 & elconloc,emec,emec0, 130 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 131 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 132 & iorien,pgauss,orab,eloc,nlgeom_undo) 133! 134 elseif(amat(1:10).eq.'LIN_ISO_EL') then 135! 136 amatloc(1:70)=amat(11:80) 137 amatloc(71:80)=' ' 138 call umat_lin_iso_el(amatloc, 139 & iel,iint,kode,elconloc,emec,emec0, 140 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 141 & icmd,ielas,mi(1), 142 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 143! 144 elseif(amat(1:9).eq.'IDEAL_GAS') then 145! 146 amatloc(1:71)=amat(10:80) 147 amatloc(72:80)=' ' 148 call umat_ideal_gas(amatloc, 149 & iel,iint,kode,elconloc,emec,emec0, 150 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 151 & icmd,ielas,mi(1), 152 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 153! 154 elseif(amat(1:20).eq.'SINGLE_CRYSTAL_CREEP') then 155! 156 amatloc(1:60)=amat(21:80) 157 amatloc(61:80)=' ' 158 call umat_single_crystal_creep(amatloc, 159 & iel,iint,kode,elconloc,emec, 160 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 161 & icmd,ielas,mi(1), 162 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab, 163 & pnewdt) 164! 165 elseif(amat(1:14).eq.'SINGLE_CRYSTAL') then 166! 167 amatloc(1:66)=amat(15:80) 168 amatloc(67:80)=' ' 169 call umat_single_crystal(amatloc, 170 & iel,iint,kode,elconloc,emec, 171 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 172 & icmd,ielas,mi(1), 173 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 174! 175 elseif(amat(1:12).eq.'TENSION_ONLY') then 176! 177 amatloc(1:68)=amat(13:80) 178 amatloc(69:80)=' ' 179 call umat_tension_only(amatloc, 180 & iel,iint,kode,elconloc,emec, 181 & emec0,beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 182 & icmd,ielas,mi(1), 183 & nstate_,xstateini,xstate,stre,stiff,iorien,pgauss,orab) 184! 185 elseif(amat(1:4).eq.'USER') then 186! 187 amatloc(1:76)=amat(5:80) 188 amatloc(77:80)=' ' 189 call umat_user(amatloc,iel,iint,kode,elconloc,emec,emec0, 190 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 191 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 192 & iorien,pgauss,orab,pnewdt,ipkon) 193! 194 elseif(amat(1:18).eq.'UNDO_NLGEOM_LIN_EL') then 195! 196 amatloc(1:62)=amat(19:80) 197 amatloc(63:80)=' ' 198 call umat_undo_nlgeom_lin_el(amatloc,iel,iint,kode, 199 & elconloc,emec,emec0, 200 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 201 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 202 & iorien,pgauss,orab,eloc,nlgeom_undo) 203! 204 elseif(amat(1:22).eq.'UNDO_NLGEOM_LIN_ISO_EL') then 205! 206 amatloc(1:58)=amat(23:80) 207 amatloc(59:80)=' ' 208 call umat_undo_nlgeom_lin_iso_el(amatloc,iel,iint,kode, 209 & elconloc,emec,emec0, 210 & beta,xikl,vij,xkl,vj,ithermal,t1l,dtime,time,ttime, 211 & icmd,ielas,mi(1),nstate_,xstateini,xstate,stre,stiff, 212 & iorien,pgauss,orab,eloc,nlgeom_undo) 213! 214 elseif(amat(1:1).eq.'@') then 215! 216 call call_external_umat_user(amat,iel,iint,kode,elconloc, 217 & emec,emec0,beta,xikl,vij,xkl,vj,ithermal,t1l, 218 & dtime,time,ttime,icmd,ielas,mi(1),nstate_,xstateini, 219 & xstate,stre,stiff,iorien,pgauss,orab,pnewdt,ipkon) 220 else 221 write(*,*) '*ERROR in umat: no user material subroutine' 222 write(*,*) ' defined for material ',amat 223 call exit(201) 224 endif 225! 226 return 227 end 228