TABLE OF CONTENTS
ABINIT/instrng [ Functions ]
NAME
instrng
FUNCTION
Read the input file, and product a string of character, with all data, to be analyzed in later routines. The length of this string is lenstr. This number is checked to be smaller than the dimension of the string of character, namely strln .
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
filnam=name of the input file, to be read
option= if 0, simple storing of the character string,
no special treatment for ABINIT (comment delimiters, checks, include ...)
if 1, suppresses text after an ABINIT comment delimiter (! or #),
checks that a minus sign is followed by a number ...
check for INCLUDE statement:
if present, add string from included file
strln=maximal number of character of string, as declared in the calling routine
OUTPUT
lenstr=actual number of character in string string*(strln)=string of character
PARENTS
anaddb,importcml,localorb_S,lwf,parsefile
CHILDREN
incomprs,instrng,wrtout
SOURCE
41 #if defined HAVE_CONFIG_H 42 #include "config.h" 43 #endif 44 45 #include "abi_common.h" 46 47 48 recursive subroutine instrng(filnam,lenstr,option,strln,string) 49 50 use defs_basis 51 use m_profiling_abi 52 use m_errors 53 54 use m_io_tools, only : open_file 55 56 !This section has been created automatically by the script Abilint (TD). 57 !Do not modify the following lines by hand. 58 #undef ABI_FUNC 59 #define ABI_FUNC 'instrng' 60 use interfaces_14_hidewrite 61 use interfaces_42_parser, except_this_one => instrng 62 !End of the abilint section 63 64 implicit none 65 66 !Arguments ------------------------------------ 67 !scalars 68 integer,intent(in) :: option,strln 69 integer,intent(out) :: lenstr 70 character(len=*),intent(in) :: filnam 71 character(len=*),intent(out) :: string 72 73 !Local variables------------------------------- 74 character :: blank=' ' 75 !scalars 76 integer,save :: include_level=-1 77 integer :: ii,ii1,ii2,ij,iline,ios,iost,lenc,lenstr_inc,mline,nline1,input_unit 78 logical :: include_found,ex 79 character(len=1) :: string1 80 character(len=3) :: string3 81 character(len=500) :: filnam_inc,msg 82 character(len=fnlen+20) :: line 83 character(len=strlen),pointer :: string_inc 84 85 !************************************************************************ 86 87 DBG_ENTER("COLL") 88 89 !%%%%%%%%%%%%%%%%%%%%%%%% 90 !read in string from file 91 !%%%%%%%%%%%%%%%%%%%%%%%% 92 93 !The file can be included in another (prevent too many include levels) 94 include_level=include_level+1 95 if (include_level>2) then 96 write(msg, '(3a)' ) & 97 & 'At least 4 levels of included files are present in input file !',ch10,& 98 & 'This is not allowed. Action: change your input file.' 99 MSG_ERROR(msg) 100 end if 101 102 !Open data file and read one line at a time, compressing data 103 !and concatenating into single string: 104 if (open_file(filnam,msg,newunit=input_unit,form="formatted",status="old",action="read") /= 0) then 105 MSG_ERROR(msg) 106 end if 107 rewind (unit=input_unit) 108 109 !Initialize string to blanks 110 string=blank 111 lenstr=1 112 113 !Set maximum number lines to be read to some large number 114 mline=50000 115 do iline=1,mline 116 117 ! Keeps reading lines until end of input file 118 read (unit=input_unit,fmt= '(a)' ,iostat=ios) line(1:fnlen+20) 119 ! Hello ! This is a commentary. Please, do not remove me. 120 ! In fact, this commentary protect tests_v4 t47 for miscopying 121 ! the input file into the output string. It _is_ strange. 122 ! The number of lines in the commentary is also resulting from 123 ! a long tuning.. 124 125 ! DEBUG 126 ! write(std_out,*)' instrng, iline=',iline,' ios=',ios,' echo :',trim(line(1:fnlen+20)) 127 ! ENDDEBUG 128 129 ! Exit the reading loop when arrived at the end 130 if(ios/=0)then 131 backspace(input_unit) 132 read (unit=input_unit,fmt= '(a1)' ,iostat=ios) string1 133 if(ios/=0)exit 134 backspace(input_unit) 135 read (unit=input_unit,fmt= '(a3)' ,iostat=ios) string3 136 if(string3=='end')exit 137 write(msg, '(3a,i0,11a)' ) & 138 & 'It is observed in the input file: ',TRIM(filnam),', line number ',iline,',',ch10,& 139 & 'that there is a non-zero IO signal.',ch10,& 140 & 'This is normal when the file is completely read.',ch10,& 141 & 'However, it seems that the error appears while your file has not been completely read.',ch10,& 142 & 'Action: correct your file. If your file seems correct, then,',ch10,& 143 & 'add the keyword ''end'' at the very beginning of the last line of your input file.' 144 MSG_ERROR(msg) 145 end if 146 147 ! Find length of input line ignoring delimiter characters (# or !) 148 ! and any characters beyond it (allows for comments beyond # or !) 149 ii1=index(line(1:fnlen+20),'#') 150 ii2=index(line(1:fnlen+20),'!') 151 if ( (ii1==0 .and. ii2==0) .or. option==0 ) then 152 ! delimiter character was not found on line so use full line 153 ii=fnlen+20 154 else if(ii1==0)then 155 ! ii will represent length of line up to but not including ! 156 ii=ii2-1 157 else if(ii2==0)then 158 ! ii will represent length of line up to but not including # 159 ii=ii1-1 160 else 161 ii=min(ii1,ii2)-1 162 end if 163 164 ! Checks that nothing is left beyond fnlen 165 if(ii>fnlen)then 166 do ij=fnlen+1,ii 167 if(line(ij:ij)/=' ')then 168 write(msg,'(3a,i0,3a,i0,3a)' ) & 169 & 'It is observed in the input file: ',TRIM(filnam),' line number ',iline,',',ch10,& 170 & 'that more than ',fnlen,' columns are used.',ch10,& 171 & 'This is not allowed. Change this line of your input file.' 172 MSG_ERROR(msg) 173 end if 174 end do 175 end if 176 177 if (ii>0) then 178 ! Check for the occurence of a minus sign followed by a blank 179 ij=index(line(1:ii),'- ') 180 if (ij>0 .and. option==1) then 181 write(msg, '(3a,i0,11a)' ) & 182 & 'It is observed in the input file:, ',TRIM(filnam),' line number ',iline,',',ch10,& 183 & 'the occurence of a minus sign followed',ch10,& 184 & 'by a blank. This is forbidden.',ch10,& 185 & 'If the minus sign is meaningful, do not leave a blank',ch10,& 186 & 'between it and the number to which it applies.',ch10,& 187 & 'Otherwise, remove it.' 188 MSG_ERROR(msg) 189 end if 190 ! Check for the occurence of a tab 191 ij=index(line(1:ii),char(9)) 192 if (ij>0 .and. option==1 ) then 193 write(msg, '(3a,i0,3a)' ) & 194 & 'The occurence of a tab, in the input file: ',TRIM(filnam),' line number ',iline,',',ch10,& 195 & 'is observed. This sign is confusing, and has been forbidden.' 196 MSG_ERROR(msg) 197 end if 198 199 ! Check for the occurence of a include statement 200 include_found=.false. 201 if (option==1) then 202 ! Look for include statement 203 ii1=index(line(1:ii),"include");ii2=index(line(1:ii),"INCLUDE") 204 include_found=(ii1>0.or.ii2>0) 205 if (include_found) then 206 ij=max(ii1,ii2);ii1=0;ii2=0 207 ! Look for quotes (ascii 34) 208 ii1=index(line(ij+7:ii),char(34)) 209 if (ii1>1) ii2=index(line(ij+7+ii1:ii),char(34)) 210 ! Look for quotes (ascii 39) 211 if (ii1==0.and.ii2==0) then 212 ii1=index(line(ij+7:ii),char(39)) 213 if (ii1>1) ii2=index(line(ij+7+ii1:ii),char(39)) 214 end if 215 ! Check if quotes are correctly set 216 ex=(ii1<=1.or.ii2<=1) 217 if (.not.ex) then 218 msg=line(ij+7:ij+5+ii1) 219 call incomprs(msg(1:ii1-1),lenc) 220 ex=(len(trim(msg))/=0) 221 end if 222 if (ex) then 223 write(msg, '(6a)' ) & 224 & 'A "include" statement has been found in input file: ',TRIM(filnam),ch10,& 225 & 'but there must be a problem with the quotes.',ch10,& 226 & 'Action: change your input file.' 227 MSG_ERROR(msg) 228 end if 229 ! Store included file name 230 filnam_inc=line(ij+7+ii1:ij+5+ii1+ii2) 231 ! Extract include statement from line 232 lenc=ii1+ii2+7 233 msg(1:ii-lenc)=line(1:ij-1)//line(ij+lenc:ii) 234 ii=ii-lenc;line(1:ii)=msg(1:ii) 235 end if 236 end if 237 238 ! Compress: remove repeated blanks, make all ASCII characters 239 ! less than a blank (and '=') to become a blank. 240 call incomprs(line(1:ii),lenc) 241 242 else 243 ! ii=0 means line starts with #, is entirely a comment line 244 lenc=0;include_found=.false. 245 end if 246 247 ! Check resulting total string length 248 if (lenstr+lenc>strln) then 249 write(msg, '(8a)' ) & 250 & 'The size of your input file: ',TRIM(filnam),' is such that the internal',ch10,& 251 & 'character string that should contain it is too small.',ch10,& 252 & 'Action: decrease the size of your input file,',ch10,& 253 & 'or contact the ABINIT group.' 254 MSG_ERROR(msg) 255 end if 256 257 if (lenc>0) then 258 ! Concatenate new compressed characters 259 ! with previous part of compressed string (unless all blank) 260 string(lenstr+1:lenstr+lenc)=line(1:lenc) 261 end if 262 ! Keep track of total string length 263 lenstr=lenstr+lenc 264 265 ! Eventually (recursively) read included file 266 if (include_found) then 267 ! Check file existence 268 inquire(file=filnam_inc ,iostat=iost,exist=ex) 269 if ((.not.ex).or.(iost/=0)) then 270 write(msg, '(5a)' ) & 271 & 'Input file: ',TRIM(filnam),' reading: the included file ',trim(filnam_inc),' cannot be found !' 272 MSG_ERROR(msg) 273 end if 274 ! Read included file (warning: recursive call !) 275 ABI_ALLOCATE(string_inc,) 276 call instrng(trim(filnam_inc),lenstr_inc,option,strln-lenstr,string_inc) 277 ! Check resulting total string length 278 if (lenstr+lenstr_inc>strln) then 279 write(msg, '(6a)' ) & 280 & 'The size of your input file: ',TRIM(filnam),' (including included files) is such that',ch10,& 281 & 'the internal character string that should contain it is too small !',ch10,& 282 & 'Action : decrease the size of your input file.' 283 MSG_ERROR(msg) 284 end if 285 ! Concatenate total string 286 string(lenstr+1:lenstr+lenstr_inc)=string_inc(1:lenstr_inc) 287 lenstr=lenstr+lenstr_inc 288 ABI_DEALLOCATE(string_inc) 289 end if 290 291 ! If mline is reached, something is wrong 292 if (iline>=mline) then 293 write(msg, '(a,i0,2a,i0,4a)' ) & 294 & 'The number of lines already read from input file=',iline,ch10,& 295 & 'is equal or greater than maximum allowed mline=',mline,ch10,& 296 & 'Action: you could decrease the length of the input file, or',ch10,& 297 & 'contact the ABINIT group.' 298 MSG_ERROR(msg) 299 end if 300 301 ! End loop on iline. Note that there is an "exit" instruction in the loop 302 end do 303 304 nline1=iline-1 305 close (unit=input_unit) 306 307 write(msg,'(a,i0,3a)')'-instrng: ',nline1,' lines of input have been read from file ',trim(filnam),ch10 308 call wrtout(std_out,msg,'COLL') 309 310 include_level=include_level-1 311 312 DBG_EXIT("COLL") 313 314 end subroutine instrng