mirror of
https://gitlab.com/scemama/EZFIO.git
synced 2025-01-03 01:55:44 +01:00
Fixed Fortran write character arrays
Version:1.6.0
This commit is contained in:
parent
baa47ab0a9
commit
e27ef1c7f4
@ -141,7 +141,7 @@ BEGIN_SHELL [ /usr/bin/env python2 ]
|
|||||||
from f_types import format, t_short
|
from f_types import format, t_short
|
||||||
|
|
||||||
|
|
||||||
template = """
|
template_nowrite = """
|
||||||
subroutine ezfio_read_%(type_short)s(dir,fil,dat)
|
subroutine ezfio_read_%(type_short)s(dir,fil,dat)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
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')
|
call ezfio_error(irp_here,'Attribute '//trim(l_filename)//' is not set')
|
||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
"""
|
||||||
|
|
||||||
|
template_write = """
|
||||||
subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
|
subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
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,'(I3)') rank
|
||||||
write(libezfio_iunit,'(30(I20,X))') dims(1:rank)
|
write(libezfio_iunit,'(30(I20,X))') dims(1:rank)
|
||||||
close(unit=libezfio_iunit)
|
close(unit=libezfio_iunit)
|
||||||
|
|
||||||
allocate (buffer(dim_max))
|
allocate (buffer(dim_max))
|
||||||
!$OMP PARALLEL DO PRIVATE(i)
|
!$OMP PARALLEL DO PRIVATE(i)
|
||||||
do i=1,dim_max
|
do i=1,dim_max
|
||||||
@ -276,6 +277,7 @@ subroutine ezfio_write_array_%(type_short)s(dir,fil,rank,dims,dim_max,dat)
|
|||||||
end
|
end
|
||||||
"""
|
"""
|
||||||
|
|
||||||
|
|
||||||
template_no_logical = """
|
template_no_logical = """
|
||||||
integer function n_count_%(type_short)s(array,isize,val)
|
integer function n_count_%(type_short)s(array,isize,val)
|
||||||
implicit none
|
implicit none
|
||||||
@ -298,7 +300,9 @@ end function
|
|||||||
! Build Python functions
|
! Build Python functions
|
||||||
"""
|
"""
|
||||||
for t in format.keys():
|
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":
|
if t != "logical":
|
||||||
print template_no_logical%{ 'type_short' : t_short(t), 'type' : t, 'fmt':format[t][0] }
|
print template_no_logical%{ 'type_short' : t_short(t), 'type' : t, 'fmt':format[t][0] }
|
||||||
|
|
||||||
@ -398,6 +402,50 @@ file_py.close()
|
|||||||
|
|
||||||
END_SHELL
|
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_PROVIDER [ integer, libezfio_buffer_rank ]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Rank of the buffer ready for reading
|
! Rank of the buffer ready for reading
|
||||||
|
Loading…
Reference in New Issue
Block a user