83 CHARACTER,
PARAMETER ::
lf = achar(10)
88 CHARACTER(LEN=12) :: realfmt
89 CHARACTER(LEN=14) :: endianness
94 INTEGER :: cbufsize, & !< size of corner output
96 INTEGER(KIND=MPI_OFFSET_KIND) :: offset
137 TYPE(
dict_typ),
INTENT(IN),
POINTER :: config,IO
140 INTEGER,
DIMENSION(3) :: gsizes,lsizes,indices
142 CHARACTER(LEN=1),
DIMENSION(:),
POINTER :: mold
146 IF (.NOT.this%Initialized()) &
147 CALL this%InitFileio(mesh,physics,timedisc,sources,config,io,
"binary",
"bin",textfile=.false.)
153 CALL this%GetEndianness(this%endianness,
'II',
'MM')
154 this%realsize =
SIZE(transfer(r, mold))
155 this%intsize =
SIZE(transfer(i, mold))
157 SELECT CASE(this%realsize)
159 WRITE(this%realfmt,
'(A,I1,A)')
'"',this%realsize,
'"'
161 CALL this%Error(
"fileio_binary::InitFileIO_binary",
"Only single and double precision are allowed")
165 this%INUM = mesh%IMAX-mesh%IMIN+1
166 this%JNUM = mesh%JMAX-mesh%JMIN+1
167 this%KNUM = mesh%KMAX-mesh%KMIN+1
172 gsizes(1:3) = (/ mesh%INUM, mesh%JNUM, mesh%KNUM /)
173 lsizes(1:3) = (/ this%INUM, this%JNUM, this%KNUM /)
174 indices(1:3) = (/ mesh%IMIN-1, mesh%JMIN-1, mesh%KMIN-1 /)
175 this%bufsize = product(lsizes)
177 SELECT TYPE(df=>this%datafile)
179 CALL mpi_type_create_subarray(3, gsizes, lsizes, indices, mpi_order_fortran,&
180 default_mpi_real,df%filetype,this%err)
181 IF (this%err.EQ.0)
CALL mpi_type_commit(df%filetype,this%err)
186 this%clsizes(:) = lsizes(:)
187 WHERE ((/mesh%INUM,mesh%JNUM,mesh%KNUM/).GT.1)
189 gsizes(:) = gsizes(:)+1
190 WHERE ((/mesh%INUM,mesh%JNUM,mesh%KNUM/).EQ.(/mesh%IMAX,mesh%JMAX,mesh%KMAX/))
192 this%clsizes(:) = lsizes(:)+1
195 this%cbufsize = product(this%clsizes)
196 SELECT TYPE(df=>this%datafile)
198 IF (this%err.EQ.0)
CALL mpi_type_create_subarray(3, gsizes, this%clsizes, indices, mpi_order_fortran,&
199 default_mpi_real,df%cfiletype,this%err)
200 IF (this%err.EQ.0)
CALL mpi_type_commit(df%cfiletype,this%err)
204 CALL this%Error(
"fileio_binary::InitFileIO_binary",
"creating MPI data types failed")
221 TYPE(
dict_typ),
POINTER :: Header,IO
223 CHARACTER(LEN=6) :: magic =
"FOSITE"
224 CHARACTER(LEN=1) :: version = achar(0)
225 CHARACTER(LEN=4) :: sizes
226 CHARACTER(LEN=13) :: sheader
228 WRITE(sizes,
'(I2,I2)') this%realsize, this%intsize
229 sheader = magic // this%endianness(1:2) // version // sizes
231 SELECT TYPE(df=>this%datafile)
234 WRITE (unit=df%GetUnitNumber(),iostat=this%err) sheader
237 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,mpi_byte,&
238 mpi_byte,
'native', mpi_info_null, this%err)
239 IF (this%GetRank().EQ.0) &
240 CALL mpi_file_write(df%GetUnitNumber(),sheader,len(sheader),mpi_byte, &
244 CALL this%Error(
"fileio_binary::WriteHeader",
"unknown file handle")
246 this%offset = this%offset + len(sheader)
302 CHARACTER(LEN=*) :: key
303 INTEGER ::
type,bytes
304 INTEGER,
DIMENSION(5),
OPTIONAL :: dims
306 CHARACTER(LEN=1),
DIMENSION(:),
ALLOCATABLE :: buf
308 INTEGER :: keylen,l,b,o
310 INTENT(IN) :: key,
type,bytes
312 keylen = len_trim(key)
313 IF(
PRESENT(dims))
THEN
315 IF(dims(4).GT.1) l = 4
316 IF(dims(5).GT.1) l = 5
320 b = bytes + l * this%intsize
321 bufsize = (3+l) * this%intsize + keylen
322 ALLOCATE(buf(bufsize))
324 CALL append(buf,o,transfer(keylen,buf))
325 CALL append(buf,o,transfer(trim(key),buf))
326 CALL append(buf,o,transfer(
type,buf))
327 CALL append(buf,o,transfer(b,buf))
329 CALL append(buf,o,transfer(dims(1:l),buf))
332 SELECT TYPE(df=>this%datafile)
335 WRITE (unit=df%GetUnitNumber(),iostat=this%err) buf
338 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,mpi_byte,&
339 mpi_byte,
'native', mpi_info_null, this%err)
340 IF (this%GetRank().EQ.0) &
341 CALL mpi_file_write(df%GetUnitNumber(),buf,bufsize,mpi_byte, &
345 CALL this%Error(
"fileio_binary::WriteKey",
"unknown file handle")
349 this%offset = this%offset + bufsize
355 CHARACTER(LEN=1),
DIMENSION(:) :: buffer,d
373 CHARACTER(LEN=*),
OPTIONAL :: path
375 CHARACTER(LEN=MAX_CHAR_LEN) :: str, key
380 IF(
PRESENT(path))
THEN
386 DO WHILE(
ASSOCIATED(node))
387 key = trim(str)//
"/"//trim(
getkey(node))
389 CALL this%WriteNode(mesh,key,node)
392 CALL this%WriteDataAttributes(mesh,
getchild(node), key)
403 CHARACTER(LEN=MAX_CHAR_LEN) :: key
407 TYPE(
int_t) :: ptrint
408 REAL,
DIMENSION(:,:),
POINTER,
CONTIGUOUS :: ptr2
409 REAL,
DIMENSION(:,:,:),
POINTER :: ptr3
410 REAL,
DIMENSION(:,:,:,:),
POINTER :: ptr4
411 REAL,
DIMENSION(:,:,:,:,:),
POINTER :: ptr5
412 INTEGER,
DIMENSION(5) :: dims
414 CHARACTER(LEN=1),
DIMENSION(:),
POINTER :: val
416 INTEGER(KIND=MPI_OFFSET_KIND) :: omax,omin
422 NULLIFY(ptr2,ptr3,ptr4,ptr5)
426 CALL getattr(node,key,ptr2)
427 dims(1:2) = shape(ptr2)
429 CALL getattr(node,key,ptr3)
430 dims(1:3) = shape(ptr3)
432 CALL getattr(node,key,ptr4)
433 dims(1:4) = shape(ptr4)
435 CALL getattr(node,key,ptr5)
436 dims(1:5) = shape(ptr5)
439 IF(product(dims).GT.1)
THEN
440 CALL this%SetOutputDims(mesh,dims)
441 bytes = product(dims(1:3)) * this%realsize
443 product(dims)*this%realsize,dims)
446 IF(
ASSOCIATED(ptr4))
THEN
447 ptr3 => ptr4(:,:,:,k)
448 ELSE IF(
ASSOCIATED(ptr5))
THEN
449 ptr3 => ptr5(:,:,:,k,l)
450 ELSE IF(
ASSOCIATED(ptr2))
THEN
451 ptr3(1:dims(1),1:dims(2),1:1) => ptr2
453 SELECT TYPE(df=>this%datafile)
456 WRITE (unit=df%GetUnitNumber(),iostat=this%err) ptr3
459 IF(this%HasMeshDims(mesh,shape(ptr3)))
THEN
460 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,default_mpi_real,&
461 df%filetype,
'native', mpi_info_null, this%err)
462 CALL mpi_file_write_all(df%GetUnitNumber(),ptr3,this%bufsize,&
463 default_mpi_real,df%status,this%err)
465 ELSE IF(this%HasCornerDims(mesh,shape(ptr3)))
THEN
466 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,default_mpi_real,&
467 df%cfiletype,
'native', mpi_info_null, this%err)
468 CALL mpi_file_write_all(df%GetUnitNumber(),ptr3(1:this%clsizes(1),1:this%clsizes(2),1:this%clsizes(3)),&
469 this%cbufsize,default_mpi_real,df%status,this%err)
471 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,mpi_byte,&
472 mpi_byte,
'native', mpi_info_null, this%err)
473 IF(this%GetRank().EQ.0)
THEN
474 CALL mpi_file_write(df%GetUnitNumber(),ptr3,bytes,mpi_byte, &
480 CALL this%Error(
"fileio_binary::WriteNode",
"unknown file handle")
482 this%offset = this%offset + bytes
488 CALL getattr(node,key,ptr0)
489 bytes = this%realsize
491 SELECT TYPE(df=>this%datafile)
494 WRITE (unit=df%GetUnitNumber(),iostat=this%err) ptr0%p
497 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,mpi_byte,&
498 mpi_byte,
'native', mpi_info_null, this%err)
499 IF(this%GetRank().EQ.0) &
500 CALL mpi_file_write(df%GetUnitNumber(),ptr0%p,bytes,mpi_byte, &
504 CALL this%Error(
"fileio_binary::WriteNode",
"unknown file handle")
507 CALL getattr(node,key,ptrint)
509 CALL this%WriteKey(key,
dict_int,bytes)
510 SELECT TYPE(df=>this%datafile)
513 WRITE (unit=df%GetUnitNumber(),iostat=this%err) ptrint%p
516 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,mpi_byte,&
517 mpi_byte,
'native', mpi_info_null, this%err)
518 IF(this%GetRank().EQ.0) &
519 CALL mpi_file_write(df%GetUnitNumber(),ptrint%p,bytes,mpi_byte, &
523 CALL this%Error(
"fileio_binary::WriteNode",
"unknown file handle")
527 IF(
ASSOCIATED(val))
THEN
534 SELECT TYPE(df=>this%datafile)
537 WRITE (unit=df%GetUnitNumber(),iostat=this%err) val
540 CALL mpi_file_set_view(df%GetUnitNumber(),this%offset,mpi_byte,&
541 mpi_byte,
'native', mpi_info_null, this%err)
542 IF(this%GetRank().EQ.0)
THEN
543 CALL mpi_file_write(df%GetUnitNumber(),val,bytes,mpi_byte, &
548 CALL this%Error(
"fileio_binary::WriteNode",
"unknown file handle")
552 this%offset = this%offset + bytes
565 CALL mpi_allreduce(this%offset,omax,1,mpi_offset,mpi_max,&
566 mesh%comm_cart,this%err)
567 CALL mpi_allreduce(this%offset,omin,1,mpi_offset,mpi_min,&
568 mesh%comm_cart,this%err)
569 IF((this%offset.NE.omax).OR.(this%offset.NE.omin)) &
570 CALL this%Error(
"WriteNode_binary",&
571 "The offsets on different nodes are not in sync anymore." //
lf &
572 //
"The last key was '" // trim(key) //
"'.")
582 INTEGER,
DIMENSION(:),
INTENT(IN) :: dims
585 IF(
SIZE(dims).GE.3)
THEN
586 res = all(dims(1:3).EQ.(/mesh%IMAX-mesh%IMIN+1, &
587 mesh%JMAX-mesh%JMIN+1, &
588 mesh%KMAX-mesh%KMIN+1/))
600 INTEGER,
DIMENSION(:) :: dims
605 IF(
SIZE(dims).GE.3)
THEN
607 res = all(dims(1:3).EQ.(/mesh%IMAX-mesh%IMIN+mesh%IP1+1, &
608 mesh%JMAX-mesh%JMIN+mesh%JP1+1, &
609 mesh%KMAX-mesh%KMIN+mesh%KP1+1/))
621 INTEGER,
DIMENSION(:),
INTENT(INOUT):: dims
623 IF(this%HasMeshDims(mesh,dims))
THEN
624 dims(1:3) = (/mesh%INUM,mesh%JNUM,mesh%KNUM/)
625 ELSE IF(this%HasCornerDims(mesh,dims))
THEN
626 dims(1:3) = (/mesh%INUM,mesh%JNUM,mesh%KNUM/)
627 WHERE ((/mesh%INUM,mesh%JNUM,mesh%KNUM/).GT.1)
630 dims(1:3) = dims(1:3) + 1
646 TYPE(
dict_typ),
POINTER :: Header,IO
648 CALL this%WriteDataAttributes(mesh,io)
678 SELECT TYPE(df=>this%datafile)
680 CALL mpi_type_free(df%cfiletype,this%err)
681 CALL mpi_type_free(df%filetype,this%err)
684 CALL this%Finalize_base()
Dictionary for generic data types.
integer, parameter, public dict_real
pointer, public getdata(root)
Return the datatype of node 'root'.
logical function, public haschild(root)
Check if the node 'root' has one or more children.
integer, parameter, public dict_real_fourd
integer, parameter, public dict_real_threed
integer, parameter, public dict_int_p
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_twod
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 append
read/write access at end
module for binary file I/O
recursive subroutine writedataattributes(this, Mesh, config, path)
Writes data attributes to a file.
subroutine initfileio_binary(this, Mesh, Physics, Timedisc, Sources, config, IO)
Constructor for the binary file I/O.
subroutine writekey(this, key, type, bytes, dims)
Writes key structure This subroutine writes the the key, data type and data sizes....
subroutine writeheader(this, Mesh, Physics, Header, IO)
Write the file header The header is written in ASCII and is 13 Byte long. First a "magic" identifier ...
subroutine setoutputdims(this, Mesh, dims)
character, parameter lf
line feed
subroutine finalize(this)
Closes the file I/O.
subroutine writenode(this, Mesh, key, node)
logical function hasmeshdims(this, Mesh, dims)
logical function hascornerdims(this, Mesh, dims)
subroutine writedataset_binary(this, Mesh, Physics, Fluxes, Timedisc, Header, IO)
Writes all desired data arrays to a file.
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
container class to manage the list of source terms