NLSL: strutl2.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

strutl2.f90
Go to the documentation of this file.
1 c NLSL Version 1.9.0 beta 2/11/15
2 c*********************************************************************
3 c
4 c STRUTL2 Fortran 90/95 does not have intrinsic functions for
5 c converting a string to uppercase, nor for finding
6 c the index of the first blank character in a string.
7 c Therefore, subroutine touppr and function itrim are
8 c being supplied here. They were previously included
9 c in the strutl.f collection.
10 c
11 c*********************************************************************
12 c
13 c----------------------------------------------------------------------
14 c =========================
15 c subroutine TOUPPR
16 c =========================
17 c
18 c Converts string argument to uppercase
19 c----------------------------------------------------------------------
20 c
21 subroutine touppr(string,lth)
22 implicit none
23 character(len=*) :: string
24 character(len=1) :: chr
25 integer :: i, ich, ichar, lth
26 c
27 do i=1,lth
28 chr=string(i:i)
29 ich=iachar(chr)
30 if (ich.ge.97 .and. ich.le.122) string(i:i)=achar(ich-32)
31 end do
32 return
33 end subroutine touppr
34 c
35 c----------------------------------------------------------------------
36 c =========================
37 c function ITRIM
38 c =========================
39 c
40 c Returns position of first blank in a string
41 c----------------------------------------------------------------------
42 c
43 function itrim( string )
44 implicit none
45 integer :: itrim, j, lth
46 character(len=*) :: string
47 lth=len(string)
48 do j=1,lth
49 if (string(j:j).eq.' ') then
50 itrim=j-1
51 return
52 end if
53 end do
54 c If here: no blanks in string, return full length
55 c Differs from F77 index() intrinsic, which would return 0
56 itrim=lth
57 return
58 end function itrim
touppr
subroutine touppr(string, lth)
Definition: strutl2.f90:22
itrim
integer function itrim(string)
Definition: strutl2.f90:44