Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / read_sufwind.f90
1 !     ######spl
2       SUBROUTINE READ_SUFWIND(HGROUP)
3 !     ###############################
4 !
5 !!****  *READ_SUFWIND* - 
6 !!
7 !!    PURPOSE
8 !!    -------
9 !      
10 !
11 !!**  METHOD
12 !!    ------
13 !!     
14 !!     N.A.
15 !!
16 !!    EXTERNAL
17 !!    --------
18 !!      None
19 !!
20 !!    IMPLICIT ARGUMENTS
21 !!    ------------------
22 !!      Module
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      J. Duron    * Laboratoire d'Aerologie *
31 !!
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original       29/01/98
36 !!      Updated   PM 
37 !-------------------------------------------------------------------------------
38 !
39 !*       0.    DECLARATIONS
40 !              ------------
41 !
42 USE MODD_RESOLVCAR
43
44 IMPLICIT NONE
45 !
46 !*       0.1   Dummy arguments
47 !              ---------------
48
49 CHARACTER(LEN=*) :: HGROUP
50 !
51 !*       0.1   Local variables
52 !              ---------------
53
54 !
55 INTEGER                    ::   J, IND, ILENGP, I
56 CHARACTER(LEN=LEN(HGROUP)) :: YGROUP
57 !------------------------------------------------------------------------------
58 YGROUP=HGROUP
59 ILENGP=LEN_TRIM(YGROUP)
60 CSUFWIND='  '
61 NSUFWIND=0
62 DO J=1,1
63   I=7
64   IND=INDEX(YGROUP,'DIRUMVM')
65   IF(IND /= 0)THEN
66     IF(ILENGP == I)THEN
67     ELSE IF((ILENGP-I) == 1)THEN
68       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
69       NSUFWIND=1
70     ELSE IF((ILENGP-I) == 2)THEN
71       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
72       NSUFWIND=2
73     ENDIF
74     EXIT
75   ENDIF
76   IND=INDEX(YGROUP,'DIRUTVT')
77   IF(IND /= 0)THEN
78     IF(ILENGP == I)THEN
79     ELSE IF((ILENGP-I) == 1)THEN
80       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
81       NSUFWIND=1
82     ELSE IF((ILENGP-I) == 2)THEN
83       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
84       NSUFWIND=2
85     ENDIF
86     EXIT
87   ENDIF
88   I=6
89   IND=INDEX(YGROUP,'DDUMVM')
90   IF(IND /= 0)THEN
91     IF(ILENGP == I)THEN
92     ELSE IF((ILENGP-I) == 1)THEN
93       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
94       NSUFWIND=1
95     ELSE IF((ILENGP-I) == 2)THEN
96       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
97       NSUFWIND=2
98     ENDIF
99     EXIT
100   ENDIF
101   IND=INDEX(YGROUP,'DDUTVT')
102   IF(IND /= 0)THEN
103     IF(ILENGP == I)THEN
104     ELSE IF((ILENGP-I) == 1)THEN
105       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
106       NSUFWIND=1
107     ELSE IF((ILENGP-I) == 2)THEN
108       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
109       NSUFWIND=2
110     ENDIF
111     EXIT
112   ENDIF
113   I=5
114   IND=INDEX(YGROUP,'MUMVM')
115   IF(IND /= 0)THEN
116     IF(ILENGP == I)THEN
117     ELSE IF((ILENGP-I) == 1)THEN
118       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
119       NSUFWIND=1
120     ELSE IF((ILENGP-I) == 2)THEN
121       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
122       NSUFWIND=2
123     ENDIF
124     EXIT
125   ENDIF
126   IND=INDEX(YGROUP,'MUTVT')
127   IF(IND /= 0)THEN
128     IF(ILENGP == I)THEN
129     ELSE IF((ILENGP-I) == 1)THEN
130       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
131       NSUFWIND=1
132     ELSE IF((ILENGP-I) == 2)THEN
133       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
134       NSUFWIND=2
135     ENDIF
136     EXIT
137   ENDIF
138   IND=INDEX(YGROUP,'ULMWM')
139   IF(IND /= 0)THEN
140     IF(ILENGP == I)THEN
141     ELSE IF((ILENGP-I) == 1)THEN
142       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
143       NSUFWIND=1
144     ELSE IF((ILENGP-I) == 2)THEN
145       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
146       NSUFWIND=2
147     ENDIF
148     EXIT
149   ENDIF
150   IND=INDEX(YGROUP,'ULTWT')
151   IF(IND /= 0)THEN
152     IF(ILENGP == I)THEN
153     ELSE IF((ILENGP-I) == 1)THEN
154       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
155       NSUFWIND=1
156     ELSE IF((ILENGP-I) == 2)THEN
157       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
158       NSUFWIND=2
159     ENDIF
160     EXIT
161   ENDIF
162   I=4
163   IND=INDEX(YGROUP,'UMVM')
164   IF(IND /= 0)THEN
165     IF(ILENGP == I)THEN
166     ELSE IF((ILENGP-I) == 1)THEN
167       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
168       NSUFWIND=1
169     ELSE IF((ILENGP-I) == 2)THEN
170       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
171       NSUFWIND=2
172     ENDIF
173     EXIT
174   ENDIF
175   IND=INDEX(YGROUP,'UTVT')
176   IF(IND /= 0)THEN
177     IF(ILENGP == I)THEN
178     ELSE IF((ILENGP-I) == 1)THEN
179       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
180       NSUFWIND=1
181     ELSE IF((ILENGP-I) == 2)THEN
182       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
183       NSUFWIND=2
184     ENDIF
185     EXIT
186   ENDIF
187   I=3
188   IND=INDEX(YGROUP,'ULM')
189   IF(IND /= 0)THEN
190     IF(ILENGP == I)THEN
191     ELSE IF((ILENGP-I) == 1)THEN
192       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
193       NSUFWIND=1
194     ELSE IF((ILENGP-I) == 2)THEN
195       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
196       NSUFWIND=2
197     ENDIF
198     EXIT
199   ENDIF
200   IND=INDEX(YGROUP,'ULT')
201   IF(IND /= 0)THEN
202     IF(ILENGP == I)THEN
203     ELSE IF((ILENGP-I) == 1)THEN
204       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
205       NSUFWIND=1
206     ELSE IF((ILENGP-I) == 2)THEN
207       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
208       NSUFWIND=2
209     ENDIF
210     EXIT
211   ENDIF
212   IND=INDEX(YGROUP,'VTM')
213   IF(IND /= 0)THEN
214     IF(ILENGP == I)THEN
215     ELSE IF((ILENGP-I) == 1)THEN
216       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
217       NSUFWIND=1
218     ELSE IF((ILENGP-I) == 2)THEN
219       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
220       NSUFWIND=2
221     ENDIF
222     EXIT
223   ENDIF
224   IND=INDEX(YGROUP,'VTT')
225   IF(IND /= 0)THEN
226     IF(ILENGP == I)THEN
227     ELSE IF((ILENGP-I) == 1)THEN
228       CSUFWIND(1:1)=YGROUP(IND+I:IND+I)
229       NSUFWIND=1
230     ELSE IF((ILENGP-I) == 2)THEN
231       CSUFWIND(1:2)=YGROUP(IND+I:IND+I+1)
232       NSUFWIND=2
233     ENDIF
234     EXIT
235   ENDIF
236 ENDDO
237 !print *,' YGROUP CSUFWIND NSUFWIND ',YGROUP,CSUFWIND,NSUFWIND
238 !
239
240 !-----------------------------------------------------------------------------
241 !
242 !*       2.       EXITS
243 !                 -----
244
245 RETURN
246 END SUBROUTINE READ_SUFWIND