./63_bader/inpar.F90

ABINIT/inpar

ABINIT/inpar [ Functions ]

NAME

 inpar

FUNCTION

 Parser for the aim utility (shorter than the one of ABINIT)

 Copyright (C) 2002-2017 ABINIT group (PCasek,FF,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

  This routine uses data from the defs_aimprom module

OUTPUT

  instr=string of character containing the input data
  lenstr=actual length of the character string

 WARNING
 This file does not follow the ABINIT coding rules (yet)

PARENTS

aim

CHILDREN

SOURCE

 33 #if defined HAVE_CONFIG_H
 34 #include "config.h"
 35 #endif
 36 
 37 #include "abi_common.h"
 38 
 39 
 40 subroutine inpar(instr,lenstr)
 41 
 42  use defs_basis
 43  use defs_aimprom
 44  use m_profiling_abi
 45  use m_errors
 46 
 47 !This section has been created automatically by the script Abilint (TD).
 48 !Do not modify the following lines by hand.
 49 #undef ABI_FUNC
 50 #define ABI_FUNC 'inpar'
 51 !End of the abilint section
 52 
 53  implicit none
 54 
 55 !Arguments ------------------------------------
 56 !scalars
 57  integer,intent(out) :: lenstr
 58  character(len=*),intent(out) :: instr
 59 
 60 !Local variables ------------------------------
 61  character(len=1),parameter :: space=' '
 62  character(len=26),parameter :: uplett='ABCDEFGHIJKLMNOPQRSTUVWXYZ', lolett='abcdefghijklmnopqrstuvwxyz'
 63 !scalars
 64  integer,parameter :: nline=100
 65  integer :: ii,inxh,inxl,ios,jj,kk,ll
 66  character(len=fnlen) :: line
 67 
 68 ! *********************************************************************
 69 
 70  lenstr=0
 71 
 72  do ii=1,26
 73    inxh=index(lolett,uplett(ii:ii))
 74    if (inxh > 0) then
 75      write(std_out,*) 'ERROR The ', uplett(ii:ii) ,' is considered come lowcase !'
 76      MSG_ERROR("Aborting now")
 77    end if
 78  end do
 79  rewind(unt0)
 80  do ii=1,nline
 81    read(unt0,'(A)',iostat=ios) line(1:fnlen)
 82    if (ios/=0) exit
 83    inxh=index(line,'#')
 84    if (inxh == 1) then
 85      cycle
 86    elseif (inxh > 0) then
 87      inxl=inxh-1
 88      line(inxh:inxh)=space
 89    else
 90      inxl=len_trim(line)
 91      if (inxl==0) cycle
 92    end if
 93    inxh=index(line(1:inxl),char(9))
 94    if (inxh/=0) line(inxh:inxh)=space
 95    do ll=1,inxl
 96      if (iachar(line(ll:ll)) < 32) line(ll:ll)=space
 97    end do
 98    inxh=index(line(1:inxl),'- ')
 99    if (inxh/=0) then
100      write(std_out,*) 'ERROR sign minus with white space in input file'
101      MSG_ERROR("Aborting now")
102    end if
103    line(1:inxl)=adjustl(line(1:inxl))
104    inxl=len_trim(line(1:inxl))+1
105    jj=2;kk=0
106    line(1:inxl)=adjustl(line(1:inxl))
107    kk=len_trim(line(1:inxl))+1
108    do ll=1,inxl
109      inxh=index(line(jj:kk),space)
110      if ((inxh==0).or.((jj+inxh-1)==kk)) exit
111      line(inxh+jj:kk)=adjustl(line(inxh+jj:kk))
112      kk=len_trim(line(1:inxl))
113      if (kk == inxl) then
114        exit
115      end if
116      jj=jj+inxh
117    end do
118    inxl=len_trim(line(1:inxl))+1
119    do ll=1,inxl-1
120      inxh=index(lolett,line(ll:ll))
121      if (inxh/=0) line(ll:ll)=uplett(inxh:inxh)
122    end do
123    if ((lenstr+inxl) > strlen ) then
124      write(std_out,*) 'ERROR Too large input !'
125      MSG_ERROR("Aborting now")
126    else
127      instr(lenstr+1:lenstr+inxl)=line(1:inxl)
128      lenstr=lenstr+inxl
129    end if
130  end do
131 end subroutine inpar

TABLE OF CONTENTS

ABINIT/inpar [ Functions ]