File: /nfs/home/0/users/jenkins/mfix.git/model/make_upper_case.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: MAKE_UPPER_CASE (LINE_STRING,MAXCOL)                   C
4     !  Purpose: change lowercase characters to uppercase in input line     C
5     !                                                                      C
6     !  Author: P.Nicoletti                                Date: 26-NOV-91  C
7     !  Reviewer: M.SYAMLAL, W.ROGERS, P.NICOLETTI         Date: 24-JAN-92  C
8     !                                                                      C
9     !  Revision Number:                                                    C
10     !  Purpose:                                                            C
11     !  Author:                                            Date: dd-mmm-yy  C
12     !  Reviewer:                                          Date: dd-mmm-yy  C
13     !                                                                      C
14     !  Literature/Document References:                                     C
15     !                                                                      C
16     !  Variables referenced: None                                          C
17     !  Variables modified: None                                            C
18     !                                                                      C
19     !  Local variables: A_UP, A_LO, Z_LO, A_DIFF, INT_C, L                 C
20     !                                                                      C
21     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
22     !
23           SUBROUTINE MAKE_UPPER_CASE(LINE_STRING, MAXCOL)
24     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
25     !...Switches: -xf
26           IMPLICIT NONE
27     !-----------------------------------------------
28     !   D u m m y   A r g u m e n t s
29     !-----------------------------------------------
30     !
31     !                   input line to change to uppercase
32           CHARACTER(len=*) LINE_STRING
33     !
34     !                   number of characters to look at in LINE_STRING
35           INTEGER       MAXCOL
36     !
37     ! local variables:
38     !
39     !                   ICHAR value for UPPERCASE A
40           INTEGER       A_UP
41     !
42     !                   ICHAR value for lowercase a
43           INTEGER       A_LO
44     !
45     !                   ICHAR value for lowercase z
46           INTEGER       Z_LO
47     !
48     !                   ICHAR differnce between lower and uppercase letters
49           INTEGER       A_DIFF
50     !
51     !                   holds ICHAR value of current character
52           INTEGER       INT_C
53     !
54     !                   loop index
55           INTEGER       L
56     !-----------------------------------------------
57     !
58     !
59           A_UP = ICHAR('A')
60           A_LO = ICHAR('a')
61           Z_LO = ICHAR('z')
62           A_DIFF = A_LO - A_UP
63     !
64           DO L = 1, MAXCOL
65              INT_C = ICHAR(LINE_STRING(L:L))
66              IF (A_LO<=INT_C .AND. INT_C<=Z_LO) THEN
67                 INT_C = INT_C - A_DIFF
68                 LINE_STRING(L:L) = CHAR(INT_C)
69              ENDIF
70           END DO
71           RETURN
72           END SUBROUTINE MAKE_UPPER_CASE
73     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
74     !                                                                      C
75     !  Module name: REPLACE_TAB (LINE_STRING,MAXCOL)                       C
76     !  Purpose: replace tab characters with space                          C
77     !                                                                      C
78     !  Author: M. Syamlal                                 Date: 10-JUL-03  C
79     !  Reviewer:                                          Date: 24-JAN-92  C
80     !                                                                      C
81     !  Revision Number:                                                    C
82     !  Purpose:                                                            C
83     !  Author:                                            Date: dd-mmm-yy  C
84     !  Reviewer:                                          Date: dd-mmm-yy  C
85     !                                                                      C
86     !  Literature/Document References:                                     C
87     !                                                                      C
88     !  Variables referenced: None                                          C
89     !  Variables modified: None                                            C
90     !                                                                      C
91     !  Local variables: A_UP, A_LO, Z_LO, A_DIFF, INT_C, L                 C
92     !                                                                      C
93     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
94     !
95           SUBROUTINE REPLACE_TAB(LINE_STRING, MAXCOL)
96     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
97     !...Switches: -xf
98           IMPLICIT NONE
99     !-----------------------------------------------
100     !   D u m m y   A r g u m e n t s
101     !-----------------------------------------------
102     !
103           CHARACTER, PARAMETER          :: TAB = CHAR(9)
104           CHARACTER, PARAMETER          :: CRET = CHAR(13)
105     
106     !                   input line to change to uppercase
107           CHARACTER(len=*) LINE_STRING
108     !
109     !                   number of characters to look at in LINE_STRING
110           INTEGER       MAXCOL
111     !
112     ! local variables:
113     !
114     !                   loop index
115           INTEGER       L
116     !-----------------------------------------------
117     !
118     !
119     !
120           DO L = 1, MAXCOL
121             if(LINE_STRING(L:L) .eq. TAB) LINE_STRING(L:L) = ' '
122             if(LINE_STRING(L:L) .eq. CRET) LINE_STRING(L:L) = ' '
123           END DO
124           RETURN
125           END SUBROUTINE REPLACE_TAB
126