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 sectionprints(inpc,textpart,set,istartset,iendset,
20     &  ialset,nset,nset_,nalset,nprint,nprint_,jout,prlab,prset,
21     &  sectionprint_flag,ithermal,istep,istat,n,iline,ipol,inl,ipoinp,
22     &  inp,amname,nam,itpamp,idrct,ipoinpc,nef,ier)
23!
24!     reading the *NODE PRINT cards in the input deck
25!
26      implicit none
27!
28      logical sectionprint_flag
29!
30      character*1 total,nodesys,inpc(*)
31      character*6 prlab(*)
32      character*80 amname(*),timepointsname
33      character*81 set(*),prset(*),noset
34      character*132 textpart(16),name
35!
36      integer istartset(*),iendset(*),ialset(*),ii,i,nam,itpamp,id,
37     &  jout(2),joutl,ithermal(*),nset,nset_,nalset,nprint,nprint_,
38     &  istat,n,key,ipos,iline,ipol,inl,ipoinp(2,*),inp(3,*),idrct,
39     &  ipoinpc(0:*),nef,ier,istep
40!
41      if(istep.lt.1) then
42         write(*,*) '*ERROR reading *SECTION PRINT: *SECTION PRINT'
43         write(*,*) '       should only be used within a *STEP'
44         write(*,*) '       definition'
45         ier=1
46         return
47      endif
48!
49      nodesys='G'
50!
51!     reset the facial print requests (nodal and element print requests,
52!     if any,are kept)
53!
54      if(.not.sectionprint_flag) then
55         ii=0
56         do i=1,nprint
57            if((prlab(i)(1:4).eq.'DRAG').or.(prlab(i)(1:4).eq.'FLUX')
58     &     .or.(prlab(i)(1:3).eq.'SOF').or.(prlab(i)(1:3).eq.'SOM')
59     &     .or.(prlab(i)(1:6).eq.'SOAREA'))
60     &           cycle
61            ii=ii+1
62            prlab(ii)=prlab(i)
63            prset(ii)=prset(i)
64         enddo
65         nprint=ii
66      endif
67!
68      do ii=1,81
69         noset(ii:ii)=' '
70      enddo
71      total=' '
72!
73      name(1:1)=' '
74      do ii=2,n
75        if(textpart(ii)(1:8).eq.'SURFACE=') then
76          noset(1:80)=textpart(ii)(9:88)
77          ipos=index(noset,' ')
78          noset(ipos:ipos)='T'
79c          do i=1,nset
80c            if(set(i).eq.noset) exit
81c          enddo
82          call cident81(set,noset,nset,id)
83          i=nset+1
84          if(id.gt.0) then
85            if(noset.eq.set(id)) then
86              i=id
87            endif
88          endif
89          if(i.gt.nset) then
90             write(*,*)
91     &           '*WARNING reading *SECTION PRINT: element surface ',
92     &            noset(1:ipos-1),' does not exist'
93             call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
94     &            ipoinp,inp,ipoinpc)
95             return
96          endif
97        elseif(textpart(ii)(1:11).eq.'FREQUENCYF=') then
98           read(textpart(ii)(12:21),'(i10)',iostat=istat) joutl
99           if(istat.gt.0) then
100              call inputerror(inpc,ipoinpc,iline,
101     &             "*SECTION PRINT%",ier)
102              return
103           endif
104           if(joutl.eq.0) then
105              do
106                 call getnewline(inpc,textpart,istat,n,key,iline,ipol,
107     &                inl,ipoinp,inp,ipoinpc)
108                 if((key.eq.1).or.(istat.lt.0)) return
109              enddo
110           endif
111           if(joutl.gt.0) then
112              jout(2)=joutl
113              itpamp=0
114           endif
115        elseif(textpart(ii)(1:11).eq.'TIMEPOINTS=') then
116           timepointsname=textpart(ii)(12:91)
117           do i=1,nam
118              if(amname(i).eq.timepointsname) then
119                 itpamp=i
120                 exit
121              endif
122           enddo
123           if(i.gt.nam) then
124              ipos=index(timepointsname,' ')
125              write(*,*)
126     &          '*ERROR reading *SECTION PRINT: time points definition '
127     &               ,timepointsname(1:ipos-1),' is unknown or empty'
128              ier=1
129              return
130           endif
131           if(idrct.eq.1) then
132              write(*,*)
133     &            '*ERROR reading *SECTION PRINT: the DIRECT option'
134              write(*,*) '       collides with a TIME POINTS '
135              write(*,*) '       specification'
136              ier=1
137              return
138           endif
139           jout(1)=1
140           jout(2)=1
141        elseif(textpart(ii)(1:5).eq.'NAME=') then
142            name(1:127)=textpart(ii)(6:132)
143        else
144            write(*,*)
145     &      '*WARNING reading *SECTION PRINT: parameter not recognized:'
146            write(*,*) '         ',
147     &                 textpart(ii)(1:index(textpart(ii),' ')-1)
148            call inputwarning(inpc,ipoinpc,iline,
149     &"*SECTION PRINT%")
150        endif
151      enddo
152!
153      if(name(1:1).eq.' ') then
154         write(*,*)
155     &        '*ERROR reading *SECTION PRINT: no NAME given'
156         write(*,*) '  '
157         call inputerror(inpc,ipoinpc,iline,
158     &        "*SECTION PRINT%",ier)
159         return
160      endif
161!
162!     check whether a set was defined
163!
164      if(noset(1:1).eq.' ') then
165         write(*,*)
166     &       '*WARNING reading *SECTION PRINT: no set was defined'
167         call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
168     &        ipoinp,inp,ipoinpc)
169         return
170      endif
171!
172      do
173         call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
174     &        ipoinp,inp,ipoinpc)
175         if(key.eq.1) exit
176         loop: do ii=1,n
177            if((textpart(ii)(1:4).ne.'DRAG').and.
178     &         (textpart(ii)(1:4).ne.'FLUX').and.
179     &         (textpart(ii)(1:3).ne.'SOF').and.
180     &         (textpart(ii)(1:3).ne.'SOM').and.
181     &         (textpart(ii)(1:6).ne.'SOAREA')) then
182               write(*,*)
183     &           '*WARNING reading *SECTION PRINT: label not applicable'
184               write(*,*) '         or unknown; '
185               call inputwarning(inpc,ipoinpc,iline,
186     &"*SECTION PRINT%")
187               cycle
188            endif
189            if((nef.eq.0).and.(textpart(ii)(1:4).eq.'DRAG')) then
190               write(*,*)
191     &           '*WARNING reading *SECTION PRINT: DRAG only makes '
192               write(*,*) '         sense for 3D fluid '
193               write(*,*) '         calculations'
194               cycle
195            endif
196!
197!           SOF, SOM and SOAREA generate the same output
198!
199            if(textpart(ii)(1:3).eq.'SOM') textpart(ii)(1:3)='SOF'
200            if(textpart(ii)(1:6).eq.'SOAREA') textpart(ii)(1:6)='SOF   '
201            do i=1,nprint
202               if(prlab(i)(1:3).eq.'SOF') then
203                  if(prset(i).eq.noset) cycle loop
204               endif
205            enddo
206!
207            nprint=nprint+1
208            if(nprint.gt.nprint_) then
209               write(*,*)
210     &            '*ERROR reading *SECTION PRINT: increase nprint_'
211               ier=1
212               return
213            endif
214            prset(nprint)=noset
215            prlab(nprint)(1:4)=textpart(ii)(1:4)
216            prlab(nprint)(5:5)=total
217            prlab(nprint)(6:6)=nodesys
218         enddo loop
219      enddo
220!
221      return
222      end
223
224