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 basemotions(inpc,textpart,amname,nam,ibasemotion,
20     &  xboun,ndirboun,iamboun,typeboun,nboun,istep,istat,n,iline,ipol,
21     &  inl,ipoinp,inp,ipoinpc,iamplitudedefault,ier,xmodal,nmethod)
22!
23!     reading the input deck: *BASE MOTION
24!
25      implicit none
26!
27      character*1 typeboun(*),type,inpc(*)
28      character*80 amname(*),amplitude
29      character*132 textpart(16)
30!
31      integer iamplitude,idof,i,j,n,nam,ibasemotion,iamboun(*),nboun,
32     &  ndirboun(*),istep,istat,iline,ipol,inl,ipoinp(2,*),inp(3,*),
33     &  key,ipoinpc(0:*),iamplitudedefault,ier,nmethod
34!
35      real*8 xboun(*),xmodal(*)
36!
37      type='A'
38      iamplitude=iamplitudedefault
39      idof=-1
40!
41      if(istep.lt.1) then
42         write(*,*) '*ERROR reading *BASE MOTION:'
43         write(*,*) '       *BASE MOTION should only be used'
44         write(*,*) '       within a STEP'
45         ier=1
46         return
47      endif
48!
49      do i=2,n
50         if(textpart(i)(1:4).eq.'DOF=') then
51            read(textpart(i)(5:14),'(i10)',iostat=istat) idof
52            if(istat.gt.0) then
53               call inputerror(inpc,ipoinpc,iline,
54     &              "*BASE MOTION%",ier)
55               return
56            endif
57         elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
58            read(textpart(i)(11:90),'(a80)') amplitude
59            do j=1,nam
60               if(amname(j).eq.amplitude) then
61                  iamplitude=j
62                  exit
63               endif
64            enddo
65            if(j.gt.nam) then
66               write(*,*) '*ERROR reading *BASE MOTION:'
67               write(*,*) '       nonexistent amplitude'
68               write(*,*) '  '
69               call inputerror(inpc,ipoinpc,iline,
70     &              "*BASE MOTION%",ier)
71               return
72            endif
73            iamplitude=j
74         elseif(textpart(i)(1:5).eq.'TYPE=') then
75            if(textpart(i)(6:17).eq.'DISPLACEMENT') then
76               type='B'
77            elseif(textpart(i)(6:17).eq.'ACCELERATION') then
78               if((nmethod.ne.5).or.(int(xmodal(7)).ne.0)) then
79                  write(*,*) '*ERROR reading *BASE MOTION'
80                  write(*,*) '       ACCELERATION is only allowed'
81                  write(*,*) '       for harmonic steady state'
82                  write(*,*) '       dynamics calculations'
83                  ier=1
84                  return
85               endif
86               type='A'
87            else
88               write(*,*) '*ERROR reading *BASE MOTION:'
89               write(*,*) '       invalid TYPE'
90               call inputerror(inpc,ipoinpc,iline,
91     &              "*BASE MOTION%",ier)
92               return
93            endif
94         else
95            write(*,*)
96     &        '*WARNING reading *BASE MOTION: parameter not recognized:'
97            write(*,*) '         ',
98     &                 textpart(i)(1:index(textpart(i),' ')-1)
99            call inputwarning(inpc,ipoinpc,iline,
100     &"*BASE MOTION%")
101         endif
102      enddo
103!
104      if(idof.eq.-1) then
105         write(*,*) '*ERROR reading *BASE MOTION'
106         write(*,*) '       no degree of freedom specified'
107         ier=1
108         return
109      elseif((idof.lt.1).or.(idof.gt.3)) then
110         write(*,*) '*ERROR reading *BASE MOTION'
111         write(*,*) '       only degrees of freedom 1 to 3 are allowed'
112         ier=1
113         return
114      elseif(iamplitude.eq.0) then
115         write(*,*) '*ERROR reading *BASE MOTION'
116         write(*,*) '       no amplitude specified'
117         ier=1
118         return
119      endif
120!
121      if(ibasemotion.eq.0) then
122!
123!        no previous *BASE MOTION within the actual step
124!
125         ibasemotion=1
126         do i=1,nboun
127            if(ndirboun(i).eq.idof) then
128               xboun(i)=1.d0
129               iamboun(i)=iamplitude
130               typeboun(i)=type
131            else
132               xboun(i)=0.d0
133            endif
134         enddo
135      else
136!
137!        previous *BASE MOTION within the actual step
138!
139         do i=1,nboun
140            if(ndirboun(i).eq.idof) then
141               xboun(i)=1.d0
142               iamboun(i)=iamplitude
143               typeboun(i)=type
144            endif
145         enddo
146      endif
147!
148      call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
149     &     ipoinp,inp,ipoinpc)
150!
151      return
152      end
153
154