TABLE OF CONTENTS
ABINIT/inarray [ Functions ]
NAME
inarray
FUNCTION
Read the array of narr numbers located immediately after a specified blank in a string of character. Might read instead one word, after the specified blank. Takes care of multipliers.
COPYRIGHT
Copyright (C) 1999-2017 ABINIT group (DCA, XG). 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
cs=character token
marr=dimension of the intarr and dprarr arrays, as declared in the
calling subroutine.
narr=actual size of array to be read in (if typevarphys='KEY', only narr=1 is allowed)
string=character string containing the data.
typevarphys=variable type (might indicate the physical meaning of
for dimensionality purposes)
'INT'=>integer
'DPR'=>real(dp) (no special treatment)
'LEN'=>real(dp) (expect a "length", identify bohr, au or angstrom,
and return in au -atomic units=bohr- )
'ENE'=>real(dp) (expect a "energy", identify Ha, hartree, eV, Ry, Rydberg)
'BFI'=>real(dp) (expect a "magnetic field", identify T, Tesla)
'LOG'=>integer, but read logical variable T,F,.true., or .false.
'KEY'=>character, returned in token cs
OUTPUT
intarr(1:narr), dprarr(1:narr) integer or real(dp) arrays, respectively, into which data is read. Use these arrays even for scalars. errcod: if /=0, then something went wrong in subroutine "inread" SIDE EFFECT b1=absolute location in string of blank which follows the token (will be modified in the execution) cs=at input : character token at output : chain of character replacing the token (only if typevarphys='KEY')
PARENTS
intagm
CHILDREN
inread,wrtout
SOURCE
56 #if defined HAVE_CONFIG_H 57 #include "config.h" 58 #endif 59 60 #include "abi_common.h" 61 62 63 subroutine inarray(b1,cs,dprarr,intarr,marr,narr,string,typevarphys) 64 65 use defs_basis 66 use m_errors 67 use m_profiling_abi 68 69 !This section has been created automatically by the script Abilint (TD). 70 !Do not modify the following lines by hand. 71 #undef ABI_FUNC 72 #define ABI_FUNC 'inarray' 73 use interfaces_14_hidewrite 74 use interfaces_42_parser, except_this_one => inarray 75 !End of the abilint section 76 77 implicit none 78 79 !Arguments ------------------------------------ 80 !scalars 81 integer,intent(in) :: marr,narr 82 integer,intent(inout) :: b1 83 character(len=*),intent(in) :: string 84 character(len=*),intent(in) :: typevarphys 85 character(len=fnlen),intent(inout) :: cs 86 !arrays 87 integer,intent(inout) :: intarr(marr) !vz_i 88 real(dp),intent(out) :: dprarr(marr) 89 90 !Local variables------------------------------- 91 character(len=1), parameter :: blank=' ' 92 !scalars 93 integer :: asciichar,b2,errcod,ii,integ,istar,nrep,strln 94 real(dp) :: factor,real8 95 character(len=3) :: typevar 96 character(len=500) :: message 97 98 ! ************************************************************************* 99 100 !DEBUG 101 !write(std_out,'(2a)' )' inarray : token=',trim(cs) 102 !write(std_out,'(a,i4)' )' inarray : narr=',narr 103 !write(std_out,'(2a)' )' inarray : typevarphys=',typevarphys 104 !ENDDEBUG 105 106 ii=0 107 typevar='INT' 108 if(typevarphys=='LOG')typevar='INT' 109 if(typevarphys=='DPR' .or. typevarphys=='LEN' .or. typevarphys=='ENE' .or. typevarphys=='BFI')typevar='DPR' 110 strln=len_trim(string) 111 112 do while (ii<narr) 113 114 ! Relative location of next blank after data 115 if(b1>=strln)exit ! b1 is the last character of the string 116 b2=index(string(b1+1:),blank) 117 ! If no second blank is found put the second blank just beyond strln 118 if(b2==0) b2=strln-b1+1 119 120 if(typevarphys=='KEY')then 121 cs=string(b1+1:b1+b2-1) 122 errcod=0 123 exit 124 end if 125 126 ! nrep tells how many times to repeat input in array: 127 nrep=1 128 129 ! Check for *, meaning repeated input (as in list-directed input): 130 istar=index(string(b1+1:b1+b2-1),'*') 131 if (istar/=0) then 132 if (istar==1) then ! Simply fills the array with the data, repeated as many times as needed 133 nrep=narr-ii 134 errcod=0 135 else 136 call inread(string(b1+1:b1+istar-1),istar-1,'INT',nrep,real8,errcod) 137 end if 138 if (errcod/=0) exit 139 ! Shift starting position of input field: 140 b1=b1+istar 141 b2=b2-istar 142 end if 143 144 ! Read data internally by calling inread at entry ini: 145 call inread(string(b1+1:b1+b2-1),b2-1,typevarphys,integ,real8,errcod) 146 if (errcod/=0) exit 147 148 ! Allow for list-directed input with repeat number nrep: 149 if(typevar=='INT')then 150 intarr(1+ii:min(nrep+ii,narr))=integ 151 else if(typevar=='DPR')then 152 dprarr(1+ii:min(nrep+ii,narr))=real8 153 else 154 MSG_BUG('Disallowed typevar='//typevar) 155 end if 156 ii=min(ii+nrep,narr) 157 158 ! Find new absolute location of next element of array: 159 b1=b1+b2 160 161 ! End do while (ii<narr). Note "exit" instructions within loop. 162 end do 163 164 !if (ii>narr) then 165 !write(message, '(a,a,a,a,a,a,a,a,a,a,i4,a,i4,a,a,a,a,a,a,a,a)' ) ch10,& 166 !' inarray : ERROR -',ch10,& 167 !& ' Too many data are provided in the input file for',ch10,& 168 !& ' the keyword "',cs,'" :',ch10,& 169 !& ' attempted to read',ii,' elements for array length',narr,ch10,& 170 !& ' This might be due to an erroneous value for the size ',ch10,& 171 !& ' of this array, in the input file.',ch10,& 172 !& ' Action : check the data provided for this keyword,',ch10,& 173 !& ' as well as its declared dimension. They do not match.' 174 !call wrtout(std_out,message,'COLL') 175 !end if 176 177 if(errcod/=0)then 178 179 write(message, '(8a,i0,a)' ) ch10,& 180 & ' inarray : ',ch10,& 181 & ' An error occurred reading data for keyword "',trim(cs),'",',ch10,& 182 & ' looking for ',narr,' array elements.' 183 call wrtout(std_out,message,do_flush=.true.) 184 185 write(message,'(8a)')& 186 & 'There is a problem with the input file : maybe ',ch10,& 187 & 'a disagreement between the declared dimension of the array,',ch10,& 188 & 'and the number of data actually provided. ',ch10,& 189 & 'Action: correct your input file, and especially the keywork', trim(cs) 190 MSG_ERROR(message) 191 end if 192 193 !In case of 'LEN', 'ENE', or 'BFI', try to identify the unit 194 if(typevarphys=='LEN' .or. typevarphys=='ENE' .or. typevarphys=='BFI')then 195 do 196 197 ! Relative location of next blank after data 198 if(b1>=strln)exit ! b1 is the last character of the string 199 b2=index(string(b1+1:),blank) 200 ! If no second blank is found put the second blank just beyond strln 201 if(b2==0) b2=strln-b1+1 202 203 ! DEBUG 204 ! write(std_out,*)' inarray : string(b1+1:)=',string(b1+1:) 205 ! write(std_out,*)' inarray : b2=',b2 206 ! write(std_out,*)' typevarphys==',typevarphys 207 ! ENDDEBUG 208 209 ! Identify the presence of a non-digit character 210 asciichar=iachar(string(b1+1:b1+1)) 211 if(asciichar<48 .or. asciichar>57)then 212 factor=one 213 if(typevarphys=='LEN' .and. b2>=7)then 214 if(string(b1+1:b1+6)=='ANGSTR')then 215 factor=one/Bohr_Ang 216 end if 217 else if(typevarphys=='ENE' .and. b2>=3)then 218 if(string(b1+1:b1+3)=='RY ')then 219 factor=half 220 else if(string(b1+1:b1+3)=='EV ')then 221 factor=one/Ha_eV 222 end if 223 else if(typevarphys=='ENE' .and. b2>=2)then 224 if(string(b1+1:b1+2)=='K ')then 225 factor=kb_HaK 226 end if 227 else if(typevarphys=='BFI' .and. b2>=2)then 228 if(string(b1+1:b1+2)=='T ' .or. string(b1+1:b1+2)=='TE')then 229 factor=BField_Tesla 230 end if 231 end if 232 dprarr(1:narr)=dprarr(1:narr)*factor 233 exit 234 else 235 ! A digit has been observed, go to the next sequence 236 b1=b2 237 cycle 238 end if 239 240 end do 241 end if 242 243 !DEBUG 244 !write(std_out,*)' inarray : exit ' 245 !write(std_out,*)' dprarr(1:narr)==',dprarr(1:narr) 246 !ENDDEBUG 247 248 end subroutine inarray