Statistics
| Revision:

root / src / upcase.f90 @ 5

History | View | Annotate | Download (678 Bytes)

1 1 pfleura2
      SUBROUTINE Upcase(String)
2 1 pfleura2
3 1 pfleura2
! This subroutine converts a string into its Upcase
4 1 pfleura2
! version
5 1 pfleura2
6 2 pfleura2
        IMPLICIT NONE
7 2 pfleura2
8 1 pfleura2
        integer, parameter :: KINT = kind(1)
9 1 pfleura2
10 1 pfleura2
        CHARACTER(*), INTENT(INOUT) :: String
11 5 pfleura2
        INTEGER(KINT) :: i,ic, length,Del,ia,iz
12 5 pfleura2
13 5 pfleura2
! We define some variables
14 5 pfleura2
! By doing this, we do not depend on the ASCII coding of the
15 5 pfleura2
! characters
16 5 pfleura2
        DEL = IACHAR('a') - IACHAR('A')
17 5 pfleura2
        ia=IACHAR('a')
18 5 pfleura2
        iz=IACHAR('z')
19 5 pfleura2
20 1 pfleura2
        length=len_trim(string)
21 1 pfleura2
        DO I=1, length
22 1 pfleura2
          ic=ICHAR(String(i:i))
23 5 pfleura2
          if ((ic.ge.ia).and.(ic.le.iz)) ic=ic-DEL
24 1 pfleura2
          String(i:i)=ACHAR(ic)
25 1 pfleura2
        END DO
26 1 pfleura2
27 1 pfleura2
        RETURN
28 1 pfleura2
      END SUBROUTINE Upcase