CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
creeps.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine creeps (inpc, textpart, nelcon, nmat, ntmat_, npmat_, plicon, nplicon, elcon, iplas, iperturb, nstate_, ncmat_, matname, irstrt, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc, ianisoplas)
 

Function/Subroutine Documentation

◆ creeps()

subroutine creeps ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
integer, dimension(2,*)  nelcon,
integer  nmat,
integer  ntmat_,
integer  npmat_,
real*8, dimension(0:2*npmat_,ntmat_,*)  plicon,
integer, dimension(0:ntmat_,*)  nplicon,
real*8, dimension(0:ncmat_,ntmat_,*)  elcon,
integer  iplas,
integer, dimension(*)  iperturb,
integer  nstate_,
integer  ncmat_,
character*80, dimension(*)  matname,
integer  irstrt,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc,
integer  ianisoplas 
)
23 !
24 ! reading the input deck: *CREEP
25 !
26  implicit none
27 !
28  logical iso
29 !
30  character*1 inpc(*)
31  character*80 matname(*)
32  character*132 textpart(16)
33 !
34  integer nelcon(2,*),nmat,ntmat_,ntmat,istep,npmat_,nstate_,
35  & n,key,i,j,iplas,iperturb(*),istat,nplicon(0:ntmat_,*),ncmat_,
36  & k,id,irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*),
37  & ianisoplas
38 !
39  real*8 temperature,elcon(0:ncmat_,ntmat_,*),t1l,
40  & plicon(0:2*npmat_,ntmat_,*)
41 !
42  iso=.true.
43  ntmat=0
44 !
45  if((istep.gt.0).and.(irstrt.ge.0)) then
46  write(*,*) '*ERROR reading *CREEP: *CREEP should be placed'
47  write(*,*) ' before all step definitions'
48  call exit(201)
49  endif
50 !
51  if(nmat.eq.0) then
52  write(*,*) '*ERROR reading *CREEP: *CREEP should be preceded'
53  write(*,*) ' by a *MATERIAL card'
54  call exit(201)
55  endif
56 !
57 ! check for anisotropic creep: assumes a ucreep routine
58 !
59 ! following if corresponds to "elastic isotropic with or
60 ! without plasticity"
61 !
62  if((nelcon(1,nmat).ne.2).and.(nelcon(1,nmat).ne.-51)) then
63 !
64 ! following if corresponds to "elastic anisotropic with or
65 ! without plasticity"
66 !
67  if((nelcon(1,nmat).ne.9).and.(nelcon(1,nmat).ne.-114)) then
68  write(*,*) '*ERROR reading *CREEP: *CREEP should be'
69  write(*,*) ' preceded by an *ELASTIC,TYPE=ISO card,'
70  write(*,*) ' or an *ELASTIC,TYPE=ORTHO card'
71  call exit(201)
72  endif
73 !
74  ianisoplas=1
75 !
76  if(nelcon(1,nmat).ne.-114) then
77 !
78 ! viscoplastic material with zero yield surface and
79 ! without hardening: no plasticity
80 !
81  iperturb(1)=3
82  nelcon(1,nmat)=-114
83  do i=2,n
84  if(textpart(i)(1:8).eq.'LAW=USER') then
85  nelcon(1,nmat)=-109
86  exit
87  endif
88  enddo
89  if(nelcon(1,nmat).eq.-109) then
90 !
91 ! elastic orthotropic
92 ! no plasticity
93 ! user creep: -109
94 !
95  nstate_=max(nstate_,7)
96  if(matname(nmat)(70:80).ne.' ') then
97  write(*,*) '*ERROR reading *CREEP: the material name'
98  write(*,*) ' for an elastically anisotropic'
99  write(*,*) ' material with isotropic creep must'
100  write(*,*) ' not exceed 69 characters'
101  call exit(201)
102  else
103  do i=80,12,-1
104  matname(nmat)(i:i)=matname(nmat)(i-11:i-11)
105  enddo
106  matname(nmat)(1:11)='ANISO_CREEP'
107  endif
108  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
109  & ipoinp,inp,ipoinpc)
110  return
111  else
112 !
113 ! elastic orthotropic
114 ! no plasticity
115 ! Norton creep: -114
116 !
117  nstate_=max(nstate_,14)
118  do i=1,nelcon(2,nmat)
119  elcon(10,i,nmat)=0.d0
120  elcon(11,i,nmat)=0.d0
121  elcon(12,i,nmat)=0.d0
122  enddo
123  if(matname(nmat)(71:80).ne.' ') then
124  write(*,*) '*ERROR reading *CREEP: the material name'
125  write(*,*) ' for an elastically anisotropic'
126  write(*,*) ' material with Norton creep'
127  write(*,*) ' must not exceed 70 characters'
128  call exit(201)
129  else
130  do i=80,11,-1
131  matname(nmat)(i:i)=matname(nmat)(i-10:i-10)
132  enddo
133  matname(nmat)(1:10)='ANISO_PLAS'
134  endif
135  endif
136  else
137 !
138 ! elastic orthotropic
139 ! plasticity
140 ! Norton creep: -114 (user creep is not allowed)
141 !
142  do i=2,n
143  if(textpart(i)(1:8).eq.'LAW=USER') then
144  write(*,*) '*ERROR reading *CREEP: for an elastically'
145  write(*,*) ' anisotropic material with von'
146  write(*,*) ' Mises plasticity only Norton creep'
147  write(*,*) ' is allowed (no user subroutine)'
148  call exit(201)
149  endif
150  enddo
151  endif
152  endif
153 !
154 ! if the *CREEP card is not preceded by a *PLASTIC card, a zero
155 ! yield surface is assumed
156 !
157  if(nelcon(1,nmat).ne.-114) then
158 !
159 ! elastic isotropic
160 ! plasticity or no plasticity
161 ! creep (Norton or user): -52
162 !
163  if(nelcon(1,nmat).ne.-51) then
164 !
165 ! elastic isotropic
166 ! no plasticity -> zero yield plasticity
167 ! creep (Norton or user)
168 !
169  nplicon(0,nmat)=1
170  nplicon(1,nmat)=2
171  plicon(0,1,nmat)=0.d0
172  plicon(1,1,nmat)=0.d0
173  plicon(2,1,nmat)=0.d0
174  plicon(3,1,nmat)=0.d0
175  plicon(4,1,nmat)=10.d10
176  endif
177 !
178  iperturb(1)=3
179  iplas=1
180  nelcon(1,nmat)=-52
181  nstate_=max(nstate_,13)
182 !
183  do i=2,n
184  if(textpart(i)(1:8).eq.'LAW=USER') then
185  do j=1,nelcon(2,nmat)
186  elcon(3,j,nmat)=-1.d0
187  enddo
188  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
189  & ipoinp,inp,ipoinpc)
190  return
191  elseif(textpart(i)(1:10).eq.'LAW=NORTON') then
192 !
193 ! default; nothing to do
194 !
195  else
196  write(*,*)
197  & '*WARNING reading *CREEP: parameter not recognized:'
198  write(*,*) ' ',
199  & textpart(i)(1:index(textpart(i),' ')-1)
200  call inputwarning(inpc,ipoinpc,iline,
201  &"*CREEP%")
202  endif
203  enddo
204 !
205 ! before interpolation: data are stored in positions 6-9:
206 ! A,n,m,temperature
207 ! after interpolation: data are stored in positions 3-5:
208 ! A,n,m
209 !
210  do
211  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
212  & ipoinp,inp,ipoinpc)
213  if((istat.lt.0).or.(key.eq.1)) exit
214  ntmat=ntmat+1
215  if(ntmat.gt.ntmat_) then
216  write(*,*) '*ERROR reading *CREEP: increase ntmat_'
217  call exit(201)
218  endif
219  do i=1,3
220  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
221  & elcon(i+5,ntmat,nmat)
222  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
223  &"*CREEP%")
224  enddo
225  if(elcon(6,ntmat,nmat).le.0.d0) then
226  write(*,*) '*ERROR reading *CREEP: parameter A'
227  write(*,*) ' in the Norton law is nonpositive'
228  call exit(201)
229  endif
230  if(elcon(7,ntmat,nmat).le.0.d0) then
231  write(*,*) '*ERROR reading *CREEP: parameter n'
232  write(*,*) ' in the Norton law is nonpositive'
233  call exit(201)
234  endif
235  if(textpart(4)(1:1).ne.' ') then
236  read(textpart(4)(1:20),'(f20.0)',iostat=istat)
237  & temperature
238  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
239  &"*CREEP%")
240  else
241  temperature=0.d0
242  endif
243  elcon(9,ntmat,nmat)=temperature
244  enddo
245 !
246  if(ntmat.eq.0) then
247  write(*,*) '*ERROR reading *CREEP: Norton law assumed,'
248  write(*,*) ' yet no constants given'
249  call exit(201)
250  endif
251 !
252 ! interpolating the creep data at the elastic temperature
253 ! data points
254 !
255  write(*,*) '*INFO: interpolating the creep data at the'
256  write(*,*) ' elastic temperature data points;'
257  write(*,*) ' please note that it is preferable'
258  write(*,*) ' to use exactly the same temperature'
259  write(*,*) ' data points for the elastic and creep'
260  write(*,*) ' data (if not already done so)'
261  write(*,*)
262  write(*,*) 'interpolated creep data'
263  write(*,*) 'temperature A n m'
264 !
265  do i=1,nelcon(2,nmat)
266  t1l=elcon(0,i,nmat)
267  call ident2(elcon(9,1,nmat),t1l,ntmat,ncmat_+1,id)
268  if(ntmat.eq.0) then
269  continue
270  elseif((ntmat.eq.1).or.(id.eq.0)) then
271  elcon(3,i,nmat)=elcon(6,1,nmat)
272  elcon(4,i,nmat)=elcon(7,1,nmat)
273  elcon(5,i,nmat)=elcon(8,1,nmat)
274  elseif(id.eq.ntmat) then
275  elcon(3,i,nmat)=elcon(6,id,nmat)
276  elcon(4,i,nmat)=elcon(7,id,nmat)
277  elcon(5,i,nmat)=elcon(8,id,nmat)
278  else
279  do k=3,5
280  elcon(k,i,nmat)=elcon(k+3,id,nmat)+
281  & (elcon(k+3,id+1,nmat)-elcon(k+3,id,nmat))*
282  & (t1l-elcon(9,id,nmat))/
283  & (elcon(9,id+1,nmat)-elcon(9,id,nmat))
284  enddo
285  endif
286  write(*,*) t1l,(elcon(k,i,nmat),k=3,5)
287  enddo
288  write(*,*)
289 !
290  else
291 !
292 ! elastically anisotropic material with isotropic viscoplasticity
293 ! (i.e. isotropic plasticity with Norton creep)
294 !
295  do
296  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
297  & ipoinp,inp,ipoinpc)
298  if((istat.lt.0).or.(key.eq.1)) exit
299  ntmat=ntmat+1
300  if(ntmat.gt.ntmat_) then
301  write(*,*) '*ERROR reading *CREEP: increase ntmat_'
302  call exit(201)
303  endif
304  do i=1,3
305  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
306  & elcon(i+15,ntmat,nmat)
307  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
308  &"*CREEP%")
309  enddo
310  if(textpart(3)(1:1).ne.' ') then
311  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
312  & temperature
313  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
314  &"*CREEP%")
315  else
316  temperature=0.d0
317  endif
318  elcon(19,ntmat,nmat)=temperature
319  enddo
320 !
321 ! interpolating the creep data at the elastic temperature
322 ! data points
323 !
324 ! before interpolation: data are stored in positions 16-19:
325 ! A,n,m,temperature
326 ! after interpolation: data are stored in positions 13-15:
327 ! A,n,m
328 !
329  write(*,*) '*INFO: interpolating the creep data at the'
330  write(*,*) ' elastic temperature data points;'
331  write(*,*) ' please note that it is preferable'
332  write(*,*) ' to use exactly the same temperature'
333  write(*,*) ' data points for the elastic and creep'
334  write(*,*) ' data (if not already done so)'
335  write(*,*)
336  write(*,*) 'interpolated creep data'
337  write(*,*) 'temperature A n m'
338 !
339  if(ntmat.eq.0) then
340  write(*,*) '*ERROR reading *CREEP: Norton law assumed,'
341  write(*,*) ' yet no constants given'
342  call exit(201)
343  endif
344 !
345  do i=1,nelcon(2,nmat)
346  t1l=elcon(0,i,nmat)
347  call ident2(elcon(19,1,nmat),t1l,ntmat,ncmat_+1,id)
348  if(ntmat.eq.0) then
349  continue
350  elseif((ntmat.eq.1).or.(id.eq.0)) then
351  elcon(13,i,nmat)=elcon(16,1,nmat)
352  elcon(14,i,nmat)=elcon(17,1,nmat)
353  elcon(15,i,nmat)=elcon(18,1,nmat)
354  elseif(id.eq.ntmat) then
355  elcon(13,i,nmat)=elcon(16,id,nmat)
356  elcon(14,i,nmat)=elcon(17,id,nmat)
357  elcon(15,i,nmat)=elcon(18,id,nmat)
358  else
359  do k=13,15
360  elcon(k,i,nmat)=elcon(k+3,id,nmat)+
361  & (elcon(k+3,id+1,nmat)-elcon(k+3,id,nmat))*
362  & (t1l-elcon(19,id,nmat))/
363  & (elcon(19,id+1,nmat)-elcon(19,id,nmat))
364  enddo
365  endif
366  write(*,*) t1l,(elcon(k,i,nmat),k=13,15)
367  enddo
368  write(*,*)
369 !
370  endif
371 !
372  return
max
#define max(a, b)
Definition: cascade.c:32
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
ident2
subroutine ident2(x, px, n, ninc, id)
Definition: ident2.f:27
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)