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

Go to the source code of this file.

Functions/Subroutines

subroutine elastics (inpc, textpart, elcon, nelcon, nmat, ntmat_, ncmat_, irstrt, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc)
 

Function/Subroutine Documentation

◆ elastics()

subroutine elastics ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
real*8, dimension(0:ncmat_,ntmat_,*)  elcon,
integer, dimension(2,*)  nelcon,
integer  nmat,
integer  ntmat_,
integer  ncmat_,
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 
)
22 !
23 ! reading the input deck: *ELASTIC
24 !
25  implicit none
26 !
27  logical engineering
28 !
29  character*1 inpc(*)
30  character*132 textpart(16)
31 !
32  integer nelcon(2,*),nmat,ntmat,ntmat_,istep,istat,ipoinpc(0:*),
33  & n,key,i,ityp,ncmat_,irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*)
34 !
35  real*8 elcon(0:ncmat_,ntmat_,*),e1,e2,e3,un12,un21,un13,un31,
36  & un23,un32,gam
37 !
38  ntmat=0
39 !
40  if((istep.gt.0).and.(irstrt.ge.0)) then
41  write(*,*) '*ERROR reading *ELASTIC: *ELASTIC should be placed'
42  write(*,*) ' before all step definitions'
43  call exit(201)
44  endif
45 !
46  if(nmat.eq.0) then
47  write(*,*)
48  & '*ERROR reading *ELASTIC: *ELASTIC should be preceded'
49  write(*,*) ' by a *MATERIAL card'
50  call exit(201)
51  endif
52 !
53  ityp=2
54 !
55  do i=2,n
56  if(textpart(i)(1:5).eq.'TYPE=') then
57  if(textpart(i)(6:8).eq.'ISO') then
58  ityp=2
59  elseif(textpart(i)(6:10).eq.'ORTHO') then
60  ityp=9
61  engineering=.false.
62  elseif(textpart(i)(6:25).eq.'ENGINEERINGCONSTANTS') then
63  ityp=9
64  engineering=.true.
65  elseif(textpart(i)(6:10).eq.'ANISO') then
66  ityp=21
67  endif
68  exit
69  else
70  write(*,*)
71  & '*WARNING reading *ELASTIC: parameter not recognized:'
72  write(*,*) ' ',
73  & textpart(i)(1:index(textpart(i),' ')-1)
74  call inputwarning(inpc,ipoinpc,iline,
75  &"*ELASTIC%")
76  endif
77  enddo
78 !
79  nelcon(1,nmat)=ityp
80 !
81  if(ityp.eq.2) then
82  do
83  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
84  & ipoinp,inp,ipoinpc)
85  if((istat.lt.0).or.(key.eq.1)) return
86  ntmat=ntmat+1
87  nelcon(2,nmat)=ntmat
88  if(ntmat.gt.ntmat_) then
89  write(*,*) '*ERROR reading *ELASTIC: increase ntmat_'
90  call exit(201)
91  endif
92  if(n.lt.2) then
93  write(*,*) '*ERROR reading *ELASTIC: not enough'
94  write(*,*) ' constants on the input line'
95  call inputerror(inpc,ipoinpc,iline,
96  &"*ELASTIC%")
97  endif
98  do i=1,2
99  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
100  & elcon(i,ntmat,nmat)
101  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
102  &"*ELASTIC%")
103  enddo
104  if(textpart(3)(1:1).ne.' ') then
105  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
106  & elcon(0,ntmat,nmat)
107  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
108  &"*ELASTIC%")
109  else
110  elcon(0,ntmat,nmat)=0.d0
111  endif
112  enddo
113  elseif(ityp.eq.9) then
114  do
115  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
116  & ipoinp,inp,ipoinpc)
117  if((istat.lt.0).or.(key.eq.1)) return
118  ntmat=ntmat+1
119  nelcon(2,nmat)=ntmat
120  if(ntmat.gt.ntmat_) then
121  write(*,*) '*ERROR reading *ELASTIC: increase ntmat_'
122  call exit(201)
123  endif
124  if(n.lt.8) then
125  write(*,*) '*ERROR reading *ELASTIC: not enough'
126  write(*,*) ' constants on the input line'
127  call inputerror(inpc,ipoinpc,iline,
128  &"*ELASTIC%")
129  endif
130  do i=1,8
131  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
132  & elcon(i,ntmat,nmat)
133  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
134  &"*ELASTIC%")
135  enddo
136 !
137  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
138  & ipoinp,inp,ipoinpc)
139  if((istat.lt.0).or.(key.eq.1)) then
140  write(*,*)
141  & '*ERROR reading *ELASTIC: orthotropic definition'
142  write(*,*) ' is not complete. '
143  call inputerror(inpc,ipoinpc,iline,
144  &"*ELASTIC%")
145  call exit(201)
146  endif
147  do i=1,1
148  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
149  & elcon(8+i,ntmat,nmat)
150  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
151  &"*ELASTIC%")
152  enddo
153  if(textpart(2)(1:1).ne.' ') then
154  read(textpart(2)(1:20),'(f20.0)',iostat=istat)
155  & elcon(0,ntmat,nmat)
156  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
157  &"*ELASTIC%")
158  else
159  elcon(0,ntmat,nmat)=0.d0
160  endif
161  if(engineering) then
162  e1=elcon(1,ntmat,nmat)
163  e2=elcon(2,ntmat,nmat)
164  e3=elcon(3,ntmat,nmat)
165  un12=elcon(4,ntmat,nmat)
166  un13=elcon(5,ntmat,nmat)
167  un23=elcon(6,ntmat,nmat)
168  un21=un12*e2/e1
169  un31=un13*e3/e1
170  un32=un23*e3/e2
171  gam=1.d0/(1.d0-un12*un21-un23*un32-un31*un13
172  & -2.d0*un21*un32*un13)
173  elcon(1,ntmat,nmat)=e1*(1.d0-un23*un32)*gam
174  elcon(2,ntmat,nmat)=e1*(un21+un31*un23)*gam
175  elcon(3,ntmat,nmat)=e2*(1.d0-un13*un31)*gam
176  elcon(4,ntmat,nmat)=e1*(un31+un21*un32)*gam
177  elcon(5,ntmat,nmat)=e2*(un32+un12*un31)*gam
178  elcon(6,ntmat,nmat)=e3*(1.d0-un12*un21)*gam
179  endif
180  enddo
181  elseif(ityp.eq.21) then
182  do
183  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
184  & ipoinp,inp,ipoinpc)
185  if((istat.lt.0).or.(key.eq.1)) return
186  ntmat=ntmat+1
187  nelcon(2,nmat)=ntmat
188  if(ntmat.gt.ntmat_) then
189  write(*,*) '*ERROR reading *ELASTIC: increase ntmat_'
190  call exit(201)
191  endif
192  if(n.lt.8) then
193  write(*,*) '*ERROR reading *ELASTIC: not enough'
194  write(*,*) ' constants on the input line'
195  call inputerror(inpc,ipoinpc,iline,
196  &"*ELASTIC%")
197  endif
198  do i=1,8
199  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
200  & elcon(i,ntmat,nmat)
201  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
202  &"*ELASTIC%")
203  enddo
204 !
205  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
206  & ipoinp,inp,ipoinpc)
207  if((istat.lt.0).or.(key.eq.1)) then
208  write(*,*)
209  & '*ERROR reading *ELASTIC: anisotropic definition'
210  write(*,*) ' is not complete. '
211  call inputerror(inpc,ipoinpc,iline,
212  &"*ELASTIC%")
213  call exit(201)
214  endif
215  if(n.lt.2) then
216  write(*,*) '*ERROR reading *ELASTIC: not enough'
217  write(*,*) ' constants on the input line'
218  call inputerror(inpc,ipoinpc,iline,
219  &"*ELASTIC%")
220  endif
221  do i=1,8
222  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
223  & elcon(8+i,ntmat,nmat)
224  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
225  &"*ELASTIC%")
226  enddo
227 !
228  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
229  & ipoinp,inp,ipoinpc)
230  if((istat.lt.0).or.(key.eq.1)) then
231  write(*,*)
232  & '*ERROR reading *ELASTIC: anisotropic definition'
233  write(*,*) ' is not complete. '
234  call inputerror(inpc,ipoinpc,iline,
235  &"*ELASTIC%")
236  call exit(201)
237  endif
238  if(n.lt.5) then
239  write(*,*) '*ERROR reading *ELASTIC: not enough'
240  write(*,*) ' constants on the input line'
241  call inputerror(inpc,ipoinpc,iline,
242  &"*ELASTIC%")
243  endif
244  do i=1,5
245  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
246  & elcon(16+i,ntmat,nmat)
247  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
248  &"*ELASTIC%")
249  enddo
250  if(textpart(6)(1:1).ne.' ') then
251  read(textpart(6)(1:20),'(f20.0)',iostat=istat)
252  & elcon(0,ntmat,nmat)
253  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
254  &"*ELASTIC%")
255  else
256  elcon(0,ntmat,nmat)=0.d0
257  endif
258  enddo
259  endif
260 !
261  if(ntmat.eq.0) nelcon(1,nmat)=0
262 !
263  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
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)