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