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 nodeprints(inpc,textpart,set,istartset,iendset,ialset, 20 & nset,nset_,nalset,nprint,nprint_,jout,prlab,prset, 21 & nodeprint_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 nodeprint_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) 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(*,*) 43 & '*ERROR reading *NODE PRINT: *NODE PRINT should only be' 44 write(*,*) ' used within a *STEP definition' 45 ier=1 46 return 47 endif 48! 49 nodesys='L' 50! 51! reset the nodal print requests (element print requests, if any, 52! are kept) 53! 54 if(.not.nodeprint_flag) then 55 ii=0 56 do i=1,nprint 57 if((prlab(i)(1:4).eq.'U ').or. 58 & (prlab(i)(1:4).eq.'NT ').or. 59 & (prlab(i)(1:4).eq.'TS ').or. 60 & (prlab(i)(1:4).eq.'RF ').or. 61 & (prlab(i)(1:4).eq.'RFL ').or. 62 & (prlab(i)(1:4).eq.'PS ').or. 63 & (prlab(i)(1:4).eq.'PN ').or. 64 & (prlab(i)(1:4).eq.'MF ').or. 65 & (prlab(i)(1:4).eq.'VF ').or. 66 & (prlab(i)(1:4).eq.'PSF ').or. 67 & (prlab(i)(1:4).eq.'TSF ').or. 68 & (prlab(i)(1:4).eq.'MACH').or. 69 & (prlab(i)(1:4).eq.'DEPF').or. 70 & (prlab(i)(1:4).eq.'TTF ').or. 71 & (prlab(i)(1:4).eq.'PTF ').or. 72 & (prlab(i)(1:4).eq.'CP ').or. 73 & (prlab(i)(1:4).eq.'TURB').or. 74 & (prlab(i)(1:4).eq.'V ')) cycle 75 ii=ii+1 76 prlab(ii)=prlab(i) 77 prset(ii)=prset(i) 78 enddo 79 nprint=ii 80 endif 81! 82c jout=max(jout,1) 83 do ii=1,81 84 noset(ii:ii)=' ' 85 enddo 86 total=' ' 87! 88 do ii=2,n 89 if(textpart(ii)(1:5).eq.'NSET=') then 90 noset(1:80)=textpart(ii)(6:85) 91 ipos=index(noset,' ') 92 noset(ipos:ipos)='N' 93c do i=1,nset 94c if(set(i).eq.noset) exit 95c enddo 96 call cident81(set,noset,nset,id) 97 i=nset+1 98 if(id.gt.0) then 99 if(noset.eq.set(id)) then 100 i=id 101 endif 102 endif 103 if(i.gt.nset) then 104 write(*,*) '*WARNING reading *NODE PRINT: node set ', 105 & noset(1:ipos-1),' does not exist' 106 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 107 & ipoinp,inp,ipoinpc) 108 return 109 endif 110 elseif(textpart(ii)(1:10).eq.'FREQUENCY=') then 111 read(textpart(ii)(11:20),'(i10)',iostat=istat) joutl 112 if(istat.gt.0) then 113 call inputerror(inpc,ipoinpc,iline, 114 & "*NODE PRINT%",ier) 115 return 116 endif 117 if(joutl.eq.0) then 118 do 119 call getnewline(inpc,textpart,istat,n,key,iline,ipol, 120 & inl,ipoinp,inp,ipoinpc) 121 if((key.eq.1).or.(istat.lt.0)) return 122 enddo 123 endif 124 if(joutl.gt.0) then 125 jout(1)=joutl 126 itpamp=0 127 endif 128 elseif(textpart(ii)(1:11).eq.'FREQUENCYF=') then 129 read(textpart(ii)(12:21),'(i10)',iostat=istat) joutl 130 if(istat.gt.0) then 131 call inputerror(inpc,ipoinpc,iline, 132 & "*NODE PRINT%",ier) 133 return 134 endif 135 if(joutl.eq.0) then 136 do 137 call getnewline(inpc,textpart,istat,n,key,iline,ipol, 138 & inl,ipoinp,inp,ipoinpc) 139 if((key.eq.1).or.(istat.lt.0)) return 140 enddo 141 endif 142 if(joutl.gt.0) then 143 jout(2)=joutl 144 itpamp=0 145 endif 146 elseif(textpart(ii)(1:10).eq.'TOTALS=YES') then 147 total='T' 148 elseif(textpart(ii)(1:11).eq.'TOTALS=ONLY') then 149 total='O' 150 elseif(textpart(ii)(1:10).eq.'GLOBAL=YES') then 151 nodesys='G' 152 elseif(textpart(ii)(1:9).eq.'GLOBAL=NO') then 153 nodesys='L' 154 elseif(textpart(ii)(1:11).eq.'TIMEPOINTS=') then 155 timepointsname=textpart(ii)(12:91) 156 do i=1,nam 157 if(amname(i).eq.timepointsname) then 158 itpamp=i 159 exit 160 endif 161 enddo 162 if(i.gt.nam) then 163 ipos=index(timepointsname,' ') 164 write(*,*) 165 & '*ERROR reading *NODE PRINT: time points definition ' 166 & ,timepointsname(1:ipos-1),' is unknown or empty' 167 ier=1 168 return 169 endif 170 if(idrct.eq.1) then 171 write(*,*) '*ERROR reading *NODE PRINT: the DIRECT option' 172 write(*,*) ' collides with a TIME POINTS ' 173 write(*,*) ' specification' 174 ier=1 175 return 176 endif 177 jout(1)=1 178 jout(2)=1 179 else 180 write(*,*) 181 & '*WARNING in modaldynamics: parameter not recognized:' 182 write(*,*) ' ', 183 & textpart(ii)(1:index(textpart(ii),' ')-1) 184 call inputwarning(inpc,ipoinpc,iline, 185 &"*NODE PRINT%") 186 endif 187 enddo 188! 189! check whether a set was defined 190! 191 if(noset(1:1).eq.' ') then 192 write(*,*) '*WARNING reading *NODE PRINT: no set was defined' 193 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 194 & ipoinp,inp,ipoinpc) 195 return 196 endif 197! 198 do 199 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 200 & ipoinp,inp,ipoinpc) 201 if(key.eq.1) exit 202 do ii=1,n 203 if((textpart(ii)(1:4).ne.'U ').and. 204 & (textpart(ii)(1:4).ne.'NT ').and. 205 & (textpart(ii)(1:4).ne.'TS ').and. 206 & (textpart(ii)(1:4).ne.'RF ').and. 207 & (textpart(ii)(1:4).ne.'RFL ').and. 208 & (textpart(ii)(1:4).ne.'PS ').and. 209 & (textpart(ii)(1:4).ne.'PN ').and. 210 & (textpart(ii)(1:4).ne.'MF ').and. 211 & (textpart(ii)(1:4).ne.'V ').and. 212 & (textpart(ii)(1:4).ne.'VF ').and. 213 & (textpart(ii)(1:4).ne.'PSF ').and. 214 & (textpart(ii)(1:4).ne.'TSF ').and. 215 & (textpart(ii)(1:4).ne.'MACH').and. 216 & (textpart(ii)(1:4).ne.'DEPF').and. 217 & (textpart(ii)(1:4).ne.'TTF ').and. 218 & (textpart(ii)(1:4).ne.'PTF ').and. 219 & (textpart(ii)(1:4).ne.'CP ').and. 220 & (textpart(ii)(1:4).ne.'TURB')) then 221 write(*,*) 222 & '*WARNING reading *NODE PRINT: label not applicable' 223 write(*,*) ' or unknown; ' 224 call inputwarning(inpc,ipoinpc,iline, 225 &"*NODE PRINT%") 226 cycle 227 endif 228 if(textpart(ii)(1:4).eq.'RFL ') then 229 if(ithermal(1).lt.2) then 230 write(*,*) 231 & '*WARNING reading *NODE PRINT: RFL only makes ' 232 write(*,*) ' sense for heat transfer ' 233 write(*,*) ' calculations' 234 cycle 235 endif 236 elseif((textpart(ii)(1:4).eq.'VF ').or. 237 & (textpart(ii)(1:4).eq.'PSF ').or. 238 & (textpart(ii)(1:4).eq.'TSF ').or. 239 & (textpart(ii)(1:4).eq.'MACH').or. 240 & (textpart(ii)(1:4).eq.'DEPF').or. 241 & (textpart(ii)(1:4).eq.'TTF ').or. 242 & (textpart(ii)(1:4).eq.'PTF ').or. 243 & (textpart(ii)(1:4).eq.'CP ').or. 244 & (textpart(ii)(1:4).eq.'TURB')) then 245 if(nef.eq.0) then 246 write(*,*) 247 & '*WARNING reading *NODE PRINT: VF, PSF, TSF,' 248 write(*,*) ' MACH, DEPF, TTF, PTF, CP or ' 249 write(*,*) ' TURB only make sense for ' 250 write(*,*) ' 3D-fluid calculations' 251 cycle 252 endif 253 endif 254 nprint=nprint+1 255 if(nprint.gt.nprint_) then 256 write(*,*) '*ERROR reading *NODE PRINT: increase nprint_' 257 ier=1 258 return 259 endif 260 prset(nprint)=noset 261 prlab(nprint)(1:4)=textpart(ii)(1:4) 262 prlab(nprint)(5:5)=total 263 prlab(nprint)(6:6)=nodesys 264 enddo 265 enddo 266! 267 return 268 end 269 270