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