Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / TOOL / verif_group.f90
1 !     ######spl
2       MODULE MODI_VERIF_GROUP
3 !     #######################
4 !
5 INTERFACE
6 !
7 SUBROUTINE VERIF_GROUP(HFILEDIA,HLUOUTDIA,HGROUP)
8 CHARACTER(LEN=*) :: HFILEDIA, HLUOUTDIA, HGROUP
9 END SUBROUTINE VERIF_GROUP
10 !
11 END INTERFACE
12 END MODULE MODI_VERIF_GROUP
13 !     ######spl
14       SUBROUTINE VERIF_GROUP(HFILEDIA,HLUOUTDIA,HGROUP)
15 !     #################################################
16 !
17 !!****  *VERIF_GROUP* - 
18 !!
19 !!    PURPOSE
20 !!    -------
21 !      
22 !
23 !!**  METHOD
24 !!    ------
25 !!     
26 !!     N.A.
27 !!
28 !!    EXTERNAL
29 !!    --------
30 !!      None
31 !!
32 !!    IMPLICIT ARGUMENTS
33 !!    ------------------
34 !!      Module
35 !!
36 !!    REFERENCE
37 !!    ---------
38 !!
39 !!
40 !!    AUTHOR
41 !!    ------
42 !!      J. Duron    * Laboratoire d'Aerologie *
43 !!
44 !!
45 !!    MODIFICATIONS
46 !!    -------------
47 !!      Original       08/01/96
48 !!      Updated   PM 
49 !-------------------------------------------------------------------------------
50 !
51 !*       0.    DECLARATIONS
52 !              ------------
53 !
54 USE MODD_DIACHRO
55 USE MODD_TYPE_AND_LH
56 USE MODD_RESOLVCAR
57 USE MODD_SEVERAL_RECORDS
58 USE MODN_NCAR
59 USE MODD_ALLOC_FORDIACHRO
60 USE MODI_REALLOC_AND_LOAD_RECORDS
61 USE MODI_FMREAD
62
63 IMPLICIT NONE
64 !
65 !*       0.1   Dummy arguments
66 !              ---------------
67
68 CHARACTER(LEN=*) :: HFILEDIA, HLUOUTDIA,HGROUP
69 !
70 !*       0.1   Local variables
71 !              ---------------
72
73 !
74 CHARACTER(LEN=16) :: YRECFM
75 CHARACTER(LEN=8)  :: YNAM1, YNAM2, YNAM1M, YNAM2M
76 ! Aout 99 Longueur YCOMMENT passee de 20 a 100
77 CHARACTER(LEN=100) :: YCOMMENT
78 CHARACTER*1       :: Y1
79 CHARACTER*2       :: Y2
80 CHARACTER*3       :: Y3
81 CHARACTER*4       :: Y4
82 CHARACTER(LEN=16),DIMENSION(:),ALLOCATABLE:: YGROUP 
83 INTEGER   ::   ILENG, ILENCH, IGRID, J, JJ, JM, ILENDIM
84 INTEGER   ::   JM1, JM2, INCR1, INCR2
85 INTEGER   ::   IRESPDIA
86 INTEGER   ::   IMINUS, ILENGP, INBC2, INBC1
87 INTEGER,SAVE   ::   IGROUP=0
88 INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
89 LOGICAL   ::   GPART
90 !------------------------------------------------------------------------------
91 !
92
93 GPART=.FALSE.
94 NBCNUM=0
95 NINCRNAM=1
96 CGPNAM(1:LEN(CGPNAM))=' '
97 CGPNAM1(1:LEN(CGPNAM1))=' '
98 CGPNAM2(1:LEN(CGPNAM2))=' '
99 YNAM1(1:LEN(YNAM1))=' '
100 YNAM2(1:LEN(YNAM2))=' '
101 YNAM1M(1:LEN(YNAM1M))=' '
102 YNAM2M(1:LEN(YNAM2M))=' '
103 print *,' VERIF_GROUP HGROUP ',HGROUP
104
105 ILENDIM=1
106 YRECFM='MENU_BUDGET.DIM'
107 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENDIM,ILENG,&
108 IGRID,ILENCH,YCOMMENT,IRESPDIA)
109
110 IF(ALLOCATED(ITABCHAR))DEALLOCATE(ITABCHAR)
111 ALLOCATE(ITABCHAR(ILENG))
112 YRECFM='MENU_BUDGET'
113 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
114 IGRID,ILENCH,YCOMMENT,IRESPDIA)
115 IGROUP=ILENG/16
116 IF(ALLOCATED(YGROUP))DEALLOCATE(YGROUP)
117 ALLOCATE(YGROUP(IGROUP))
118 print *,' ILENG ILENCH IGROUP ',ILENG,ILENCH,IGROUP
119
120 DO JJ=1,IGROUP
121   DO J = 1,16
122     YGROUP(JJ)(J:J)=CHAR(ITABCHAR(16*(JJ-1)+J))
123   ENDDO
124 ENDDO
125 DEALLOCATE(ITABCHAR)
126 YRECFM=ADJUSTL(ADJUSTR(HGROUP)//'.TYPE')
127 ILENG=LEN(CTYPE)
128 ALLOCATE(ITABCHAR(ILENG))
129 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
130 IGRID,ILENCH,YCOMMENT,IRESPDIA)
131 !******************************************************************************
132
133 IF(IRESPDIA == 0)THEN
134 !*************  A DEFINIR **********************
135   LGROUP=.TRUE.
136   RETURN
137 !******************************************************************************
138
139 ELSE IF(IRESPDIA == -47)THEN
140
141   LGROUP=.FALSE.
142
143 ! On decortique HGROUP
144
145   ILENGP=LEN_TRIM(HGROUP)
146
147 !---------------------------------------------------
148   IF(HGROUP(1:ILENGP) == 'PABSM' .OR. HGROUP(1:ILENGP) == 'PABST' .OR. &
149      HGROUP(1:ILENGP) == 'THM'   .OR. HGROUP(1:ILENGP) == 'THT'   .OR. &
150      HGROUP(1:ILENGP) == 'POVOM' .OR. HGROUP(1:ILENGP) == 'POVOT' .OR. &
151      HGROUP(1:ILENGP) == 'SVM3' .OR. HGROUP(1:ILENGP) == 'SVM003' .OR. &
152      HGROUP(1:ILENGP) == 'SVT3' .OR. HGROUP(1:ILENGP) == 'SVT003' .OR. &
153      HGROUP(1:ILENGP) == 'LGZM' .OR. HGROUP(1:ILENGP) == 'LGZT'   )THEN
154 !   print *,' VERIF_GROUP PAS OK 1',HGROUP
155      LPBREAD=.TRUE.
156      RETURN
157   ENDIF
158 !---------------------------------------------------
159 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
160   IF(ILENGP > 1)THEN
161     IF(ILENGP <= 4 ) THEN
162       IF( HGROUP(ILENGP:ILENGP) == '0' .OR. HGROUP(ILENGP:ILENGP) == '1' .OR. &
163           HGROUP(ILENGP:ILENGP) == '2' .OR. HGROUP(ILENGP:ILENGP) == '4' .OR. &
164           HGROUP(ILENGP:ILENGP) == '5' .OR. HGROUP(ILENGP:ILENGP) == '6' .OR. &
165           HGROUP(ILENGP:ILENGP) == '7' .OR. HGROUP(ILENGP:ILENGP) == '8' .OR. &
166           HGROUP(ILENGP:ILENGP) == '9') THEN
167           IF (HGROUP(1:2) == 'UM' .OR. HGROUP(1:2) == 'VM' .OR.&
168               HGROUP(1:2) == 'WM' .OR. HGROUP(1:2) == 'UT' .OR.&
169               HGROUP(1:2) == 'VT' .OR. HGROUP(1:2) == 'WT') THEN
170                 LPBREAD=.TRUE.
171    !             print *,' VERIF_GROUP PAS OK 2',HGROUP
172                RETURN
173           ENDIF
174       ENDIF
175     ENDIF
176   ENDIF
177 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
178 ! Recherche d'un signe - a partir de la fin
179
180   DO J=0,4
181     IMINUS=INDEX(HGROUP(MAX(ILENGP-J,1):ILENGP),'-')
182     IF(IMINUS /= 0)THEN
183       JM=J
184       EXIT
185     ENDIF
186   ENDDO
187
188 ! Presence d'un signe moins
189
190   IF(IMINUS /= 0)THEN
191
192 ! Cas expression groupe sous la forme AA__0001-0099 (Donc LFIC1=.TRUE.)  ou
193 ! sous la forme AA_b-c-
194
195     IMINUS=ILENGP-JM+IMINUS-1
196
197     IF(IMINUS == ILENGP)THEN     !00000000000000000000000000000000000000
198 ! Pas d'intervalle mais presence d'un ou plusieurs signes -
199
200       GPART=.TRUE.
201
202     ELSE              !0000000000000000000000000000000000000
203
204 ! Intervalle poossible
205
206       JM1=0; JM2=0; INCR1=0; INCR2=0
207       J=IMINUS-1 ;  JJ=IMINUS+1
208       IF((HGROUP(J:J) == '0' .OR. HGROUP(J:J) == '1' .OR. HGROUP(J:J) == '2' &
209       .OR. HGROUP(J:J) == '3' .OR. HGROUP(J:J) == '4' .OR. HGROUP(J:J) == '5' &
210       .OR. HGROUP(J:J) == '6' .OR. HGROUP(J:J) == '7' .OR. HGROUP(J:J) == '8' &
211       .OR. HGROUP(J:J) == '9') .AND.                     &
212        (HGROUP(JJ:JJ) == '0' .OR. HGROUP(JJ:JJ) =='1' .OR. HGROUP(JJ:JJ) == '2' &
213        .OR. HGROUP(JJ:JJ)=='3' .OR. HGROUP(JJ:JJ)=='4' .OR. HGROUP(JJ:JJ) == '5' &
214        .OR. HGROUP(JJ:JJ)=='6' .OR. HGROUP(JJ:JJ)=='7' .OR. HGROUP(JJ:JJ) == '8' &
215        .OR. HGROUP(JJ:JJ) == '9'))THEN
216       
217       INBC2=ILENGP-IMINUS
218       READ(HGROUP(IMINUS+1:ILENGP),*)NAM2
219       JM=0
220       DO J=2,IMINUS-1
221         IF(HGROUP(J:J) == '0' .OR. HGROUP(J:J) == '1' .OR. HGROUP(J:J) == '2'  &
222         .OR. HGROUP(J:J) == '3' .OR. HGROUP(J:J) == '4' .OR. HGROUP(J:J) == '5' &
223         .OR. HGROUP(J:J) == '6' .OR. HGROUP(J:J) == '7' .OR. HGROUP(J:J) == '8' &
224         .OR. HGROUP(J:J) == '9')THEN
225         JM=J
226         EXIT
227         ENDIF
228       ENDDO
229
230         INBC1=IMINUS-JM
231 ! On memorise les infos pour realloc_several_records
232         READ(HGROUP(JM:IMINUS-1),*)NAM1
233         IF(INBC1-INBC2 == 0)NBCNUM=INBC1
234         CGPNAM=HGROUP(1:JM-1)
235         CGPNAM=ADJUSTL(CGPNAM)
236         CGPNAM1=HGROUP(1:IMINUS-1)
237         CGPNAM1=ADJUSTL(CGPNAM1)
238         CGPNAM2=ADJUSTL(ADJUSTR(CGPNAM)//HGROUP(IMINUS+1:ILENGP))
239         IF(LTYPE)RETURN
240         CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,CGPNAM1)
241         IF(LPBREAD)THEN
242           print *,' VRAISEMBLABLEMENT PB AVEC LE NOM DU GROUPE : ', &
243           HGROUP(1:ILENGP)
244           RETURN
245         ENDIF
246
247         DO J=NAM1,NAM2
248
249         SELECT CASE(NBCNUM)
250           CASE(:1)
251             IF(J < 10)THEN
252               WRITE(Y1,'(I1)')J
253               YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y1)
254             ELSE IF(J < 100)THEN
255               WRITE(Y2,'(I2)')J
256               YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y2)
257             ELSE IF(J < 1000)THEN
258               WRITE(Y3,'(I3)')J
259               YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y3)
260             ELSE
261               WRITE(Y4,'(I4)')J
262               YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y4)
263             ENDIF
264           CASE(2)
265             WRITE(Y2,'(I2.2)')J
266             YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y2)
267           CASE(3)
268             WRITE(Y3,'(I3.3)')J
269             YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y3)
270           CASE(4)
271             WRITE(Y4,'(I4.4)')J
272             YNAM1=ADJUSTL(ADJUSTR(CGPNAM)//Y4)
273         END SELECT
274
275           YRECFM=ADJUSTL(ADJUSTR(YNAM1)//'.TYPE')
276           YNAM1=ADJUSTL(YNAM1)
277           ILENG=LEN(CTYPE)
278           DEALLOCATE(ITABCHAR)
279           ALLOCATE(ITABCHAR(ILENG))
280           CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
281           IGRID,ILENCH,YCOMMENT,IRESPDIA)
282           IF(IRESPDIA == 0)THEN
283             IF(JM1 == 0)THEN
284               JM1=J
285             ELSE
286               INCR1=J-JM1
287               EXIT
288             ENDIF
289           ENDIF
290
291         ENDDO
292
293         DO J=NAM2,NAM1,-1
294
295         SELECT CASE(NBCNUM)
296           CASE(:1)
297             IF(J < 10)THEN
298               WRITE(Y1,'(I1)')J
299               YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y1)
300             ELSE IF(J < 100)THEN
301               WRITE(Y2,'(I2)')J
302               YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y2)
303             ELSE IF(J < 1000)THEN
304               WRITE(Y3,'(I3)')J
305               YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y3)
306             ELSE
307               WRITE(Y4,'(I4)')J
308               YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y4)
309             ENDIF
310           CASE(2)
311             WRITE(Y2,'(I2.2)')J
312             YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y2)
313           CASE(3)
314             WRITE(Y3,'(I3.3)')J
315             YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y3)
316           CASE(4)
317             WRITE(Y4,'(I4.4)')J
318             YNAM2=ADJUSTL(ADJUSTR(CGPNAM)//Y4)
319         END SELECT
320
321           YRECFM=ADJUSTL(ADJUSTR(YNAM2)//'.TYPE')
322           YNAM2=ADJUSTL(YNAM2)
323           ILENG=LEN(CTYPE)
324           DEALLOCATE(ITABCHAR)
325           ALLOCATE(ITABCHAR(ILENG))
326           CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
327           IGRID,ILENCH,YCOMMENT,IRESPDIA)
328           IF(IRESPDIA == 0)THEN
329             IF(JM2 == 0)THEN
330               JM2=J
331             ELSE
332               INCR2=JM2-J
333               EXIT
334             ENDIF
335           ENDIF
336
337         ENDDO
338
339         IF(INCR1 /= 0 .AND. INCR1 == INCR2)THEN
340           NINCRNAM=INCR1
341         ELSE IF(INCR1 /= 0 .AND. INCR1 /= INCR2)THEN
342           LPBREAD=.TRUE.
343           print *,' Increment Numero Nom Groupe non constant : CAS NON PREVU '
344         IF(ALLOCATED(XVAR))THEN
345           CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
346         ENDIF
347           RETURN
348         ENDIF
349     
350         CALL REALLOC_AND_LOAD_RECORDS(HFILEDIA,HLUOUTDIA)
351         RETURN
352
353       ELSE
354
355         GPART=.TRUE.
356
357       ENDIF
358
359     ENDIF        !0000000000000000000000000000000000000
360
361   ELSE
362 ! Cas expression groupe sous la forme AA__  (Donc LFIC1=.TRUE. ou .FALSE.)
363
364     GPART=.TRUE.
365   ENDIF
366
367   IF(GPART)THEN
368 ! On essaie de rajouter 1, puis 2 puis 3 chiffres
369     JM1=0; JM2=0; INCR1=0; INCR2=0
370     DO J=1,9999
371       IF(J <10)THEN
372         WRITE(Y1,'(I1)')J
373         YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y1)
374       ELSE IF(J <=99)THEN
375         WRITE(Y2,'(I2)')J
376         YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y2)
377       ELSE IF(J <= 999)THEN
378         WRITE(Y3,'(I3)')J
379         YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y3)
380       ELSE
381         WRITE(Y4,'(I4)')J
382         YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y4)
383       ENDIF
384       YRECFM=ADJUSTL(ADJUSTR(YNAM1)//'.TYPE')
385       YNAM1=ADJUSTL(YNAM1)
386       ILENG=LEN(CTYPE)
387       DEALLOCATE(ITABCHAR)
388       ALLOCATE(ITABCHAR(ILENG))
389       CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
390       IGRID,ILENCH,YCOMMENT,IRESPDIA)
391       IF(IRESPDIA == 0)THEN
392         IF(JM1 == 0)THEN
393           JM1=J
394           YNAM1M=YNAM1
395         ELSE
396           INCR1=J-JM1
397           YNAM1=YNAM1M
398           EXIT
399         ENDIF
400       ENDIF
401     ENDDO
402     IF(JM1 /= 0)THEN    !+++++++++++++++++++++++++++++++++++++
403     DO J=9999,1,-1
404       IF(J <10)THEN
405         WRITE(Y1,'(I1)')J
406         YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y1)
407       ELSE IF(J <=99)THEN
408         WRITE(Y2,'(I2)')J
409         YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y2)
410       ELSE IF(J <= 999)THEN
411         WRITE(Y3,'(I3)')J
412         YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y3)
413       ELSE
414         WRITE(Y4,'(I4)')J
415         YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y4)
416       ENDIF
417       YRECFM=ADJUSTL(ADJUSTR(YNAM2)//'.TYPE')
418       YNAM2=ADJUSTL(YNAM2)
419       ILENG=LEN(CTYPE)
420       DEALLOCATE(ITABCHAR)
421       ALLOCATE(ITABCHAR(ILENG))
422       CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
423       IGRID,ILENCH,YCOMMENT,IRESPDIA)
424       IF(IRESPDIA == 0)THEN
425         IF(JM2 == 0)THEN
426           JM2=J
427           YNAM2M=YNAM2
428         ELSE
429           INCR2=JM2-J
430           YNAM2=YNAM2M
431           EXIT
432         ENDIF
433       ENDIF
434     ENDDO
435     ENDIF        !+++++++++++++++++++++++++++++++++++++
436
437     IF(INCR1 /= 0 .AND. INCR1 == INCR2)THEN
438       NINCRNAM=INCR1
439     ELSE IF(INCR1 /= 0 .AND. INCR1 /= INCR2)THEN
440       LPBREAD=.TRUE.
441       print *,' Increment Numero Nom Groupe non constant : CAS NON PREVU '
442         IF(ALLOCATED(XVAR))THEN
443           CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
444         ENDIF
445       RETURN
446     ENDIF
447
448     IF(JM1 /= 0 .AND. JM2 /=0)THEN
449 ! On memorise les infos pour realloc_several_records
450       CGPNAM=HGROUP(1:LEN_TRIM(HGROUP))
451       CGPNAM=ADJUSTL(CGPNAM)
452       CGPNAM1=YNAM1
453       CGPNAM1=ADJUSTL(CGPNAM1)
454       CGPNAM2=YNAM2
455       NAM1=JM1; NAM2=JM2
456       IF(LTYPE)RETURN
457       CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,CGPNAM1)
458       CALL REALLOC_AND_LOAD_RECORDS(HFILEDIA,HLUOUTDIA)
459       RETURN
460
461     ELSE
462
463 ! On essaie de rajouter une zone numerique sur 4 positions
464       JM1=0; JM2=0; INCR1=0; INCR2=0
465       DO J=1,9999
466         WRITE(Y4,'(I4.4)')J
467         YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y4)
468         YRECFM=ADJUSTL(ADJUSTR(YNAM1)//'.TYPE')
469         YNAM1=ADJUSTL(YNAM1)
470         ILENG=LEN(CTYPE)
471         DEALLOCATE(ITABCHAR)
472         ALLOCATE(ITABCHAR(ILENG))
473         CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
474         IGRID,ILENCH,YCOMMENT,IRESPDIA)
475         IF(IRESPDIA == 0)THEN
476           IF(JM1 == 0)THEN
477             JM1=J
478             YNAM1M=YNAM1
479           ELSE
480             INCR1=J-JM1
481             YNAM1=YNAM1M
482             EXIT
483           ENDIF
484         ENDIF
485       ENDDO
486       IF(JM1 /= 0)THEN    !+++++++++++++++++++++++++++++++++++++
487       DO J=9999,1,-1
488         WRITE(Y4,'(I4.4)')J
489         YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y4)
490         YRECFM=ADJUSTL(ADJUSTR(YNAM2)//'.TYPE')
491         YNAM2=ADJUSTL(YNAM2)
492         ILENG=LEN(CTYPE)
493         DEALLOCATE(ITABCHAR)
494         ALLOCATE(ITABCHAR(ILENG))
495         CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
496         IGRID,ILENCH,YCOMMENT,IRESPDIA)
497         IF(IRESPDIA == 0)THEN
498           IF(JM2 == 0)THEN
499             JM2=J
500             YNAM2M=YNAM2
501           ELSE
502             INCR2=JM2-J
503             YNAM2=YNAM2M
504             EXIT
505           ENDIF
506         ENDIF
507       ENDDO
508       ENDIF
509
510       IF(INCR1 /= 0 .AND. INCR1 == INCR2)THEN
511         NINCRNAM=INCR1
512       ELSE IF(INCR1 /= 0 .AND. INCR1 /= INCR2)THEN
513         LPBREAD=.TRUE.
514         print *,' Increment Numero Nom Groupe non constant : CAS NON PREVU '
515         IF(ALLOCATED(XVAR))THEN
516           CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
517         ENDIF
518         RETURN
519       ENDIF
520   
521       IF(JM1 /= 0 .AND. JM2 /=0)THEN
522 ! On memorise les infos pour realloc_several_records
523         CGPNAM=HGROUP(1:LEN_TRIM(HGROUP))
524         CGPNAM=ADJUSTL(CGPNAM)
525         CGPNAM1=YNAM1
526         CGPNAM1=ADJUSTL(CGPNAM1)
527         CGPNAM2=YNAM2
528 !       print *,' 4 positions CGPNAM,CGPNAM1,CGPNAM2 ',CGPNAM,CGPNAM1,CGPNAM2
529         NAM1=JM1; NAM2=JM2
530         NBCNUM=4
531         IF(LTYPE)RETURN
532         CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,CGPNAM1)
533         CALL REALLOC_AND_LOAD_RECORDS(HFILEDIA,HLUOUTDIA)
534         RETURN
535
536       ELSE
537
538 ! On essaie de rajouter une zone numerique sur 3 positions
539         JM1=0; JM2=0; INCR1=0; INCR2=0
540         DO J=1,999
541           WRITE(Y3,'(I3.3)')J
542           YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y3)
543           YRECFM=ADJUSTL(ADJUSTR(YNAM1)//'.TYPE')
544           YNAM1=ADJUSTL(YNAM1)
545           ILENG=LEN(CTYPE)
546           DEALLOCATE(ITABCHAR)
547           ALLOCATE(ITABCHAR(ILENG))
548           CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
549           IGRID,ILENCH,YCOMMENT,IRESPDIA)
550           IF(IRESPDIA == 0)THEN
551             IF(JM1 == 0)THEN
552               JM1=J
553               YNAM1M=YNAM1
554             ELSE
555               INCR1=J-JM1
556               YNAM1=YNAM1M
557               EXIT
558             ENDIF
559           ENDIF
560         ENDDO
561         IF(JM1 /= 0)THEN    !+++++++++++++++++++++++++++++++++++++
562         DO J=999,1,-1
563           WRITE(Y3,'(I3.3)')J
564           YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y3)
565           YRECFM=ADJUSTL(ADJUSTR(YNAM2)//'.TYPE')
566           YNAM2=ADJUSTL(YNAM2)
567           ILENG=LEN(CTYPE)
568           DEALLOCATE(ITABCHAR)
569           ALLOCATE(ITABCHAR(ILENG))
570           CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
571           IGRID,ILENCH,YCOMMENT,IRESPDIA)
572           IF(IRESPDIA == 0)THEN
573             IF(JM2 == 0)THEN
574               JM2=J
575               YNAM2M=YNAM2
576             ELSE
577               INCR2=JM2-J
578               YNAM2=YNAM2M
579               EXIT
580             ENDIF
581           ENDIF
582         ENDDO
583         ENDIF
584
585         IF(INCR1 /= 0 .AND. INCR1 == INCR2)THEN
586           NINCRNAM=INCR1
587         ELSE IF(INCR1 /= 0 .AND. INCR1 /= INCR2)THEN
588           LPBREAD=.TRUE.
589           print *,' Increment Numero Nom Groupe non constant : CAS NON PREVU '
590         IF(ALLOCATED(XVAR))THEN
591           CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
592         ENDIF
593           RETURN
594         ENDIF
595     
596         IF(JM1 /= 0 .AND. JM2 /=0)THEN
597 ! On memorise les infos pour realloc_several_records
598           CGPNAM=HGROUP(1:LEN_TRIM(HGROUP))
599           CGPNAM=ADJUSTL(CGPNAM)
600           CGPNAM1=YNAM1
601           CGPNAM1=ADJUSTL(CGPNAM1)
602           CGPNAM2=YNAM2
603           NAM1=JM1; NAM2=JM2
604           NBCNUM=3
605 !         print *,' 3 positions CGPNAM,CGPNAM1,CGPNAM2 ',CGPNAM,CGPNAM1,CGPNAM2
606           IF(LTYPE)RETURN
607           CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,CGPNAM1)
608           CALL REALLOC_AND_LOAD_RECORDS(HFILEDIA,HLUOUTDIA)
609           RETURN
610
611         ELSE
612
613 ! On essaie de rajouter une zone numerique sur 2 positions
614           JM1=0; JM2=0; INCR1=0; INCR2=0
615           DO J=1,99
616             WRITE(Y2,'(I2.2)')J
617             YNAM1=ADJUSTL(ADJUSTR(HGROUP)//Y2)
618             YRECFM=ADJUSTL(ADJUSTR(YNAM1)//'.TYPE')
619             YNAM1=ADJUSTL(YNAM1)
620             ILENG=LEN(CTYPE)
621             DEALLOCATE(ITABCHAR)
622             ALLOCATE(ITABCHAR(ILENG))
623             CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
624             IGRID,ILENCH,YCOMMENT,IRESPDIA)
625             IF(IRESPDIA == 0)THEN
626               IF(JM1 == 0)THEN
627                 JM1=J
628                 YNAM1M=YNAM1
629               ELSE
630                 INCR1=J-JM1
631                 YNAM1=YNAM1M
632                 EXIT
633               ENDIF
634             ENDIF
635           ENDDO
636           IF(JM1 /= 0)THEN    !+++++++++++++++++++++++++++++++++++++
637           DO J=99,1,-1
638             WRITE(Y2,'(I2.2)')J
639             YNAM2=ADJUSTL(ADJUSTR(HGROUP)//Y2)
640             YRECFM=ADJUSTL(ADJUSTR(YNAM2)//'.TYPE')
641             YNAM2=ADJUSTL(YNAM2)
642             ILENG=LEN(CTYPE)
643             DEALLOCATE(ITABCHAR)
644             ALLOCATE(ITABCHAR(ILENG))
645             CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
646             IGRID,ILENCH,YCOMMENT,IRESPDIA)
647             IF(IRESPDIA == 0)THEN
648               JM2=J
649           EXIT
650             ENDIF
651           ENDDO
652           ENDIF
653       
654           IF(INCR1 /= 0 .AND. INCR1 == INCR2)THEN
655             NINCRNAM=INCR1
656           ELSE IF(INCR1 /= 0 .AND. INCR1 /= INCR2)THEN
657             LPBREAD=.TRUE.
658             print *,' Increment Numero Nom Groupe non constant : CAS NON PREVU '
659         IF(ALLOCATED(XVAR))THEN
660           CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
661         ENDIF
662             RETURN
663           ENDIF
664       
665           IF(JM1 /= 0 .AND. JM2 /=0)THEN
666 ! On memorise les infos pour realloc_several_records
667             CGPNAM=HGROUP(1:LEN_TRIM(HGROUP))
668             CGPNAM=ADJUSTL(CGPNAM)
669             CGPNAM1=YNAM1
670             CGPNAM1=ADJUSTL(CGPNAM1)
671             CGPNAM2=YNAM2
672             NAM1=JM1; NAM2=JM2
673             NBCNUM=2
674 !           print *,' 2 positions CGPNAM,CGPNAM1,CGPNAM2 ',CGPNAM,CGPNAM1,CGPNAM2
675             IF(LTYPE)RETURN
676             CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,CGPNAM1)
677             CALL REALLOC_AND_LOAD_RECORDS(HFILEDIA,HLUOUTDIA)
678             RETURN
679
680           ELSE
681
682           ENDIF
683
684         ENDIF
685
686       ENDIF
687
688     ENDIF
689
690 ! ELSE
691
692   ENDIF
693
694     LPBREAD=.TRUE.
695 !************   Le tester dans le pg appelant **************
696     IF(INDEX(HGROUP(1:ILENGP),'NPROFILE') /= 0)THEN
697     RETURN
698     ELSE
699     print *,' PB AVEC LE NOM DU GROUPE ou DU PARAMETRE : ',HGROUP(1:ILENGP)
700     print *,' VERIFIEZ ET RENTREZ A NOUVEAU VOTRE DIRECTIVE '
701     RETURN
702     ENDIF
703
704
705 ENDIF
706
707 !
708 !-----------------------------------------------------------------------------
709 !
710 !*       2.       EXITS
711 !                 -----
712
713 RETURN
714 END SUBROUTINE VERIF_GROUP