KTH framework for Nek5000 toolboxes; testing version  0.0.1
pstat3D_IO.f
Go to the documentation of this file.
1 
6 !=======================================================================
9  subroutine pstat3d_mfo
10  implicit none
11 
12  include 'SIZE'
13  include 'INPUT'
14  include 'SOLN'
15  include 'FRAMELP'
16  include 'PSTAT3D'
17 
18  ! local variables
19  integer il
20 !-----------------------------------------------------------------------
21  ! save all fields
22  ifxyo = .true.
23  ifvo = .true.
24  ifpo = .false.
25  ifto = .true.
26  do il=1, npscal
27  ifpsco(il)= .false.
28  enddo
29 
30  call outpost(pstat_ruavg(1,1,1),pstat_ruavg(1,1,2), ! U,V,W,uu
31  $ pstat_ruavg(1,1,3),pr,pstat_ruavg(1,1,5),'a01')
32  call outpost(pstat_ruavg(1,1,6),pstat_ruavg(1,1,7), ! vv,ww,uv,uw
33  $ pstat_ruavg(1,1,9),pr,pstat_ruavg(1,1,11),'a02')
34  call outpost(pstat_ruavg(1,1,10),pstat_ruavg(1,1,4), ! vw,P,pp,ppp
35  $ pstat_ruavg(1,1,8),pr,pstat_ruavg(1,1,27),'a03')
36  call outpost(pstat_ruavg(1,1,38),pstat_ruavg(1,1,24), ! pppp,uuu,vvv,www
37  $ pstat_ruavg(1,1,25),pr,pstat_ruavg(1,1,26),'a04')
38  call outpost(pstat_ruavg(1,1,28),pstat_ruavg(1,1,29), ! uuv,uuw,uvv,vvw
39  $ pstat_ruavg(1,1,30),pr,pstat_ruavg(1,1,31),'a05')
40  call outpost(pstat_ruavg(1,1,32),pstat_ruavg(1,1,33), ! uww,vww,uvw,Pxx
41  $ pstat_ruavg(1,1,34),pr,pstat_rutmp(1,1,1),'a06')
42  call outpost(pstat_rutmp(1,1,2),pstat_rutmp(1,1,3), ! Pyy,Pzz,Pxy,Pxz
43  $ pstat_rutmp(1,1,4),pr,pstat_rutmp(1,1,5),'a07')
44  call outpost(pstat_rutmp(1,1,6),pstat_ruavg(1,1,39), ! Pyz,Dxx,Dyy,Dzz
45  $ pstat_ruavg(1,1,40),pr,pstat_ruavg(1,1,41),'a08')
46  call outpost(pstat_ruavg(1,1,42),pstat_ruavg(1,1,43), ! Dxy,Dxz,Dyz,Txx
47  $ pstat_ruavg(1,1,44),pr,pstat_runew(1,1,22),'a09')
48  call outpost(pstat_runew(1,1,23),pstat_runew(1,1,24), ! Tyy,Tzz,Txy,Txz
49  $ pstat_runew(1,1,25),pr,pstat_runew(1,1,27),'a10')
50  call outpost(pstat_runew(1,1,26),pstat_runew(1,1,16), ! Tyz,VDxx,VDyy,VDzz
51  $ pstat_runew(1,1,17),pr,pstat_runew(1,1,18),'a11')
52  call outpost(pstat_runew(1,1,19),pstat_runew(1,1,21), ! VDxy,VDxz,VDyz,Pixx
53  $ pstat_runew(1,1,20),pr,pstat_rutmp(1,1,7),'a12')
54  call outpost(pstat_rutmp(1,1,8),pstat_rutmp(1,1,9), ! Piyy,Pizz,Pixy,Pixz
55  $ pstat_rutmp(1,1,10),pr,pstat_rutmp(1,1,11),'a13')
56  call outpost(pstat_rutmp(1,1,12),pstat_runew(1,1,10), ! Piyz,Cxx,Cyy,Czz
57  $ pstat_runew(1,1,11),pr,pstat_runew(1,1,12),'a14')
58  call outpost(pstat_runew(1,1,13),pstat_runew(1,1,15), ! Cxy,Cxz,Cyz,Pk
59  $ pstat_runew(1,1,14),pr,pstat_rutmp(1,1,13),'a15')
60  call outpost(pstat_rutmp(1,1,14),pstat_rutmp(1,1,15), ! Dk,Tk,VDk,Pik
61  $ pstat_rutmp(1,1,16),pr,pstat_rutmp(1,1,17),'a16')
62  call outpost(pstat_rutmp(1,1,18),pstat_rutmp(1,1,19), ! Ck,Resk,PTxx,PTyy
63  $ pstat_ruavg(1,1,12),pr,pstat_ruavg(1,1,13),'a17')
64  call outpost(pstat_ruavg(1,1,14),pstat_ruavg(1,1,15), ! PTzz,PTxy,PTxz,PTyz
65  $ pstat_ruavg(1,1,16),pr,pstat_ruavg(1,1,17),'a18')
66  call outpost(pstat_ruavg(1,1,18),pstat_ruavg(1,1,19), ! PSxx,PSyy,PSzz,PSxy
67  $ pstat_ruavg(1,1,20),pr,pstat_ruavg(1,1,21),'a19')
68  call outpost(pstat_ruavg(1,1,22),pstat_ruavg(1,1,23), ! PSxz,PTyz,dUdx,dUdy
69  $ pstat_runew(1,1,1),pr,pstat_runew(1,1,2),'a20')
70  call outpost(pstat_runew(1,1,3),pstat_runew(1,1,4), ! dUdz,dVdx,dVdy,dVdz
71  $ pstat_runew(1,1,5),pr,pstat_runew(1,1,6),'a21')
72  call outpost(pstat_runew(1,1,7),pstat_runew(1,1,8), ! dWdx,dWdy,dWdz,Tk
73  $ pstat_runew(1,1,9),pr,pstat_rutmp(1,1,15),'a22')
74  call outpost(pstat_pgrad(1,1,1),pstat_pgrad(1,1,2), ! dPdx,dPdy,dPdz,Tk
75  $ pstat_pgrad(1,1,3),pr,pstat_rutmp(1,1,15),'a23')
76 
77  return
78  end subroutine
79 !=======================================================================
82  subroutine pstat3d_mfi_interp
83  implicit none
84 
85  include 'SIZE'
86  include 'INPUT'
87  include 'RESTART'
88  include 'PARALLEL'
89  include 'FRAMELP'
90  include 'PSTAT3D'
91 
92  ! global data structures
93  integer mid,mp,nekcomm,nekgroup,nekreal
94  common /nekmpi/ mid,mp,nekcomm,nekgroup,nekreal
95 
96  ! local variables
97  integer il, jl ! loop index
98  integer ierr ! error flag
99  integer ldiml ! dimesion of interpolation file
100  integer nptsr ! number of points in the file
101  integer npass ! number of messages to send
102  real rtmp_pts(ldim,lhis)
103  real*4 rbuffl(2*ldim*lhis)
104  real rtmp1, rtmp2
105  character*132 fname ! file name
106  integer hdrl
107  parameter(hdrl=32)
108  character*32 hdr ! file header
109  character*4 dummy
110  real*4 bytetest
111 
112  ! functions
113  logical if_byte_swap_test
114 
115 !#define DEBUG
116 #ifdef DEBUG
117  character*3 str1, str2
118  integer iunit
119  ! call number
120  integer icalld
121  save icalld
122  data icalld /0/
123 #endif
124 !-----------------------------------------------------------------------
125  ! master opens files and gets point number
126  ierr = 0
127  if (nid.eq.pid00) then
128  !open the file
129  fname='DATA/int_pos'
130  call byte_open(fname,ierr)
131 
132  ! read header
133  call blank (hdr,hdrl)
134  call byte_read (hdr,hdrl/4,ierr)
135  if (ierr.ne.0) goto 101
136 
137  ! big/little endian test
138  call byte_read (bytetest,1,ierr)
139  if(ierr.ne.0) goto 101
140  if_byte_sw = if_byte_swap_test(bytetest,ierr)
141  if(ierr.ne.0) goto 101
142 
143  ! extract header information
144  read(hdr,*,iostat=ierr) dummy, wdsizr, ldiml, nptsr
145  endif
146 
147  101 continue
148 
149  call mntr_check_abort(pstat_id,ierr,
150  $ 'pstat_mfi_interp: Error opening point files')
151 
152  ! broadcast header data
153  call bcast(wdsizr,isize)
154  call bcast(ldiml,isize)
155  call bcast(nptsr,isize)
156  call bcast(if_byte_sw,lsize)
157 
158  ! check dimension consistency
159  if (ldim.ne.ldiml) call mntr_check_abort(pstat_id,
160  $ 'pstat_mfi_interp: Inconsisten dimension.')
161 
162  ! calculate point distribution; I assume it is post-processing
163  ! done on small number of cores, so I assume nptsr >> mp
164  pstat_nptot = nptsr
165  pstat_npt = nptsr/mp
166  if (pstat_npt.gt.0) then
167  pstat_npt1 = mod(pstat_nptot,mp)
168  else
169  pstat_npt1 = pstat_nptot
170  endif
171  if (nid.lt.pstat_npt1) pstat_npt = pstat_npt +1
172 
173  ! stamp logs
174  call mntr_logi(pstat_id,lp_prd,
175  $ 'Interpolation point number :', pstat_nptot)
176 
177  ierr = 0
178  if (pstat_npt.gt.lhis) ierr = 1
179  call mntr_check_abort(pstat_id,ierr,
180  $ 'pstat_mfi_interp: lhis too small')
181 
182  ! read and redistribute points
183  ! this part is not optimised, but it is post-processing
184  ! done locally, so I don't care
185  if (nid.eq.pid00) then
186  if (pstat_nptot.gt.0) then
187  ! read points for the master rank
188  ldiml = ldim*pstat_npt*wdsizr/4
189  call byte_read (rbuffl,ldiml,ierr)
190 
191  ! get byte shift
192  if (if_byte_sw) then
193  if(wdsizr.eq.8) then
194  call byte_reverse8(rbuffl,ldiml,ierr)
195  else
196  call byte_reverse(rbuffl,ldiml,ierr)
197  endif
198  endif
199 
200  ! copy data
201  ldiml = ldim*pstat_npt
202  if (wdsizr.eq.4) then
203  call copy4r(pstat_int_pts,rbuffl,ldiml)
204  else
205  call copy(pstat_int_pts,rbuffl,ldiml)
206  endif
207 
208  ! redistribute rest of points
209  npass = min(mp,pstat_nptot)
210  do il = 1,npass-1
211  nptsr = pstat_npt
212  if (pstat_npt1.gt.0.and.il.ge.pstat_npt1) then
213  nptsr = pstat_npt -1
214  endif
215  ! read points for the slave rank
216  ldiml = ldim*nptsr*wdsizr/4
217  call byte_read (rbuffl,ldiml,ierr)
218 
219  ! get byte shift
220  if (if_byte_sw) then
221  if(wdsizr.eq.8) then
222  call byte_reverse8(rbuffl,ldiml,ierr)
223  else
224  call byte_reverse(rbuffl,ldiml,ierr)
225  endif
226  endif
227 
228  ! copy data
229  ldiml = ldim*nptsr
230  if (wdsizr.eq.4) then
231  call copy4r(rtmp_pts,rbuffl,ldiml)
232  else
233  call copy(rtmp_pts,rbuffl,ldiml)
234  endif
235 
236  ! send data
237  ldiml = ldiml*wdsizr
238  call csend(il,rtmp_pts,ldiml,il,jl)
239  enddo
240  endif
241  else
242  if (pstat_npt.gt.0) then
243  call crecv2(nid,pstat_int_pts,ldim*pstat_npt*wdsize,0)
244  endif
245  endif
246 
247  ! master closes files
248  if (nid.eq.pid00) then
249  call byte_close(ierr)
250  endif
251 
252 #ifdef DEBUG
253  ! for testing
254  ! to output refinement
255  icalld = icalld+1
256  call io_file_freeid(iunit, ierr)
257  write(str1,'(i3.3)') nid
258  write(str2,'(i3.3)') icalld
259  open(unit=iunit,file='INTpos.txt'//str1//'i'//str2)
260 
261  write(iunit,*) pstat_nptot, pstat_npt
262  do il=1, pstat_npt
263  write(iunit,*) il, (pstat_int_pts(jl,il),jl=1,ldim)
264  enddo
265 
266  close(iunit)
267 #endif
268 #undef DEBUG
269 
270  return
271  end subroutine
272 !=======================================================================
275  subroutine pstat3d_mfo_interp
276  implicit none
277 
278  include 'SIZE'
279  include 'INPUT'
280  include 'RESTART'
281  include 'PARALLEL'
282  include 'GEOM'
283  include 'PSTAT3D'
284 
285  ! local variables
286  integer il
287  integer ierr ! error flag
288  character*132 fname ! file name
289  character*500 head ! file header
290  character*500 ftm ! header format
291  real*4 test
292  parameter(test=6.54321)
293 
294  real rtmp
295 
296  real lx,ly,lz ! box dimensions
297  integer nlx,nly,nlz ! for tensor product meshes
298  integer iavfr
299  integer int_nvar ! number of interpolated varibales
300 
301  integer wdsl, isl ! double and integer sizes
302 
303  ! functions
304  real glmin, glmax
305 !-----------------------------------------------------------------------
306  ! double and integer sizes
307  wdsl = wdsize/4
308  isl = isize/4
309 
310  ! gether information for file header
311  il = lx1*ly1*lz1*nelt
312  lx = glmax(xm1,il) - glmin(xm1,il)
313  ly = glmax(ym1,il) - glmin(ym1,il)
314  if (if3d) then
315  lz = glmax(zm1,il) - glmin(zm1,il)
316  else
317  lz = 0.0 ! this should be changed
318  endif
319  ! for tensor product meshes; element count
320  nlx = nelgv
321  nly = 1
322  nlz = 1
323  ! frequency of averaging in steps
324  iavfr = pstat_nstep
325  ! stat averagign time
326  rtmp = pstat_etime-pstat_stime
327  ! currently I interpolate and save 90 variables
328  int_nvar = 90
329  ! this is far from optimal, but for post-processing I do not care
330  ! master opens files and writes header
331  ierr = 0
332  if (nid.eq.pid00) then
333  !open the file
334  fname='int_fld'
335  call byte_open(fname,ierr)
336 
337  if (ierr.ne.0) goto 20
338 
339  ! write file's header
340  ftm="('#iv1',1x,i1,1x,"//
341  $ "1p,'(Re =',e17.9,') (Lx, Ly, Lz =',3e17.9,"//
342  $ "') (nelx, nely, nelz =',3i9,') (Polynomial order =',3i9,"//
343  $ "') (Nstat =',i9,') (start time =',e17.9,"//
344  $ "') (end time =',e17.9,') (effective average time =',e17.9,"//
345  $ "') (time step =',e17.9,') (nrec =',i9"//
346  $ "') (time interval =',e17.9,') (npoints =',i9,')')"
347  write(head,ftm) wdsize,
348  $ 1.0/param(2),lx,ly,lz,nlx,nly,nlz,lx1,ly1,lz1,
349  $ int_nvar,pstat_stime,pstat_etime,rtmp/iavfr,
350  $ rtmp/pstat_istepr,pstat_istepr/iavfr,rtmp,pstat_nptot
351  call byte_write(head,115,ierr)
352 
353  ! write big/little endian test
354  call byte_write(test,1,ierr)
355 
356  if (ierr.ne.0) goto 20
357 
358  ! write parameter set with all the digits
359  call byte_write(1.0/param(2),wdsl,ierr)
360  call byte_write(lx,wdsl,ierr)
361  call byte_write(ly,wdsl,ierr)
362  call byte_write(lz,wdsl,ierr)
363  call byte_write(nlx,isl,ierr)
364  call byte_write(nly,isl,ierr)
365  call byte_write(nlz,isl,ierr)
366  call byte_write(lx1,isl,ierr)
367  call byte_write(ly1,isl,ierr)
368  call byte_write(lz1,isl,ierr)
369  call byte_write(int_nvar,isl,ierr)
370  call byte_write(pstat_stime,wdsl,ierr)
371  call byte_write(pstat_etime,wdsl,ierr)
372  call byte_write(rtmp/iavfr,wdsl,ierr)
373  call byte_write(rtmp/pstat_istepr,wdsl,ierr)
374  call byte_write(pstat_istepr/iavfr,isl,ierr)
375  call byte_write(rtmp,wdsl,ierr)
376  call byte_write(pstat_nptot,isl,ierr)
377  endif
378 
379  20 continue
380  call mntr_check_abort(pstat_id,ierr,
381  $ 'Error opening interpolation file in pstat_mfo_interp.')
382 
383  ! write down point coordinates
384  call pstat3d_field_out(pstat_int_pts,ldim,ierr)
385  call mntr_check_abort(pstat_id,ierr,
386  $ 'Error writing coordinates in pstat_mfo_interp.')
387 
388  ! geather single field data and write it down to the file
389  ! this is kind of strange, but I have to keep variables order from a** files
390  call pstat3d_field_out(pstat_int_avg(1,1),1,ierr) ! U
391  call mntr_check_abort(pstat_id,ierr,'Error writing U interp.')
392  call pstat3d_field_out(pstat_int_avg(1,2),1,ierr) ! V
393  call mntr_check_abort(pstat_id,ierr,'Error writing V interp.')
394  call pstat3d_field_out(pstat_int_avg(1,3),1,ierr) ! W
395  call mntr_check_abort(pstat_id,ierr,'Error writing W interp.')
396  call pstat3d_field_out(pstat_int_avg(1,5),1,ierr) ! uu
397  call mntr_check_abort(pstat_id,ierr,'Error writing uu interp.')
398  call pstat3d_field_out(pstat_int_avg(1,6),1,ierr) ! vv
399  call mntr_check_abort(pstat_id,ierr,'Error writing vv interp.')
400  call pstat3d_field_out(pstat_int_avg(1,7),1,ierr) ! ww
401  call mntr_check_abort(pstat_id,ierr,'Error writing ww interp.')
402  call pstat3d_field_out(pstat_int_avg(1,9),1,ierr) ! uv
403  call mntr_check_abort(pstat_id,ierr,'Error writing uv interp.')
404  call pstat3d_field_out(pstat_int_avg(1,11),1,ierr) ! uw
405  call mntr_check_abort(pstat_id,ierr,'Error writing uw interp.')
406  call pstat3d_field_out(pstat_int_avg(1,10),1,ierr) ! vw
407  call mntr_check_abort(pstat_id,ierr,'Error writing vw interp.')
408  call pstat3d_field_out(pstat_int_avg(1,4),1,ierr) ! P
409  call mntr_check_abort(pstat_id,ierr,'Error writing P interp.')
410  call pstat3d_field_out(pstat_int_avg(1,8),1,ierr) ! pp
411  call mntr_check_abort(pstat_id,ierr,'Error writing pp interp.')
412  call pstat3d_field_out(pstat_int_avg(1,27),1,ierr) ! ppp
413  call mntr_check_abort(pstat_id,ierr,'Error writing ppp interp.')
414  call pstat3d_field_out(pstat_int_avg(1,38),1,ierr) ! pppp
415  call mntr_check_abort(pstat_id,ierr,'Error writing pppp interp.')
416  call pstat3d_field_out(pstat_int_avg(1,24),1,ierr) ! uuu
417  call mntr_check_abort(pstat_id,ierr,'Error writing uuu interp.')
418  call pstat3d_field_out(pstat_int_avg(1,25),1,ierr) ! vvv
419  call mntr_check_abort(pstat_id,ierr,'Error writing vvv interp.')
420  call pstat3d_field_out(pstat_int_avg(1,26),1,ierr) ! www
421  call mntr_check_abort(pstat_id,ierr,'Error writing www interp.')
422  call pstat3d_field_out(pstat_int_avg(1,28),1,ierr) ! uuv
423  call mntr_check_abort(pstat_id,ierr,'Error writing uuv interp.')
424  call pstat3d_field_out(pstat_int_avg(1,29),1,ierr) ! uuw
425  call mntr_check_abort(pstat_id,ierr,'Error writing uuw interp.')
426  call pstat3d_field_out(pstat_int_avg(1,30),1,ierr) ! uvv
427  call mntr_check_abort(pstat_id,ierr,'Error writing uvv interp.')
428  call pstat3d_field_out(pstat_int_avg(1,31),1,ierr) ! vvw
429  call mntr_check_abort(pstat_id,ierr,'Error writing vvw interp.')
430  call pstat3d_field_out(pstat_int_avg(1,32),1,ierr) ! uww
431  call mntr_check_abort(pstat_id,ierr,'Error writing uww interp.')
432  call pstat3d_field_out(pstat_int_avg(1,33),1,ierr) ! vww
433  call mntr_check_abort(pstat_id,ierr,'Error writing vww interp.')
434  call pstat3d_field_out(pstat_int_avg(1,34),1,ierr) ! uvw
435  call mntr_check_abort(pstat_id,ierr,'Error writing uvw interp.')
436  call pstat3d_field_out(pstat_int_tmp(1,1),1,ierr) ! Pxx
437  call mntr_check_abort(pstat_id,ierr,'Error writing Pxx interp.')
438  call pstat3d_field_out(pstat_int_tmp(1,2),1,ierr) ! Pyy
439  call mntr_check_abort(pstat_id,ierr,'Error writing Pyy interp.')
440  call pstat3d_field_out(pstat_int_tmp(1,3),1,ierr) ! Pzz
441  call mntr_check_abort(pstat_id,ierr,'Error writing Pzz interp.')
442  call pstat3d_field_out(pstat_int_tmp(1,4),1,ierr) ! Pxy
443  call mntr_check_abort(pstat_id,ierr,'Error writing Pxy interp.')
444  call pstat3d_field_out(pstat_int_tmp(1,5),1,ierr) ! Pxz
445  call mntr_check_abort(pstat_id,ierr,'Error writing Pxz interp.')
446  call pstat3d_field_out(pstat_int_tmp(1,6),1,ierr) ! Pyz
447  call mntr_check_abort(pstat_id,ierr,'Error writing Pyz interp.')
448  call pstat3d_field_out(pstat_int_avg(1,39),1,ierr) ! Dxx
449  call mntr_check_abort(pstat_id,ierr,'Error writing Dxx interp.')
450  call pstat3d_field_out(pstat_int_avg(1,40),1,ierr) ! Dyy
451  call mntr_check_abort(pstat_id,ierr,'Error writing Dyy interp.')
452  call pstat3d_field_out(pstat_int_avg(1,41),1,ierr) ! Dzz
453  call mntr_check_abort(pstat_id,ierr,'Error writing Dzz interp.')
454  call pstat3d_field_out(pstat_int_avg(1,42),1,ierr) ! Dxy
455  call mntr_check_abort(pstat_id,ierr,'Error writing Dxy interp.')
456  call pstat3d_field_out(pstat_int_avg(1,43),1,ierr) ! Dxz
457  call mntr_check_abort(pstat_id,ierr,'Error writing Dxz interp.')
458  call pstat3d_field_out(pstat_int_avg(1,44),1,ierr) ! Dyz
459  call mntr_check_abort(pstat_id,ierr,'Error writing Dyz interp.')
460  call pstat3d_field_out(pstat_int_new(1,22),1,ierr) ! Txx
461  call mntr_check_abort(pstat_id,ierr,'Error writing Txx interp.')
462  call pstat3d_field_out(pstat_int_new(1,23),1,ierr) ! Tyy
463  call mntr_check_abort(pstat_id,ierr,'Error writing Tyy interp.')
464  call pstat3d_field_out(pstat_int_new(1,24),1,ierr) ! Tzz
465  call mntr_check_abort(pstat_id,ierr,'Error writing Tzz interp.')
466  call pstat3d_field_out(pstat_int_new(1,25),1,ierr) ! Txy
467  call mntr_check_abort(pstat_id,ierr,'Error writing Txy interp.')
468  call pstat3d_field_out(pstat_int_new(1,27),1,ierr) ! Txz
469  call mntr_check_abort(pstat_id,ierr,'Error writing Txz interp.')
470  call pstat3d_field_out(pstat_int_new(1,26),1,ierr) ! Tyz
471  call mntr_check_abort(pstat_id,ierr,'Error writing Tyz interp.')
472  call pstat3d_field_out(pstat_int_new(1,16),1,ierr) ! VDxx
473  call mntr_check_abort(pstat_id,ierr,'Error writing VDxx interp.')
474  call pstat3d_field_out(pstat_int_new(1,17),1,ierr) ! VDyy
475  call mntr_check_abort(pstat_id,ierr,'Error writing VDyy interp.')
476  call pstat3d_field_out(pstat_int_new(1,18),1,ierr) ! VDzz
477  call mntr_check_abort(pstat_id,ierr,'Error writing VDzz interp.')
478  call pstat3d_field_out(pstat_int_new(1,19),1,ierr) ! VDxy
479  call mntr_check_abort(pstat_id,ierr,'Error writing VDxy interp.')
480  call pstat3d_field_out(pstat_int_new(1,21),1,ierr) ! VDxz
481  call mntr_check_abort(pstat_id,ierr,'Error writing VDxz interp.')
482  call pstat3d_field_out(pstat_int_new(1,20),1,ierr) ! VDyz
483  call mntr_check_abort(pstat_id,ierr,'Error writing VDyz interp.')
484  call pstat3d_field_out(pstat_int_tmp(1,7),1,ierr) ! Pixx
485  call mntr_check_abort(pstat_id,ierr,'Error writing Pixx interp.')
486  call pstat3d_field_out(pstat_int_tmp(1,8),1,ierr) ! Piyy
487  call mntr_check_abort(pstat_id,ierr,'Error writing Piyy interp.')
488  call pstat3d_field_out(pstat_int_tmp(1,9),1,ierr) ! Pizz
489  call mntr_check_abort(pstat_id,ierr,'Error writing Pizz interp.')
490  call pstat3d_field_out(pstat_int_tmp(1,10),1,ierr) ! Pixy
491  call mntr_check_abort(pstat_id,ierr,'Error writing Pixy interp.')
492  call pstat3d_field_out(pstat_int_tmp(1,11),1,ierr) ! Pixz
493  call mntr_check_abort(pstat_id,ierr,'Error writing Pixz interp.')
494  call pstat3d_field_out(pstat_int_tmp(1,12),1,ierr) ! Piyz
495  call mntr_check_abort(pstat_id,ierr,'Error writing Piyz interp.')
496  call pstat3d_field_out(pstat_int_new(1,10),1,ierr) ! Cxx
497  call mntr_check_abort(pstat_id,ierr,'Error writing Cxx interp.')
498  call pstat3d_field_out(pstat_int_new(1,11),1,ierr) ! Cyy
499  call mntr_check_abort(pstat_id,ierr,'Error writing Cyy interp.')
500  call pstat3d_field_out(pstat_int_new(1,12),1,ierr) ! Czz
501  call mntr_check_abort(pstat_id,ierr,'Error writing Czz interp.')
502  call pstat3d_field_out(pstat_int_new(1,13),1,ierr) ! Cxy
503  call mntr_check_abort(pstat_id,ierr,'Error writing Cxy interp.')
504  call pstat3d_field_out(pstat_int_new(1,15),1,ierr) ! Cxz
505  call mntr_check_abort(pstat_id,ierr,'Error writing Cxz interp.')
506  call pstat3d_field_out(pstat_int_new(1,14),1,ierr) ! Cyz
507  call mntr_check_abort(pstat_id,ierr,'Error writing Cyz interp.')
508  call pstat3d_field_out(pstat_int_tmp(1,13),1,ierr) ! Pk
509  call mntr_check_abort(pstat_id,ierr,'Error writing Pk interp.')
510  call pstat3d_field_out(pstat_int_tmp(1,14),1,ierr) ! Dk
511  call mntr_check_abort(pstat_id,ierr,'Error writing Dk interp.')
512  call pstat3d_field_out(pstat_int_tmp(1,15),1,ierr) ! Tk
513  call mntr_check_abort(pstat_id,ierr,'Error writing Tk interp.')
514  call pstat3d_field_out(pstat_int_tmp(1,16),1,ierr) ! VDk
515  call mntr_check_abort(pstat_id,ierr,'Error writing VDk interp.')
516  call pstat3d_field_out(pstat_int_tmp(1,17),1,ierr) ! Pik
517  call mntr_check_abort(pstat_id,ierr,'Error writing Pik interp.')
518  call pstat3d_field_out(pstat_int_tmp(1,18),1,ierr) ! Ck
519  call mntr_check_abort(pstat_id,ierr,'Error writing Ck interp.')
520  call pstat3d_field_out(pstat_int_tmp(1,19),1,ierr) ! Resk
521  call mntr_check_abort(pstat_id,ierr,'Error writing Resk interp.')
522  call pstat3d_field_out(pstat_int_avg(1,12),1,ierr) ! PTxx
523  call mntr_check_abort(pstat_id,ierr,'Error writing PTxx interp.')
524  call pstat3d_field_out(pstat_int_avg(1,13),1,ierr) ! PTyy
525  call mntr_check_abort(pstat_id,ierr,'Error writing PTyy interp.')
526  call pstat3d_field_out(pstat_int_avg(1,14),1,ierr) ! PTzz
527  call mntr_check_abort(pstat_id,ierr,'Error writing PTzz interp.')
528  call pstat3d_field_out(pstat_int_avg(1,15),1,ierr) ! PTxy
529  call mntr_check_abort(pstat_id,ierr,'Error writing PTxy interp.')
530  call pstat3d_field_out(pstat_int_avg(1,16),1,ierr) ! PTxz
531  call mntr_check_abort(pstat_id,ierr,'Error writing PTxz interp.')
532  call pstat3d_field_out(pstat_int_avg(1,17),1,ierr) ! PTyz
533  call mntr_check_abort(pstat_id,ierr,'Error writing PTyz interp.')
534  call pstat3d_field_out(pstat_int_avg(1,18),1,ierr) ! PSxx
535  call mntr_check_abort(pstat_id,ierr,'Error writing PSxx interp.')
536  call pstat3d_field_out(pstat_int_avg(1,19),1,ierr) ! PSyy
537  call mntr_check_abort(pstat_id,ierr,'Error writing PSyy interp.')
538  call pstat3d_field_out(pstat_int_avg(1,20),1,ierr) ! PSzz
539  call mntr_check_abort(pstat_id,ierr,'Error writing PSzz interp.')
540  call pstat3d_field_out(pstat_int_avg(1,21),1,ierr) ! PSxy
541  call mntr_check_abort(pstat_id,ierr,'Error writing PSxy interp.')
542  call pstat3d_field_out(pstat_int_avg(1,22),1,ierr) ! PSxz
543  call mntr_check_abort(pstat_id,ierr,'Error writing PSxz interp.')
544  call pstat3d_field_out(pstat_int_avg(1,23),1,ierr) ! PSyz
545  call mntr_check_abort(pstat_id,ierr,'Error writing PSyz interp.')
546  call pstat3d_field_out(pstat_int_new(1,1),1,ierr) ! dUdx
547  call mntr_check_abort(pstat_id,ierr,'Error writing dUdx interp.')
548  call pstat3d_field_out(pstat_int_new(1,2),1,ierr) ! dUdy
549  call mntr_check_abort(pstat_id,ierr,'Error writing dUdy interp.')
550  call pstat3d_field_out(pstat_int_new(1,3),1,ierr) ! dUdz
551  call mntr_check_abort(pstat_id,ierr,'Error writing dUdz interp.')
552  call pstat3d_field_out(pstat_int_new(1,4),1,ierr) ! dVdx
553  call mntr_check_abort(pstat_id,ierr,'Error writing dVdx interp.')
554  call pstat3d_field_out(pstat_int_new(1,5),1,ierr) ! dVdy
555  call mntr_check_abort(pstat_id,ierr,'Error writing dVdy interp.')
556  call pstat3d_field_out(pstat_int_new(1,6),1,ierr) ! dVdz
557  call mntr_check_abort(pstat_id,ierr,'Error writing dVdz interp.')
558  call pstat3d_field_out(pstat_int_new(1,7),1,ierr) ! dWdx
559  call mntr_check_abort(pstat_id,ierr,'Error writing dWdx interp.')
560  call pstat3d_field_out(pstat_int_new(1,8),1,ierr) ! dWdy
561  call mntr_check_abort(pstat_id,ierr,'Error writing dWdy interp.')
562  call pstat3d_field_out(pstat_int_new(1,9),1,ierr) ! dWdz
563  call mntr_check_abort(pstat_id,ierr,'Error writing dWdz interp.')
564  call pstat3d_field_out(pstat_int_pgr(1,1),1,ierr) ! dPdx
565  call mntr_check_abort(pstat_id,ierr,'Error writing dPdx interp.')
566  call pstat3d_field_out(pstat_int_pgr(1,2),1,ierr) ! dPdy
567  call mntr_check_abort(pstat_id,ierr,'Error writing dPdx interp.')
568  call pstat3d_field_out(pstat_int_pgr(1,3),1,ierr) ! dPdz
569  call mntr_check_abort(pstat_id,ierr,'Error writing dPdx interp.')
570 
571  ! master closes the file
572  if (nid.eq.pid00) then
573  call byte_close(ierr)
574  endif
575 
576  call mntr_check_abort(pstat_id,ierr,
577  $ 'Error closing interpolation file in pstat_mfo_interp.')
578 
579 
580  return
581  end subroutine
582 !=======================================================================
588  subroutine pstat3d_field_out(int_field,fldim,ierr)
589  implicit none
590 
591  include 'SIZE'
592  include 'PARALLEL'
593  include 'PSTAT3D'
594 
595  ! global data structures
596  integer mid,mp,nekcomm,nekgroup,nekreal
597  common /nekmpi/ mid,mp,nekcomm,nekgroup,nekreal
598 
599  !argument list
600  integer fldim, ierr
601  real int_field(fldim*lhis)
602 
603  ! local variables
604  integer jl, kl ! loop index
605  integer npass ! number of messages to send for single field
606  integer npts ! number of points for transfer
607  integer itmp ! temporary variables
608  real rtmpv(lhis*ldim), rtmpv1(lhis*ldim), rtmp
609  real*4 rtmpv2(2*lhis*ldim)
610  equivalence(rtmpv1,rtmpv2)
611 
612  integer wdsl ! double size
613 !-----------------------------------------------------------------------
614  ierr = 0
615  wdsl = wdsize/4
616 
617  if (nid.eq.0) then
618  ! first master writes its own data
619  if (wdsl.eq.2) then
620  call copy(rtmpv1,int_field,pstat_npt*fldim)
621  call byte_write(rtmpv2,pstat_npt*fldim*wdsl,ierr)
622  else
623  call copyx4(rtmpv2,int_field,pstat_npt*fldim)
624  call byte_write(rtmpv2,pstat_npt*fldim,ierr)
625  endif
626 
627  ! geather data from slaves
628  npass = min(mp,pstat_nptot)
629  do jl = 1,npass-1
630  npts = pstat_npt
631  if (pstat_npt1.gt.0.and.jl.ge.pstat_npt1) then
632  npts = pstat_npt -1
633  endif
634  call csend(jl,itmp,isize,jl,kl) ! hand shaiking
635  call crecv2(jl,rtmpv,npts*fldim*wdsize,jl)
636 
637  ! write data
638  if (wdsl.eq.2) then
639  call copy(rtmpv1,rtmpv,npts*fldim)
640  call byte_write(rtmpv2,npts*fldim*wdsl,ierr)
641  else
642  call copyx4(rtmpv2,rtmpv,npts*fldim)
643  call byte_write(rtmpv2,npts*fldim,ierr)
644  endif
645  enddo
646  else
647  ! slaves send their data
648  if (pstat_npt.gt.0) then
649  call crecv2(nid,itmp,isize,0) ! hand shaiking
650  call csend(nid,int_field,pstat_npt*fldim*wdsize,0,itmp)
651  endif
652  endif
653 
654  return
655  end subroutine
656 !=======================================================================
byte_reverse8
#define byte_reverse8
Definition: byte.c:34
byte_open
#define byte_open
Definition: byte.c:35
byte_reverse
#define byte_reverse
Definition: byte.c:33
byte_write
#define byte_write
Definition: byte.c:39
byte_close
#define byte_close
Definition: byte.c:36
byte_read
#define byte_read
Definition: byte.c:38
crecv2
subroutine crecv2(mtype, buf, lenm, jnid)
Definition: comm_mpi.f:333
csend
subroutine csend(mtype, buf, len, jnid, jpid)
Definition: comm_mpi.f:303
bcast
subroutine bcast(buf, len)
Definition: comm_mpi.f:431
io_file_freeid
subroutine io_file_freeid(iunit, ierr)
Get free file unit number and store max unit value.
Definition: io_tools.f:47
mntr_logi
subroutine mntr_logi(mid, priority, logs, ivar)
Write log message adding single integer.
Definition: mntrlog.f:709
mntr_check_abort
subroutine mntr_check_abort(mid, ierr, logs)
Abort simulation.
Definition: mntrlog.f:856
pstat3d_mfi_interp
subroutine pstat3d_mfi_interp
Read interpolation points position and redistribute them.
Definition: pstat3D_IO.f:83
pstat3d_mfo_interp
subroutine pstat3d_mfo_interp
Geather data and write it down.
Definition: pstat3D_IO.f:276
pstat3d_field_out
subroutine pstat3d_field_out(int_field, fldim, ierr)
Geather single field data and write it down.
Definition: pstat3D_IO.f:589
pstat3d_mfo
subroutine pstat3d_mfo
Write field data data to the file.
Definition: pstat3D_IO.f:10
copy
subroutine copy(a, b, n)
Definition: math.f:260
blank
subroutine blank(A, N)
Definition: math.f:19
copy4r
subroutine copy4r(a, b, n)
Definition: prepost.f:568
copyx4
subroutine copyx4(a, b, n)
Definition: prepost.f:560
outpost
subroutine outpost(v1, v2, v3, vp, vt, name3)
Definition: prepost.f:1378