Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM2DIA / resolv_units.f90
1 !     ######spl
2       MODULE MODI_RESOLV_UNITS
3 !     #############################
4 !
5 INTERFACE
6 !
7 SUBROUTINE RESOLV_UNITS(HCARIN,HCAROUT)
8 CHARACTER(LEN=*) :: HCARIN
9 CHARACTER(LEN=*) :: HCAROUT
10 END SUBROUTINE  RESOLV_UNITS
11 !
12 END INTERFACE
13 END MODULE MODI_RESOLV_UNITS
14 !     #######################################
15       SUBROUTINE RESOLV_UNITS(HCARIN,HCAROUT)
16 !     #######################################
17 !
18 !!****  *RESOLV_UNITS* - Extraction du champ unites
19
20 !!
21 !!    PURPOSE
22 !!    -------
23 !      
24 !
25 !!**  METHOD
26 !!    ------
27 !!     
28 !!     N.A.
29 !!
30 !!    EXTERNAL
31 !!    --------
32 !!      None
33 !!
34 !!    IMPLICIT ARGUMENTS
35 !!    ------------------
36 !!      Module
37 !!
38 !!    REFERENCE
39 !!    ---------
40 !!
41 !!
42 !!    AUTHOR
43 !!    ------
44 !!      J. Duron    * Laboratoire d'Aerologie *
45 !!
46 !!
47 !!    MODIFICATIONS
48 !!    -------------
49 !!      Original       06/06/94
50 !!      Updated   PM   02/12/94
51 !-------------------------------------------------------------------------------
52 !
53 !*       0.    DECLARATIONS
54 !              ------------
55 !
56 USE MODD_RESOLVCAR
57 USE MODD_CONF
58
59 IMPLICIT NONE
60 !
61 !*       0.1   Dummy arguments
62 !              ---------------
63
64 CHARACTER(LEN=*) :: HCARIN
65 CHARACTER(LEN=*)         :: HCAROUT
66 !
67 !*       0.1   Local variables
68 !              ---------------
69
70 !
71 CHARACTER(LEN=1)         :: YC
72 CHARACTER(LEN=LEN(HCARIN)) :: YCARIN
73 INTEGER   ::   ILENC
74                
75 INTEGER   ::   J, J1, J2, JJ
76 !------------------------------------------------------------------------------
77 !
78 YCARIN=HCARIN
79 ILENC = LEN(YCARIN)
80 !print *,' YCARIN ',LEN(YCARIN),YCARIN
81 J1=0; J2=0
82 J1=INDEX(YCARIN,'(')
83 DO J=ILENC,1,-1
84   IF(YCARIN(J:J) == ')')THEN
85   J2=J
86   EXIT
87   ENDIF
88 ENDDO
89 CGROUP=ADJUSTL(CGROUP)
90 !print *,'CGROUP ',CGROUP
91 IF(J2 < J1)THEN
92   J2=LEN_TRIM(YCARIN)+1
93 ENDIF
94 IF(J1 == 0 .AND. J2 == 0)THEN
95   IF(INDEX(YCARIN,CGROUP(1:LEN_TRIM(CGROUP))) /= 0 )THEN
96     HCAROUT(1:LEN(HCAROUT))=' '
97   ELSE
98     HCAROUT=ADJUSTL(YCARIN)
99   ENDIF
100 ELSE
101   HCAROUT=ADJUSTL(YCARIN(J1+1:J2-1))
102 ENDIF
103 !print *,' HCAROUT ',HCAROUT
104 YCARIN(1:LEN(YCARIN))=' '
105 !
106 !-----------------------------------------------------------------------------
107 !
108 !*       2.       EXITS
109 !                 -----
110
111 RETURN
112 END SUBROUTINE RESOLV_UNITS