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