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 cloads(inpc,textpart,set,istartset,iendset,
20     &  ialset,nset,nodeforc,ndirforc,xforc,nforc,nforc_,iamforc,
21     &  amname,nam,ntrans,trab,inotr,co,ikforc,ilforc,nk,
22     &  cload_flag,istep,istat,n,iline,ipol,inl,ipoinp,inp,nam_,
23     &  namtot_,namta,amta,nmethod,iaxial,iperturb,ipoinpc,
24     &  maxsectors,idefforc,ipompc,nodempc,
25     &  nmpc,ikmpc,ilmpc,labmpc,iamplitudedefault,namtot,ier)
26!
27!     reading the input deck: *CLOADS
28!
29      implicit none
30!
31      logical cload_flag,add,user,submodel,green
32!
33      character*1 inpc(*)
34      character*20 labmpc(*)
35      character*80 amplitude,amname(*)
36      character*81 set(*),noset
37      character*132 textpart(16)
38!
39      integer istartset(*),iendset(*),ialset(*),nodeforc(2,*),
40     &  nset,nforc,nforc_,istep,istat,n,i,j,k,l,iforcdir,key,
41     &  iamforc(*),nam,iamplitude,ntrans,inotr(2,*),ipos,ikforc(*),
42     &  ilforc(*),nk,iline,ipol,inl,ipoinp(2,*),inp(3,*),nam_,namtot,
43     &  namtot_,namta(3,*),idelay,lc,nmethod,ndirforc(*),isector,
44     &  iperturb(*),iaxial,ipoinpc(0:*),maxsectors,jsector,idefforc(*),
45     &  iglobstep,ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*),
46     &  iamplitudedefault,ier,id
47!
48      real*8 xforc(*),forcval,co(3,*),trab(7,*),amta(2,*),omega0
49!
50      iamplitude=iamplitudedefault
51      idelay=0
52      lc=1
53      isector=0
54      user=.false.
55      add=.false.
56      iglobstep=0
57      submodel=.false.
58      green=.false.
59!
60      if(istep.lt.1) then
61         write(*,*) '*ERROR reading *CLOAD: *CLOAD should only be used'
62         write(*,*) '  within a STEP'
63         ier=1
64         return
65      endif
66!
67      do i=2,n
68         if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.cload_flag)) then
69            do j=1,nforc
70               xforc(j)=0.d0
71            enddo
72         elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
73            read(textpart(i)(11:90),'(a80)') amplitude
74            do j=1,nam
75               if(amname(j).eq.amplitude) then
76                  iamplitude=j
77                  exit
78               endif
79            enddo
80            if(j.gt.nam) then
81               write(*,*)'*ERROR reading *CLOAD: nonexistent amplitude'
82               write(*,*) '  '
83               call inputerror(inpc,ipoinpc,iline,
84     &              "*CLOAD%",ier)
85               return
86            endif
87            iamplitude=j
88         elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
89            if(idelay.ne.0) then
90               write(*,*)
91     &            '*ERROR reading *CLOAD: the parameter TIME DELAY'
92               write(*,*) '       is used twice in the same keyword'
93               write(*,*) '       '
94               call inputerror(inpc,ipoinpc,iline,
95     &              "*CLOAD%",ier)
96               return
97            else
98               idelay=1
99            endif
100            nam=nam+1
101            if(nam.gt.nam_) then
102               write(*,*) '*ERROR reading *CLOAD: increase nam_'
103               ier=1
104               return
105            endif
106            amname(nam)='
107     &                                 '
108            if(iamplitude.eq.0) then
109               write(*,*) '*ERROR reading *CLOAD: time delay must be'
110               write(*,*) '       preceded by the amplitude parameter'
111               ier=1
112               return
113            endif
114            namta(3,nam)=sign(iamplitude,namta(3,iamplitude))
115            iamplitude=nam
116c            if(nam.eq.1) then
117c               namtot=0
118c            else
119c               namtot=namta(2,nam-1)
120c            endif
121            namtot=namtot+1
122            if(namtot.gt.namtot_) then
123               write(*,*) '*ERROR cloads: increase namtot_'
124               ier=1
125               return
126            endif
127            namta(1,nam)=namtot
128            namta(2,nam)=namtot
129c            call reorderampl(amname,namta,nam)
130            read(textpart(i)(11:30),'(f20.0)',iostat=istat)
131     &           amta(1,namtot)
132            if(istat.gt.0) then
133               call inputerror(inpc,ipoinpc,iline,
134     &              "*CLOAD%",ier)
135               return
136            endif
137         elseif(textpart(i)(1:9).eq.'LOADCASE=') then
138            read(textpart(i)(10:19),'(i10)',iostat=istat) lc
139            if(istat.gt.0) then
140               call inputerror(inpc,ipoinpc,iline,
141     &              "*CLOAD%",ier)
142               return
143            endif
144            if(nmethod.ne.5) then
145               write(*,*)
146     &            '*ERROR reading *CLOAD: the parameter LOAD CASE'
147               write(*,*) '       is only allowed in STEADY STATE'
148               write(*,*) '       DYNAMICS calculations'
149               ier=1
150               return
151            endif
152         elseif(textpart(i)(1:7).eq.'SECTOR=') then
153            read(textpart(i)(8:17),'(i10)',iostat=istat) isector
154            if(istat.gt.0) then
155               call inputerror(inpc,ipoinpc,iline,
156     &              "*CLOAD%",ier)
157               return
158            endif
159            if((nmethod.le.3).or.(iperturb(1).gt.1)) then
160               write(*,*) '*ERROR reading *CLOAD: the parameter SECTOR'
161               write(*,*) '       is only allowed in MODAL DYNAMICS or'
162               write(*,*) '       STEADY STATE DYNAMICS calculations'
163               ier=1
164               return
165            endif
166            if(isector.gt.maxsectors) then
167               write(*,*) '*ERROR reading *CLOAD: sector ',isector
168               write(*,*) '       exceeds number of sectors'
169               ier=1
170               return
171            endif
172            isector=isector-1
173         elseif(textpart(i)(1:4).eq.'USER') then
174            user=.true.
175         elseif(textpart(i)(1:8).eq.'SUBMODEL') then
176            submodel=.true.
177         elseif(textpart(i)(1:5).eq.'STEP=') then
178            read(textpart(i)(6:15),'(i10)',iostat=istat) iglobstep
179            if(istat.gt.0) then
180               call inputerror(inpc,ipoinpc,iline,
181     &              "*CLOAD%",ier)
182               return
183            endif
184         elseif(textpart(i)(1:8).eq.'DATASET=') then
185            read(textpart(i)(9:18),'(i10)',iostat=istat) iglobstep
186            if(istat.gt.0) then
187               call inputerror(inpc,ipoinpc,iline,
188     &              "*CLOAD%",ier)
189               return
190            endif
191!
192!           the mode number for submodels
193!           is stored as a negative global step
194!
195            iglobstep=-iglobstep
196         elseif(textpart(i)(1:7).eq.'OMEGA0=') then
197            green=.true.
198            read(textpart(i)(8:27),'(f20.0)',iostat=istat) omega0
199            if(istat.gt.0) then
200               call inputerror(inpc,ipoinpc,iline,
201     &              "*CLOAD%",ier)
202               return
203            endif
204            omega0=omega0**2
205         else
206            write(*,*)
207     &        '*WARNING reading *CLOAD: parameter not recognized:'
208            write(*,*) '         ',
209     &                 textpart(i)(1:index(textpart(i),' ')-1)
210            call inputwarning(inpc,ipoinpc,iline,
211     &"*CLOAD%")
212         endif
213      enddo
214!
215!     check whether global step was specified for submodel
216!
217      if((submodel).and.(iglobstep.eq.0)) then
218         write(*,*) '*ERROR reading *CLOAD: no global step'
219         write(*,*) '       step specified for the submodel'
220         call inputerror(inpc,ipoinpc,iline,
221     &        "*CLOAD%",ier)
222         return
223      endif
224!
225!     storing the step for submodels in iamboun
226!
227      if(submodel) then
228         if(iamplitude.ne.0) then
229            write(*,*) '*WARNING reading *CLOAD:'
230            write(*,*) '         no amplitude definition is allowed'
231            write(*,*) '         in combination with a submodel'
232         endif
233         iamplitude=iglobstep
234      endif
235!
236      if(user.and.(iamplitude.ne.0)) then
237         write(*,*) '*WARNING: no amplitude definition is allowed'
238         write(*,*) '          for concentrated loads defined by a'
239         write(*,*) '          user routine'
240         iamplitude=0
241      endif
242!
243      do
244         call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
245     &        ipoinp,inp,ipoinpc)
246         if((istat.lt.0).or.(key.eq.1)) return
247!
248         read(textpart(2)(1:10),'(i10)',iostat=istat) iforcdir
249         if(istat.gt.0) then
250            call inputerror(inpc,ipoinpc,iline,
251     &           "*CLOAD%",ier)
252            return
253         endif
254         if((iforcdir.lt.1).or.(iforcdir.gt.6)) then
255            write(*,*)
256     &         '*ERROR reading *CLOAD: nonexistent degree of freedom'
257            write(*,*) '       '
258            call inputerror(inpc,ipoinpc,iline,
259     &           "*CLOAD%",ier)
260            return
261         endif
262c         if(iforcdir.gt.3) iforcdir=iforcdir+1
263!
264!        for Green function applications the value of omega_0^2 is stored as
265!        force value
266!
267         if(green) then
268            forcval=omega0
269         elseif(textpart(3)(1:1).eq.' ') then
270            forcval=0.d0
271         else
272            read(textpart(3)(1:20),'(f20.0)',iostat=istat) forcval
273            if(istat.gt.0) then
274               call inputerror(inpc,ipoinpc,iline,
275     &              "*CLOAD%",ier)
276               return
277            endif
278            if(iaxial.eq.180) forcval=forcval/iaxial
279         endif
280!
281!        dummy flux consisting of the first primes
282!
283         if(user) forcval=1.2357111317d0
284         if(submodel) forcval=1.9232931374d0
285!
286         read(textpart(1)(1:10),'(i10)',iostat=istat) l
287         if(istat.eq.0) then
288            if(l.gt.nk) then
289               write(*,*) '*ERROR reading *CLOAD: node ',l
290               write(*,*) '       is not defined'
291               ier=1
292               return
293            endif
294            if(submodel) then
295               if(ntrans.gt.0) then
296                  if(inotr(1,l).gt.0) then
297                     write(*,*) '*ERROR reading *CLOAD: in submodel'
298                     write(*,*) '       node',l,' a local coordinate'
299                     write(*,*) '       system was defined. This is not'
300                     write(*,*) '       allowed'
301                     ier=1
302                     return
303                  endif
304               endif
305            endif
306            if(lc.ne.1) then
307               jsector=isector+maxsectors
308            else
309               jsector=isector
310            endif
311            call forcadd(l,iforcdir,forcval,nodeforc,ndirforc,xforc,
312     &        nforc,nforc_,iamforc,iamplitude,nam,ntrans,trab,inotr,co,
313     &        ikforc,ilforc,jsector,add,user,idefforc,ipompc,nodempc,
314     &        nmpc,ikmpc,ilmpc,labmpc)
315         else
316            read(textpart(1)(1:80),'(a80)',iostat=istat) noset
317            noset(81:81)=' '
318            ipos=index(noset,' ')
319            noset(ipos:ipos)='N'
320c            do i=1,nset
321c               if(set(i).eq.noset) exit
322c            enddo
323            call cident81(set,noset,nset,id)
324            i=nset+1
325            if(id.gt.0) then
326              if(noset.eq.set(id)) then
327                i=id
328              endif
329            endif
330            if(i.gt.nset) then
331               noset(ipos:ipos)=' '
332               write(*,*) '*ERROR reading *CLOAD: node set ',noset
333               write(*,*) '  has not yet been defined. '
334               call inputerror(inpc,ipoinpc,iline,
335     &              "*CLOAD%",ier)
336               return
337            endif
338            do j=istartset(i),iendset(i)
339               if(ialset(j).gt.0) then
340                  k=ialset(j)
341                  if(submodel) then
342                     if(ntrans.gt.0) then
343                        if(inotr(1,k).gt.0) then
344                           write(*,*)
345     &                       '*ERROR reading *CLOAD: in submodel'
346                           write(*,*) '       node',k,
347     &                       ' a local coordinate'
348                           write(*,*)
349     &                       '       system was defined. This is not'
350                           write(*,*) '       allowed'
351                           ier=1
352                           return
353                        endif
354                     endif
355                  endif
356                  if(lc.ne.1) then
357                     jsector=isector+maxsectors
358                  else
359                     jsector=isector
360                  endif
361                  call forcadd(k,iforcdir,forcval,
362     &               nodeforc,ndirforc,xforc,nforc,nforc_,iamforc,
363     &               iamplitude,nam,ntrans,trab,inotr,co,ikforc,ilforc,
364     &               jsector,add,user,idefforc,ipompc,nodempc,
365     &               nmpc,ikmpc,ilmpc,labmpc)
366               else
367                  k=ialset(j-2)
368                  do
369                     k=k-ialset(j)
370                     if(k.ge.ialset(j-1)) exit
371                     if(submodel) then
372                        if(ntrans.gt.0) then
373                           if(inotr(1,k).gt.0) then
374                              write(*,*)
375     &                          '*ERROR reading *CLOAD: in submodel'
376                              write(*,*) '       node',k,
377     &                          ' a local coordinate'
378                              write(*,*)
379     &                          '       system was defined. This is not'
380                              write(*,*) '       allowed'
381                              ier=1
382                              return
383                           endif
384                        endif
385                     endif
386                     if(lc.ne.1) then
387                        jsector=isector+maxsectors
388                     else
389                        jsector=isector
390                     endif
391                     call forcadd(k,iforcdir,forcval,
392     &                 nodeforc,ndirforc,xforc,nforc,nforc_,
393     &                 iamforc,iamplitude,nam,ntrans,trab,inotr,co,
394     &                 ikforc,ilforc,jsector,add,user,idefforc,
395     &                 ipompc,nodempc,nmpc,ikmpc,ilmpc,labmpc)
396                  enddo
397               endif
398            enddo
399         endif
400      enddo
401!
402      return
403      end
404
405