69 INTEGER,
PARAMETER ::
hlen = 10000
72 CHARACTER,
PARAMETER ::
sp = achar(32)
73 CHARACTER,
PARAMETER ::
lf = achar(10)
78 CHARACTER(LEN=30),
PARAMETER :: &
84 REAL,
DIMENSION(:,:,:),
POINTER :: val
89 CHARACTER(LEN=MAX_CHAR_LEN) :: key
90 CHARACTER(LEN=1024) :: path
97 CHARACTER(LEN=MAX_CHAR_LEN) :: key
103 TYPE(
output_typ),
DIMENSION(:),
POINTER :: & !< list of output fields
105 TYPE(
tsoutput_typ),
DIMENSION(:),
POINTER :: & !< list of scalar time step output
107 CHARACTER(LEN=1),
DIMENSION(:,:),
POINTER :: &
109 CHARACTER(LEN=512) :: heading
110 CHARACTER(LEN=512) :: tsheading
111 CHARACTER(LEN=512) :: linebuf
112 CHARACTER(LEN=512) :: tslinebuf
113 CHARACTER(LEN=64) :: fmtstr
153 TYPE(
dict_typ),
INTENT(IN),
POINTER :: config
154 TYPE(
dict_typ),
INTENT(IN),
POINTER :: IO
156 TYPE(
output_typ),
DIMENSION(:),
POINTER :: poutput
158 CHARACTER(LEN=MAX_CHAR_LEN),
DIMENSION(4) :: skip
160 REAL,
DIMENSION(:,:,:,:),
POINTER :: dummy4
161 INTEGER :: cartcoords
166 INTEGER,
DIMENSION(Mesh%JMAX-Mesh%JMIN+1,Mesh%KMAX-Mesh%KMIN+1) :: blocklen,indices
169 CALL this%InitFileio(mesh,physics,timedisc,sources,config,io,
"gnuplot",
"dat",textfile=.false.)
171 CALL getattr(config,
"decimals", this%DECS,
default_decs)
176 this%FLEN = this%DECS + 9
177 this%MAXCOLS = len(this%linebuf)/this%FLEN-1
180 ALLOCATE(this%output(this%MAXCOLS),this%tsoutput(this%MAXCOLS),stat=this%err)
182 CALL this%Error(
"fileio_gnuplot::InitFileIO",
"memory allocation failed for this%output, this%tsoutput")
186 CALL getattr(io,
"/timedisc/time",dummy1)
187 IF (
ASSOCIATED(dummy1%p))
THEN
188 this%tsoutput(1)%val => dummy1%p
189 this%tsoutput(1)%key =
"time"
196 IF (this%cartcoords)
THEN
198 CALL getattr(io,
"/mesh/bary_centers",dummy4)
200 ALLOCATE(this%output(1)%p(3),stat=this%err)
203 CALL getattr(io,
"/mesh/bary_curv",dummy4)
206 ALLOCATE(this%output(1)%p(3),stat=this%err)
211 CALL this%Error(
"fileio_gnuplot::InitFileIO",
"memory allocation failed for this%output(1)%p")
215 this%output(1)%p(n)%val => dummy4(:,:,:,n)
217 this%output(1)%key =
'# ' //
'x' // repeat(
' ',this%FLEN-3) //
'y' // repeat(
' ',this%FLEN-1) &
218 //
'z' // repeat(
' ',this%FLEN-1)
239 skip(1:4) = [
CHARACTER(LEN=MAX_CHAR_LEN) ::
"bary_centers",
"bary_curv",
"corners",
"time"]
241 CALL this%GetOutputList(mesh,node,k,this%TSCOLS,skip)
244 poutput => this%output
245 ALLOCATE(this%output,source=poutput(1:k),stat=this%err)
247 CALL this%Error(
"fileio_gnuplot::InitFileIO",
"memory allocation failed for this%output")
252 DO n=1,
SIZE(this%output)
253 this%COLS = this%COLS +
SIZE(this%output(n)%p)
257 this%linelen = this%COLS * this%FLEN
258 IF (this%linelen.GT.len(this%linebuf)) &
259 CALL this%Error(
"fileio_gnuplot::InitFileIO", &
260 "linebuffer to small; reducing decimals or number of output fields may help")
265 n =
SIZE(this%output(1)%p)*this%FLEN
266 this%linebuf(1:n-1) = this%output(1)%key(1:n-1)
268 WRITE(this%fmtstr,
'(A,I2,A1)')
'(A',this%FLEN,
')'
269 DO k=2,
SIZE(this%output)
270 i = index(this%output(k)%key,
"/",back=.true.)
272 WRITE(this%linebuf(n:),trim(this%fmtstr)) this%output(k)%key(i+1:i+this%FLEN-1)
274 DO i=2,
SIZE(this%output(k)%p)
275 WRITE(this%linebuf(n+(i-1)*this%FLEN:),trim(this%fmtstr)) repeat(
' ',this%FLEN)
277 n = n + (i - 1)*this%FLEN
279 this%heading = trim(this%linebuf) //
lf
285 WRITE(this%linebuf(1+(k-1)*this%FLEN:),trim(this%fmtstr)) trim(this%tsoutput(k)%key(1:this%FLEN-1))
287 this%tsheading = repeat(
"#",this%FLEN-1) // trim(this%linebuf(1:)) //
lf
290 this%INUM = mesh%IMAX - mesh%IMIN + 1
291 this%JNUM = mesh%JMAX - mesh%JMIN + 1
292 this%KNUM = mesh%KMAX - mesh%KMIN + 1
295 this%bufsize = this%INUM
299 ALLOCATE(this%outbuf(this%linelen,this%bufsize),stat=this%err)
301 CALL this%Error(
"fileio_gnuplot::InitFileIO_gnuplot",
"memory allocation failed for this%outbuf")
306 blocknum = this%JNUM * this%KNUM
307 blocklen(:,:) = this%bufsize
310 indices(j,k) = ((k+mesh%KMIN-2)*mesh%JNUM + (j+mesh%JMIN-2) )*mesh%INUM + mesh%IMIN - 1
315 SELECT TYPE(df=>this%datafile)
318 CALL mpi_type_contiguous(this%linelen,mpi_character,df%basictype,this%err)
319 IF (this%err.EQ.0)
CALL mpi_type_commit(df%basictype,this%err)
322 IF (this%err.EQ.0)
CALL mpi_type_indexed(blocknum,reshape(blocklen,(/blocknum/)), &
323 reshape(indices,(/blocknum/)),df%basictype,df%filetype,this%err)
324 IF (this%err.EQ.0)
CALL mpi_type_commit(df%filetype,this%err)
327 CALL this%Error(
"fileio_gnuplot::InitFileIO_gnuplot",
"creation of MPI file types failed")
332 WRITE (this%fmtstr,
'(A3,I2,A,I2.2,A5)')
'(ES', this%FLEN-2,
'.', this%DECS,
',A2)'
344 TYPE(
dict_typ),
POINTER :: root,node,subnode
345 CHARACTER(LEN=*) :: string
346 CHARACTER(LEN=*),
OPTIONAL :: prefix
347 CHARACTER(LEN=128) :: buf
351 CHARACTER(LEN=MAX_CHAR_LEN):: cdummy
354 INTENT(INOUT) :: string,k
358 DO WHILE(
ASSOCIATED(node))
361 CALL getattr(node,
getkey(node),idummy)
362 WRITE(buf,
'(A1,A25,I14,A)')
'#',trim(
getkey(node))//
": ",idummy,
linsep
363 WRITE(string(k:),
'(A)')buf
364 k = k + len(trim(buf))
366 CALL getattr(node,
getkey(node),rdummy)
367 WRITE(buf,
'(A1,A25,ES14.4E3,A)')
'#',trim(
getkey(node))//
": ",rdummy,
linsep
368 WRITE(string(k:),
'(A)')buf
369 k = k + len(trim(buf))
371 CALL getattr(node,
getkey(node),cdummy)
372 WRITE(buf,
'(A1,A25,A,A)')
'#',trim(
getkey(node))//
": ",trim(cdummy),
linsep
373 WRITE(string(k:),
'(A)')buf
374 k = k + len(trim(buf))
376 CALL getattr(node,
getkey(node),ldummy)
377 WRITE(buf,
'(A1,A25,L14,A)')
'#',trim(
getkey(node))//
": ",ldummy,
linsep
378 WRITE(string(k:),
'(A)')buf
379 k = k + len(trim(buf))
382 IF (
present(prefix))
THEN
383 WRITE(buf,
'(A)')
'# ['//trim(prefix)//
'/'//trim(
getkey(node))//
']' //
linsep
385 WRITE(buf,
'(A)')
'# ['//trim(
getkey(node))//
']' //
linsep
387 WRITE(string(k:),
'(A)')buf
388 k = k + len(trim(buf))
389 IF (
present(prefix))
THEN
390 buf = trim(prefix)//
'/'//trim(
getkey(node))
411 INTEGER,
INTENT(INOUT) :: oarr
412 INTEGER,
INTENT(INOUT) :: onum
413 CHARACTER(LEN=MAX_CHAR_LEN),
DIMENSION(:),
OPTIONAL,
INTENT(IN) &
415 CHARACTER(LEN=*),
OPTIONAL,
INTENT(INOUT) &
419 CHARACTER(LEN=MAX_CHAR_LEN) :: key
421 REAL,
DIMENSION(:,:),
POINTER :: dummy2
422 REAL,
DIMENSION(:,:,:),
POINTER :: dummy3
423 REAL,
DIMENSION(:,:,:,:),
POINTER :: dummy4
424 REAL,
DIMENSION(:,:,:,:,:),
POINTER :: dummy5
425 INTEGER,
DIMENSION(5) :: dims
429 DO WHILE(
ASSOCIATED(node))
433 IF (
PRESENT(prefix))
THEN
435 key = trim(prefix)//
'/'//trim(
getkey(node))
437 key =
'/'//trim(
getkey(node))
440 IF (
PRESENT(skip))
THEN
447 IF (
PRESENT(skip))
THEN
448 IF (any(skip(:) ==
getkey(node)))
THEN
462 CALL getattr(node,trim(
getkey(node)),dummy3)
463 dims(1:3) = shape(dummy3)
466 CALL getattr(node,trim(
getkey(node)),dummy4)
467 dims(1:4) = shape(dummy4)
470 CALL getattr(node,trim(
getkey(node)),dummy5)
471 dims(1:5) = shape(dummy5)
473 CALL getattr(node,
getkey(node),dummy1)
474 IF (
ASSOCIATED(dummy1%p))
THEN
476 IF (onum.GT.
this%MAXCOLS-1) &
477 CALL this%Error(
"fileio_gnuplot::GetOutputList", &
478 "number of scalar output fields exceeds upper limit")
480 this%tsoutput(onum)%val => dummy1%p
482 IF (
PRESENT(prefix))
THEN
483 this%tsoutput(onum)%key = trim(prefix) //
'/' //
this%tsoutput(onum)%key
487 CALL this%Warning(
"fileio_gnuplot::GetOutputList", &
488 "'" //
getkey(node) //
"'" //
" registered for output," &
489 //
" but data type is currently not supported")
493 IF ((dims(1).EQ.(mesh%IMAX-mesh%IMIN+1)).AND.&
494 (dims(2).EQ.(mesh%JMAX-mesh%JMIN+1)).AND.&
495 (dims(3).EQ.(mesh%KMAX-mesh%KMIN+1)))
THEN
499 n = n +
SIZE(
this%output(m)%p)
502 IF (n+dims(4)*dims(5).GT.
this%MAXCOLS) &
503 CALL this%Error(
"fileio_gnuplot::GetOutputList", &
504 "number of array output fields exceeds upper limit")
510 IF (
PRESENT(prefix))
THEN
511 this%output(oarr)%key = trim(prefix) //
'/' //
this%output(oarr)%key
514 ALLOCATE(
this%output(oarr)%p(dims(4)*dims(5)),stat=
this%err)
516 CALL this%Error(
"fileio_gnuplot::GetOutputList",
"Unable to allocate memory.")
518 IF (dims(4).EQ.1)
THEN
520 this%output(oarr)%p(1)%val => dummy3
521 ELSE IF (dims(5).EQ.1)
THEN
524 this%output(oarr)%p(n)%val => dummy4(:,:,:,n)
530 this%output(oarr)%p(n+(m-1)*dims(5))%val => dummy5(:,:,:,m,n)
550 TYPE(
dict_typ),
POINTER :: Header,IO
555 IF (this%GetRank().EQ.0)
THEN
562 SELECT TYPE(df=>this%datafile)
565 WRITE (unit=df%GetUnitNumber(),iostat=this%err) trim(
header_buf)
569 mpi_character,df%status,this%err)
583 INTENT(OUT) :: success
586 IF (this%GetRank().EQ.0)
THEN
590 CALL this%Warning(
"fileio_gnuplot::ReadHeader",
"reading file header not implemented yet")
604 TYPE(
dict_typ),
POINTER :: Header,IO
605 INTEGER :: i,j,k,m,l,n
607 INTEGER(KIND=MPI_OFFSET_KIND) :: offset
608 INTEGER :: request, status(MPI_STATUS_SIZE)
613 IF (.NOT.
ASSOCIATED(this%output))
RETURN
616 DO l=1,
SIZE(this%output)
617 IF (.NOT.
ASSOCIATED(this%output(l)%p))
THEN
618 CALL this%Error(
"fileio_gnuplot::WriteDataset", &
619 "this should not happen: output data pointer for " &
620 // trim(this%output(l)%key) //
" not associated")
622 DO m=1,
SIZE(this%output(l)%p)
623 IF (.NOT.
ASSOCIATED(this%output(l)%p(m)%val)) &
624 CALL this%Error(
"fileio_gnuplot::WriteDataset", &
625 "this should not happen: one of the data array pointers for " &
626 // trim(this%output(l)%key) //
" not associated")
632 IF (this%GetRank().EQ.0)
THEN
635 WRITE(this%tslinebuf(1+(k-1)*this%FLEN:),trim(this%fmtstr)) this%tsoutput(k)%val
637 this%tslinebuf = repeat(
"#",this%FLEN-1) //
sp // trim(this%tslinebuf) //
lf
640 SELECT TYPE(df=>this%datafile)
643 WRITE (df%GetUnitNumber(),iostat=this%err) trim(this%tsheading) &
644 // trim(this%tslinebuf) // trim(this%heading)
647 CALL mpi_file_write(df%GetUnitNumber(),trim(this%tsheading),len(trim(this%tsheading)), &
648 mpi_character,df%status,this%err)
649 IF (this%err.EQ.0)
CALL mpi_file_write(df%GetUnitNumber(),trim(this%tslinebuf), &
650 len(trim(this%tslinebuf)),mpi_character,df%status,this%err)
651 IF (this%err.EQ.0)
CALL mpi_file_write(df%GetUnitNumber(),trim(this%heading), &
652 len(trim(this%heading)),mpi_character,df%status,this%err)
658 CALL this%Error(
"fileio_gnuplot::WriteDataset",
"writing time step data to file failed")
660 SELECT TYPE(df=>this%datafile)
664 WRITE (df%GetUnitNumber(),iostat=this%err)
lf
668 CALL mpi_barrier(mpi_comm_world,this%err)
670 IF (this%err.EQ.0)
CALL mpi_file_get_size(df%GetUnitNumber(),offset,this%err)
672 IF (this%GetRank().EQ.0)
THEN
673 IF (this%err.EQ.0)
CALL mpi_file_write_at(df%GetUnitNumber(), offset,
lf, 1, &
674 mpi_character, df%status, this%err)
680 CALL this%Error(
"fileio_gnuplot::WriteDataset",
"writing preceeding line feed to file failed")
683 SELECT TYPE(df=>this%datafile)
688 IF (this%err.EQ.0)
CALL mpi_file_set_view(df%GetUnitNumber(),offset,df%basictype,df%filetype, &
689 'native',mpi_info_null,this%err)
693 CALL this%Error(
"fileio_gnuplot::WriteDataset",
"creating MPI file view failed")
697 DO l=1,
SIZE(this%output)
698 DO m=1,
SIZE(this%output(l)%p)
699 WHERE (abs(this%output(l)%p(m)%val(:,:,:)).LT.max(tiny(this%output(l)%p(m)%val),1.0d-99))
700 this%output(l)%p(m)%val(:,:,:) = 0.0e+00
708 DO k=mesh%KMIN,mesh%KMAX
709 DO j=mesh%JMIN,mesh%JMAX
710 DO i=mesh%IMIN,mesh%IMAX
713 DO l=1,
SIZE(this%output)
714 DO m=1,
SIZE(this%output(l)%p)
716 WRITE (this%linebuf((n-1)*this%FLEN+1:n*this%FLEN),trim(this%fmtstr)) &
717 this%output(l)%p(m)%val(i-mesh%IMIN+1,j-mesh%JMIN+1,k-mesh%KMIN+1),
recsep
722 IF (mesh%INUM.GT.1)
THEN
723 IF (i.EQ.mesh%INUM)
THEN
725 this%linebuf(this%linelen-1:this%linelen) =
blksep
728 this%linebuf(this%linelen-1:this%linelen) =
linsep
730 ELSE IF (mesh%JNUM.GT.1)
THEN
731 IF (j.EQ.mesh%JNUM)
THEN
733 this%linebuf(this%linelen-1:this%linelen) =
blksep
736 this%linebuf(this%linelen-1:this%linelen) =
linsep
739 IF (k.EQ.mesh%KNUM)
THEN
741 this%linebuf(this%linelen-1:this%linelen) =
blksep
744 this%linebuf(this%linelen-1:this%linelen) =
linsep
749 this%outbuf(:,i-mesh%IMIN+1) = transfer(this%linebuf,this%outbuf(:,1),size=this%linelen)
753 SELECT TYPE(df=>this%datafile)
758 WRITE (df%GetUnitNumber(),iostat=this%err) this%outbuf
763 IF (this%err.EQ.0)
CALL mpi_file_write_all(df%GetUnitNumber(),this%outbuf, &
764 this%bufsize,df%basictype,status,this%err)
777 CALL this%Error(
"fileio_gnuplot::WriteDataset",
"creating MPI file view failed")
803 CHARACTER(LEN=*),
INTENT(IN) :: modproc
804 CHARACTER(LEN=*),
INTENT(IN) :: msg
806 IF (this%Initialized()) &
807 CALL this%datafile%CloseFile(this%step)
808 CALL this%Error(modproc,msg)
820 IF (
ASSOCIATED(this%outbuf))
DEALLOCATE(this%outbuf)
821 IF (
ASSOCIATED(this%output))
THEN
822 DO k=1,
SIZE(this%output)
823 IF (
ASSOCIATED(this%output(k)%p))
DEALLOCATE(this%output(k)%p)
825 DEALLOCATE(this%output)
827 IF (
ASSOCIATED(this%tsoutput))
DEALLOCATE(this%tsoutput)
829 NULLIFY(this%outbuf,this%output,this%tsoutput)
831 CALL this%Finalize_base()
Dictionary for generic data types.
integer, parameter, public dict_real
logical function, public haschild(root)
Check if the node 'root' has one or more children.
integer, parameter, public dict_real_fourd
logical function, public hasdata(root)
Checks if the node 'root' has data associated.
integer, parameter, public dict_real_threed
integer function, public getdatatype(root)
Return the datatype of node 'root'.
function, public getkey(root)
Get the key of pointer 'root'.
integer, parameter, public dict_real_fived
integer, parameter, public dict_real_p
type(dict_typ) function, pointer, public getnext(root)
Get the pointer to the next child.
type(logging_base), save this
integer, parameter, public dict_int
type(dict_typ) function, pointer, public getchild(root)
Get the pointer to a direct child of the pointer 'root'.
integer, parameter, public dict_char
integer, parameter, public dict_bool
I/O for GNUPLOT readable tabular files.
character(len=2), parameter linsep
line separator
recursive subroutine getheaderstring(string, root, k, prefix)
Creates a string with the configuration (from the dictionary)
subroutine finalize(this)
Closes the file I/O.
character(len=2), parameter blksep
block separator
subroutine error(this, modproc, msg)
Closes the file I/O and calls a further error function.
subroutine initfileio_gnuplot(this, Mesh, Physics, Timedisc, Sources, config, IO)
Constructor for the GNUPLOT file I/O.
integer, parameter default_decs
default decimal places
recursive subroutine getoutputlist(this, Mesh, node, oarr, onum, skip, prefix)
Creates a list of all data arrays which will be written to file.
character, parameter sp
space
subroutine writedataset_gnuplot(this, Mesh, Physics, Fluxes, Timedisc, Header, IO)
Writes all desired data arrays to a file.
subroutine writeheader(this, Mesh, Physics, Header, IO)
Writes the configuration as a header to the file.
subroutine readheader(this, success)
Reads the header (not implemented)
character(len=2), parameter recsep
data record separator
integer, parameter hlen
header length in bytes
character(len=30), parameter header_string
the header string
character(len=hlen) header_buf
buffer of header
character, parameter lf
line feed
base module for numerical flux functions
base class for geometrical properties
module to manage list of source terms
class for Fortran file handle
class for MPI file handle
output-pointer for time step scalar data
output-pointer for 3D array data
container class to manage the list of source terms