io.f90

Go to the documentation of this file.

module io

  use real_type, only: rp
  use basic_tools
  use choral_variables

  implicit none  
  private


  !       %----------------------------------------%
  !       |                                        |
  !       |          PUBLIC DATA                   |
  !       |                                        |
  !       %----------------------------------------%
  public :: file_exists        ! TESTED
  public :: write              ! TESTED
  public :: read               ! TESTED

  !       %----------------------------------------%
  !       |                                        |
  !       |       GENERIc SUBROUTINES              |
  !       |                                        |
  !       %----------------------------------------%
  interface write
     module procedure  writevec_f, writevec_i
     module procedure  writearray_f
  end interface write

  interface read
     module procedure  readvec_f, readvec_i
     module procedure  readarray_f
  end interface read

contains
  
  subroutine writearray_f(tab, fic, transpose)  
    real(RP)      , dimension(:,:), intent(in) :: tab
    character(len=*), intent(in)               :: fic
    logical         , intent(in), optional     :: transpose
    
    integer :: ii, jj

    logical :: bool

    if (choral_verb>2) write(*,*) &
         & 'io              : writeArray_f   = '&
         &, trim(fic)
    open(unit=60,file=fic)   

    bool = .false.
    if (present(transpose)) bool = transpose

    if (bool) then

       !! write transpose(tab)
       do ii=1, size(tab,2)
          do jj=1, size(tab,1)
             write(60, '(7g27.16)', advance='no') tab(jj, ii)
          end do
          write(60, '(7g27.16)', advance='yes') 
       end do

    else

       do ii=1, size(tab,1)
          do jj=1, size(tab,2)
             write(60, '(7g27.16)', advance='no') tab(ii,jj)
          end do
          write(60, '(7g27.16)', advance='yes') 
       end do

    end if

    close(60)
  end subroutine writearray_f

  subroutine writevec_f(vec,fic)  
    real(RP)      , dimension(:), intent(in) :: vec
    character(len=*), intent(in)               :: fic
    
    integer :: i,sz

    if (choral_verb>2) write(*,*) &
         & 'io              : writeVec_f     = ',&
         & trim(fic)
    sz=size(vec,1)
    open(unit=60,file=fic)   
    do i=1, sz
       write(60,*) vec(i)
    end do   
    close(60)

  end subroutine writevec_f

  subroutine writevec_i(vec,fic)  
    integer, dimension(:), intent(in) :: vec
    character(len=*)  , intent(in) :: fic
    
    integer :: i,sz

    if (choral_verb>2) write(*,*) &
         & 'io              : writeVec_i     = ',&
    & trim(fic)
    sz=size(vec,1)
    open(unit=60,file=fic)  
     do i=1, sz
        write(60,*) vec(i)
     end do
    close(60)

  end subroutine writevec_i


  subroutine readvec_f(vec,fic)  
    real(RP), dimension(:), intent(out) :: vec
    character(len=*)      , intent(in)  :: fic

    integer :: i,sz

    sz = count_lines(fic)
    if(sz/=size(vec,1)) call quit( 'io: readVec_f' )

    open(unit=60,file=fic)   
    do i=1, sz
       read(60,*) vec(i)
    end do   
    close(60)

  end subroutine readvec_f



  subroutine readarray_f(vec,fic)  
    real(RP), dimension(:,:), intent(out) :: vec
    character(len=*)        , intent(in)  :: fic

    integer :: ii, sz

    sz = count_lines(fic)
    if(sz/=size(vec,2)) call quit( 'io: readArray_f' )

    open(unit=60,file=fic)   
    do ii=1, size(vec,2)
       read(60,*) vec(1:size(vec,1), ii)
    end do   
    close(60)

  end subroutine readarray_f



  subroutine readvec_i(vec,fic)  
    integer, dimension(:), intent(out) :: vec
    character(len=*)  , intent(in) :: fic
    
    integer :: i,sz

    if (choral_verb>2) write(*,*) &
         & 'io              : readVec_i      = ',&
         & trim(fic)

    sz = count_lines(fic)
    if(sz/=size(vec,1)) call quit( 'io: readVec_i' )

    sz=size(vec,1)
    open(unit=60,file=fic)  
     do i=1, sz
        read(60,*) vec(i)
     end do
    close(60)

  end subroutine readvec_i


  function count_lines(fic) result(res)
    character(len=*)  , intent(in) :: fic
    integer :: res

    character(len=120) :: sh_comm

    if(.NOT.file_exists(trim(fic))) call quit( &
            &  "io: count_lines "//trim(fic) )

    sh_comm='wc -l '//trim(fic)//' > xxxx'
    call system(trim(sh_comm))
    open(1,file='xxxx')
    read(1,*) res
    close(1)

    sh_comm='rm -f xxxx'
    call system(trim(sh_comm))

  end function count_lines

  function file_exists(filename) result(res)
    character(len=*),intent(in) :: filename
    logical                     :: res

    inquire( file=trim(filename), exist=res )
  end function file_exists


end module io