IOIPSL/Stringop/find_sig.f90

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	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