IOIPSL/Stringop/find_sig.f

module find_sig_m

implicit none

contains

!=
!------------------
   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, my_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)
         my_len = LEN_TRIM(str_tab(minpos(1)))
         IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
                 .AND.(my_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)
            my_len = LEN_TRIM(str_tab(minpos(1)))
            IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
                 .AND.(my_len == il) ) THEN
               pos = minpos(1)
            ELSE
               loczeros(minpos(1)) = 99999
            ENDIF
         ENDDO
         !
      ENDIF
      !
   ENDIF
!-
 END SUBROUTINE find_sig

end module find_sig_m
1	guez	32	module find_sig_m
2
3			implicit none
4
5			contains
6
7			!=
8			!------------------
9			SUBROUTINE find_sig (nb_sig, str_tab, str, sig_tab, sig, pos)
10			!---------------------------------------------------------------------
11			!- Find the string signature in a list of signatures
12			!---------------------------------------------------------------------
13			!- INPUT
14			!- nb_sig : length of table of signatures
15			!- str_tab : Table of strings
16			!- str : Target string we are looking for
17			!- sig_tab : Table of signatures
18			!- sig : Target signature we are looking for
19			!- OUTPUT
20			!- pos : -1 if str not found, else value in the table
21			!---------------------------------------------------------------------
22			IMPLICIT NONE
23			!-
24			INTEGER :: nb_sig
25			CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
26			CHARACTER(LEN=*) :: str
27			INTEGER, DIMENSION(nb_sig) :: sig_tab
28			INTEGER :: sig
29			!-
30			INTEGER :: pos
31			INTEGER, DIMENSION(nb_sig) :: loczeros
32			!-
33			INTEGER :: il, my_len
34			INTEGER, DIMENSION(1) :: minpos
35			!---------------------------------------------------------------------
36			!-
37			pos = -1
38			il = LEN_TRIM(str)
39			!-
40			IF ( nb_sig > 0 ) THEN
41			!
42			loczeros = ABS(sig_tab(1:nb_sig)-sig)
43			!
44			IF ( COUNT(loczeros < 1) == 1 ) THEN
45			!
46			minpos = MINLOC(loczeros)
47			my_len = LEN_TRIM(str_tab(minpos(1)))
48			IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
49			.AND.(my_len == il) ) THEN
50			pos = minpos(1)
51			ENDIF
52			!
53			ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
54			!
55			DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
56			minpos = MINLOC(loczeros)
57			my_len = LEN_TRIM(str_tab(minpos(1)))
58			IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
59			.AND.(my_len == il) ) THEN
60			pos = minpos(1)
61			ELSE
62			loczeros(minpos(1)) = 99999
63			ENDIF
64			ENDDO
65			!
66			ENDIF
67			!
68			ENDIF
69			!-
70			END SUBROUTINE find_sig
71
72			end module find_sig_m