Fixed Fortran write character arrays

Version:1.6.0

src/libezfio_util.irp.f

@@ -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

version

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