Line data    Source code

       1              : ! ***********************************************************************
       2              : !
       3              : !   Copyright (C) 2010-2019  The MESA Team
       4              : !
       5              : !   This program is free software: you can redistribute it and/or modify
       6              : !   it under the terms of the GNU Lesser General Public License
       7              : !   as published by the Free Software Foundation,
       8              : !   either version 3 of the License, or (at your option) any later version.
       9              : !
      10              : !   This program is distributed in the hope that it will be useful,
      11              : !   but WITHOUT ANY WARRANTY; without even the implied warranty of
      12              : !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
      13              : !   See the GNU Lesser General Public License for more details.
      14              : !
      15              : !   You should have received a copy of the GNU Lesser General Public License
      16              : !   along with this program. If not, see <https://www.gnu.org/licenses/>.
      17              : !
      18              : ! ***********************************************************************
      19              : 
      20              : module math_io
      21              : 
      22              :   use const_def, only: dp
      23              : 
      24              :   implicit none
      25              : 
      26              :   private
      27              : 
      28              :   public :: str_to_vector
      29              :   public :: str_to_double
      30              :   public :: double_to_str
      31              : 
      32              : contains
      33              : 
      34     40906859 :   subroutine str_to_vector (str, vec, n, ierr)
      35              : 
      36              :     character (len=*), intent(in)    :: str
      37              :     real(dp), pointer, intent(inout) :: vec(:)
      38              :     integer, intent(out)             :: n
      39              :     integer, intent(out)             :: ierr
      40              : 
      41              :     integer :: maxlen
      42              :     integer :: i
      43              :     integer :: j
      44              :     integer :: k
      45              :     integer :: l
      46              : 
      47     40906859 :     maxlen = size(vec,dim=1)
      48              : 
      49     40906859 :     n = 0
      50     40906859 :     ierr = 0
      51              : 
      52     40906859 :     l = len_trim(str)
      53              : 
      54     40906859 :     j = 1
      55              : 
      56    508234412 :     do i=1,maxlen
      57              : 
      58   1069879384 :        do while (j < l .and. str(j:j) == ' ')
      59   1069879384 :           j = j+1
      60              :        end do
      61              : 
      62              :        k = j
      63              : 
      64  10140522992 :        do while (k < l .and. str(k:k) /= ' ')
      65  10099616133 :           k = k+1
      66              :        end do
      67              : 
      68    508234412 :        call str_to_double(str(j:k),vec(i),ierr)
      69    508234412 :        if (ierr /= 0) then
      70              :           return
      71              :        end if
      72              : 
      73    508234412 :        n = i
      74              : 
      75    508234412 :        if (k == l) exit
      76              : 
      77    508234412 :        j = k+1
      78              : 
      79              :     end do
      80              : 
      81              :   end subroutine str_to_vector
      82              : 
      83              : 
      84    509330791 :   subroutine str_to_double (str, x, ierr)
      85              : 
      86              :     character(*), intent(in) :: str
      87              :     real(dp), intent(out)    :: x
      88              :     integer, intent(out)     :: ierr
      89              : 
      90    509330791 :     read(str, *, ROUND='COMPATIBLE', IOSTAT=ierr) x
      91              : 
      92    509330791 :   end subroutine str_to_double
      93              : 
      94              : 
      95            0 :   subroutine double_to_str (x, str)
      96              : 
      97              :     integer, parameter :: l=26
      98              : 
      99              :     real(dp), intent(in)          :: x
     100              :     character(len=l), intent(out) :: str
     101              : 
     102            0 :     write(str, 100, ROUND='COMPATIBLE') x
     103              : 100 format(1PD26.16)
     104              : 
     105            0 :   end subroutine double_to_str
     106              : 
     107              : end module math_io