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 changeplastics(inpc,textpart,imat,ntmat_,npmat_, 20 & plicon,nplicon,plkcon,nplkcon,istep,istat,n,iline,ipol, 21 & inl,ipoinp,inp,ipoinpc,nelcon,ier) 22! 23! reading the input deck: *CHANGE PLASTIC 24! 25 implicit none 26! 27 logical iso 28! 29 character*1 inpc(*) 30 character*132 textpart(16) 31! 32 integer imat,ntmat_,ntmat,npmat_,npmat,istep,nelcon(2,*), 33 & n,key,i,nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),istat, 34 & iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*),ier 35! 36 real*8 plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*), 37 & temperature 38! 39 iso=.true. 40! 41 ntmat=0 42 npmat=0 43! 44 if(istep.lt.1) then 45 write(*,*) '*ERROR reading *CHANGE PLASTIC: *CHANGE PLASTIC' 46 write(*,*) ' should only be used within a STEP' 47 ier=1 48 return 49 endif 50! 51 if((nelcon(1,imat).ne.-51).and. 52 & (nelcon(1,imat).ne.-52)) then 53 write(*,*) '*ERROR reading *CHANGE PLASTIC: *CHANGE PLASTIC' 54 write(*,*) ' can only be used to change the plastic' 55 write(*,*) ' definition of an elastically isotropic' 56 write(*,*) ' material with *PLASTIC data' 57 ier=1 58 return 59 endif 60! 61 do i=2,n 62 if(textpart(i)(1:10).eq.'HARDENING=') then 63 if(textpart(i)(11:19).eq.'KINEMATIC') then 64 iso=.false. 65 elseif(textpart(i)(11:18).eq.'COMBINED') then 66 write(*,*) '*ERROR reading *CHANGE PLASTIC' 67 write(*,*) ' combined hardening is not allowed' 68 ier=1 69 return 70 elseif(textpart(i)(11:14).eq.'USER') then 71 write(*,*) '*ERROR reading *CHANGE PLASTIC' 72 write(*,*) ' parameter USER is not allowed' 73 ier=1 74 return 75 endif 76 exit 77 else 78 write(*,*) 79 & '*WARNING reading *CHANGE PLASTIC: parameter not recognized:' 80 write(*,*) ' ', 81 & textpart(i)(1:index(textpart(i),' ')-1) 82 call inputwarning(inpc,ipoinpc,iline, 83 &"*CHANGE PLASTIC%") 84 endif 85 enddo 86! 87 if(iso) then 88! 89! isotropic hardening coefficients 90! 91 do 92 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 93 & ipoinp,inp,ipoinpc) 94 if((istat.lt.0).or.(key.eq.1)) exit 95 read(textpart(3)(1:20),'(f20.0)',iostat=istat) temperature 96 if(istat.gt.0) then 97 call inputerror(inpc,ipoinpc,iline, 98 & "*CHANGE PLASTIC%",ier) 99 return 100 endif 101! 102! first temperature 103! 104 if(ntmat.eq.0) then 105 npmat=0 106 ntmat=ntmat+1 107 if(ntmat.gt.ntmat_) then 108 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 109 write(*,*) ' more temperature data points' 110 write(*,*) ' than underneath the *PLASTIC card' 111 ier=1 112 return 113 endif 114 nplicon(0,imat)=ntmat 115 plicon(0,ntmat,imat)=temperature 116! 117! new temperature 118! 119 elseif(plicon(0,ntmat,imat).ne.temperature) then 120 npmat=0 121 ntmat=ntmat+1 122 if(ntmat.gt.ntmat_) then 123 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 124 write(*,*) ' more temperature data points' 125 write(*,*) ' than underneath the *PLASTIC card' 126 ier=1 127 return 128 endif 129 nplicon(0,imat)=ntmat 130 plicon(0,ntmat,imat)=temperature 131 endif 132 do i=1,2 133 read(textpart(i)(1:20),'(f20.0)',iostat=istat) 134 & plicon(2*npmat+i,ntmat,imat) 135 if(istat.gt.0) then 136 call inputerror(inpc,ipoinpc,iline, 137 & "*CHANGE PLASTIC%",ier) 138 return 139 endif 140 enddo 141 npmat=npmat+1 142 if(npmat.gt.npmat_) then 143 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 144 write(*,*) ' more stress versus equivalent' 145 write(*,*) ' plastic strain data points' 146 write(*,*) ' than underneath the *PLASTIC card' 147 ier=1 148 return 149 endif 150 nplicon(ntmat,imat)=npmat 151 enddo 152 else 153! 154! kinematic hardening coefficients 155! 156 do 157 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 158 & ipoinp,inp,ipoinpc) 159 if((istat.lt.0).or.(key.eq.1)) exit 160 read(textpart(3)(1:20),'(f20.0)',iostat=istat) temperature 161 if(istat.gt.0) then 162 call inputerror(inpc,ipoinpc,iline, 163 & "*CHANGE PLASTIC%",ier) 164 return 165 endif 166! 167! first temperature 168! 169 if(ntmat.eq.0) then 170 npmat=0 171 ntmat=ntmat+1 172 if(ntmat.gt.ntmat_) then 173 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 174 write(*,*) ' more temperature data points' 175 write(*,*) ' than underneath the *PLASTIC card' 176 ier=1 177 return 178 endif 179 nplkcon(0,imat)=ntmat 180 plkcon(0,ntmat,imat)=temperature 181! 182! new temperature 183! 184 elseif(plkcon(0,ntmat,imat).ne.temperature) then 185 npmat=0 186 ntmat=ntmat+1 187 if(ntmat.gt.ntmat_) then 188 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 189 write(*,*) ' more temperature data points' 190 write(*,*) ' than underneath the *PLASTIC card' 191 ier=1 192 return 193 endif 194 nplkcon(0,imat)=ntmat 195 plkcon(0,ntmat,imat)=temperature 196 endif 197 do i=1,2 198 read(textpart(i)(1:20),'(f20.0)',iostat=istat) 199 & plkcon(2*npmat+i,ntmat,imat) 200 if(istat.gt.0) then 201 call inputerror(inpc,ipoinpc,iline, 202 & "*CHANGE PLASTIC%",ier) 203 return 204 endif 205 enddo 206 npmat=npmat+1 207 if(npmat.gt.npmat_) then 208 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 209 write(*,*) ' more stress versus equivalent' 210 write(*,*) ' plastic strain data points' 211 write(*,*) ' than underneath the *PLASTIC card' 212 ier=1 213 return 214 endif 215 nplkcon(ntmat,imat)=npmat 216 enddo 217 endif 218! 219 if(ntmat.eq.0) then 220 write(*,*) '*ERROR reading *CHANGE PLASTIC:' 221 write(*,*) ' *CHANGE PLASTIC card without data' 222 ier=1 223 return 224 endif 225! 226 return 227 end 228 229