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