CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
nodeprints.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine nodeprints (inpc, textpart, set, istartset, iendset, ialset, nset, nset_, nalset, nprint, nprint_, jout, prlab, prset, nodeprint_flag, ithermal, istep, istat, n, iline, ipol, inl, ipoinp, inp, amname, nam, itpamp, idrct, ipoinpc, cfd)
 

Function/Subroutine Documentation

◆ nodeprints()

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