get_values.f

Go to the documentation of this file.

!      program test; call tester; end program test

      subroutine get_values_tester
      implicit none

      integer          :: i
      double precision :: value1 , value2 , value3
       character(len=81)     :: line

      open (unit=10,file='BURCAT.THR',status='old')
      do i = 1,9765
        read (10,'(a80)') line
      end do

      write (*,'(1x,a80)') line

      call get_values(line,value1,value2,value3)

      write (*,*) value1
      write (*,*) value2
      write (*,*) value3

      stop
      end subroutine get_values_tester


      subroutine get_values(line,value1,value2,value3)

      implicit none

      character(*)    :: line
      character(len=80)     :: tokens(80)
      logical          :: bSpace
      integer          :: nTokens , start , i
      double precision :: value1 , value2 , value3

      bspace = .false.
      ntokens = 0
      start = 1

      do i = 1,len(line)
        if (line(i:i).eq.char(9) .or. line(i:i).eq.char(32)) then
           if (.not.bspace) then
              bspace = .true.
               ntokens = ntokens + 1
              tokens(ntokens) = line(start:i-1)
           end if
        else
           if (bspace) start = i
           bspace = .false.
        end if
      end do

      if (start .ne. len(line)) ntokens = ntokens - 1

      if (ntokens .ge. 4) then
         read (tokens(ntokens  ),'(f16.8)') value3
         read (tokens(ntokens-1),'(f16.8)',err=111) value2
         read (tokens(ntokens-2),'(f16.8)') value1
         return
 111     continue
         read (tokens(ntokens-3),'(f16.8)') value1
         read (tokens(ntokens-2),'(f16.8)') value2
       end if


       return
       end