1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
! This file is part of xtb.
!
! Copyright (C) 2017-2020 Stefan Grimme
!
! xtb is free software: you can redistribute it and/or modify it under
! the terms of the GNU Lesser General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! xtb is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with xtb. If not, see <https://www.gnu.org/licenses/>.
!cuts the at blanks and tabstops and returns all floats and strings in order of occurence
subroutine cutline(line,floats,strings)
use xtb_mctc_accuracy, only : wp
implicit none
real(wp) floats(*),num
character(len=128) line,str,stmp
character(len=80) strings(3)
character(len=1) digit
integer i,ty,cs,cf
stmp=''
cs=1
cf=1
strings(:)=''
do i=1,len(trim(line))
digit=line(i:i)
if(digit.ne.' '.and.digit.ne.char(9)) then !should exclude tabstops and blanks, 9 is ascii code for tab
stmp=trim(stmp)//trim(digit)
elseif(stmp.ne.'')then
call checktype(stmp,num,str,ty) !get type of string, 0=number, 1=character
if(ty.eq.0) then
floats(cf)=num
cf=cf+1
elseif(ty.eq.1) then
strings(cs)=trim(str)
cs=cs+1
else
write(*,*)'Problem in checktype, must abort'
exit
endif
stmp=''
endif
if(i.eq.len(trim(line))) then !special case: end of line
call checktype(stmp,num,str,ty)
if(ty.eq.0) then
floats(cf)=num
cf=cf+1
elseif(ty.eq.1) then
strings(cs)=trim(str)
cs=cs+1
else
write(*,*)'Problem in checktype, must abort'
exit
endif
stmp=''
endif
enddo
end subroutine cutline
!this checks the type of the string and returns it cast to real or as string.
subroutine checktype(field,num,str,ty)
use xtb_mctc_accuracy, only : wp
implicit none
character(len=*) field,str
real(wp) num
integer i,e,ty
logical is_num
ty=99
str=''
is_num=.false.
read(field,'(F10.5)',IOSTAT=e)num !cast string on real and get error code; 0 means success.
if(e.eq.0)is_num=.true.
if(is_num)then
if(index(field,'.').ne.0) then !check for integer/real
read(field,'(F30.16)')num
ty=0
else !if integer, add .0 to string; otherwise cast to real does not work
str=trim(field)//'.0'
read(str,'(F30.16)')num
str=''
ty=0
endif
else
str=field
ty=1
endif
end subroutine checktype
|
