source: LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/ioipsl_stringop.F90 @ 1182

Last change on this file since 1182 was 1140, checked in by Ehouarn Millour, 17 years ago

Premiere vaque de modifications pour l'unification des dynamiques (planetes-Terre) et un peu de netoyage ...

  • modified 'makegcm' and 'makegcm_fcm' to remove 'CPP_PHYS' key and add 'CPP_EARTH' preprocessing key instead
  • updated 'diagedyn.F' (in dyn3d and dyn3dpar) to use 'CPP_EARTH' key
  • added 'ioipsl_getincom.F90' and 'ioipsl_stringop.F90' to 'dyn3d' and 'dyn3dpar' for future possibility of running without IOIPSL library
  • modified conf_gcm.F ( in d'yn3d' and 'dyn3dpar') to read in flag 'planet_type' (default=='earth') (flag added in 'control.h')
  • modified 'gcm.F' (in 'dyn3d' and 'dyn3dpar') so that flags so that 'read_start' and 'iflag_phys' (known from conf_gcm.F) are used
  • added flag 'output_grads_dyn' (read by conf_gcm.F, stored in 'control.h') to write grads outputs from 'leapfrog.F' and 'leapfrog_p.F'
  • removed 'comdiss.h' from 'dyn3d' and 'dyn3dpar' (it is not used)
  • removed variable 'lstardis' from 'comdissip.h' (it is also in

'comdissnew.h'), in dyn3d as well as in dyn3dpar

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