Ignore:
Timestamp:
03/04/10 12:01:32 (12 years ago)
Author:
bellier
Message:

stringop :

  • added a subroutine ("str_xfw") to extract the words of a string
  • suppressed unused subroutines ("gensig" and "find_sig")

fliocom :

  • modified the syntax of the file creating mode (in "fliocrfd") to be on the road to NETCDF4
File:
1 edited

Legend:

Unmodified
Added
Removed
  • IOIPSL/trunk/src/stringop.f90

    r386 r936  
    55! This software is governed by the CeCILL license 
    66! 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 !- 
    137!--------------------------------------------------------------------- 
    148CONTAINS 
     
    160154END SUBROUTINE struppercase 
    161155!=== 
    162 SUBROUTINE gensig (str,sig) 
     156SUBROUTINE str_xfw (c_string,c_word,l_ok) 
    163157!--------------------------------------------------------------------- 
    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. 
     158!- Given a character string "c_string", of arbitrary length, 
     159!- returns a logical flag "l_ok" if a word is found in it, 
     160!- the first word "c_word" if found and the new string "c_string" 
     161!- without the first word "c_word" 
    167162!--------------------------------------------------------------------- 
    168   IMPLICIT NONE 
     163  CHARACTER(LEN=*),INTENT(INOUT) :: c_string 
     164  CHARACTER(LEN=*),INTENT(OUT) :: c_word 
     165  LOGICAL,INTENT(OUT) :: l_ok 
    169166!- 
    170   CHARACTER(LEN=*) :: str 
    171   INTEGER          :: sig 
    172 !- 
    173   INTEGER :: i 
     167  INTEGER :: i_b,i_e 
    174168!--------------------------------------------------------------------- 
    175   sig = 0 
    176   DO i=1,MIN(LEN_TRIM(str),30) 
    177     sig = sig + prime(i)*IACHAR(str(i:i)) 
    178   ENDDO 
    179 !-------------------- 
    180 END SUBROUTINE gensig 
    181 !=== 
    182 SUBROUTINE 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 
     169  l_ok = (LEN_TRIM(c_string) > 0) 
     170  IF (l_ok) THEN 
     171    i_b = VERIFY(c_string,' ') 
     172    i_e = INDEX(c_string(i_b:),' ') 
     173    IF (i_e == 0) THEN 
     174      c_word = c_string(i_b:) 
     175      c_string = "" 
     176    ELSE 
     177      c_word = c_string(i_b:i_b+i_e-2) 
     178      c_string = ADJUSTL(c_string(i_b+i_e-1:)) 
    232179    ENDIF 
    233180  ENDIF 
    234 !----------------------- 
    235  END SUBROUTINE find_sig 
     181!--------------------- 
     182END SUBROUTINE str_xfw 
    236183!=== 
    237184!------------------ 
Note: See TracChangeset for help on using the changeset viewer.