Changeset 1993 for branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90

Timestamp:

2010-07-08T15:42:43+02:00 (14 years ago)

Author:

smasson

Message:

merging IOIPSL/v2_2_1 into the EXTERNAL deposit

File:

• branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90 (modified) (2 diffs)

branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90

@@ -1 +1 @@
 MODULE stringop
 !-
-!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: stringop.f90 936 2010-03-04 11:01:32Z bellier $
 !-
 ! This software is governed by the CeCILL license
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
-!---------------------------------------------------------------------
-!-
-  INTEGER,DIMENSION(30) :: &
- & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
- & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
-!-
 !---------------------------------------------------------------------
 CONTAINS
@@ -160 +154 @@
 END SUBROUTINE struppercase
 !===
-SUBROUTINE gensig (str,sig)
+SUBROUTINE str_xfw (c_string,c_word,l_ok)
 !---------------------------------------------------------------------
-!- Generate a signature from the first 30 characters of the string
-!- This signature is not unique and thus when one looks for the
-!- one needs to also verify the string.
+!- Given a character string "c_string", of arbitrary length,
+!- returns a logical flag "l_ok" if a word is found in it,
+!- the first word "c_word" if found and the new string "c_string"
+!- without the first word "c_word"
 !---------------------------------------------------------------------
-  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(INOUT) :: c_string
+  CHARACTER(LEN=*),INTENT(OUT) :: c_word
+  LOGICAL,INTENT(OUT) :: l_ok
 !-
-  CHARACTER(LEN=*) :: str
-  INTEGER          :: sig
-!-
-  INTEGER :: i
+  INTEGER :: i_b,i_e
 !---------------------------------------------------------------------
-  sig = 0
-  DO i=1,MIN(LEN_TRIM(str),30)
-    sig = sig + prime(i)*IACHAR(str(i:i))
-  ENDDO
-!--------------------
-END SUBROUTINE gensig
-!===
-SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
-!---------------------------------------------------------------------
-!- Find the string signature in a list of signatures
-!---------------------------------------------------------------------
-!- INPUT
-!-   nb_sig      : length of table of signatures
-!-   str_tab     : Table of strings
-!-   str         : Target string we are looking for
-!-   sig_tab     : Table of signatures
-!-   sig         : Target signature we are looking for
-!- OUTPUT
-!-   pos         : -1 if str not found, else value in the table
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb_sig
-  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
-  CHARACTER(LEN=*) :: str
-  INTEGER,DIMENSION(nb_sig) :: sig_tab
-  INTEGER :: sig
-!-
-  INTEGER :: pos
-  INTEGER,DIMENSION(nb_sig) :: loczeros
-!-
-  INTEGER :: il,len
-  INTEGER,DIMENSION(1) :: minpos
-!---------------------------------------------------------------------
-  pos = -1
-  il = LEN_TRIM(str)
-!-
-  IF ( nb_sig > 0 ) THEN
-    loczeros = ABS(sig_tab(1:nb_sig)-sig)
-    IF ( COUNT(loczeros < 1) == 1 ) THEN
-      minpos = MINLOC(loczeros)
-      len = LEN_TRIM(str_tab(minpos(1)))
-      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
-          .AND.(len == il) ) THEN
-        pos = minpos(1)
-      ENDIF
-    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
-      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
-        minpos = MINLOC(loczeros)
-        len = LEN_TRIM(str_tab(minpos(1)))
-        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
-            .AND.(len == il) ) THEN
-          pos = minpos(1)
-        ELSE
-          loczeros(minpos(1)) = 99999
-        ENDIF
-      ENDDO
+  l_ok = (LEN_TRIM(c_string) > 0)
+  IF (l_ok) THEN
+    i_b = VERIFY(c_string,' ')
+    i_e = INDEX(c_string(i_b:),' ')
+    IF (i_e == 0) THEN
+      c_word = c_string(i_b:)
+      c_string = ""
+    ELSE
+      c_word = c_string(i_b:i_b+i_e-2)
+      c_string = ADJUSTL(c_string(i_b+i_e-1:))
     ENDIF
   ENDIF
-!-----------------------
- END SUBROUTINE find_sig
+!---------------------
+END SUBROUTINE str_xfw
 !===
 !------------------