LCPQ
/
EZFIO
mirror of https://gitlab.com/scemama/EZFIO.git
10
0
Fork 0
Code Releases Activity

Accelerated write

This commit is contained in:
Anthony Scemama 2018-06-05 23:34:18 +02:00
parent d96976828b
commit 4142dac475
1 changed files with 29 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/libezfio_util.irp.f
View File

@ -94,6 +94,28 @@ subroutine libezfio_openz(filename,mode,err)
endif
end
subroutine libezfio_reopenz_unformatted(filename,mode,err)
implicit none
BEGIN_DOC
! Opens a compressed file
END_DOC
character*(*) :: filename, mode
character*(1024) :: fifo
integer :: err
fifo = trim(filename)//'.'//trim(PID_str)
err=1
if (mode(1:1) == 'r') then
call ezfio_error(irp_here,'Mode '//trim(mode)//' is not implemented.')
else if (mode(1:1) == 'w') then
close(unit=libezfio_iunit)
open(unit=libezfio_iunit,file=trim(fifo),form='UNFORMATTED',action='WRITE',access='STREAM',position='APPEND')
err=0
else
call ezfio_error(irp_here,'Mode '//trim(mode)//' is not implemented.')
endif
end
subroutine libezfio_closez(filename,mode)
implicit none
BEGIN_DOC
@ -220,7 +242,7 @@ subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
integer :: err
integer :: i
character*(1024) :: l_filename(2)
character*(32), allocatable :: buffer(:)
character*(25), allocatable :: buffer(:)
if (libezfio_read_only) then
call ezfio_error(irp_here,'Read-only file.')
endif
@ -232,16 +254,19 @@ subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
if (err == 0) then
write(libezfio_iunit,'(I3)') rank
write(libezfio_iunit,'(30(I20,X))') dims(1:rank)
close(unit=libezfio_iunit)
allocate (buffer(dim_max))
!$OMP PARALLEL DO PRIVATE(i)
do i=1,dim_max
write(buffer(i), %(fmt)s) dat(i)
write(buffer(i)(1:24), %(fmt)s) dat(i)
buffer(i)(25:25) = ACHAR(10)
enddo
!$OMP END PARALLEL DO
write(libezfio_iunit,'(A)') buffer(1:dim_max)
deallocate(buffer)
call libezfio_reopenz_unformatted(trim(l_filename(1)),'wb',err)
write(libezfio_iunit) buffer
call libezfio_closez(trim(l_filename(1)),'w')
deallocate(buffer)
endif
call system( 'mv -f '//trim(l_filename(1))//' '//trim(l_filename(2)) )
end