fileio_base.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: fileio_base.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!# Manuel Jung <mjung@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!#############################################################################
38#ifdef HAVE_NETCDF
39!! \key{ncfmt,INTEGER,netcdf format type}
40#endif
41!----------------------------------------------------------------------------!
53!----------------------------------------------------------------------------!
56 USE common_dict
62#ifdef PARALLEL
63#ifdef HAVE_MPI_MOD
64 USE mpi
65#endif
66#endif
67 IMPLICIT NONE
68#ifdef PARALLEL
69#ifdef HAVE_MPIF_H
70 include 'mpif.h'
71#endif
72#endif
73 !--------------------------------------------------------------------------!
74 PRIVATE
75 !--------------------------------------------------------------------------!
76 ! Private Attributes section starts here:
79 INTEGER, PARAMETER :: fextlen = 4
80 INTEGER, PARAMETER :: fcyclen = 5
81 INTEGER, PARAMETER :: fnamlen = 256
82 INTEGER, PARAMETER :: fpatlen = 1024
85 INTEGER, PARAMETER :: maxcycles = 10000
87 !--------------------------------------------------------------------------!
89 TYPE, EXTENDS(logging_base), abstract :: filehandle_base
90 CONTAINS
91 procedure(initfilehandle_deferred), DEFERRED :: initfilehandle
92 procedure(openfile_deferred), DEFERRED :: openfile
93 procedure(closefile_deferred), DEFERRED :: closefile
94 procedure(getbasename_deferred), DEFERRED :: getbasename
95 procedure(getfilename_deferred), DEFERRED :: getfilename
96 procedure(getstatus_deferred), DEFERRED :: getstatus
97 END TYPE filehandle_base
101 INTEGER :: fid
102 LOGICAL :: textfile
103 LOGICAL :: onefile
104 INTEGER :: cycles
105 CHARACTER(LEN=FNAMLEN) :: filename
106 CHARACTER(LEN=FPATLEN) :: path
107 CHARACTER(LEN=FEXTLEN) :: extension
108 CONTAINS
110 PROCEDURE :: initfilehandle
111 PROCEDURE :: openfile
112 PROCEDURE :: closefile
113 PROCEDURE :: getfilename
114 PROCEDURE :: getbasename
115 PROCEDURE :: getunitnumber
116 PROCEDURE :: getformat
117 PROCEDURE :: getstatus
118 PROCEDURE :: getstepstring
120 END TYPE filehandle_fortran
121
124#ifdef PARALLEL
125 INTEGER :: basictype,& !< basic MPI data type
126 cfiletype,& !< data types for MPI i/o
127 filetype
128 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
129 CONTAINS
131 PROCEDURE :: openfile => openfile_mpi
132 PROCEDURE :: closefile => closefile_mpi
133 PROCEDURE :: getstatus => getstatus_mpi
135#endif
136 END TYPE filehandle_mpi
137
139 TYPE, ABSTRACT,EXTENDS(logging_base) :: fileio_base
141 CLASS(filehandle_fortran), ALLOCATABLE &
142 :: datafile
143 LOGICAL :: cartcoords
144! INTEGER :: unit !< i/o unit
145 INTEGER :: step
146 INTEGER :: count
147 INTEGER :: dtwall
148 INTEGER :: inum,jnum,& !< local mesh extent
149 knum
150 INTEGER :: bufsize
151 REAL :: stoptime
152 REAL :: starttime
153 REAL :: time
154 REAL :: walltime
155! REAL, DIMENSION(:,:,:,:), POINTER :: &
156! binout !< binary data output buffer
157! REAL, DIMENSION(:,:) , POINTER :: &
158! bflux !< boundary flux output buffer
159#ifdef PARALLEL
160
161#endif
162 CONTAINS
164 procedure(initfileio_deferred), DEFERRED :: initfileio_deferred
165 PROCEDURE :: initfileio_base
166 generic :: initfileio => initfileio_base, initfileio_deferred
167 procedure(writeheader), DEFERRED :: writeheader
168 PROCEDURE :: writedataset
169 procedure(writedataset_deferred), DEFERRED :: writedataset_deferred
170 PROCEDURE :: adjusttimestep
171 PROCEDURE :: finalize_base
172 PROCEDURE :: getendianness
173! PROCEDURE :: MakeMultstr
174 PROCEDURE :: inctime
175 END TYPE fileio_base
176
177 ! Interfaces
178 abstract INTERFACE
179 SUBROUTINE initfilehandle_deferred(this,filename,path,extension,textfile,onefile,cycles,unit)
180 IMPORT filehandle_base
181 IMPLICIT NONE
182 !------------------------------------------------------------------------!
183 CLASS(filehandle_base), INTENT(INOUT) :: this
184 CHARACTER(LEN=*), INTENT(IN) :: filename
185 CHARACTER(LEN=*), INTENT(IN) :: path
186 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
187 LOGICAL, OPTIONAL, INTENT(IN) :: textfile
188 LOGICAL, OPTIONAL, INTENT(IN) :: onefile
189 INTEGER, OPTIONAL, INTENT(IN) :: cycles
190 INTEGER, OPTIONAL, INTENT(IN) :: unit
191 END SUBROUTINE
192 SUBROUTINE openfile_deferred(this,action,step)
193 IMPORT filehandle_base
194 IMPLICIT NONE
195 !------------------------------------------------------------------------!
196 CLASS(filehandle_base), INTENT(INOUT) :: this
197 INTEGER, INTENT(IN) :: action
198 INTEGER, INTENT(IN) :: step
199 END SUBROUTINE
200 SUBROUTINE closefile_deferred(this,step)
201 IMPORT filehandle_base
202 IMPLICIT NONE
203 !------------------------------------------------------------------------!
204 CLASS(filehandle_base), INTENT(INOUT) :: this
205 INTEGER, INTENT(IN) :: step
206 END SUBROUTINE
207 FUNCTION getbasename_deferred(this,step) RESULT (fname)
208 IMPORT filehandle_base
209 IMPLICIT NONE
210 !------------------------------------------------------------------------!
211 CLASS(filehandle_base), INTENT(IN) :: this
212 INTEGER, INTENT(IN) :: step
213 CHARACTER(LEN=256) :: fname
214 END FUNCTION
215 FUNCTION getfilename_deferred(this,step) RESULT (fname)
216 IMPORT filehandle_base
217 IMPLICIT NONE
218 !------------------------------------------------------------------------!
219 CLASS(filehandle_base), INTENT(IN) :: this
220 INTEGER, INTENT(IN) :: step
221 CHARACTER(LEN=256) :: fname
222 END FUNCTION
223 FUNCTION getstatus_deferred(this,step) RESULT(fstatus)
224 IMPORT filehandle_base
225 IMPLICIT NONE
226 !------------------------------------------------------------------------!
227 CLASS(filehandle_base), INTENT(INOUT) :: this
228 INTEGER, INTENT(IN) :: step
229 INTEGER :: fstatus
230 END FUNCTION
231 SUBROUTINE initfileio_deferred(this,Mesh,Physics,Timedisc,Sources,config,IO)
233 IMPLICIT NONE
234 !------------------------------------------------------------------------!
235 CLASS(fileio_base), INTENT(INOUT) :: this
236 CLASS(mesh_base), INTENT(IN) :: Mesh
237 CLASS(physics_base), INTENT(IN) :: Physics
238 CLASS(timedisc_base),INTENT(IN) :: Timedisc
239 CLASS(sources_list), ALLOCATABLE, INTENT(IN) :: Sources
240 TYPE(dict_typ), INTENT(IN), POINTER :: config
241 TYPE(dict_typ), INTENT(IN), POINTER :: IO
242 END SUBROUTINE
243 SUBROUTINE writedataset_deferred(this,Mesh,Physics,Fluxes,Timedisc,Header,IO)
245 IMPLICIT NONE
246 CLASS(fileio_base), INTENT(INOUT) :: this
247 CLASS(mesh_base), INTENT(IN) :: Mesh
248 CLASS(physics_base), INTENT(INOUT) :: Physics
249 CLASS(fluxes_base), INTENT(IN) :: Fluxes
250 CLASS(timedisc_base), INTENT(IN) :: Timedisc
251 TYPE(dict_typ), POINTER :: Header,IO
252 END SUBROUTINE
253 SUBROUTINE writeheader(this,Mesh,Physics,Header,IO)
255 IMPLICIT NONE
256 CLASS(fileio_base), INTENT(INOUT) :: this
257 CLASS(mesh_base), INTENT(IN) :: Mesh
258 CLASS(physics_base), INTENT(IN) :: Physics
259 TYPE(dict_typ), POINTER :: Header,IO
260 END SUBROUTINE
261 SUBROUTINE finalize(this)
262 IMPORT fileio_base
263 IMPLICIT NONE
264 CLASS(fileio_base), INTENT(INOUT) :: this
265 END SUBROUTINE
266 END INTERFACE
267 !--------------------------------------------------------------------------!
268
272! INTEGER, PARAMETER :: FILE_EXISTS = B'00000001' !< file status for existing files
273 INTEGER, PARAMETER :: closed = 0
274 INTEGER, PARAMETER :: readonly = 1
275 INTEGER, PARAMETER :: readend = 2
276 INTEGER, PARAMETER :: replace = 3
277 INTEGER, PARAMETER :: append = 4
278 INTEGER, PARAMETER :: open_undef = 5
280
283 INTEGER, PARAMETER :: fortranfile = 1
284 INTEGER, PARAMETER :: mpifile = 2
286 INTEGER, PARAMETER :: binary = 1
287 INTEGER, PARAMETER :: gnuplot = 2
288 INTEGER, PARAMETER :: vtk = 4
289! INTEGER, PARAMETER :: NPY = 5
290! INTEGER, PARAMETER :: HDF = 6
291 INTEGER, PARAMETER :: xdmf = 7
293 !--------------------------------------------------------------------------!
294 INTEGER, SAVE :: lastunit = 10
295
296 INTERFACE filehandle_fortran
297 MODULE PROCEDURE createfilehandle
298 END INTERFACE
299 !--------------------------------------------------------------------------!
300 PUBLIC :: &
301 ! types
302 fileio_base, &
304 ! constants
305 binary, gnuplot, vtk, xdmf, &
306#ifdef PARALLEL
309#endif
311
312
313CONTAINS
314
315
317 FUNCTION createfilehandle(filename,path,extension,textfile) RESULT(new_fh)
318 IMPLICIT NONE
319 !-------------------------------------------------------------------!
320 TYPE(filehandle_fortran) :: new_fh
321 CHARACTER(LEN=*), INTENT(IN) :: filename
322 CHARACTER(LEN=*), INTENT(IN) :: path
323 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
324 LOGICAL, OPTIONAL, INTENT(IN) :: textfile
325 !-------------------------------------------------------------------!
326 CALL new_fh%InitFilehandle(filename,path,extension,textfile)
327 END FUNCTION createfilehandle
328
330 SUBROUTINE initfilehandle(this,filename,path,extension,textfile,onefile,cycles,unit)
331 IMPLICIT NONE
332 !-------------------------------------------------------------------!
333 CLASS(filehandle_fortran), INTENT(INOUT) :: this
334 CHARACTER(LEN=*), INTENT(IN) :: filename
335 CHARACTER(LEN=*), INTENT(IN) :: path
336 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
337 LOGICAL, OPTIONAL, INTENT(IN) :: textfile
338 LOGICAL, OPTIONAL, INTENT(IN) :: onefile
339 INTEGER, OPTIONAL, INTENT(IN) :: cycles
340 INTEGER, OPTIONAL, INTENT(IN) :: unit
341 !-------------------------------------------------------------------!
342 IF (.NOT.this%Initialized()) CALL this%InitLogging(fortranfile,"fortran")
343 ! check file name length
344 IF (len_trim(filename).GT.fnamlen) &
345 CALL this%Error("fileio_base::InitFilehandle","file name too long")
346 this%filename = filename
347 ! check file path length
348 IF (len_trim(path).GT.fpatlen) &
349 CALL this%Error("fileio_base::InitFilehandle","file path too long")
350 this%path = path
351 IF (PRESENT(textfile)) THEN
352 this%textfile = textfile
353 ELSE
354 this%textfile = .true. ! default is textfile
355 END IF
356 ! check file name extension
357 IF (PRESENT(extension)) THEN
358 IF (len_trim(extension).GT.fextlen) &
359 CALL this%Error("fileio_base::InitFilehandle","file name extension too long")
360 this%extension = extension
361 ELSE
362 IF (this%textfile) THEN
363 this%extension = "txt"
364 ELSE
365 this%extension = "bin"
366 END IF
367 END IF
368 IF (PRESENT(onefile)) THEN
369 this%onefile = onefile
370 ELSE
371 this%onefile = .false. ! default is multiple data files (one for each time step)
372 END IF
373 IF (PRESENT(cycles)) THEN
374 this%cycles = cycles
375 ELSE
376 this%cycles = maxcycles
377 END IF
378 IF (PRESENT(unit)) THEN
379 IF (unit.EQ.lastunit) &
380 CALL this%Error("filehandle_fortran::InitFilehandle","fortran i/o unit number already assigned")
381 this%fid = unit
382 ELSE
383 this%fid = lastunit + 1
384 END IF
385 lastunit = this%fid
386 END SUBROUTINE initfilehandle
387
390 SUBROUTINE initfileio_base(this,Mesh,Physics,Timedisc,Sources,config,IO,fmtname,fext,textfile)
391 IMPLICIT NONE
392 !------------------------------------------------------------------------!
393 CLASS(fileio_base), INTENT(INOUT) :: this
394 CLASS(mesh_base), INTENT(IN) :: Mesh
395 CLASS(physics_base), INTENT(IN) :: Physics
396 CLASS(timedisc_base),INTENT(IN) :: Timedisc
397 CLASS(sources_list), ALLOCATABLE, INTENT(IN) :: Sources
398 TYPE(dict_typ), INTENT(IN), POINTER :: config
399 TYPE(dict_typ), INTENT(IN), POINTER :: IO
400 CHARACTER(LEN=*), INTENT(IN) :: fmtname
401 CHARACTER(LEN=*), INTENT(IN) :: fext
402 LOGICAL, OPTIONAL, INTENT(IN) :: textfile
403 !------------------------------------------------------------------------!
404 INTEGER :: fileformat
405 CHARACTER(LEN=MAX_CHAR_LEN) :: fname
406 CHARACTER(LEN=MAX_CHAR_LEN) :: fpath
407 INTEGER :: unit
408 LOGICAL :: onefile
409 CHARACTER(LEN=32) :: timestamp
410 INTEGER :: cycles,dtwall,cartcoords
411 REAL :: stoptime
412 REAL :: time
413 !------------------------------------------------------------------------!
414 CALL getattr(config, "fileformat", fileformat)
415 ! InitLogging after reading fileformat from config
416 CALL this%InitLogging(fileformat,fmtname)
417
418 ! get file name and path from dictionary
419 CALL getattr(config, "filename" , fname)
420 fpath = ""
421 CALL getattr(config, "filepath" , fpath, fpath)
422
423 ! number of output steps
424 CALL getattr(config, "count" , this%count, 1)
425
426 ! number of data files
427 ! cycles = 0 : one data file, append data
428 ! cycles = 1 : one data file, overwrite data
429 ! cycles = X > 1 : X data files
430 CALL getattr(config, "filecycles", cycles, this%count+1)
431 ! check cycles
432 IF (cycles.GT.maxcycles) &
433 CALL this%Error("fileio_base::InitFileIO_base","file cycles exceed limits")
434
435 IF (cycles.GT.1) THEN
436 onefile = .false.
437 ELSE
438 onefile = .true.
439 END IF
440 ! fortran i/o unit
441 CALL getattr(config, "unit" , unit , lastunit+1)
442
443 ! wall clock time between successive outputs
444 ! this is mainly intended for log file outputs
445 CALL getattr(config, "dtwall" , this%dtwall, 3600) !default is one hour
446
447 ! stop time for output defaults to simulation stop time
448 CALL getattr(config, "stoptime" , this%stoptime, timedisc%stoptime)
449 CALL getattr(config, "walltime" , this%walltime, huge(1.0))
450
451 ! initial step, usually 0 except for restarted simulations
452 CALL getattr(config, "step", this%step, 0)
453
454 ! mesh coordinates are cartesian by default (cartcoords == 1)
455 ! set to 0 for curvilinear coordinates (currently supported in gnuplot and vtk)
456 CALL getattr(config, "cartcoords", cartcoords, 1)
457 IF (cartcoords.EQ.0) THEN
458 this%cartcoords = .false.
459 ELSE
460 this%cartcoords = .true.
461 END IF
462
463 ! initialize file handle for the data file
464 IF (.NOT.ALLOCATED(this%datafile)) THEN
465 ! this is the default if the datafile has not been allocated within the calling scope
466#ifdef PARALLEL
467 ALLOCATE(filehandle_mpi::this%datafile)
468#else
469 ALLOCATE(filehandle_fortran::this%datafile)
470#endif
471 END IF
472 CALL this%datafile%InitFilehandle(fname,fpath,fext,textfile,onefile,cycles,unit)
473
474 this%starttime = timedisc%time ! set to initial time defined in Timedisc
475 this%time = this%starttime
476 this%err = 0
477
478 ! print some information
479 CALL this%Info(" FILEIO---> file type: " // trim(this%GetName()))
480 CALL this%Info(" file name: " // trim(this%datafile%GetFilename(this%step)))
481 WRITE (timestamp,'(ES12.4)') timedisc%time
482 CALL this%Info(" time stamp: " // trim(timestamp))
483 IF (.NOT.this%cartcoords) &
484 CALL this%Info(" cruvilinear coords: yes")
485
486 ! time for next output
487 IF (timedisc%time.GT.0.0) CALL this%IncTime()
488
489
490!!!!! old fosite code, may be obsolete
491! #ifdef PARALLEL
492! ! check data type extents in files
493! ! first try to create a new dummy file
494! CALL MPI_File_open(MPI_COMM_WORLD,GetFilename(this),IOR(IOR(MPI_MODE_RDWR,&
495! MPI_MODE_CREATE),IOR(MPI_MODE_EXCL,MPI_MODE_DELETE_ON_CLOSE)),&
496! MPI_INFO_NULL,this%handle,this%error)
497! ! maybe file exists
498! IF (this%error.NE.0) CALL MPI_File_open(MPI_COMM_WORLD,GetFilename(this),&
499! MPI_MODE_RDONLY,MPI_INFO_NULL,this%handle,this%error)
500! ! then check the data type sizes
501! ! extent of integer in file
502! IF (this%error.EQ.0) CALL MPI_File_get_type_extent(this%handle,MPI_INTEGER,&
503! this%intext,this%error)
504! ! extent of real in file
505! IF (this%error.EQ.0) CALL MPI_File_get_type_extent(this%handle,DEFAULT_MPI_REAL,&
506! this%realext,this%error)
507! IF (this%error.NE.0) CALL Error(this,"InitFileIO","unable to check file properties")
508! CALL MPI_File_close(this%handle,this%error)
509! #endif
510 END SUBROUTINE initfileio_base
511
514 SUBROUTINE writedataset(this,Mesh,Physics,Fluxes,Timedisc,Header,IO)
515 IMPLICIT NONE
516 !------------------------------------------------------------------------!
517 CLASS(fileio_base), INTENT(INOUT) :: this
518 CLASS(mesh_base), INTENT(IN) :: Mesh
519 CLASS(physics_base), INTENT(INOUT) :: Physics
520 CLASS(fluxes_base), INTENT(IN) :: Fluxes
521 CLASS(timedisc_base), INTENT(IN) :: Timedisc
522 TYPE(dict_typ), POINTER :: Header,IO
523 !------------------------------------------------------------------------!
524 ! transform to true velocities if fargo is enabled
525 IF (ASSOCIATED(timedisc%w)) THEN
526 SELECT CASE(mesh%fargo%GetDirection())
527 CASE(1)
528 CALL physics%AddBackgroundVelocityX(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
529 CASE(2)
530 CALL physics%AddBackgroundVelocityY(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
531 CASE(3)
532 CALL physics%AddBackgroundVelocityZ(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
533 END SELECT
534 END IF
535
536 ! open data file and write header if necessary
537 IF ((.NOT.this%datafile%onefile).OR.this%step.EQ.0) THEN
538 CALL this%datafile%OpenFile(replace,this%step)
539 CALL this%WriteHeader(mesh,physics,header,io)
540 ELSE
541 CALL this%datafile%OpenFile(append,this%step)
542 END IF
543
544 ! write data
545 CALL this%WriteDataset_deferred(mesh,physics,fluxes,timedisc,header,io)
546
547 ! close data file and increment output time for next output
548 CALL this%datafile%CloseFile(this%step)
549 CALL this%IncTime()
550 END SUBROUTINE writedataset
551
552
556 SUBROUTINE getendianness(this, res, littlestr, bigstr)
557 IMPLICIT NONE
558 !------------------------------------------------------------------------!
559 CLASS(fileio_base), INTENT(INOUT):: this
560 CHARACTER(LEN=*) :: res
561 CHARACTER(LEN=*) :: littlestr
562 CHARACTER(LEN=*) :: bigstr
563 !------------------------------------------------------------------------!
564 INTEGER :: k,iTIPO
565 CHARACTER, POINTER :: cTIPO(:)
566 !------------------------------------------------------------------------!
567 INTENT(IN) :: littlestr, bigstr
568 INTENT(OUT) :: res
569 !------------------------------------------------------------------------!
570 !endianness
571 k = bit_size(itipo)/8
572 ALLOCATE(ctipo(k),stat = this%err)
573 IF (this%err.NE.0) &
574 CALL this%Error("GetEndianness", "Unable to allocate memory.")
575 ctipo(1)='A'
576 !cTIPO(2:k-1) = That's of no importance.
577 ctipo(k)='B'
578
579 itipo = transfer(ctipo, itipo)
580 DEALLOCATE(ctipo)
581 !Test of 'B'=b'01000010' ('A'=b'01000001')
582 IF (btest(itipo,1)) THEN
583 write(res,'(A)',iostat=this%err)bigstr
584 ELSE
585 write(res,'(A)',iostat=this%err)littlestr
586 END IF
587 END SUBROUTINE getendianness
588
591 PURE SUBROUTINE inctime(this)
592 IMPLICIT NONE
593 !------------------------------------------------------------------------!
594 CLASS(fileio_base), INTENT(INOUT) :: this
595 !------------------------------------------------------------------------!
596 this%time = this%time + abs(this%stoptime - this%starttime) / this%count
597 this%step = this%step + 1
598 END SUBROUTINE inctime
599
600
604 PURE SUBROUTINE adjusttimestep(this,time,dt,dtcause)
605 IMPLICIT NONE
606 !------------------------------------------------------------------------!
607 CLASS(fileio_base), INTENT(IN) :: this
608 REAL :: time
609 REAL :: dt
610 INTEGER :: dtcause
611 !------------------------------------------------------------------------!
612 INTENT(INOUT) :: time,dt,dtcause
613 !------------------------------------------------------------------------!
614 IF ((time+dt)/this%time.GT.1.0) THEN
615 dt = this%time - time
616 dtcause = dtcause_fileio
617 ELSE IF((time+1.5*dt)/this%time.GT.1.0) THEN
618 dt = 0.5*(this%time - time)
619 dtcause = dtcause_fileio
620 END IF
621 END SUBROUTINE adjusttimestep
622
623
626 SUBROUTINE finalize_base(this)
627 IMPLICIT NONE
628 !------------------------------------------------------------------------!
629 CLASS(fileio_base),INTENT(INOUT) :: this
630 !------------------------------------------------------------------------!
631 IF (.NOT.this%Initialized()) &
632 CALL this%Error("fileio_base::Finalize_base","FileIO not initialized")
633 IF (ALLOCATED(this%datafile)) DEALLOCATE(this%datafile)
634 END SUBROUTINE finalize_base
635
638 SUBROUTINE openfile(this,action,step)
639 IMPLICIT NONE
640 !------------------------------------------------------------------------!
641 CLASS(filehandle_fortran), INTENT(INOUT):: this
642 INTEGER, INTENT(IN) :: action
643 INTEGER, INTENT(IN) :: step
644 !------------------------------------------------------------------------!
645 CHARACTER(LEN=32) :: sta,act,pos,frm
646 !------------------------------------------------------------------------!
647 SELECT CASE(action)
648 CASE(readonly)
649 sta = 'OLD'
650 act = 'READ'
651 pos = 'REWIND'
652 CASE(readend)
653 sta = 'OLD'
654 act = 'READ'
655 pos = 'APPEND'
656 CASE(replace)
657 sta = 'REPLACE'
658 act = 'WRITE'
659 pos = 'REWIND'
660 CASE(append)
661 sta = 'OLD'
662 act = 'READWRITE'
663 pos = 'APPEND'
664 CASE DEFAULT
665 CALL this%Error("fileio_base::OpenFile","Unknown access mode.")
666 END SELECT
667 this%err = 0
668 CALL this%CloseFile(step) ! make sure we don't open an already opened file
669 IF (this%err.EQ.0) &
670 OPEN(unit=this%GetUnitNumber(),file=trim(this%GetFilename(step)),status=trim(sta), &
671 access='STREAM',action=trim(act),position=trim(pos),form=trim(this%GetFormat()), &
672 iostat=this%err)
673 IF (this%err.NE.0) &
674 CALL this%Error("fileio_base::OpenFile","File opening failed for: " // &
675 trim(this%GetFilename(step)))
676 END SUBROUTINE openfile
677
679 FUNCTION getunitnumber(this)
680 IMPLICIT NONE
681 !------------------------------------------------------------------------!
682 CLASS(filehandle_fortran), INTENT(INOUT) :: this
683 !------------------------------------------------------------------------!
684 INTEGER :: getunitnumber
685 !------------------------------------------------------------------------!
686 getunitnumber = this%fid
687 END FUNCTION getunitnumber
688
690 FUNCTION getstatus(this,step)
691 IMPLICIT NONE
692 !------------------------------------------------------------------------!
693 CLASS(filehandle_fortran), INTENT(INOUT) :: this
694 INTEGER, INTENT(IN) :: step
695 !------------------------------------------------------------------------!
696 INTEGER :: getstatus
697 LOGICAL :: ex,op
698 CHARACTER(LEN=64) :: act,pos
699 !------------------------------------------------------------------------!
700#if DEBUG > 2
701 print *,"DEBUG INFO in fileio_base::GetStatus: called for " // trim(this%GetFilename(step)), &
702 ", unit:", this%GetUnitNumber()
703#endif
704 getstatus = -1 ! unknown / undefined / does not exist
705 ! check if file exist
706 act="NO-RETURN-VALUE"
707 pos="NO-RETURN-VALUE"
708 INQUIRE(file=trim(this%GetFilename(step)),exist=ex,opened=op,action=act,position=pos,iostat=this%err)
709#if DEBUG > 2
710 print *,"DEBUG INFO in fileio_base::GetStatus: inquire results (ex,op,act,pos): ", &
711 ex, op, " " // trim(act) // " " // trim(pos)
712#endif
713 IF (this%err.NE.0) &
714 CALL this%Error("filehandle_fortran::GetStatus","serious failure during file inquiry")
715 IF (ex) THEN
716 ! file exists
717 IF (op) THEN
718 ! file is open
720 SELECT CASE(trim(act))
721 CASE("READ")
722 SELECT CASE(trim(pos))
723 CASE("REWIND")
725 CASE("APPEND")
727 END SELECT
728 CASE("WRITE","READWRITE")
729 SELECT CASE(trim(pos))
730 CASE("REWIND")
732 CASE("APPEND")
734 END SELECT
735 END SELECT
736 ELSE
737 ! file exists, but is closed
739 END IF
740 ELSE
741 ! file doesn't exist -> return negative number
742 END IF
743 END FUNCTION getstatus
744
746 FUNCTION getformat(this)
747 IMPLICIT NONE
748 !------------------------------------------------------------------------!
749 CLASS(filehandle_fortran), INTENT(INOUT) :: this
750 !------------------------------------------------------------------------!
751 CHARACTER(LEN=16) :: getformat
752 !------------------------------------------------------------------------!
753 IF (this%textfile) THEN
754 getformat = "FORMATTED"
755 ELSE
756 getformat = "UNFORMATTED"
757 END IF
758 END FUNCTION getformat
759
761 PURE FUNCTION getstepstring(this,step)
762 IMPLICIT NONE
763 !------------------------------------------------------------------------!
764 CLASS(filehandle_fortran), INTENT(IN) :: this
765 INTEGER, INTENT(IN) :: step
766 CHARACTER(LEN=FCYCLEN) :: getstepstring
767 !------------------------------------------------------------------------!
768 CHARACTER(LEN=16) :: fmtstr
769 !-------------------------------------------------------------------!
770 WRITE (fmtstr ,'(A,I1,A)') "(A1,I0.",fcyclen-1,")"
771 IF (step.LT.0.OR.step.GE.maxcycles) THEN
772 ! return _X...X if step is invalid, i.e. negative or exceeds maximum
773 getstepstring = "_" // repeat("X",fcyclen-1)
774 ELSE IF (step.EQ.0) THEN
775 WRITE(getstepstring, fmt=trim(fmtstr)) "_",0
776 ELSE
777 ! determine file number based on current step and number of files,
778 ! i.e. cycles, and generate the file name with these extensions
779 WRITE(getstepstring, fmt=trim(fmtstr)) "_",modulo(step,this%cycles)
780 END IF
781 END FUNCTION getstepstring
782
786 FUNCTION getbasename(this,step) RESULT (fname)
787 IMPLICIT NONE
788 !------------------------------------------------------------------------!
789 CLASS(filehandle_fortran), INTENT(IN) :: this
790 INTEGER, INTENT(IN) :: step
791 CHARACTER(LEN=256) :: fname
792 !------------------------------------------------------------------------!
793 IF (this%onefile) THEN
794 ! all data goes into one file -> no extra string indicating time step
795 fname = trim(this%filename)
796 ELSE
797 ! insert extra string for each time step before the extension
798 fname = trim(this%filename) // trim(this%GetStepString(step))
799 END IF
800 END FUNCTION getbasename
801
803 FUNCTION getfilename(this,step)
804 IMPLICIT NONE
805 !------------------------------------------------------------------------!
806 CLASS(filehandle_fortran), INTENT(IN) :: this
807 INTEGER, INTENT(IN) :: step
808 !------------------------------------------------------------------------!
809 CHARACTER(LEN=256) :: getfilename
810 !------------------------------------------------------------------------!
811 getfilename = trim(this%path) // trim(this%GetBasename(step)) // "." // trim(this%extension)
812 END FUNCTION getfilename
813
816 SUBROUTINE closefile(this,step)
817 IMPLICIT NONE
818 !------------------------------------------------------------------------!
819 CLASS(filehandle_fortran), INTENT(INOUT) :: this
820 INTEGER, INTENT(IN) :: step
821 !------------------------------------------------------------------------!
822#if DEBUG > 2
823 print *,"DEBUG INFO in fileio_base::CloseFile: called for " // trim(this%GetFilename(step)), &
824 ", unit:", this%GetUnitNumber()
825#endif
826 this%err = 0
827 IF (this%GetStatus(step).GT.0) THEN
828 IF (this%err.EQ.0) THEN
829#if DEBUG > 2
830 print *,"DEBUG INFO in fileio_base::CloseFile: closing file ..."
831#endif
832 CLOSE(unit=this%GetUnitNumber(),iostat=this%err)
833 END IF
834 END IF
835 IF (this%err.NE.0) THEN
836#if DEBUG > 2
837 print *,"DEBUG INFO in fileio_base::CloseFile: Fatal error IOSTAT=",this%err
838#endif
839 CALL this%Error("filehandle_fortran::CloseFile","Cannot close file " // &
840 trim(this%GetFilename(step)))
841 END IF
842 END SUBROUTINE closefile
843
845 SUBROUTINE finalize_fortran(this)
846 IMPLICIT NONE
847 !------------------------------------------------------------------------!
848 TYPE(filehandle_fortran), INTENT(INOUT) :: this
849 !------------------------------------------------------------------------!
850 LOGICAL :: op
851 !------------------------------------------------------------------------!
852 INQUIRE(unit=this%GetUnitNumber(),opened=op,iostat=this%err)
853 IF (this%err.EQ.0) CLOSE(unit=this%GetUnitNumber(),iostat=this%err)
854 END SUBROUTINE finalize_fortran
855
856#ifdef PARALLEL
857
859 SUBROUTINE openfile_mpi(this,action,step)
860 IMPLICIT NONE
861 !------------------------------------------------------------------------!
862 CLASS(filehandle_mpi), INTENT(INOUT) :: this
863 INTEGER, INTENT(IN) :: action
864 INTEGER, INTENT(IN) :: step
865 !------------------------------------------------------------------------!
866 INTEGER(KIND=MPI_OFFSET_KIND) :: offset
867 INTEGER :: amode,smode,fstatus
868 !------------------------------------------------------------------------!
869 this%err = mpi_success
870 CALL this%CloseFile(step) ! make sure the file is closed
871 IF (this%err.EQ.mpi_success) THEN
872 ! delete file if it exists and should be replaced
873 SELECT CASE(action)
874 CASE(readonly)
875 amode = mpi_mode_rdonly
876 smode = mpi_seek_set
877 offset = 0
878 CASE(readend)
879 amode = ior(mpi_mode_rdonly,mpi_mode_append)
880 smode = mpi_seek_end
881 offset = 0
882 CASE(replace)
883 fstatus = this%GetStatus(step)
884 IF (fstatus.EQ.closed) THEN
885 ! delete the file only on rank 0, otherwise this%err > 0 if another
886 ! process tries to delete an already deleted file
887 IF (this%GetRank().EQ.0) &
888 CALL mpi_file_delete(trim(this%GetFilename(step)),fstatus,this%err)
889 IF (this%err.NE.mpi_success) &
890 CALL this%Error("fileio_base::OpenFile_mpi","cannot delete file " // &
891 trim(this%GetFilename(step)))
892 END IF
893 amode = ior(mpi_mode_wronly,mpi_mode_create)
894 smode = mpi_seek_end
895 offset = 0
896 CASE(append)
897 amode = ior(mpi_mode_rdwr,mpi_mode_append)
898 smode = mpi_seek_end
899 offset = 0
900 CASE DEFAULT
901 ! abort with error if either the access mode is wrong or someone tries parallel i/o in serial mode
902 CALL this%Error("fileio_base::OpenFile_mpi","Unknown access mode.")
903 END SELECT
904 IF (this%err.EQ.mpi_success) THEN
905 CALL mpi_file_open(mpi_comm_world,trim(this%GetFilename(step)),amode, &
906 mpi_info_null,this%fid,this%err)
907 IF (this%err.EQ.mpi_success) CALL mpi_file_seek(this%GetUnitNumber(),offset,smode,this%err)
908 IF (this%err.EQ.mpi_success) CALL mpi_file_sync(this%GetUnitNumber(),this%err)
909 END IF
910 END IF
911 IF (this%err.NE.mpi_success) &
912 CALL this%Error("fileio_base::OpenFile_mpi","file open failed, aborting")
913 END SUBROUTINE openfile_mpi
914
916 SUBROUTINE initfilehandle_mpi(this,filename,path,extension,textfile,onefile,cycles,unit)
917 IMPLICIT NONE
918 !-------------------------------------------------------------------!
919 CLASS(filehandle_mpi), INTENT(INOUT) :: this
920 CHARACTER(LEN=*), INTENT(IN) :: filename
921 CHARACTER(LEN=*), INTENT(IN) :: path
922 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
923 LOGICAL, OPTIONAL, INTENT(IN) :: textfile
924 LOGICAL, OPTIONAL, INTENT(IN) :: onefile
925 INTEGER, OPTIONAL, INTENT(IN) :: cycles
926 INTEGER, OPTIONAL, INTENT(IN) :: unit
927 !-------------------------------------------------------------------!
928 IF (.NOT.this%Initialized()) CALL this%InitLogging(mpifile,"mpi")
929 CALL this%filehandle_fortran%InitFilehandle(filename,path,extension,textfile,onefile,cycles,unit)
930 ! set the fid explicitly to MPI_File_NULL, because the fortran default is some number >= 10
931 this%fid = mpi_file_null
932 END SUBROUTINE initfilehandle_mpi
933
935 FUNCTION getstatus_mpi(this,step) RESULT(FileStatus)
936 IMPLICIT NONE
937 !------------------------------------------------------------------------!
938 CLASS(filehandle_mpi), INTENT(INOUT) :: this
939 INTEGER, INTENT(IN) :: step
940 !------------------------------------------------------------------------!
941 INTEGER :: filestatus
942 INTEGER :: amode
943 !------------------------------------------------------------------------!
944 filestatus = -1 ! unknown / undefined / does not exist
945 this%err = mpi_success
946 ! check if file handle is associated
947 IF (this%GetUnitNumber().NE.mpi_file_null) THEN
948 ! file handle has been associated -> check access mode
949 CALL mpi_file_get_amode(this%GetUnitnumber(),amode,this%err)
950 IF (this%err.NE.mpi_success) &
951 CALL this%Error("filehandle_mpi::GetStatus","cannot determine file access mode")
952 ! file exists
953 IF (iand(amode,mpi_mode_rdonly).GT.0) THEN
954 IF (iand(amode,mpi_mode_append).GT.0) THEN
955 filestatus = readend
956 ELSE
957 filestatus = readonly
958 END IF
959 ELSE IF (iand(amode,ior(mpi_mode_wronly,mpi_mode_create)).GT.0) THEN
960 filestatus = replace
961 ELSE IF (iand(amode,ior(mpi_mode_rdwr,mpi_mode_append)).GT.0) THEN
962 filestatus = append
963 ELSE
964 ! undefined
965 END IF
966 ELSE
967 ! file handle not associated:
968 ! There is no MPI file inquiry to test whether the file exists.
969 ! Therefore we try to open the file RO and check for success.
970 CALL mpi_file_open(mpi_comm_world,trim(this%GetFilename(step)),mpi_mode_rdonly, &
971 mpi_info_null,this%fid,this%err)
972
973 IF (this%err.EQ.mpi_success) THEN
974 CALL mpi_file_sync(this%GetUnitNumber(),this%err)
975 IF (this%err.EQ.mpi_success.AND.this%GetUnitnumber().NE.mpi_file_null) THEN
976 CALL mpi_file_close(this%fid,this%err)
977 IF (this%err.NE.mpi_success) &
978 CALL this%Error("filehandle_mpi::GetStatus","cannot close file")
979 END IF
980 this%fid = mpi_file_null
981 filestatus=closed
982 ELSE
983 ! undefined
984 END IF
985 this%err = mpi_success
986 END IF
987 END FUNCTION getstatus_mpi
988
991 SUBROUTINE closefile_mpi(this,step)
992 IMPLICIT NONE
993 !------------------------------------------------------------------------!
994 CLASS(filehandle_mpi), INTENT(INOUT) :: this
995 INTEGER, INTENT(IN) :: step
996 !------------------------------------------------------------------------!
997 this%err = mpi_success
998 IF (this%GetStatus(step).GT.0) THEN
999 IF (this%err.EQ.mpi_success) CALL mpi_file_close(this%fid,this%err)
1000 this%fid = mpi_file_null
1001 END IF
1002 IF (this%err.NE.mpi_success) &
1003 CALL this%Error("filehandle_mpi::CloseFile","Cannot close file " // trim(this%GetFilename(step)))
1004 END SUBROUTINE closefile_mpi
1005
1007 SUBROUTINE finalize_mpi(this)
1008 IMPLICIT NONE
1009 !------------------------------------------------------------------------!
1010 TYPE(filehandle_mpi), INTENT(INOUT) :: this
1011 !------------------------------------------------------------------------!
1012 LOGICAL :: op
1013 !------------------------------------------------------------------------!
1014 IF (this%GetUnitNumber().NE.mpi_file_null) &
1015 CALL mpi_file_close(this%fid,this%err)
1016 IF (this%err.NE.mpi_success) &
1017 CALL this%Error("filehandle_mpi::Finalize","serious error occured while close file")
1018 END SUBROUTINE finalize_mpi
1019#endif
1020END MODULE fileio_base_mod
Dictionary for generic data types.
Definition: common_dict.f90:61
type(logging_base), save this
Generic file I/O module.
Definition: fileio_base.f90:54
integer, parameter, public xdmf
integer, parameter readend
readonly access at end
subroutine finalize_fortran(this)
destructor of Fortran stream handle
subroutine initfilehandle_mpi(this, filename, path, extension, textfile, onefile, cycles, unit)
basic initialization of MPI file handle
integer, parameter readonly
readonly access
integer function getstatus(this, step)
get Fortran file status
subroutine initfileio_base(this, Mesh, Physics, Timedisc, Sources, config, IO, fmtname, fext, textfile)
Basic FileIO initialization.
integer, parameter closed
file closed
pure character(len=fcyclen) function getstepstring(this, step)
Get the time step as string with leading zeros.
character(len=16) function getformat(this)
get Fortran i/o format string
integer, save lastunit
integer, parameter fortranfile
subroutine closefile_mpi(this, step)
close MPI file
integer, parameter append
read/write access at end
subroutine getendianness(this, res, littlestr, bigstr)
Determines the endianness of the system.
subroutine writedataset(this, Mesh, Physics, Fluxes, Timedisc, Header, IO)
Write all data registered for output to the data file.
subroutine initfilehandle(this, filename, path, extension, textfile, onefile, cycles, unit)
basic initialization of Fortran file handle
type(filehandle_fortran) function createfilehandle(filename, path, extension, textfile)
constructor for Fortran file handle
integer, parameter, public vtk
character(len=256) function getfilename(this, step)
Return file name of Fortran stream with full path and extension.
integer, parameter, public gnuplot
integer function getstatus_mpi(this, step)
get MPI file status
integer, parameter fextlen
file name extension length
Definition: fileio_base.f90:79
integer, parameter fpatlen
file path length (without file name)
Definition: fileio_base.f90:82
pure subroutine inctime(this)
Increments the counter for timesteps and sets the time for next output.
integer, parameter replace
read/write access replacing file
subroutine closefile(this, step)
close Fortran stream
integer, parameter, public binary
file I/O types
integer function getunitnumber(this)
get Fortran i/o unit number
character(len=256) function getbasename(this, step)
get the file name without path and extension but with step string appended; if thisonefile suppress t...
integer, parameter fcyclen
length of timestep string
Definition: fileio_base.f90:80
integer, parameter open_undef
open with undefined io action/position
integer, parameter maxcycles
max. number of data files (not counting multiple files per time step in parallel mode)
Definition: fileio_base.f90:85
subroutine openfile_mpi(this, action, step)
Open file for input/ouput in parallel mode.
subroutine finalize_mpi(this)
destructor of MPI file handle handle
integer, parameter mpifile
integer, parameter fnamlen
file name length (without any extension)
Definition: fileio_base.f90:81
subroutine openfile(this, action, step)
Open file to access Fortran stream.
base module for numerical flux functions
Definition: fluxes_base.f90:39
Basic fosite module.
subroutine finalize(this)
Destructor of logging_base class.
integer, save default_mpi_real
default real type for MPI
basic mesh module
Definition: mesh_base.f90:72
Basic physics module.
module to manage list of source terms
subroutine finalize_base(this)
integer, parameter, public dtcause_fileio
smallest ts due to fileio
real function adjusttimestep(this, maxerr, dtold)
adjust the time step
class basic (abstract) class for file handles
Definition: fileio_base.f90:89
class for Fortran file handle
Definition: fileio_base.f90:99
class for MPI file handle
common data structure
mesh data structure
Definition: mesh_base.f90:122
container class to manage the list of source terms