source: IOIPSL/trunk/src/stringop.f90 @ 4

Last change on this file since 4 was 4, checked in by rblod, 16 years ago

First import of IOIPSL sources

File size: 7.5 KB
Line 
1!$Header: /home/ioipsl/CVSROOT/IOIPSL/src/stringop.f90,v 2.0 2004/04/05 14:47:51 adm Exp $
2!
3MODULE stringop
4!---------------------------------------------------------------------
5!-
6  INTEGER, DIMENSION(30) :: &
7       & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
8       & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
9!-
10!---------------------------------------------------------------------
11CONTAINS
12!=
13   SUBROUTINE cmpblank (str)
14!---------------------------------------------------------------------
15!-
16!---------------------------------------------------------------------
17   CHARACTER(LEN=*),INTENT(inout) :: str
18!-
19   INTEGER :: lcc,ipb
20!---------------------------------------------------------------------
21   lcc = LEN_TRIM(str)
22   ipb = 1
23   DO
24     IF (ipb >= lcc)   EXIT
25     IF (str(ipb:ipb+1) == '  ') THEN
26       str(ipb+1:) = str(ipb+2:lcc)
27       lcc = lcc-1
28     ELSE
29       ipb = ipb+1
30     ENDIF
31   ENDDO
32!-------------------------
33   END SUBROUTINE cmpblank
34!=
35   INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
36!---------------------------------------------------------------------
37!- Finds number of occurences of c_r in c_c
38!---------------------------------------------------------------------
39   IMPLICIT NONE
40!-
41   CHARACTER(LEN=*),INTENT(in) :: c_c
42   INTEGER,INTENT(IN) :: l_c
43   CHARACTER(LEN=*),INTENT(in) :: c_r
44   INTEGER,INTENT(IN) :: l_r
45!-
46   INTEGER :: ipos,indx,ires
47!---------------------------------------------------------------------
48   cntpos = 0
49   ipos   = 1
50   DO
51     indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
52     IF (indx > 0) THEN
53       cntpos = cntpos+1
54       ipos   = ipos+indx+l_r-1
55     ELSE
56       EXIT
57     ENDIF
58   ENDDO
59!---------------------
60   END FUNCTION cntpos
61!=
62   INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
63!---------------------------------------------------------------------
64!- Finds position of c_r in c_c
65!---------------------------------------------------------------------
66   IMPLICIT NONE
67!-
68   CHARACTER(LEN=*),INTENT(in) :: c_c
69   INTEGER,INTENT(IN) :: l_c
70   CHARACTER(LEN=*),INTENT(in) :: c_r
71   INTEGER,INTENT(IN) :: l_r
72!---------------------------------------------------------------------
73    findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
74    IF (findpos == 0)   findpos=-1
75!----------------------
76   END FUNCTION findpos
77!=
78   SUBROUTINE find_str (nb_str,str_tab,str_len_tab,str,pos)
79!---------------------------------------------------------------------
80!- This subroutine looks for a string in a table
81!---------------------------------------------------------------------
82!- INPUT
83!-   nb_str      : length of table
84!-   str_tab     : Table  of strings
85!-   str_len_tab : Table  of string-length
86!-   str         : Target we are looking for
87!- OUTPUT
88!-   pos         : -1 if str not found, else value in the table
89!---------------------------------------------------------------------
90   IMPLICIT NONE
91!-
92   INTEGER :: nb_str
93   CHARACTER(LEN=*),DIMENSION(nb_str) :: str_tab
94   INTEGER,DIMENSION(nb_str) :: str_len_tab
95   CHARACTER(LEN=*) :: str
96   INTEGER :: pos
97!-
98   INTEGER :: i,il
99!---------------------------------------------------------------------
100   pos = -1
101   il = LEN_TRIM(str)
102   IF ( nb_str > 0 ) THEN
103      DO i=1,nb_str
104         IF (     (INDEX(str_tab(i),str(1:il)) > 0) &
105              .AND.(str_len_tab(i) == il) ) THEN
106            pos = i
107            EXIT
108         ENDIF
109      ENDDO
110   ENDIF
111!-------------------------
112   END SUBROUTINE find_str
113!=
114   SUBROUTINE nocomma (str)
115!---------------------------------------------------------------------
116!-
117!---------------------------------------------------------------------
118   IMPLICIT NONE
119!-
120   CHARACTER(LEN=*) :: str
121!-
122   INTEGER :: i
123!---------------------------------------------------------------------
124   DO i=1,LEN_TRIM(str)
125     IF (str(i:i) == ',')   str(i:i) = ' '
126   ENDDO
127!------------------------
128   END SUBROUTINE nocomma
129!=
130   SUBROUTINE strlowercase (str)
131!---------------------------------------------------------------------
132!- Converts a string into lowercase
133!---------------------------------------------------------------------
134   IMPLICIT NONE
135!-
136   CHARACTER(LEN=*) :: str
137!-
138   INTEGER :: i,ic
139!---------------------------------------------------------------------
140   DO i=1,LEN_TRIM(str)
141     ic = IACHAR(str(i:i))
142     IF ( (ic >= 65) .AND. (ic <= 90) )   str(i:i) = ACHAR(ic+32)
143   ENDDO
144!-----------------------------
145   END SUBROUTINE strlowercase
146!=
147   SUBROUTINE struppercase (str)
148!---------------------------------------------------------------------
149!- Converts a string into uppercase
150!---------------------------------------------------------------------
151   IMPLICIT NONE
152!-
153   CHARACTER(LEN=*) :: str
154!-
155   INTEGER :: i,ic
156!---------------------------------------------------------------------
157   DO i=1,LEN_TRIM(str)
158     ic = IACHAR(str(i:i))
159     IF ( (ic >= 97) .AND. (ic <= 122) )   str(i:i) = ACHAR(ic-32)
160   ENDDO
161!-----------------------------
162   END SUBROUTINE struppercase
163!=
164!------------------
165   SUBROUTINE gensig (str, sig)
166!---------------------------------------------------------------------
167!- Generate a signature from the first 30 characters of the string
168!- This signature is not unique and thus when one looks for the
169!- one needs to also verify the string.
170!---------------------------------------------------------------------
171   IMPLICIT NONE
172!-
173   CHARACTER(LEN=*) :: str
174   INTEGER          :: sig
175!-
176   INTEGER :: i
177!---------------------------------------------------------------------
178   sig = 0
179   DO i=1,MIN(len_trim(str),30)
180      sig = sig  + prime(i)*IACHAR(str(i:i))
181   ENDDO
182!-----------------------------
183 END SUBROUTINE gensig
184!=
185!------------------
186   SUBROUTINE find_sig (nb_sig, str_tab, str, sig_tab, sig, pos)
187!---------------------------------------------------------------------
188!- Find the string signature in a list of signatures
189!---------------------------------------------------------------------
190!- INPUT
191!-   nb_sig      : length of table of signatures
192!-   str_tab     : Table of strings
193!-   str         : Target string we are looking for
194!-   sig_tab     : Table of signatures
195!-   sig         : Target signature we are looking for
196!- OUTPUT
197!-   pos         : -1 if str not found, else value in the table
198!---------------------------------------------------------------------
199   IMPLICIT NONE
200!-
201   INTEGER :: nb_sig
202   CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
203   CHARACTER(LEN=*) :: str
204   INTEGER, DIMENSION(nb_sig) :: sig_tab
205   INTEGER :: sig
206!-
207   INTEGER :: pos
208   INTEGER, DIMENSION(nb_sig) :: loczeros
209!-
210   INTEGER :: il, len
211   INTEGER, DIMENSION(1) :: minpos
212!---------------------------------------------------------------------
213!-
214   pos = -1
215   il = LEN_TRIM(str)
216!-
217   IF ( nb_sig > 0 ) THEN
218      !
219      loczeros = ABS(sig_tab(1:nb_sig)-sig)
220      !
221      IF ( COUNT(loczeros < 1) == 1 ) THEN
222         !
223         minpos = MINLOC(loczeros)
224         len = LEN_TRIM(str_tab(minpos(1)))
225         IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
226                 .AND.(len == il) ) THEN
227            pos = minpos(1)
228         ENDIF
229         !
230      ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
231         !
232         DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
233            minpos = MINLOC(loczeros)
234            len = LEN_TRIM(str_tab(minpos(1)))
235            IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
236                 .AND.(len == il) ) THEN
237               pos = minpos(1)
238            ELSE
239               loczeros(minpos(1)) = 99999
240            ENDIF
241         ENDDO
242         !
243      ENDIF
244      !
245   ENDIF
246!-
247 END SUBROUTINE find_sig
248!=
249!------------------
250END MODULE stringop
Note: See TracBrowser for help on using the repository browser.