fileio_gnuplot.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: fileio_gnuplot.f90 #
5!# #
6!# Copyright (C) 2008-2024 #
7!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
8!# Björn Sperling <sperling@astrophysik.uni-kiel.de> #
9!# Jannes Klee <jklee@astrophysik.uni-kiel.de> #
10!# #
11!# This program is free software; you can redistribute it and/or modify #
12!# it under the terms of the GNU General Public License as published by #
13!# the Free Software Foundation; either version 2 of the License, or (at #
14!# your option) any later version. #
15!# #
16!# This program is distributed in the hope that it will be useful, but #
17!# WITHOUT ANY WARRANTY; without even the implied warranty of #
18!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
19!# NON INFRINGEMENT. See the GNU General Public License for more #
20!# details. #
21!# #
22!# You should have received a copy of the GNU General Public License #
23!# along with this program; if not, write to the Free Software #
24!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
25!# #
26!#############################################################################
30!----------------------------------------------------------------------------!
43!----------------------------------------------------------------------------!
52 USE common_dict
53#ifdef PARALLEL
54#ifdef HAVE_MPI_MOD
55 USE mpi
56#endif
57#endif
58 IMPLICIT NONE
59#ifdef PARALLEL
60#ifdef HAVE_MPIF_H
61 include 'mpif.h'
62#endif
63#endif
64 !--------------------------------------------------------------------------!
65 PRIVATE
66 ! Private Attributes section starts here:
69 INTEGER, PARAMETER :: hlen = 10000
70 INTEGER, PARAMETER :: default_decs = 5
72 CHARACTER, PARAMETER :: sp = achar(32)
73 CHARACTER, PARAMETER :: lf = achar(10)
74 CHARACTER(LEN=2), PARAMETER :: recsep = sp // sp
75 CHARACTER(LEN=2), PARAMETER :: linsep = sp // lf
76 CHARACTER(LEN=2), PARAMETER :: blksep = lf // lf
78 CHARACTER(LEN=30), PARAMETER :: &
79 header_string = "# Data output of fosite" // linsep
80 CHARACTER(LEN=HLEN) :: header_buf
81 !--------------------------------------------------------------------------!
84 REAL, DIMENSION(:,:,:), POINTER :: val
85 END TYPE
86
88 TYPE(valptr_typ), DIMENSION(:), POINTER :: p
89 CHARACTER(LEN=MAX_CHAR_LEN) :: key
90 CHARACTER(LEN=1024) :: path
91 INTEGER :: numbytes
92 END TYPE output_typ
93
96 REAL, POINTER :: val
97 CHARACTER(LEN=MAX_CHAR_LEN) :: key
98 END TYPE tsoutput_typ
99
101 TYPE, EXTENDS(fileio_base) :: fileio_gnuplot
103 TYPE(output_typ),DIMENSION(:), POINTER :: & !< list of output fields
104 output => null()
105 TYPE(tsoutput_typ),DIMENSION(:), POINTER :: & !< list of scalar time step output
106 tsoutput => null()
107 CHARACTER(LEN=1), DIMENSION(:,:), POINTER :: &
108 outbuf => null()
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
114 INTEGER :: cols
115 INTEGER :: tscols
116 INTEGER :: maxcols
118 INTEGER :: decs
119 INTEGER :: flen
120 INTEGER :: linelen
121 INTEGER :: tslinelen
122 CONTAINS
124 PROCEDURE :: initfileio_deferred => initfileio_gnuplot
125 PROCEDURE :: writeheader
126 PROCEDURE :: readheader
127 PROCEDURE :: writedataset_deferred => writedataset_gnuplot
128! PROCEDURE :: ReadDataset
129 PROCEDURE :: getoutputlist
130 final :: finalize
131 END TYPE
132
133 !--------------------------------------------------------------------------!
134 PUBLIC :: &
135 ! types
137 !--------------------------------------------------------------------------!
138
139CONTAINS
140
145 SUBROUTINE initfileio_gnuplot(this,Mesh,Physics,Timedisc,Sources,config,IO)
146 IMPLICIT NONE
147 !------------------------------------------------------------------------!
148 CLASS(fileio_gnuplot),INTENT(INOUT) :: this
149 CLASS(mesh_base), INTENT(IN) :: Mesh
150 CLASS(physics_base), INTENT(IN) :: Physics
151 CLASS(timedisc_base),INTENT(IN) :: Timedisc
152 CLASS(sources_list), ALLOCATABLE, INTENT(IN) :: Sources
153 TYPE(dict_typ), INTENT(IN), POINTER :: config
154 TYPE(dict_typ), INTENT(IN), POINTER :: IO
155 !------------------------------------------------------------------------!
156 TYPE(output_typ),DIMENSION(:),POINTER :: poutput
157 TYPE(dict_typ), POINTER :: node
158 CHARACTER(LEN=MAX_CHAR_LEN),DIMENSION(4) :: skip
159 TYPE(real_t) :: dummy1
160 REAL, DIMENSION(:,:,:,:), POINTER :: dummy4
161 INTEGER :: cartcoords
162 INTEGER :: depth
163 INTEGER :: i,j,k,n
164#ifdef PARALLEL
165 INTEGER :: blocknum
166 INTEGER, DIMENSION(Mesh%JMAX-Mesh%JMIN+1,Mesh%KMAX-Mesh%KMIN+1) :: blocklen,indices
167#endif
168 !------------------------------------------------------------------------!
169 CALL this%InitFileio(mesh,physics,timedisc,sources,config,io,"gnuplot","dat",textfile=.false.)
170
171 CALL getattr(config, "decimals", this%DECS, default_decs)
172 ! compute length of character field for real number output
173 ! and check if linebuffer is large enough
174 ! flen = 1 (sign) + 1 (one digit) + 1 (decimal point) + decs (decimal places)
175 ! + 1 (E character) + 1 (sign of exponent) + 2 (exponent digits) + 2 (spaces)
176 this%FLEN = this%DECS + 9
177 this%MAXCOLS = len(this%linebuf)/this%FLEN-1
178
179 ! this is for registering all arrays which are supposed to be written to the output file
180 ALLOCATE(this%output(this%MAXCOLS),this%tsoutput(this%MAXCOLS),stat=this%err)
181 IF (this%err.NE.0) &
182 CALL this%Error("fileio_gnuplot::InitFileIO","memory allocation failed for this%output, this%tsoutput")
183
184 ! get pointer to simulation time to make it the first entry
185 ! in the time step data set
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"
190 this%TSCOLS = 1
191 ELSE
192 this%TSCOLS = 0
193 END IF
194
195 ! check if cartesian coordinates are selected for output
196 IF (this%cartcoords) THEN
197 ! output cartesian coordinates
198 CALL getattr(io,"/mesh/bary_centers",dummy4)
199 ! requires 3 pointers, one for each cartesian coordinate
200 ALLOCATE(this%output(1)%p(3),stat=this%err)
201 ELSE
202 ! output curvilinear coordinates
203 CALL getattr(io,"/mesh/bary_curv",dummy4)
204 ! requires NDIMS pointers, one for each curvilinear coordinate, depending on the
205 ! dimensionality of the mesh
206 ALLOCATE(this%output(1)%p(3),stat=this%err)
207 !!!!! only output necessary curvilinear coordinates; needs some addional checks below
208! ALLOCATE(this%output(1)%p(Mesh%NDIMS),STAT=this%err)
209 END IF
210 IF (this%err.NE.0) &
211 CALL this%Error("fileio_gnuplot::InitFileIO","memory allocation failed for this%output(1)%p")
212
213 ! register coordinate array pointers for output
214 DO n=1,3
215 this%output(1)%p(n)%val => dummy4(:,:,:,n)
216 END DO
217 this%output(1)%key = '# ' // 'x' // repeat(' ',this%FLEN-3) // 'y' // repeat(' ',this%FLEN-1) &
218 // 'z' // repeat(' ',this%FLEN-1)
219
220 !!!!!! ATTENTION old code suppresses coordinate output in 1D/2D simulations
221 !!!!!! if the coordinate does not vary along a specific dimension
222! IF (Mesh%INUM.EQ.1) THEN
223! ! use format string as temp
224! WRITE (this%fmtstr,'(A5,I2,A1)')'(A1,A',this%FLEN-3,')'
225! WRITE(this%linebuf,TRIM(this%fmtstr))'#','y'
226! this%COLS = 1
227! ELSE IF (Mesh%JNUM.EQ.1) THEN
228! WRITE (this%fmtstr,'(A5,I2,A1)')'(A1,A',this%FLEN-3,')'
229! WRITE(this%linebuf,TRIM(this%fmtstr))'#','x'
230! this%COLS = 1
231! ELSE
232! WRITE (this%fmtstr,'(A5,I2,A2,I2,A1)')'(A1,A',this%FLEN-3,',A',this%FLEN-1,')'
233! WRITE(this%linebuf,TRIM(this%fmtstr))'#','x','y'
234! this%COLS = 2
235! END IF
236
237 ! register scalars and arrays for output
238 node => io
239 skip(1:4) = [CHARACTER(LEN=MAX_CHAR_LEN) :: "bary_centers", "bary_curv", "corners", "time"]
240 k = 1
241 CALL this%GetOutputList(mesh,node,k,this%TSCOLS,skip)
242
243 ! shrink this%output
244 poutput => this%output
245 ALLOCATE(this%output,source=poutput(1:k),stat=this%err)
246 IF (this%err.NE.0) &
247 CALL this%Error("fileio_gnuplot::InitFileIO","memory allocation failed for this%output")
248 DEALLOCATE(poutput)
249
250 ! count number of output columns for array data
251 this%COLS = 0
252 DO n=1,SIZE(this%output)
253 this%COLS = this%COLS + SIZE(this%output(n)%p)
254 END DO
255
256 ! length of one output line
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")
261
262 ! create heading for field data
263 this%linebuf = ""
264 ! copy heading for coordinates first
265 n = SIZE(this%output(1)%p)*this%FLEN
266 this%linebuf(1:n-1) = this%output(1)%key(1:n-1)
267 ! format string for writing one string of width FLEN
268 WRITE(this%fmtstr,'(A,I2,A1)') '(A',this%FLEN,')'
269 DO k=2,SIZE(this%output) ! skip entry for coordinates, i.e. this%output(1)
270 i = index(this%output(k)%key,"/",back=.true.) ! find last occurance of slash in key
271 ! write key (without leading path)
272 WRITE(this%linebuf(n:),trim(this%fmtstr)) this%output(k)%key(i+1:i+this%FLEN-1)
273 ! append spaces
274 DO i=2,SIZE(this%output(k)%p)
275 WRITE(this%linebuf(n+(i-1)*this%FLEN:),trim(this%fmtstr)) repeat(' ',this%FLEN)
276 END DO
277 n = n + (i - 1)*this%FLEN
278 END DO
279 this%heading = trim(this%linebuf) // lf
280
281 ! create heading for time step data
282 ! prepend hash -> comment line in GNUPLOT
283 this%linebuf = ""
284 DO k=1,this%TSCOLS
285 WRITE(this%linebuf(1+(k-1)*this%FLEN:),trim(this%fmtstr)) trim(this%tsoutput(k)%key(1:this%FLEN-1))
286 END DO
287 this%tsheading = repeat("#",this%FLEN-1) // trim(this%linebuf(1:)) // lf
288
289 ! local domain size
290 this%INUM = mesh%IMAX - mesh%IMIN + 1
291 this%JNUM = mesh%JMAX - mesh%JMIN + 1
292 this%KNUM = mesh%KMAX - mesh%KMIN + 1
293
294 ! size of the output buffer (on this process)
295 this%bufsize = this%INUM
296
297 ! allocate memory for output buffer and displacement records
298 this%err = 0
299 ALLOCATE(this%outbuf(this%linelen,this%bufsize),stat=this%err)
300 IF (this%err.NE.0) &
301 CALL this%Error("fileio_gnuplot::InitFileIO_gnuplot","memory allocation failed for this%outbuf")
302
303#ifdef PARALLEL
304 ! number of output blocks (on this process)
305 ! = number of cells (excluding ghost cells)
306 blocknum = this%JNUM * this%KNUM
307 blocklen(:,:) = this%bufsize
308 DO k=1,this%KNUM
309 DO j=1,this%JNUM
310 indices(j,k) = ((k+mesh%KMIN-2)*mesh%JNUM + (j+mesh%JMIN-2) )*mesh%INUM + mesh%IMIN - 1
311 END DO
312 END DO
313
314 ! create new MPI data types
315 SELECT TYPE(df=>this%datafile)
316 CLASS IS(filehandle_mpi)
317 ! basic type is one output line corresponding to one data point (coordinates + data)
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)
320
321 ! file type for blocknum indexed blocks of basic type
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)
325 END SELECT
326 IF (this%err.NE.0) &
327 CALL this%Error("fileio_gnuplot::InitFileIO_gnuplot","creation of MPI file types failed")
328
329#endif
330 ! write the format string for one entry in the data file:
331 ! FLEN-2 characters for the number and 2 for the separators
332 WRITE (this%fmtstr,'(A3,I2,A,I2.2,A5)') '(ES', this%FLEN-2, '.', this%DECS,',A2)'
333
334 ! print some information
335 ! ...
336 END SUBROUTINE initfileio_gnuplot
337
338
341 RECURSIVE SUBROUTINE getheaderstring(string,root,k,prefix)
342 IMPLICIT NONE
343 !------------------------------------------------------------------------!
344 TYPE(dict_typ), POINTER :: root,node,subnode
345 CHARACTER(LEN=*) :: string
346 CHARACTER(LEN=*), OPTIONAL :: prefix
347 CHARACTER(LEN=128) :: buf
348 !------------------------------------------------------------------------!
349 INTEGER :: idummy, k
350 LOGICAL :: ldummy
351 CHARACTER(LEN=MAX_CHAR_LEN):: cdummy
352 REAL :: rdummy
353 !------------------------------------------------------------------------!
354 INTENT(INOUT) :: string,k
355 !------------------------------------------------------------------------!
356
357 node => root
358 DO WHILE(ASSOCIATED(node))
359 SELECT CASE(getdatatype(node))
360 CASE(dict_int)
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))
365 CASE(dict_real)
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))
370 CASE(dict_char)
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))
375 CASE(dict_bool)
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))
380 END SELECT
381 IF(haschild(node)) THEN
382 IF (present(prefix)) THEN
383 WRITE(buf,'(A)')'# ['//trim(prefix)//'/'//trim(getkey(node))//']' // linsep
384 ELSE
385 WRITE(buf,'(A)')'# ['//trim(getkey(node))//']' // linsep
386 END IF
387 WRITE(string(k:),'(A)')buf
388 k = k + len(trim(buf))
389 IF (present(prefix)) THEN
390 buf = trim(prefix)//'/'//trim(getkey(node))
391 ELSE
392 buf = trim(getkey(node))
393 END IF
394 subnode => getchild(node)
395 CALL getheaderstring(string,subnode,k,trim(buf))
396 END IF
397 node => getnext(node)
398 END DO
399 END SUBROUTINE getheaderstring
400
405 RECURSIVE SUBROUTINE getoutputlist(this,Mesh,node,oarr,onum,skip,prefix)
406 IMPLICIT NONE
407 !------------------------------------------------------------------------!
408 CLASS(fileio_gnuplot), INTENT(INOUT) :: this
409 CLASS(mesh_base), INTENT(IN) :: mesh
410 TYPE(dict_typ), POINTER :: node
411 INTEGER, INTENT(INOUT) :: oarr
412 INTEGER, INTENT(INOUT) :: onum
413 CHARACTER(LEN=MAX_CHAR_LEN), DIMENSION(:), OPTIONAL, INTENT(IN) &
414 :: skip
415 CHARACTER(LEN=*), OPTIONAL, INTENT(INOUT) &
416 :: prefix
417 !------------------------------------------------------------------------!
418 TYPE(dict_typ), POINTER :: dir
419 CHARACTER(LEN=MAX_CHAR_LEN) :: key
420 TYPE(real_t) :: dummy1
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
426 INTEGER :: m,n
427 !------------------------------------------------------------------------!
428 ! reset error code
429 DO WHILE(ASSOCIATED(node))
430 ! check if node is directory
431 IF(haschild(node)) THEN
432 ! recursion
433 IF (PRESENT(prefix)) THEN
434 ! add prefix to key
435 key = trim(prefix)//'/'//trim(getkey(node))
436 ELSE
437 key = '/'//trim(getkey(node))
438 END IF
439 dir => getchild(node)
440 IF (PRESENT(skip)) THEN
441 CALL getoutputlist(this,mesh,dir,oarr,onum,skip,key)
442 ELSE
443 CALL getoutputlist(this,mesh,dir,oarr,onum,prefix=key)
444 END IF
445 ELSE IF (hasdata(node)) THEN
446 ! node contains data
447 IF (PRESENT(skip)) THEN
448 IF (any(skip(:) == getkey(node))) THEN
449 ! skip entry and continue with next node
450 node=>getnext(node)
451 cycle
452 END IF
453 END IF
454 ! check shape of data
455 dims = 0
456 SELECT CASE(getdatatype(node))
457! CASE(DICT_REAL_TWOD)
458! CALL GetAttr(node,TRIM(GetKey(node)),dummy2)
459! dims(1:2) = SHAPE(dummy2)
460! dims(3:5) = 1
461 CASE(dict_real_threed)
462 CALL getattr(node,trim(getkey(node)),dummy3)
463 dims(1:3) = shape(dummy3)
464 dims(4:5) = 1
465 CASE(dict_real_fourd)
466 CALL getattr(node,trim(getkey(node)),dummy4)
467 dims(1:4) = shape(dummy4)
468 dims(5) = 1
469 CASE(dict_real_fived)
470 CALL getattr(node,trim(getkey(node)),dummy5)
471 dims(1:5) = shape(dummy5)
472 CASE(dict_real_p)
473 CALL getattr(node,getkey(node),dummy1)
474 IF (ASSOCIATED(dummy1%p)) THEN
475 onum=onum+1
476 IF (onum.GT.this%MAXCOLS-1) &
477 CALL this%Error("fileio_gnuplot::GetOutputList", &
478 "number of scalar output fields exceeds upper limit")
479 ! register number data for output
480 this%tsoutput(onum)%val => dummy1%p
481 this%tsoutput(onum)%key = trim(getkey(node))
482 IF (PRESENT(prefix)) THEN
483 this%tsoutput(onum)%key = trim(prefix) // '/' // this%tsoutput(onum)%key
484 END IF
485 END IF
486 CASE DEFAULT
487 CALL this%Warning("fileio_gnuplot::GetOutputList", &
488 "'" // getkey(node) // "'" // " registered for output," &
489 // " but data type is currently not supported")
490 END SELECT
491 ! only register array data for output if it contains
492 ! mesh data
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
496 ! count number of output columns currently registered
497 n=0
498 DO m=1,oarr
499 n = n + SIZE(this%output(m)%p)
500 END DO
501 ! check limit for output of array data
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")
505 ! increase array output index
506 oarr = oarr + 1
507 ! store name of the output array
508 this%output(oarr)%key = trim(getkey(node))
509 ! prepend prefix if present
510 IF (PRESENT(prefix)) THEN
511 this%output(oarr)%key = trim(prefix) // '/' // this%output(oarr)%key
512 END IF
513 ! allocate memory for pointer to output arrays
514 ALLOCATE(this%output(oarr)%p(dims(4)*dims(5)),stat=this%err)
515 IF (this%err.NE.0) &
516 CALL this%Error( "fileio_gnuplot::GetOutputList", "Unable to allocate memory.")
517 ! set pointer to output arrays
518 IF (dims(4).EQ.1) THEN
519 ! 3D data
520 this%output(oarr)%p(1)%val => dummy3
521 ELSE IF (dims(5).EQ.1) THEN
522 ! 4D data (for example pvars - density,xvel,yvel)
523 DO n=1,dims(4)
524 this%output(oarr)%p(n)%val => dummy4(:,:,:,n)
525 END DO
526 ELSE
527 ! 5D data, e.g., stress tensor components
528 DO n=1,dims(5)
529 DO m=1,dims(4)
530 this%output(oarr)%p(n+(m-1)*dims(5))%val => dummy5(:,:,:,m,n)
531 END DO
532 END DO
533 END IF
534 END IF
535
536 END IF
537 node=>getnext(node)
538 END DO
539 END SUBROUTINE getoutputlist
540
541
544 SUBROUTINE writeheader(this,Mesh,Physics,Header,IO)
545 IMPLICIT NONE
546 !------------------------------------------------------------------------!
547 CLASS(fileio_gnuplot), INTENT(INOUT) :: this
548 CLASS(mesh_base), INTENT(IN) :: Mesh
549 CLASS(physics_base), INTENT(IN) :: Physics
550 TYPE(dict_typ), POINTER :: Header,IO
551 !------------------------------------------------------------------------!
552 TYPE(dict_typ), POINTER :: node
553 INTEGER :: depth
554 !------------------------------------------------------------------------!
555 IF (this%GetRank().EQ.0) THEN
556 ! get settings from config dictionary and store in header_buf
557 depth = 1
558 node => header
559 CALL getheaderstring(header_buf,node,depth)
560 header_buf = trim(header_string) // trim(header_buf)
561
562 SELECT TYPE(df=>this%datafile)
563#ifndef PARALLEL
564 CLASS IS(filehandle_fortran)
565 WRITE (unit=df%GetUnitNumber(),iostat=this%err) trim(header_buf) !(1:HLEN-1)
566#else
567 CLASS IS(filehandle_mpi)
568 CALL mpi_file_write(df%GetUnitNumber(),trim(header_buf),len(trim(header_buf)), &
569 mpi_character,df%status,this%err)
570#endif
571 END SELECT
572 END IF
573 END SUBROUTINE writeheader
574
577 SUBROUTINE readheader(this,success)
578 IMPLICIT NONE
579 !------------------------------------------------------------------------!
580 CLASS(fileio_gnuplot) :: this
581 LOGICAL :: success
582 !------------------------------------------------------------------------!
583 INTENT(OUT) :: success
584 !------------------------------------------------------------------------!
585#ifdef PARALLEL
586 IF (this%GetRank().EQ.0) THEN
587 END IF
588#else
589#endif
590 CALL this%Warning("fileio_gnuplot::ReadHeader","reading file header not implemented yet")
591 success = .false.
592 END SUBROUTINE readheader
593
596 SUBROUTINE writedataset_gnuplot(this,Mesh,Physics,Fluxes,Timedisc,Header,IO)
597 IMPLICIT NONE
598 !------------------------------------------------------------------------!
599 CLASS(fileio_gnuplot), INTENT(INOUT) :: this
600 CLASS(mesh_base), INTENT(IN) :: Mesh
601 CLASS(physics_base), INTENT(INOUT) :: Physics
602 CLASS(fluxes_base), INTENT(IN) :: Fluxes
603 CLASS(timedisc_base), INTENT(IN) :: Timedisc
604 TYPE(dict_typ), POINTER :: Header,IO
605 INTEGER :: i,j,k,m,l,n
606#ifdef PARALLEL
607 INTEGER(KIND=MPI_OFFSET_KIND) :: offset
608 INTEGER :: request, status(MPI_STATUS_SIZE)
609#endif
610 !------------------------------------------------------------------------!
611 ! some sanity checks:
612 ! 1. no output data
613 IF (.NOT.ASSOCIATED(this%output)) RETURN
614
615 ! 2. uninitilized output data structure
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")
621 ELSE
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")
627 END DO
628 END IF
629 END DO
630
631 this%err = 0
632 IF (this%GetRank().EQ.0) THEN
633 ! generate string with time step data
634 DO k=1,this%TSCOLS
635 WRITE(this%tslinebuf(1+(k-1)*this%FLEN:),trim(this%fmtstr)) this%tsoutput(k)%val
636 END DO
637 this%tslinebuf = repeat("#",this%FLEN-1) // sp // trim(this%tslinebuf) // lf
638
639 ! write time step data to file
640 SELECT TYPE(df=>this%datafile)
641#ifndef PARALLEL
642 CLASS IS(filehandle_fortran)
643 WRITE (df%GetUnitNumber(),iostat=this%err) trim(this%tsheading) &
644 // trim(this%tslinebuf) // trim(this%heading)
645#else
646 CLASS IS(filehandle_mpi)
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)
653#endif
654 END SELECT
655 END IF
656
657 IF (this%err.NE.0) &
658 CALL this%Error("fileio_gnuplot::WriteDataset","writing time step data to file failed")
659
660 SELECT TYPE(df=>this%datafile)
661#ifndef PARALLEL
662 CLASS IS(filehandle_fortran)
663 ! write _one_ line feed at the beginning of each time step
664 WRITE (df%GetUnitNumber(),iostat=this%err) lf
665#else
666 CLASS IS(filehandle_mpi)
667 ! very important: wait for the header write command to finish
668 CALL mpi_barrier(mpi_comm_world,this%err)
669 ! be sure to write at the end, i.e. after the time step data, by getting the offset from the file's size
670 IF (this%err.EQ.0) CALL mpi_file_get_size(df%GetUnitNumber(),offset,this%err)
671 ! write _one_ line feed at the beginning of each time step
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)
675 END IF
676#endif
677 END SELECT
678
679 IF (this%err.NE.0) &
680 CALL this%Error("fileio_gnuplot::WriteDataset","writing preceeding line feed to file failed")
681
682#ifdef PARALLEL
683 SELECT TYPE(df=>this%datafile)
684 CLASS IS(filehandle_mpi)
685 ! add the initial line feed and the general offset (depends on Mesh%IMIN)
686 offset = offset + 1
687 ! create the file view
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)
690 END SELECT
691
692 IF (this%err.NE.0) &
693 CALL this%Error("fileio_gnuplot::WriteDataset","creating MPI file view failed")
694#endif
695
696 ! trim the floating point values for gnuplot output, i.e. set small numbers to 0
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
701 END WHERE
702 END DO
703 END DO
704
705 ! write array data to file
706 ! do not use Mesh%IMIN/MAX etc., because the indices of this%output()%p()%val start at 1
707 this%err = 0
708 DO k=mesh%KMIN,mesh%KMAX
709 DO j=mesh%JMIN,mesh%JMAX
710 DO i=mesh%IMIN,mesh%IMAX
711 ! write array data to line buffer
712 n = 1
713 DO l=1,SIZE(this%output)
714 DO m=1,SIZE(this%output(l)%p)
715 ! fill output line buffer with data
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
718 n = n + 1
719 END DO
720 END DO
721
722 IF (mesh%INUM.GT.1) THEN
723 IF (i.EQ.mesh%INUM) THEN
724 ! finish the block
725 this%linebuf(this%linelen-1:this%linelen) = blksep
726 ELSE
727 ! finish the line
728 this%linebuf(this%linelen-1:this%linelen) = linsep
729 END IF
730 ELSE IF (mesh%JNUM.GT.1) THEN
731 IF (j.EQ.mesh%JNUM) THEN
732 ! finish the block
733 this%linebuf(this%linelen-1:this%linelen) = blksep
734 ELSE
735 ! finish the line
736 this%linebuf(this%linelen-1:this%linelen) = linsep
737 END IF
738 ELSE
739 IF (k.EQ.mesh%KNUM) THEN
740 ! finish the block
741 this%linebuf(this%linelen-1:this%linelen) = blksep
742 ELSE
743 ! finish the line
744 this%linebuf(this%linelen-1:this%linelen) = linsep
745 END IF
746 END IF
747
748 ! write line buffer to output buffer
749 this%outbuf(:,i-mesh%IMIN+1) = transfer(this%linebuf,this%outbuf(:,1),size=this%linelen)
750 END DO ! i-loop
751
752 ! write output buffer to file
753 SELECT TYPE(df=>this%datafile)
754#ifndef PARALLEL
755 CLASS IS(filehandle_fortran)
756 ! write line buffer to file
757 IF (this%err.EQ.0) &
758 WRITE (df%GetUnitNumber(),iostat=this%err) this%outbuf
759#else
760 CLASS IS(filehandle_mpi)
761 !*****************************************************************!
762 ! This collective call didn't work for pvfs2 -> bug in ROMIO ?
763 IF (this%err.EQ.0) CALL mpi_file_write_all(df%GetUnitNumber(),this%outbuf, &
764 this%bufsize,df%basictype,status,this%err)
765 !*****************************************************************!
766 ! If the collective call above fails try this:
767! IF (this%err.EQ.0) CALL MPI_File_iwrite(df%GetUnitNumber(),this%outbuf, &
768! this%bufsize,df%basictype,request,this%err)
769! IF (this%err.EQ.0) CALL MPI_Wait(request,df%status,this%err)
770#endif
771 END SELECT
772
773 END DO ! j-loop
774 END DO ! k-loop
775
776 IF (this%err.NE.0) &
777 CALL this%Error("fileio_gnuplot::WriteDataset","creating MPI file view failed")
778
779 END SUBROUTINE writedataset_gnuplot
780
781! !> \public Reads the data arrays from file (not yet implemented)
782! !!
783! SUBROUTINE ReadDataset(this,Mesh,Physics,Timedisc)
784! IMPLICIT NONE
785! !------------------------------------------------------------------------!
786! CLASS(fileio_gnuplot) :: this !< \param [in,out] this fileio type
787! CLASS(mesh_base) :: Mesh !< \param [in] mesh mesh type
788! CLASS(physics_base) :: Physics !< \param [in] physics physics type
789! CLASS(timedisc_base) :: Timedisc !< \param [in] timedisc timedisc type
790! !------------------------------------------------------------------------!
791! INTENT(IN) :: Mesh,Physics,Timedisc
792! INTENT(INOUT) :: this
793! !------------------------------------------------------------------------!
794! END SUBROUTINE ReadDataset
795
796
799 SUBROUTINE error(this,modproc,msg)
800 IMPLICIT NONE
801 !------------------------------------------------------------------------!
802 CLASS(fileio_gnuplot), INTENT(INOUT) :: this
803 CHARACTER(LEN=*), INTENT(IN) :: modproc
804 CHARACTER(LEN=*), INTENT(IN) :: msg
805 !------------------------------------------------------------------------!
806 IF (this%Initialized()) &
807 CALL this%datafile%CloseFile(this%step)
808 CALL this%Error(modproc,msg)
809 END SUBROUTINE error
810
813 SUBROUTINE finalize(this)
814 IMPLICIT NONE
815 !------------------------------------------------------------------------!
816 TYPE(fileio_gnuplot),INTENT(INOUT) :: this
817 !------------------------------------------------------------------------!
818 INTEGER :: k
819 !------------------------------------------------------------------------!
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)
824 END DO
825 DEALLOCATE(this%output)
826 END IF
827 IF (ASSOCIATED(this%tsoutput)) DEALLOCATE(this%tsoutput)
828
829 NULLIFY(this%outbuf,this%output,this%tsoutput)
830
831 CALL this%Finalize_base()
832 END SUBROUTINE finalize
833
834END MODULE fileio_gnuplot_mod
Dictionary for generic data types.
Definition: common_dict.f90:61
integer, parameter, public dict_real
Definition: common_dict.f90:95
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
Definition: common_dict.f90:94
type(dict_typ) function, pointer, public getchild(root)
Get the pointer to a direct child of the pointer 'root'.
integer, parameter, public dict_char
Definition: common_dict.f90:96
integer, parameter, public dict_bool
Definition: common_dict.f90:97
Generic file I/O module.
Definition: fileio_base.f90:54
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
Definition: fluxes_base.f90:39
base class for geometrical properties
basic mesh module
Definition: mesh_base.f90:72
Basic physics module.
module to manage list of source terms
class for Fortran file handle
Definition: fileio_base.f90:99
class for MPI file handle
output-pointer for time step scalar data
output-pointer for 3D array data
mesh data structure
Definition: mesh_base.f90:122
container class to manage the list of source terms