LCPQ/EZFIO
10
0
Fork 0
mirror of https://gitlab.com/scemama/EZFIO.git synced 2024-12-22 04:13:34 +01:00
Code Releases Activity

Fixed Fortran write character arrays

Browse Source 
Version:1.6.0
This commit is contained in:
Anthony Scemama 2019-10-24 21:21:10 +02:00
parent baa47ab0a9
commit e27ef1c7f4
2 changed files with 52 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/libezfio_util.irp.f
View File

@ -141,7 +141,7 @@ BEGIN_SHELL [ /usr/bin/env python2 ]
from f_types import format, t_short
template = """
template_nowrite = """
subroutine ezfio_read_%(type_short)s(dir,fil,dat)
implicit none
BEGIN_DOC
@ -232,7 +232,9 @@ subroutine ezfio_read_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
call ezfio_error(irp_here,'Attribute '//trim(l_filename)//' is not set')
endif
end
"""
template_write = """
subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
implicit none
BEGIN_DOC
@ -259,7 +261,6 @@ subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
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
@ -276,6 +277,7 @@ subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
end
"""
template_no_logical = """
integer function n_count_%(type_short)s(array,isize,val)
implicit none
@ -298,7 +300,9 @@ end function
! Build Python functions
"""
for t in format.keys():
print template%{ 'type_short' : t_short(t), 'type' : t, 'fmt':format[t][0] }
print template_nowrite%{ 'type_short' : t_short(t), 'type' : t, 'fmt':format[t][0] }
if not t.startswith("character"):
print template_write%{ 'type_short' : t_short(t), 'type' : t, 'fmt':format[t][0] }
if t != "logical":
print template_no_logical%{ 'type_short' : t_short(t), 'type' : t, 'fmt':format[t][0] }
@ -398,6 +402,50 @@ file_py.close()
END_SHELL
subroutine ezfio_write_array_ch(dir,fil,rank,dims,dim_max,dat)
implicit none
BEGIN_DOC
! Writes a string array
END_DOC
character*(*), intent(in) :: dir, fil
integer, intent(in) :: rank
integer, intent(in) :: dims(rank)
integer, intent(in) :: dim_max
character*(*), intent(in) :: dat(dim_max)
integer :: err
integer :: i
character*(1024) :: l_filename(2)
integer :: length
character(len=:), allocatable :: buffer(:)
if (libezfio_read_only) then
call ezfio_error(irp_here,'Read-only file.')
endif
l_filename(1)=trim(dir)//'/.'//fil//trim(PID_str)//'.gz'
l_filename(2)=trim(dir)//'/'//fil//'.gz'
err = 0
call libezfio_openz(trim(l_filename(1)),'wb',err)
if (err == 0) then
write(libezfio_iunit,'(I3)') rank
write(libezfio_iunit,'(30(I20,X))') dims(1:rank)
close(unit=libezfio_iunit)
length = len(dat(1))
allocate( character(len=length+1) :: buffer(dim_max) )
!$OMP PARALLEL DO PRIVATE(i)
do i=1,dim_max
write(buffer(i)(1:length), '(A)') dat(i)
buffer(i)(length+1:length+1) = ACHAR(10)
enddo
!$OMP END PARALLEL DO
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 rename(trim(l_filename(1)),trim(l_filename(2)) )
end
BEGIN_PROVIDER [ integer, libezfio_buffer_rank ]
BEGIN_DOC
! Rank of the buffer ready for reading

2
version
View File

@ -1 +1 @@
VERSION=1.5.0
VERSION=1.6.0