Line data    Source code

       1             : !> \file    mo_io.f90
       2             : !> \brief \copybrief mo_io
       3             : !> \details \copydetails mo_io
       4             : 
       5             : !> \brief   File reading routines.
       6             : !> \details This module provides routines to load a file into an array.
       7             : !!          This is mainly taken from the Fortran stdlib: https://github.com/fortran-lang/stdlib
       8             : !> \version 0.1
       9             : !> \authors Sebastian Mueller
      10             : !> \date    Apr 2022
      11             : !> \copyright Copyright 2005-\today, the CHS Developers, Sabine Attinger: All rights reserved.
      12             : !! FORCES is released under the LGPLv3+ license \license_note
      13             : module mo_io
      14             : 
      15             :   use mo_kind, only: i4, dp, sp
      16             :   use mo_message, only: error_message
      17             :   use mo_string_utils, only: is_blank
      18             : 
      19             :   implicit none
      20             :   private
      21             :   public :: loadtxt
      22             :   public :: number_of_columns
      23             :   public :: number_of_rows
      24             : 
      25             :   !> \brief   Read a file into a 2D array containing reals.
      26             :   interface loadtxt
      27             :     module procedure loadtxt_dp, loadtxt_sp
      28             :   end interface loadtxt
      29             : 
      30             : contains
      31             : 
      32             :   !> \brief   Read a file into a 2D array containing reals.
      33           2 :   subroutine loadtxt_dp(filename, d, skiprows, max_rows)
      34             : 
      35             :     !> Filename to load the array from
      36             :     character(len=*), intent(in) :: filename
      37             :     !> The array 'd' will be automatically allocated with the correct dimensions
      38             :     real(dp), allocatable, intent(out) :: d(:,:)
      39             :     !> lines to skip at the begining
      40             :     integer(i4), intent(in), optional :: skiprows
      41             :     !> Read max_rows lines of content after skiprows lines. The default is to read all the lines (negative values).
      42             :     integer(i4), intent(in), optional :: max_rows
      43             : 
      44             :     integer(i4) :: u,  nrow, ncol, i, skiprows_, max_rows_
      45             : 
      46           2 :     skiprows_ = 0
      47           2 :     if ( present(skiprows) ) skiprows_ = max(skiprows, 0)
      48             : 
      49           2 :     max_rows_ = -1
      50           2 :     if ( present(max_rows) ) max_rows_ = max_rows
      51             : 
      52           2 :     open(newunit=u, file=filename, action='read', position='asis', status='old', access='stream', form='formatted')
      53             : 
      54             :     ! determine size
      55           2 :     ncol = number_of_columns(u)
      56           2 :     nrow = number_of_rows(u)
      57           2 :     skiprows_ = min(skiprows_, nrow)
      58           2 :     if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_)) max_rows_ = nrow - skiprows_
      59             : 
      60           8 :     allocate(d(max_rows_, ncol))
      61             : 
      62           6 :     do i = 1, skiprows_
      63           6 :       read(u, *)
      64             :     end do
      65             : 
      66       14602 :     do i = 1, max_rows_
      67       14602 :       read(u, "(*(es24.16e3,1x))") d(i, :)
      68             :     end do
      69             : 
      70           2 :     close(u)
      71             : 
      72           2 :   end subroutine loadtxt_dp
      73             : 
      74             :   !> \brief   Read a file into a 2D array containing reals.
      75           0 :   subroutine loadtxt_sp(filename, d, skiprows, max_rows)
      76             : 
      77             :     !> Filename to load the array from
      78             :     character(len=*), intent(in) :: filename
      79             :     !> The array 'd' will be automatically allocated with the correct dimensions
      80             :     real(sp), allocatable, intent(out) :: d(:,:)
      81             :     !> lines to skip at the begining
      82             :     integer(i4), intent(in), optional :: skiprows
      83             :     !> Read max_rows lines of content after skiprows lines. The default is to read all the lines (negative values).
      84             :     integer(i4), intent(in), optional :: max_rows
      85             : 
      86             :     integer(i4) :: u, nrow, ncol, i, skiprows_, max_rows_
      87             : 
      88           0 :     skiprows_ = 0
      89           0 :     if ( present(skiprows) ) skiprows_ = max(skiprows, 0)
      90             : 
      91           0 :     max_rows_ = -1
      92           0 :     if ( present(max_rows) ) max_rows_ = max_rows
      93             : 
      94           0 :     open(newunit=u, file=filename, action='read', position='asis', status='old', access='stream', form='formatted')
      95             : 
      96             :     ! determine size
      97           0 :     ncol = number_of_columns(u)
      98           0 :     nrow = number_of_rows(u)
      99           0 :     skiprows_ = min(skiprows_, nrow)
     100           0 :     if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_)) max_rows_ = nrow - skiprows_
     101             : 
     102           0 :     allocate(d(max_rows_, ncol))
     103             : 
     104           0 :     do i = 1, skiprows_
     105           0 :       read(u, *)
     106             :     end do
     107             : 
     108           0 :     do i = 1, max_rows_
     109           0 :       read(u, "(*(es15.8e2,1x))") d(i, :)
     110             :     end do
     111             : 
     112           0 :     close(u)
     113             : 
     114           2 :   end subroutine loadtxt_sp
     115             : 
     116             :   !> \brief   Determine number of columns in a file. The columns are assumed to be separated by spaces or tabs.
     117             :   !> \return  Number of columns.
     118           2 :   integer function number_of_columns(u)
     119             : 
     120             :     integer(i4),intent(in) :: u !< unit of the open file
     121             :     integer(i4) :: ios
     122             :     character :: c
     123             :     logical :: lastblank
     124             : 
     125           2 :     rewind(u)
     126           2 :     number_of_columns = 0
     127           2 :     lastblank = .true.
     128             :     do
     129          20 :       read(u, '(a)', advance='no', iostat=ios) c
     130          20 :       if (ios /= 0) exit
     131          18 :       if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1
     132           2 :       lastblank = is_blank(c)
     133             :     end do
     134           2 :     rewind(u)
     135             : 
     136           0 :   end function number_of_columns
     137             : 
     138             :   !> \brief   Determine number of rows in a file.
     139             :   !> \return  Number of rows.
     140           2 :   integer function number_of_rows(u)
     141             : 
     142             :     integer(i4), intent(in) :: u !< unit of the open file
     143             :     integer(i4) :: ios
     144             : 
     145           2 :     rewind(u)
     146           2 :     number_of_rows = 0
     147       14604 :     do
     148       14606 :       read(u, *, iostat=ios)
     149       14606 :       if (ios /= 0) exit
     150       14604 :       number_of_rows = number_of_rows + 1
     151             :     end do
     152           2 :     rewind(u)
     153             : 
     154           2 :   end function number_of_rows
     155             : 
     156             : end module mo_io