source: dynamico_lmdz/aquaplanet/ICOSAGCM/tools/ioipsl/stringop.f90 @ 3888

Last change on this file since 3888 was 3810, checked in by ymipsl, 10 years ago

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