TABLE OF CONTENTS
ABINIT/inread [ Functions ]
NAME
inread
FUNCTION
Carry out internal read from input character string, starting at first character in string, reading ndig digits (including possible sign, decimal, and exponent) by computing the appropriate format and performing a formatted read (list-directed read would be perfect for this application but is inconsistent with internal read according to Fortran90 standard). In case of a real number, this routine is also able to read SQRT(number): return the square root of the number.
COPYRIGHT
Copyright (C) 1998-2017 ABINIT group (DCA, XG, GMR). This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
INPUTS
string=character string. ndig=length of field to be read (including signs, decimals, and exponents). typevarphys=variable type (might indicate the physical meaning of for dimensionality purposes) 'INT'=>integer 'DPR','LEN','ENE'=>real(dp) (no special treatment) 'LOG'=>integer, but read logical variable T,F,.true., or .false. 'KEY'=>character, returned in token
OUTPUT
outi or outr (integer or real respectively) errcod, =0 for success, 1,2 for ini, inr failure resp.
PARENTS
adini,inarray
CHILDREN
SOURCE
44 #if defined HAVE_CONFIG_H 45 #include "config.h" 46 #endif 47 48 #include "abi_common.h" 49 50 51 subroutine inread(string,ndig,typevarphys,outi,outr,errcod) 52 53 use defs_basis 54 use m_profiling_abi 55 use m_errors 56 57 !This section has been created automatically by the script Abilint (TD). 58 !Do not modify the following lines by hand. 59 #undef ABI_FUNC 60 #define ABI_FUNC 'inread' 61 !End of the abilint section 62 63 implicit none 64 65 !Arguments ------------------------------------ 66 !scalars 67 integer,intent(in) :: ndig 68 integer,intent(out) :: errcod,outi 69 real(dp),intent(out) :: outr 70 character(len=*),intent(in) :: string 71 character(len=*),intent(in) :: typevarphys 72 73 !Local variables------------------------------- 74 !scalars 75 integer :: done,idig,index_slash,sign 76 real(dp) :: den,num 77 logical :: logi 78 character(len=500) :: msg 79 80 ! ************************************************************************* 81 82 !write(std_out,*)'inread : enter ' 83 !write(std_out,*)'string(1:ndig)=',string(1:ndig) 84 !write(std_out,*)'typevarphys=',typevarphys 85 86 if (typevarphys=='INT') then 87 88 ! integer input section 89 read (unit=string(1:ndig),fmt=*,iostat=errcod) outi 90 if(errcod/=0)then 91 ! integer reading error 92 write(std_out,'(/,a,/,a,i0,a)' ) & 93 & ' inread : ERROR -',& 94 & ' Attempted to read ndig=',ndig,' integer digits,' 95 write(std_out,'(a,a,a)' ) ' from string(1:ndig)= ',string(1:ndig),& 96 & ', to initialize an integer variable' 97 errcod=1 98 end if 99 100 else if (typevarphys=='DPR' .or. typevarphys=='LEN' .or. typevarphys=='ENE' .or. typevarphys=='BFI') then 101 102 ! real(dp) input section 103 104 ! Special treatment of SQRT(xxx) or -SQRT(xxx) chains of characters, where xxx can be a fraction 105 done=0 106 if (ndig>5) then 107 if(string(1:5)=='SQRT(' .and. string(ndig:ndig)==')')then 108 done=1 ; sign=1 109 else if(string(1:6)=='-SQRT(' .and. string(ndig:ndig)==')')then 110 done=1 ; sign=2 111 end if 112 if(done==1)then 113 index_slash=index(string(5+sign:ndig-1),'/') 114 if(index_slash==0)then 115 read (unit=string(5+sign:ndig-1),fmt=*,iostat=errcod) outr 116 else if(index_slash/=0)then 117 read (unit=string(5+sign:5+sign+index_slash-2),fmt=*,iostat=errcod) num 118 if(errcod==0)then 119 read (unit=string(5+sign+index_slash:ndig-1),fmt=*,iostat=errcod) den 120 if(errcod==0)then 121 if(abs(den)<tol12)then 122 errcod=1 123 else 124 outr=num/den 125 end if 126 end if 127 end if 128 end if 129 if(outr<-tol12)then 130 errcod=1 131 else 132 outr=sqrt(outr) 133 if(sign==2)outr=-outr 134 end if 135 end if 136 end if 137 138 ! Special treatment of fractions 139 if(done==0)then 140 index_slash=index(string(1:ndig),'/') 141 if(index_slash/=0)then 142 done=1 143 read (unit=string(1:index_slash-1),fmt=*,iostat=errcod) num 144 if(errcod==0)then 145 read (unit=string(index_slash+1:ndig),fmt=*,iostat=errcod) den 146 if(errcod==0)then 147 if(abs(den)<tol12)then 148 errcod=1 149 else 150 outr=num/den 151 end if 152 end if 153 end if 154 end if 155 end if 156 157 ! Normal treatment of floats 158 if(done==0)then ! Normal treatment of float numbers 159 read (unit=string(1:ndig),fmt=*,iostat=errcod) outr 160 end if 161 162 ! Treatment of errors 163 if(errcod/=0)then 164 ! real(dp) data reading error 165 write(std_out,'(/,a,/,a,i0,a)' ) & 166 & 'inread : ERROR -',& 167 & 'Attempted to read ndig=',ndig,' floating point digits,' 168 write(std_out,'(a,a,a)' ) ' from string(1:ndig) ',string(1:ndig),& 169 & ', to initialize a floating variable.' 170 errcod=2 171 end if 172 173 else if (typevarphys=='LOG') then 174 175 read (unit=string(1:ndig),fmt=*,iostat=errcod) logi 176 if(errcod/=0)then 177 ! integer reading error 178 write(std_out,'(/,a,/,a,i0,a)' ) & 179 & 'inread : ERROR -',& 180 & 'Attempted to read ndig=',ndig,' integer digits,' 181 write(std_out,'(a,a,a)' ) ' from string(1:ndig)= ',string(1:ndig),', to initialize a logical variable.' 182 errcod=3 183 end if 184 if(logi)outi=1 185 if(.not.logi)outi=0 186 187 else 188 write(msg,'(4a)' ) & 189 & 'Argument typevarphys must be INT,DPR,LEN,ENE,BFI or LOG ',ch10,& 190 & 'but input value was: ',trim(typevarphys) 191 MSG_ERROR(msg) 192 end if 193 194 if(errcod /= 0)then 195 do idig=1,ndig 196 if( string(idig:idig) == 'O' )then 197 write(std_out,'(/,a,/,a,a,a)' ) & 198 & 'inread : WARNING -',& 199 & 'Note that this string contains the letter O. ',ch10,& 200 & 'It is likely that this letter should be replaced by the number 0.' 201 exit 202 end if 203 end do 204 end if 205 206 end subroutine inread