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

Go to the source code of this file.

Functions/Subroutines

subroutine springs (inpc, textpart, nelcon, nmat, ntmat_, npmat_, plicon, nplicon, ncmat_, elcon, matname, irstrt, istep, istat, n, iline, ipol, inl, ipoinp, inp, nmat_, set, istartset, iendset, ialset, nset, ielmat, ielorien, ipoinpc, mi, norien, orname)
 

Function/Subroutine Documentation

◆ springs()

subroutine springs ( 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,
integer  ncmat_,
real*8, dimension(0:ncmat_,ntmat_,*)  elcon,
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  nmat_,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer, dimension(mi(3),*)  ielmat,
integer, dimension(mi(3),*)  ielorien,
integer, dimension(0:*)  ipoinpc,
integer, dimension(*)  mi,
integer  norien,
character*80, dimension(*)  orname 
)
24 !
25 ! reading the input deck: *SPRING
26 !
27  implicit none
28 !
29  logical linear
30 !
31  character*1 inpc(*)
32  character*80 matname(*),orientation,orname(*)
33  character*81 set(*),elset
34  character*132 textpart(16)
35 !
36  integer mi(*),nelcon(2,*),nmat,ntmat_,ntmat,npmat_,npmat,istep,
37  & n,key,i,nplicon(0:ntmat_,*),ncmat_,istat,istartset(*),
38  & iendset(*),irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*),nmat_,
39  & ialset(*),ipos,nset,j,k,ielmat(mi(3),*),ielorien(mi(3),*),
40  & ipoinpc(0:*),idof,iorientation,norien,idof2
41 !
42  real*8 plicon(0:2*npmat_,ntmat_,*),temperature,
43  & elcon(0:ncmat_,ntmat_,*)
44 !
45  linear=.true.
46 !
47  ntmat=0
48  npmat=0
49 !
50  orientation='
51  & '
52 !
53  if((istep.gt.0).and.(irstrt.ge.0)) then
54  write(*,*) '*ERROR reading *SPRING: *SPRING should be placed'
55  write(*,*) ' before all step definitions'
56  call exit(201)
57  endif
58 !
59  nmat=nmat+1
60  if(nmat.gt.nmat_) then
61  write(*,*) '*ERROR reading *SPRING: increase nmat_'
62  call exit(201)
63  endif
64  matname(nmat)(1:6)='SPRING'
65  do i=7,80
66  matname(nmat)(i:i)=' '
67  enddo
68 !
69  do i=2,n
70  if(textpart(i)(1:9).eq.'NONLINEAR') then
71  linear=.false.
72  elseif(textpart(i)(1:12).eq.'ORIENTATION=') then
73  orientation=textpart(i)(13:92)
74  elseif(textpart(i)(1:6).eq.'ELSET=') then
75  elset=textpart(i)(7:86)
76  elset(81:81)=' '
77  ipos=index(elset,' ')
78  elset(ipos:ipos)='E'
79  else
80  write(*,*)
81  & '*WARNING reading *SPRING: parameter not recognized:'
82  write(*,*) ' ',
83  & textpart(i)(1:index(textpart(i),' ')-1)
84  call inputwarning(inpc,ipoinpc,iline,
85  &"*SPRING%")
86  endif
87  enddo
88 !
89  if(orientation.eq.' ') then
90  iorientation=0
91  else
92  do i=1,norien
93  if(orname(i).eq.orientation) exit
94  enddo
95  if(i.gt.norien) then
96  write(*,*)
97  & '*ERROR reading *SPRING: nonexistent orientation'
98  write(*,*) ' '
99  call inputerror(inpc,ipoinpc,iline,
100  &"*SPRING%")
101  call exit(201)
102  endif
103  iorientation=i
104  endif
105 !
106  if(linear) then
107  nelcon(1,nmat)=2
108 !
109 ! linear spring
110 !
111  do
112  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
113  & ipoinp,inp,ipoinpc)
114  if((istat.lt.0).or.(key.eq.1)) exit
115 !
116 ! check whether the first field in the first line
117 ! underneath *SPRING contains a decimal point. If so,
118 ! this line is considered to be the start of material
119 ! data for SPRINGA elements. If not, it is considered
120 ! to contain degrees of freedom for SPRING1 or SPRING2 elements.
121 !
122  if(ntmat.eq.0) then
123  idof=1
124  do i=1,132
125  if(textpart(1)(i:i).eq.'.') then
126  idof=0
127  exit
128  endif
129  enddo
130  if(idof.eq.1) then
131  read(textpart(2)(1:10),'(i10)',iostat=istat) idof2
132  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
133  &"*SPRING%")
134  if(idof2.eq.0) then
135  if(ncmat_.lt.3) then
136  write(*,*) '*ERROR reading *SPRING: one degree'
137  write(*,*) ' of freedom was specified'
138  write(*,*) ' (no decimal point in entry),'
139  write(*,*) ' however, there are no'
140  write(*,*) ' SPRING1 elements'
141  write(*,*) ' in the input deck'
142  call inputerror(inpc,ipoinpc,iline,
143  & "*SPRING%")
144  endif
145  read(textpart(1)(1:20),'(f20.0)',iostat=istat)
146  & elcon(3,1,nmat)
147  else
148  if(ncmat_.lt.4) then
149  write(*,*) '*ERROR reading *SPRING: two degrees'
150  write(*,*) ' of freedom were specified'
151  write(*,*) ' (no decimal point in entry),'
152  write(*,*) ' however, there are no'
153  write(*,*) ' SPRING2 elements'
154  write(*,*) ' in the input deck'
155  call inputerror(inpc,ipoinpc,iline,
156  & "*SPRING%")
157  endif
158  read(textpart(1)(1:20),'(f20.0)',iostat=istat)
159  & elcon(3,1,nmat)
160  read(textpart(2)(1:20),'(f20.0)',iostat=istat)
161  & elcon(4,1,nmat)
162  endif
163  cycle
164  endif
165  endif
166 !
167  ntmat=ntmat+1
168  nelcon(2,nmat)=ntmat
169  if(ntmat.gt.ntmat_) then
170  write(*,*) '*ERROR reading *SPRING: increase ntmat_'
171  call exit(201)
172  endif
173  do i=1,2
174  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
175  & elcon(i,ntmat,nmat)
176  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
177  &"*SPRING%")
178  enddo
179  if(textpart(3)(1:1).ne.' ') then
180  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
181  & elcon(0,ntmat,nmat)
182  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
183  &"*SPRING%")
184  else
185  elcon(0,ntmat,nmat)=0.d0
186  endif
187  enddo
188  else
189  nelcon(1,nmat)=-51
190 !
191 ! nonlinear spring behavior
192 !
193  do
194  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
195  & ipoinp,inp,ipoinpc)
196  if((istat.lt.0).or.(key.eq.1)) exit
197 !
198 ! check whether the first field in the first line
199 ! underneath *SPRING contains a decimal point. If so,
200 ! this line is considered to be the start of material
201 ! data for SPRINGA elements. If not, it is considered
202 ! to contain degrees of freedom for SPRING1 or SPRING2 elements.
203 !
204  if(ntmat.eq.0) then
205  idof=1
206  do i=1,132
207  if(textpart(1)(i:i).eq.'.') then
208  idof=0
209  exit
210  endif
211  enddo
212  if(idof.eq.1) then
213  if(ncmat_.lt.4) then
214  write(*,*) '*ERROR reading *SPRING: a degree'
215  write(*,*) ' of freedom was specified'
216  write(*,*) ' (no decimal point in entry),'
217  write(*,*) ' however, there are neither'
218  write(*,*) ' SPRING1 nor SPRING2 elements'
219  write(*,*) ' in the input deck'
220  call inputerror(inpc,ipoinpc,iline,
221  &"*SPRING%")
222  endif
223  read(textpart(1)(1:20),'(f20.0)',iostat=istat)
224  & elcon(3,1,nmat)
225  read(textpart(2)(1:20),'(f20.0)',iostat=istat)
226  & elcon(4,1,nmat)
227  cycle
228  endif
229  endif
230 !
231  read(textpart(3)(1:20),'(f20.0)',iostat=istat) temperature
232  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
233  &"*SPRING%")
234 !
235 ! first temperature
236 !
237  if(ntmat.eq.0) then
238  npmat=0
239  ntmat=ntmat+1
240  if(ntmat.gt.ntmat_) then
241  write(*,*) '*ERROR reading *SPRING: increase ntmat_'
242  call exit(201)
243  endif
244  nplicon(0,nmat)=ntmat
245  plicon(0,ntmat,nmat)=temperature
246 !
247 ! new temperature
248 !
249  elseif(plicon(0,ntmat,nmat).ne.temperature) then
250  npmat=0
251  ntmat=ntmat+1
252  if(ntmat.gt.ntmat_) then
253  write(*,*) '*ERROR reading *SPRING: increase ntmat_'
254  call exit(201)
255  endif
256  nplicon(0,nmat)=ntmat
257  plicon(0,ntmat,nmat)=temperature
258  endif
259  do i=1,2
260  read(textpart(i)(1:20),'(f20.0)',iostat=istat)
261  & plicon(2*npmat+i,ntmat,nmat)
262  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
263  &"*SPRING%")
264  enddo
265  npmat=npmat+1
266  if(npmat.gt.npmat_) then
267  write(*,*) '*ERROR reading *SPRING: increase npmat_'
268  call exit(201)
269  endif
270  nplicon(ntmat,nmat)=npmat
271  enddo
272  endif
273 !
274  if(ntmat.eq.0) then
275  write(*,*) '*ERROR reading *SPRING: *SPRING card without data'
276  call exit(201)
277  endif
278  do i=1,nset
279  if(set(i).eq.elset) exit
280  enddo
281  if(i.gt.nset) then
282  elset(ipos:ipos)=' '
283  write(*,*) '*ERROR reading *SPRING: element set ',elset
284  write(*,*) ' has not yet been defined. '
285  call inputerror(inpc,ipoinpc,iline,
286  &"*SPRING%")
287  call exit(201)
288  endif
289 !
290 ! assigning the elements of the set the appropriate material
291 !
292  do j=istartset(i),iendset(i)
293  if(ialset(j).gt.0) then
294  ielmat(1,ialset(j))=nmat
295  ielorien(1,ialset(j))=iorientation
296  else
297  k=ialset(j-2)
298  do
299  k=k-ialset(j)
300  if(k.ge.ialset(j-1)) exit
301  ielmat(1,k)=nmat
302  ielorien(1,k)=iorientation
303  enddo
304  endif
305  enddo
306 !
307  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)