./32_util/inupper.F90

ABINIT/inupper

ABINIT/inupper [ Functions ]

NAME

 inupper

FUNCTION

 Maps all characters in string to uppercase except for tokes between quotation marks.
 Uses fortran90 character string manipulation but should work
 independent of EBCDIC or ASCII assumptions--only relies on
 'index' intrinsic character string matching function.
 Makes sure that the string 'lolett' remains defined as the lower
 case 26-character alphabet string and 'uplett' remains upper case.

 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 with arbitrary case

OUTPUT

  string= same character string mapped to upper case

SIDE EFFECTS

  string= (input) character string with arbitrary case
          (output) same character string mapped to upper case

PARENTS

      anaddb,band2eps,chkvars,intagm,invars1,m_ab7_invars_f90
      m_anaddb_dataset,m_exit,multibinit,parsefile

CHILDREN

SOURCE

 39 #if defined HAVE_CONFIG_H
 40 #include "config.h"
 41 #endif
 42 
 43 #include "abi_common.h"
 44 
 45 subroutine inupper(string)
 46 
 47  use defs_basis
 48  use m_errors
 49 
 50 !This section has been created automatically by the script Abilint (TD).
 51 !Do not modify the following lines by hand.
 52 #undef ABI_FUNC
 53 #define ABI_FUNC 'inupper'
 54 !End of the abilint section
 55 
 56  implicit none
 57 
 58 !Arguments ------------------------------------
 59 !scalars
 60  character(len=*),intent(inout) :: string
 61 
 62 !Local variables-------------------------------
 63 !scalars
 64  integer :: ii,indx,inquotes
 65  logical,save :: first=.true.
 66  character(len=1) :: cc
 67  character(len=500) :: message
 68  character(len=26), parameter :: uplett='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
 69  character(len=26), parameter :: lolett='abcdefghijklmnopqrstuvwxyz'
 70 
 71 ! *************************************************************************
 72 !
 73 !On first entry make sure lower case letters stayed
 74 !lower case and upper case letters stayed upper case
 75  if (first) then
 76    do ii=1,26
 77 !    Look for occurrence of each upper case character
 78 !    anywhere in string of all lower case letters
 79      indx=index(lolett,uplett(ii:ii))
 80 !    If found then print error message and quit
 81      if (indx>0) then
 82        write(message, '(a,a,a,a,a,a,a,a,a)' )&
 83 &       'Upper case string = ',uplett,ch10,&
 84 &       'Lower case string = ',lolett,ch10,&
 85 &       'Upper case character ',uplett(ii:ii),'found in supposedly lower case string.'
 86        MSG_BUG(message)
 87      end if
 88    end do
 89    first=.false.
 90  end if
 91 
 92  inquotes = 0
 93  do ii=1,len_trim(string)
 94 !  Pick off single character of string (one byte):
 95    cc=string(ii:ii)
 96 
 97    ! Ignore tokens between quotation marks.
 98    if (cc == "'" .or. cc == '"') inquotes = inquotes + 1
 99    if (inquotes == 1) cycle
100    if (inquotes == 2) then
101      inquotes = 0; cycle
102    end if
103    ! determine whether a lowercase letter:
104    indx=index(lolett,cc)
105    ! Map to uppercase:
106    if (indx>0) string(ii:ii)=uplett(indx:indx)
107  end do
108 
109 end subroutine inupper

TABLE OF CONTENTS

ABINIT/inupper [ Functions ]