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 timepointss(inpc,textpart,amname,amta,namta,nam, 20 & nam_,namtot_,irstrt,istep,istat,n,iline,ipol,inl,ipoinp,inp, 21 & ipoinpc,namtot,ier) 22! 23! reading the input deck: *AMPLITUDE 24! 25 implicit none 26! 27 character*1 inpc(*) 28 character*80 amname(*) 29 character*132 textpart(16) 30! 31 integer namta(3,*),nam,nam_,istep,istat,n,key,i,namtot, 32 & namtot_,irstrt(*),iline,ipol,inl,ipoinp(2,*),inp(3,*),ipos, 33 & ipoinpc(0:*),nttp,ier 34! 35 logical igen 36! 37! 38 real*8 amta(2,*),x,tpmin,tpmax,tpinc 39! 40 igen=.false. 41 42 if((istep.gt.0).and.(irstrt(1).ge.0)) then 43 write(*,*) '*ERROR reading *TIME POINTS: *AMPLITUDE should be' 44 write(*,*) ' placed before all step definitions' 45 ier=1 46 return 47 endif 48! 49 nam=nam+1 50 if(nam.gt.nam_) then 51 write(*,*) '*ERROR reading *TIME POINTS: increase nam_' 52 ier=1 53 return 54 endif 55 namta(3,nam)=nam 56 amname(nam)=' 57 & ' 58! 59 do i=2,n 60 if(textpart(i)(1:5).eq.'NAME=') then 61 amname(nam)=textpart(i)(6:85) 62 if(textpart(i)(86:86).ne.' ') then 63 write(*,*) 64 & '*ERROR reading *TIME POINTS: amplitude name too long' 65 write(*,*) ' (more than 80 characters)' 66 write(*,*) ' amplitude name:',textpart(i)(1:132) 67 ier=1 68 return 69 endif 70 elseif(textpart(i)(1:14).eq.'TIME=TOTALTIME') then 71 namta(3,nam)=-nam 72 elseif(textpart(i)(1:8).eq.'GENERATE') then 73 igen=.true. 74 else 75 write(*,*) 76 & '*WARNING reading *TIME POINTS: parameter not recognized:' 77 write(*,*) ' ', 78 & textpart(i)(1:index(textpart(i),' ')-1) 79 call inputwarning(inpc,ipoinpc,iline, 80 &"*TIME POINTS%") 81 endif 82 enddo 83! 84 if(amname(nam).eq.' 85 & ') then 86 write(*,*) '*ERROR reading *TIME POINTS: Amplitude has no name' 87 call inputerror(inpc,ipoinpc,iline, 88 & "*TIME POINTS%",ier) 89 return 90 endif 91! 92c if(nam.eq.1) then 93c namtot=0 94c else 95c namtot=namta(2,nam-1) 96c endif 97 namta(1,nam)=namtot+1 98! 99 do 100 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 101 & ipoinp,inp,ipoinpc) 102 if((istat.lt.0).or.(key.eq.1)) exit 103 if(.not.igen)then 104 do i=1,8 105 if(textpart(i)(1:1).ne.' ') then 106 namtot=namtot+1 107 if(namtot.gt.namtot_) then 108 write(*,*) 109 & '*ERROR reading *TIME POINTS: increase namtot_' 110 ier=1 111 return 112 endif 113 read(textpart(i),'(f20.0)',iostat=istat) x 114 if(istat.gt.0) then 115 call inputerror(inpc,ipoinpc,iline, 116 & "*TIME POINTS%",ier) 117 return 118 endif 119 amta(1,namtot)=x 120 namta(2,nam)=namtot 121 else 122 exit 123 endif 124 enddo 125 else 126 read(textpart(1)(1:20),'(f20.0)',iostat=istat) tpmin 127 if(istat.gt.0) then 128 call inputerror(inpc,ipoinpc,iline, 129 & "*TIME POINTS%",ier) 130 return 131 endif 132 read(textpart(2)(1:20),'(f20.0)',iostat=istat) tpmax 133 if(istat.gt.0) then 134 call inputerror(inpc,ipoinpc,iline, 135 & "*TIME POINTS%",ier) 136 return 137 endif 138 read(textpart(3)(1:20),'(f20.0)',iostat=istat) tpinc 139 if(istat.gt.0) then 140 call inputerror(inpc,ipoinpc,iline, 141 & "*TIME POINTS%",ier) 142 return 143 endif 144! 145 nttp=INT((tpmax-tpmin)/tpinc) 146! 147 if(namtot+2+nttp.gt.namtot_) then 148 write(*,*) '*ERROR in timepoints: increase namtot_' 149 ier=1 150 return 151 endif 152 amta(1,namtot+1)=tpmin 153 do i=1,nttp 154 amta(1,namtot+1+i)=tpmin+(i*tpinc) 155 enddo 156 namtot=namtot+2+nttp 157 amta(1,namtot)=tpmax 158 namta(2,nam)=namtot 159 endif 160 if(textpart(9)(1:1).ne.' ') then 161 write(*,*) '*WARNING reading *TIME POINTS:' 162 write(*,*) ' only 8 entries per line allowed' 163 write(*,*) ' 9th entry and above will be discarded' 164 call inputwarning(inpc,ipoinpc,iline, 165 &"*TIME POINTS%") 166 endif 167 enddo 168! 169 if(namta(1,nam).gt.namta(2,nam)) then 170 ipos=index(amname(nam),' ') 171 write(*,*) 172 & '*WARNING reading *TIME POINTS: *TIME POINTS definition ', 173 & amname(nam)(1:ipos-1) 174 write(*,*) ' has no data points' 175 nam=nam-1 176c else 177c call reorderampl(amname,namta,nam) 178 endif 179! 180 return 181 end 182 183