Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / traxy.f90
1 !     ######spl
2       SUBROUTINE TRAXY(PTEMX,PTEMY,KLOOP,HTITX,HTITY,PTIMED,PTIMEF)
3 !     #############################################################
4 !
5 !!****  *TRAXY* - 
6 !!
7 !!    PURPOSE
8 !!    -------
9 !
10 !!**  METHOD
11 !!    ------
12 !!     
13 !!    EXTERNAL
14 !!    --------
15 !!
16 !!
17 !!    IMPLICIT ARGUMENTS
18 !!    ------------------
19 !! modif juin 2010 : ajout de LVARNPHUSER=T et LFACTAXEX=T
20 !!
21 USE MODD_NMGRID
22 USE MODN_PARA
23 USE MODN_NCAR
24 USE MODD_COORD  
25 USE MODD_FILES_DIACHRO
26 USE MODD_TYPE_AND_LH
27 USE MODD_GRID1  
28 !USE MODD_GRID
29 USE MODD_CONF   
30 USE MODD_DIM1  
31 USE MODD_SUPER  
32 USE MODD_TIT
33 USE MODD_NMGRID
34 USE MODD_TITLE
35 USE MODD_RESOLVCAR
36 USE MODD_ALLOC_FORDIACHRO
37 USE MODD_PARAMETERS
38 USE MODD_CTL_AXES_AND_STYL
39 USE MODI_SET_DIM
40 !
41 IMPLICIT NONE
42 !
43 INTERFACE
44       SUBROUTINE IMAGE_FORDIACHRO(PTAB,KLREF,PTABINT,KNHI,KNDOT,HTEXTE)
45       CHARACTER(LEN=*)   :: HTEXTE
46       REAL                :: PTABINT
47       REAL,DIMENSION(:,:) :: PTAB
48       INTEGER :: KNI, KNDOT, KLREF
49       END SUBROUTINE IMAGE_FORDIACHRO
50 END INTERFACE
51 !
52 !*      0.1    Dummy arguments 
53 !
54 INTEGER    :: KLOOP
55 REAL,DIMENSION(:)  :: PTEMX, PTEMY
56 REAL               :: PTIMED, PTIMEF
57 CHARACTER(LEN=*) :: HTITX, HTITY
58 !
59 !*      0.2    Local variables 
60 !
61 !
62 INTEGER           :: ICOMPT=0
63 INTEGER,SAVE      :: ISUPERDIA, ILENW, ILR
64 INTEGER,SAVE      :: J, IC, ID, ITOT, JMCUR
65 INTEGER           :: JD, JE, JF, JI, J2, JJE, JA, JM
66 INTEGER           :: ISUIT
67 INTEGER           :: INUM, IRESP, IER, IERR
68 INTEGER           :: ISTYL
69 INTEGER,DIMENSION(:),ALLOCATABLE,SAVE   :: ICOMPTSZ, IBRECOUV, IST
70 INTEGER,DIMENSION(:,:),ALLOCATABLE,SAVE :: IRECOUV, IWORK
71 !
72 REAL,SAVE         :: ZMINX, ZMAXX, ZMINY, ZMAXY, ZZMINY, ZZMAXY
73 REAL,SAVE         :: ZVL, ZVR, ZVB, ZVT, ZWL, ZWR, ZWB,ZWT
74 REAL         :: ZWLL,ZWRR,ZWBB,ZWTT
75 INTEGER,SAVE      :: IDD
76 REAL,SAVE         :: ZZVT, ZZT
77 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: ZTEMX2D, ZTEMY2D
78 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: ZTEM2D, ZWORK2D
79 REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: ZTIMD, ZTIMF, ZWORK1D
80 REAL,DIMENSION(:),ALLOCATABLE        :: ZWT1, ZWT2
81 REAL,SAVE         :: ZW, ZE36, ZLWSC
82 REAL              :: ZXPOSTITT1, ZXYPOSTITT1
83 REAL              :: ZXPOSTITT2, ZXYPOSTITT2
84 REAL              :: ZXPOSTITT3, ZXYPOSTITT3
85 REAL              :: ZXPOSTITB1, ZXYPOSTITB1
86 REAL              :: ZXPOSTITB2, ZXYPOSTITB2
87 REAL              :: ZXPOSTITB3, ZXYPOSTITB3
88 REAL              :: ZCONSTIM
89 !INTEGER           :: ICLIP
90 !REAL,DIMENSION(4) :: ZCL
91 !
92 CHARACTER(LEN=80) :: YTEM, YCAR
93 CHARACTER(LEN=40),SAVE :: YTITY
94 CHARACTER(LEN=40),DIMENSION(:),ALLOCATABLE,SAVE :: YTITGAL
95 CHARACTER(LEN=1)  :: YC1
96 CHARACTER(LEN=2)  :: YC2, YTEXT
97 CHARACTER(LEN=3)  :: YC3
98 !
99 LOGICAL,SAVE :: GOK
100 LOGICAL      :: GCOLINE
101 !
102 !-------------------------------------------------------------------------------
103 ZZVT=0.; ZZT=0.
104 GOK=.FALSE.
105 ZE36=1.E36
106 ICOMPT=ICOMPT+1
107 IF(NVERBIA > 0)THEN
108 print *,'TRAXY ICOMPT ',ICOMPT
109 print *,'TRAXY LCONT, LRELIEF',LCONT, LRELIEF
110 ENDIF
111 !print *,' PTEMX ',PTEMX
112 !print *,' PTEMY ',PTEMY
113
114 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
115 IF(LPRINT)THEN
116   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
117   IF(IRESP /= 0)THEN
118     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
119     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
120     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
121   ENDIF
122   WRITE(INUM,'(''TRAXY  '',''G:'',A16,'' P:'',A25,'' TD:'',F8.0,''s'','' TF:'', &
123 & F8.0,''s'')')CGROUP,CTITGAL(1:25),PTIMED,PTIMEF
124   WRITE(INUM,'(''TITX:'',A25,'' TITY:'',A25,'' NBVAL:'',I8)')HTITX,HTITY,SIZE(PTEMX)
125   IF(LPLUS .OR.LMINUS)THEN
126     WRITE(INUM,'(A70)')CTITB3
127   ELSE
128     WRITE(INUM,'(A40)')CTITGAL
129   ENDIF
130 ! JUin 2001 Ecriture des dates (Demande G.Jaubert ) si LPRDAT=T
131   IF(LPRDAT)THEN
132     IF(.NOT.ALLOCATED(XPRDAT))THEN
133       print *,'**TRAXY XPRDAT NON ALLOUE.Dates non ecrites ds FICVAL .Prevenir J.Duron'
134     ELSE
135       if(nverbia >0)then
136        print *,' ** traxy AV toute ecriture et avec LPRDAT=T'
137       endif
138       WRITE(INUM,'(1X,75(1H*))')
139       WRITE(INUM,'(1X,''    Dates courante   *     modele      *   experience    *      segment'')')
140       WRITE(INUM,'(1X,'' J   An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.'')')
141       WRITE(INUM,'(1X,75(1H*))')
142       if(nverbia >0)then
143        print *,' ** traxy AP ecriture entete dates et avec LPRDAT=T'
144       endif
145       DO J=1,SIZE(XPRDAT,2)
146       if(nverbia >0)then
147        print *,' **  ecriture dates et avec LPRDAT=T j SIZE(XPRDAT,2) ',J,SIZE(XPRDAT,2)
148       endif
149         WRITE(INUM,'(1X,I3,1X,3(I4,I3,I3,I6,'' *''),I4,I3,I3,I6)')J,INT(XPRDAT(:,J))
150       ENDDO
151       if(nverbia >0)then
152        print *,' ** traxy AP ecriture dates et avec LPRDAT=T'
153       endif
154     ENDIF
155   ENDIF
156 ! JUin 2001 Ecriture des dates 
157 !!Avril 2002 + lat et lon
158   IF(LCV .AND. .NOT.LCARTESIAN)THEN
159     WRITE(INUM,'(1X,78(1H*))')
160   WRITE(INUM,'(16X,''X'',19X,''Y'',16X,''LAT'',16X,''LON'')')
161   WRITE(INUM,'(1X,78(1H*))')
162   DO J=1,SIZE(PTEMX)
163     WRITE(INUM,'(I5,4X,E15.8,4X,E15.8,3X,E15.7,3X,E15.7)')J,PTEMX(J),PTEMY(J),&
164     XLATCV(J),XLONCV(J)
165   ENDDO
166   ELSE
167   WRITE(INUM,'(1X,45(1H*))')
168   WRITE(INUM,'(16X,''X'',19X,''Y'')')
169   WRITE(INUM,'(1X,45(1H*))')
170   DO J=1,SIZE(PTEMX)
171     WRITE(INUM,'(I5,4X,E15.8,4X,E15.8)')J,PTEMX(J),PTEMY(J)
172   ENDDO
173   ENDIF
174       if(nverbia >0)then
175        print *,' ** traxy AP ecriture coordonnees et avec LPRDAT=T ou F'
176       endif
177 ENDIF
178 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
179 IF(ICOMPT == 1)THEN
180
181   IF((CGROUPS(NSUPERDIA) == 'ZSBIS' .OR. CGROUPS(NSUPERDIA) == 'ZS') .AND. &
182     NSUPERDIA > 1 .AND. .NOT.(LCH.AND.LCV))THEN
183     NSUPERDIA=NSUPERDIA-1
184     ISUPERDIA=NSUPERDIA
185     LRELIEF=.TRUE.
186   ELSE
187     ISUPERDIA=NSUPERDIA
188     LRELIEF=.FALSE.
189   ENDIF
190 ! IF(LMINUS .OR. LPLUS)ISUPERDIA=ISUPERDIA-1
191   IF(LMINUS .OR. LPLUS)ISUPERDIA=1
192 ! Cas LCH+LCV -> PH sur CV
193   IF(NHISTORY(KLOOP) == 3)THEN
194     DO J=1,MAX(1,KLOOP-1)
195       IF(NHISTORY(J) == 1)THEN
196         ISUPERDIA=1
197       ENDIF
198     ENDDO
199   ENDIF
200   if(nverbia > 0)then
201   print *,' TRAXY ISUPERDIA ',ISUPERDIA
202   endif
203   ALLOCATE(ZTEMX2D(SIZE(PTEMX),ISUPERDIA))
204   ALLOCATE(ZTEMY2D(SIZE(PTEMY),ISUPERDIA))
205   ALLOCATE(ICOMPTSZ(ISUPERDIA))
206   ALLOCATE(IBRECOUV(ISUPERDIA))
207   ALLOCATE(IST(ISUPERDIA))
208   ALLOCATE(IRECOUV(NBRECOUV*2,ISUPERDIA))
209   ALLOCATE(ZTIMD(ISUPERDIA))
210   ALLOCATE(ZTIMF(ISUPERDIA))
211   ALLOCATE(YTITGAL(ISUPERDIA))
212   ZTEMX2D(:,ICOMPT)=PTEMX
213   ZTEMY2D(:,ICOMPT)=PTEMY
214   ICOMPTSZ(ICOMPT)=SIZE(PTEMX)
215   IBRECOUV(ICOMPT)=NBRECOUV
216   IST(ICOMPT)=NLOOPN
217   DO J=1,NBRECOUV
218     IRECOUV(J*2-1,ICOMPT)=NRECOUV(J*2-1)
219     IRECOUV(J*2,ICOMPT)=NRECOUV(J*2)
220   ENDDO
221   IF(NBRECOUV == 1 .AND. PTIMED == PTIMEF)THEN
222     IRECOUV(1,ICOMPT)=1
223     IRECOUV(2,ICOMPT)=SIZE(PTEMX)
224   ENDIF
225   ZTIMD(ICOMPT)=PTIMED
226   ZTIMF(ICOMPT)=PTIMEF
227   YTITGAL(ICOMPT)=CTITGAL
228   YTITGAL(ICOMPT)=ADJUSTL(YTITGAL(ICOMPT))
229   YTITY=HTITY
230   YTITY=ADJUSTL(YTITY)
231
232 ELSE 
233
234   ILENW=SIZE(PTEMX)
235
236   IF(ILENW < MAXVAL(ICOMPTSZ(1:ICOMPT-1)))THEN
237     ZTEMX2D(:,ICOMPT)=PTEMX
238     ZTEMY2D(:,ICOMPT)=PTEMY
239   ELSE
240     ALLOCATE(ZTEM2D(SIZE(PTEMX),ISUPERDIA))
241     ALLOCATE(ZWORK2D(SIZE(PTEMX),ISUPERDIA))
242     DO J=1,ICOMPT-1
243       ZTEM2D(1:ICOMPTSZ(J),J)=ZTEMX2D(1:ICOMPTSZ(J),J)
244       ZWORK2D(1:ICOMPTSZ(J),J)=ZTEMY2D(1:ICOMPTSZ(J),J)
245     ENDDO
246     ZTEM2D(:,ICOMPT)=PTEMX
247     ZWORK2D(:,ICOMPT)=PTEMY
248     DEALLOCATE(ZTEMX2D,ZTEMY2D)
249     ALLOCATE(ZTEMX2D(SIZE(ZTEM2D,1),SIZE(ZTEM2D,2)))
250     ALLOCATE(ZTEMY2D(SIZE(ZWORK2D,1),SIZE(ZWORK2D,2)))
251     ZTEMX2D(:,:)= ZTEM2D(:,:)
252     ZTEMY2D(:,:)= ZWORK2D(:,:)
253     DEALLOCATE(ZTEM2D,ZWORK2D)
254   ENDIF
255
256   ICOMPTSZ(ICOMPT)=SIZE(PTEMX)
257   ZTIMD(ICOMPT)=PTIMED
258   ZTIMF(ICOMPT)=PTIMEF
259   YTITGAL(ICOMPT)=CTITGAL
260   YTITGAL(ICOMPT)=ADJUSTL(YTITGAL(ICOMPT))
261   HTITY=ADJUSTL(HTITY)
262   IF(HTITY /= YTITY)THEN
263      YTITGAL(ICOMPT)=ADJUSTL(ADJUSTR(YTITGAL(ICOMPT))//' '//HTITY) 
264   ENDIF
265   IBRECOUV(ICOMPT)=NBRECOUV
266   IST(ICOMPT)=NLOOPN
267   ILR=NBRECOUV*2
268
269   IF(ILR <= MAXVAL(IBRECOUV(1:ICOMPT-1))*2)THEN
270     DO J=1,ILR
271       IRECOUV(J,ICOMPT)=NRECOUV(J)
272     ENDDO
273     IF(NBRECOUV == 1 .AND. PTIMED == PTIMEF)THEN
274       IRECOUV(1,ICOMPT)=1
275       IRECOUV(2,ICOMPT)=SIZE(PTEMX)
276     ENDIF
277   ELSE
278     ALLOCATE(IWORK(ILR,ISUPERDIA))
279     DO J=1,ICOMPT-1
280       IWORK(1:IBRECOUV(J)*2,J)=IRECOUV(1:IBRECOUV(J)*2,J)
281     ENDDO
282     IWORK(1:ILR,ICOMPT)=NRECOUV(1:ILR)
283     IF(NBRECOUV == 1 .AND. PTIMED == PTIMEF)THEN
284       IWORK(1,ICOMPT)=1
285       IWORK(2,ICOMPT)=SIZE(PTEMX)
286     ENDIF
287     DEALLOCATE(IRECOUV)
288     ALLOCATE(IRECOUV(ILR,ISUPERDIA))
289     IRECOUV(:,:)=IWORK(:,:)
290     DEALLOCATE(IWORK)
291   ENDIF
292
293 ENDIF
294
295 !----------------------------------------------------------------------------
296
297 IF(ICOMPT < ISUPERDIA)THEN
298
299   RETURN
300
301 ELSE
302 ! print *,' ICOMPT ISUPERDIA ',ICOMPT,ISUPERDIA
303 ! print *,' IBRECOUV, IRECOUV ',IBRECOUV,IRECOUV
304   ITOT=0
305   DO J=1,ICOMPT
306     ITOT=ITOT+ICOMPTSZ(J)
307   ENDDO
308 ! print *,' ITOT ',ITOT
309   ALLOCATE(ZWORK1D(ITOT))
310   ID=0
311   DO J=1,ICOMPT
312     IC=ICOMPTSZ(J)
313     IF(LXT .OR. LYT .OR. LZT)THEN
314       ZCONSTIM=0
315       IF(MOD(J,8) == 1)THEN
316         ZCONSTIM=XFT_ADTIM1
317         IF(ZCONSTIM /= 0.)THEN
318           print *,' ****ATTENTION Ajout pour la courbe N.1 d''une constante de temps de : ',&
319           ZCONSTIM,'sec.'
320           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM1 a zero'
321         ENDIF
322       ELSEIF(MOD(J,8) == 2)THEN
323         ZCONSTIM=XFT_ADTIM2
324         IF(ZCONSTIM /= 0.)THEN
325           print *,' ****ATTENTION Ajout pour la courbe N.2 d''une constante de temps de : ',&
326           ZCONSTIM,'sec.'
327           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM2 a zero'
328         ENDIF
329       ELSEIF(MOD(J,8) == 3)THEN
330         ZCONSTIM=XFT_ADTIM3
331         IF(ZCONSTIM /= 0.)THEN
332           print *,' ****ATTENTION Ajout pour la courbe N.3 d''une constante de temps de : ',&
333           ZCONSTIM,'sec.'
334           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM3 a zero'
335         ENDIF
336       ELSEIF(MOD(J,8) == 4)THEN
337         ZCONSTIM=XFT_ADTIM4
338         IF(ZCONSTIM /= 0.)THEN
339           print *,' ****ATTENTION Ajout pour la courbe N.4 d''une constante de temps de : ',&
340           ZCONSTIM,'sec.'
341           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM4 a zero'
342         ENDIF
343       ELSEIF(MOD(J,8) == 5)THEN
344         ZCONSTIM=XFT_ADTIM5
345         IF(ZCONSTIM /= 0.)THEN
346           print *,' ****ATTENTION Ajout pour la courbe N.5 d''une constante de temps de : ',&
347           ZCONSTIM,'sec.'
348           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM5 a zero'
349         ENDIF
350       ELSEIF(MOD(J,8) == 6)THEN
351         ZCONSTIM=XFT_ADTIM6
352         IF(ZCONSTIM /= 0.)THEN
353           print *,' ****ATTENTION Ajout pour la courbe N.6 d''une constante de temps de : ',&
354           ZCONSTIM,'sec.'
355           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM6 a zero'
356         ENDIF
357       ELSEIF(MOD(J,8) == 7)THEN
358         ZCONSTIM=XFT_ADTIM7
359         IF(ZCONSTIM /= 0.)THEN
360           print *,' ****ATTENTION Ajout pour la courbe N.7 d''une constante de temps de : ',&
361           ZCONSTIM,'sec.'
362           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM7 a zero'
363         ENDIF
364       ELSEIF(MOD(J,8) == 0)THEN
365         ZCONSTIM=XFT_ADTIM8
366         IF(ZCONSTIM /= 0.)THEN
367           print *,' ****ATTENTION Ajout pour la courbe N.8 d''une constante de temps de : ',&
368           ZCONSTIM,'sec.'
369           print *,' S''il s''agit d''une erreur, remettez XFT_ADTIM8 a zero'
370         ENDIF
371       ENDIF
372       ZTEMX2D(1:IC,J)=ZTEMX2D(1:IC,J)+ZCONSTIM
373     ENDIF
374     ZWORK1D(ID+1:ID+IC)=ZTEMX2D(1:IC,J)
375     ID=IC+ID
376   ENDDO
377 ! Mai 2000
378   IF(LSPVALT)THEN
379     WHERE (ZWORK1D == XSPVALT)
380       ZWORK1D = ZE36
381     ENDWHERE
382     DO J=1,SIZE(ZWORK1D)
383       IF(ZWORK1D(J) /= ZE36)THEN
384         ZMINX=ZWORK1D(J)
385         ZMAXX=ZWORK1D(J)
386         EXIT
387       ENDIF
388     ENDDO
389     DO J=1,SIZE(ZWORK1D)
390       IF(ZWORK1D(J) /= ZE36)THEN
391         ZMINX=MIN(ZMINX,ZWORK1D(J))
392         ZMAXX=MAX(ZMAXX,ZWORK1D(J))
393       ENDIF
394     ENDDO
395     print *,' ZMINX,ZMAXX trouves, (eventuelles valeurs speciales non comprises ',ZMINX,ZMAXX
396
397   ELSE
398     ZMINX=MINVAL(ZWORK1D)
399     ZMAXX=MAXVAL(ZWORK1D)
400     print *,' ZMINX,ZMAXX trouves, (eventuelles valeurs speciales comprises ',ZMINX,ZMAXX
401   ENDIF
402 ! CALL VALMNMX(ZMINX,ZMAXX)
403 !print *,' ap VALMNMX ',ZMINX,ZMAXX
404   IF(ZMAXX - ZMINX == 0)THEN
405     ZMAXX=ZMAXX+1.
406     ZMINX=ZMINX-1.
407   ENDIF
408   print *,' ZMINX,ZMAXX utilisees ',ZMINX,ZMAXX
409
410   ID=0
411   DO J=1,ICOMPT
412     IC=ICOMPTSZ(J)
413     ZWORK1D(ID+1:ID+IC)=ZTEMY2D(1:IC,J)
414     ID=IC+ID
415   ENDDO
416 ! Mai 2000
417   IF(LSPVALT)THEN
418     WHERE (ZWORK1D == XSPVALT)
419       ZWORK1D = ZE36
420     ENDWHERE
421     DO J=1,SIZE(ZWORK1D)
422       IF(ZWORK1D(J) /= ZE36)THEN
423         ZMINY=ZWORK1D(J)
424         ZMAXY=ZWORK1D(J)
425         EXIT
426       ENDIF
427     ENDDO
428     DO J=1,SIZE(ZWORK1D)
429       IF(ZWORK1D(J) /= ZE36)THEN
430         ZMINY=MIN(ZMINY,ZWORK1D(J))
431         ZMAXY=MAX(ZMAXY,ZWORK1D(J))
432       ENDIF
433     ENDDO
434     print *,' ZMINY,ZMAXY trouves, (eventuelles valeurs speciales non comprises ',ZMINY,ZMAXY
435   ELSE
436     ZMINY=MINVAL(ZWORK1D)
437     ZMAXY=MAXVAL(ZWORK1D)
438     print *,' TRAXY : Bornes en Y trouvees : ',ZMINY,ZMAXY
439     print *,'        (Eventuelles valeurs speciales : XSPVALT(ou XSPVAL pour trace instantane) ou 1.E36 comprises <--> relief)'
440     print *,'        (Actuellement les valeurs XSPVALT(ou XSPVAL pour trace instantane)  sont tracees, pas les valeurs 1.E36)'
441     print *,'        Pour les supprimer, affecter sa valeur a XSPVALT (ou XSPVAL) etfournir LSPVALT=T '
442   ENDIF
443   ZZMINY=1.E35
444   ZZMAXY=-1.E35
445   JA=0
446   DO J=1,SIZE(ZWORK1D,1)
447 !   IF(ZWORK1D(J) /= 999. .AND. ZWORK1D(J) /= 1.E36)THEN
448 ! Mai 2000
449     IF(LSPVALT)THEN
450       IF(ZWORK1D(J) /= XSPVALT .AND. ZWORK1D(J) /= 1.E36)THEN
451         ZZMINY=MIN(ZZMINY,ZWORK1D(J))
452         ZZMAXY=MAX(ZZMAXY,ZWORK1D(J))
453       ELSE
454         JA=JA+1
455       ENDIF
456     ELSE
457       IF(ZWORK1D(J) /= XSPVAL .AND. ZWORK1D(J) /= 1.E36)THEN
458         ZZMINY=MIN(ZZMINY,ZWORK1D(J))
459         ZZMAXY=MAX(ZZMAXY,ZWORK1D(J))
460       ELSE
461         JA=JA+1
462       ENDIF
463     ENDIF
464   ENDDO
465   IF(ZZMINY /= 1.E35 .AND. ZZMAXY /= -1.E35 .AND. JA>0)THEN
466     print *,'         Bornes en Y trouvees : ',ZZMINY,ZZMAXY
467     print *,'        (Abstraction faite des valeurs speciales)'
468   ENDIF
469 ! CALL VALMNMX(ZMINY,ZMAXY)
470   IF(ZMAXY - ZMINY == 0)THEN
471     ZMAXY=ZMAXY+1.
472     ZMINY=ZMINY-1.
473   ENDIF
474   DEALLOCATE(ZWORK1D)
475 ! print *,' TRAXY ZMINX,ZMAXX,ZMINY,ZMAXY ',ZMINX,ZMAXX,ZMINY,ZMAXY
476 ENDIF
477 !IF(.NOT.LCONT .AND. .NOT.LRELIEF)THEN
478 IF(XVARMAX-XVARMIN >0)THEN
479   print *,'         Bornes en Y fournies : ',XVARMIN,XVARMAX
480   print *,' Si elles ne conviennent pas, donnez de nouvelles valeurs dans XVARMIN et XVARMAX '
481   print *,' (Retour au calcul automatique des bornes avec XVARMIN=0 et XVARMAX=0)'
482   ZMINY=XVARMIN; ZMAXY=XVARMAX
483 ELSE
484   print *,' Vous pouvez fournir des bornes en Y dans XVARMIN et XVARMAX' 
485   print *,' (Retour au calcul automatique des bornes avec XVARMIN=0 et XVARMAX=0)'
486 ENDIF
487 !ENDIF
488
489
490 ! IF(LRELIEF .OR. LCONT)THEN
491 IF((LCONT .OR. LRELIEF .OR.(LRELIEF .AND. LCONT))  .AND. LXYDIA)THEN
492   if(nverbia > 0)then
493   print *,'passage ici NIMAX ',nimax,' LCARTESIAN ',LCARTESIAN
494   print *,'passage ici NIINF,NJINF,NISUP,NJSUP ',NIINF,NJINF,NISUP,NJSUP
495   endif
496   IF(NIMAX == 0)THEN
497     IF (NBFILES == 1)THEN
498       print *,' Impossibilite de tracer les continents; pas d''entete dans le fichier'
499       IF(LVPTXYUSER)THEN
500         CALL SET(XVPTXYL,XVPTXYR,XVPTXYB,XVPTXYT,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
501       ELSE
502         CALL SET(.13,.9,.1,.9,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
503       ENDIF
504     ELSE
505       DO J=1,NBFILES
506         IF(NUMFILES(J)==NUMFILECUR)THEN
507           JMCUR=J
508           if(nverbia > 0)then
509           print *,' traxy J JMCUR ',J,JMCUR
510           endif
511           EXIT
512         ENDIF
513       ENDDO
514       DO J=1,NBFILES
515         IF(NUMFILES(J)==NUMFILECUR)THEN
516           CYCLE
517         ELSE
518           JM=J
519           if(nverbia > 0 )THEN
520           print *,' traxy JM,CFILEDIAS(JM) ',JM,CFILEDIAS(JM)
521           ENDIF
522           CALL READ_FILEHEAD(JM,CFILEDIAS(JM),CLUOUTDIAS(JM))
523           IF(NIMAX /= 0)THEN
524             IF(NIINF == 0 .AND. NJINF == 0 .AND. NISUP == 0 .AND. &
525             NJSUP == 0)THEN
526               CALL SET_DIM(CFILEDIAS(JM),CLUOUTDIAS(JM),NIINF,NISUP, &
527               NJINF,NJSUP,NIMAX,NJMAX,NKMAX)
528               print *,' NIINF,NJINF,NISUP,NJSUP non definis --> '
529               print *,' On prend la totalite du domaine horizontal sans les points de garde'
530               NIINF=NIINF+JPHEXT
531               NISUP=NISUP-JPHEXT
532               NJINF=NJINF+JPHEXT
533               NJSUP=NJSUP-JPHEXT
534               IF(NVERBIA > 0)THEN
535               print *,NIINF,NJINF,NISUP,NJSUP
536               ENDIF
537             ENDIF
538             CALL COMPCOORD_FORDIACHRO(0)
539             NMGRID=1
540             CALL BCGRD_FORDIACHRO(2)
541             IF(LRELIEF)THEN
542               ALLOCATE(ZTEM2D(1:NISUP-NIINF+1,1:NJSUP-NJINF+1))
543               ZTEM2D(:,:)=XXZS(NIINF:NISUP,NJINF:NJSUP,1)
544               YTEXT='  '
545               LCHXY=.TRUE.
546               CTYPHOR='K'
547               GCOLINE=LCOLINE
548               LCOLINE=.FALSE.
549               CALL IMAGE_FORDIACHRO(ZTEM2D,1,XDIAINT,NHI,NDOT,YTEXT)
550               CALL SFLUSH
551               LCOLINE=GCOLINE
552 ! CALL GSTXCI(1)
553 ! CALL GSPLCI(1)
554               IF(LDOMAIN)THEN
555                 CALL GSLWSC(XLWDOMAIN)
556                 CALL FRSTPT(XXX(NDOMAINL,NMGRID),XXY(NDOMAINB,NMGRID))
557                 CALL VECTOR(XXX(NDOMAINR,NMGRID),XXY(NDOMAINB,NMGRID))
558                 CALL VECTOR(XXX(NDOMAINR,NMGRID),XXY(NDOMAINT,NMGRID))
559                 CALL VECTOR(XXX(NDOMAINL,NMGRID),XXY(NDOMAINT,NMGRID))
560                 CALL VECTOR(XXX(NDOMAINL,NMGRID),XXY(NDOMAINB,NMGRID))
561               ENDIF
562               DEALLOCATE(ZTEM2D)
563               LRELIEF=.FALSE.
564               if(nverbia > 0)THEN
565                 print *,' TRAXY NSUPERDIA AP TRACE RELIEF ',NSUPERDIA
566               endif
567               CGROUPS(NSUPERDIA+1)(1:LEN(CGROUPS(NSUPERDIA+1)))=' '
568             ENDIF
569             if(nverbia > 0 )THEN
570               print *,' traxy JMCUR,CFILEDIAS(JMCUR) ',JMCUR,CFILEDIAS(JMCUR)
571             endif
572             CALL READ_FILEHEAD(JMCUR,CFILEDIAS(JMCUR),CLUOUTDIAS(JMCUR))
573             GOK=.TRUE.
574             EXIT
575           ELSE
576             CYCLE
577           ENDIF
578         ENDIF
579       ENDDO
580       IF(.NOT.GOK)THEN
581       IF(NIMAX == 0)THEN
582       print *,' Impossibilite de tracer les continents; pas d''entete dans le fichier'
583       IF(LVPTXYUSER)THEN
584         CALL SET(XVPTXYL,XVPTXYR,XVPTXYB,XVPTXYT,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
585       ELSE
586         CALL SET(.13,.9,.1,.9,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
587       ENDIF
588       ENDIF
589     ENDIF
590     ENDIF
591   ELSE
592     if(nverbia > 0)then
593       print *,' ** traxy Cas ou NIMAX =/= 0'
594     endif
595     IF(NIINF == 0 .AND. NJINF == 0 .AND. NISUP == 0 .AND. &
596       NJSUP == 0)THEN
597       DO J=1,NBFILES
598         IF(NUMFILES(J)==NUMFILECUR)THEN
599           JMCUR=J
600           if(nverbia > 0)then
601           print *,' traxy J JMCUR ',J,JMCUR
602           endif
603           EXIT
604         ENDIF
605       ENDDO
606               CALL SET_DIM(CFILEDIAS(JMCUR),CLUOUTDIAS(JMCUR),NIINF,NISUP, &
607               NJINF,NJSUP,NIMAX,NJMAX,NKMAX)
608               print *,' NIINF,NJINF,NISUP,NJSUP non definis --> '
609               print *,' On prend la totalite du domaine horizontal sans les points de garde'
610               NIINF=NIINF+JPHEXT
611               NISUP=NISUP-JPHEXT
612               NJINF=NJINF+JPHEXT
613               NJSUP=NJSUP-JPHEXT
614               IF(NVERBIA > 0)THEN
615               print *,NIINF,NJINF,NISUP,NJSUP
616               ENDIF
617             CALL COMPCOORD_FORDIACHRO(0)
618             ENDIF
619             NMGRID=1
620     CALL BCGRD_FORDIACHRO(2)
621     GOK=.TRUE.
622             IF(LRELIEF)THEN
623               ALLOCATE(ZTEM2D(1:NISUP-NIINF+1,1:NJSUP-NJINF+1))
624               ZTEM2D(:,:)=XXZS(NIINF:NISUP,NJINF:NJSUP,1)
625               YTEXT='  '
626               LCHXY=.TRUE.
627               GCOLINE=LCOLINE
628               LCOLINE=.FALSE.
629               CTYPHOR='K'
630               CALL IMAGE_FORDIACHRO(ZTEM2D,1,XDIAINT,NHI,NDOT,YTEXT)
631               CALL SFLUSH
632               LCOLINE=GCOLINE
633 ! CALL GSTXCI(1)
634 ! CALL GSPLCI(1)
635               IF(LDOMAIN)THEN
636                 CALL GSLWSC(XLWDOMAIN)
637                 CALL FRSTPT(XXX(NDOMAINL,NMGRID),XXY(NDOMAINB,NMGRID))
638                 CALL VECTOR(XXX(NDOMAINR,NMGRID),XXY(NDOMAINB,NMGRID))
639                 CALL VECTOR(XXX(NDOMAINR,NMGRID),XXY(NDOMAINT,NMGRID))
640                 CALL VECTOR(XXX(NDOMAINL,NMGRID),XXY(NDOMAINT,NMGRID))
641                 CALL VECTOR(XXX(NDOMAINL,NMGRID),XXY(NDOMAINB,NMGRID))
642               ENDIF
643               DEALLOCATE(ZTEM2D)
644               LRELIEF=.FALSE.
645               if(nverbia > 0)THEN
646                 print *,' TRAXY NSUPERDIA AP TRACE RELIEF ',NSUPERDIA
647               endif
648               CGROUPS(NSUPERDIA+1)(1:LEN(CGROUPS(NSUPERDIA+1)))=' '
649             ENDIF
650   ENDIF
651 ELSE
652 ! Pour ajuster le titre en haut au dessus de la + gde fenetre en cas de
653 ! superposition CV et PH=CV+K
654   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
655   ZZVT=ZVT
656   IF(KLOOP > 1 .AND. NHISTORY(KLOOP) == 3)THEN
657     DO J=1,MAX(1,KLOOP-1)
658       IF(NHISTORY(J) == 1)THEN
659         IF(LVPTXYUSER)THEN
660           CALL SET(ZVL,ZVR,XVPTXYB,XVPTXYT,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
661         ELSE
662           CALL SET(ZVL,ZVR,ZVB,ZVT,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
663         ENDIF
664         if(nverbia > 0)then
665         print *,' **traxy fentere recuperee ZVL,ZVR,ZVB,ZVT ',ZVL,ZVR,ZVB,ZVT
666         endif
667         EXIT 
668       ENDIF
669       IF(LVPTXYUSER)THEN
670         CALL SET(XVPTXYL,XVPTXYR,XVPTXYB,XVPTXYT,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
671       ELSE
672         CALL SET(.13,.9,.1,.9,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
673       ENDIF
674     ENDDO
675   ELSE
676     IF(LVPTXYUSER)THEN
677       CALL SET(XVPTXYL,XVPTXYR,XVPTXYB,XVPTXYT,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
678     ELSE
679       IF(LXYWINCUR)THEN
680 !!!PROVI
681       ELSE
682       CALL SET(.13,.9,.1,.9,ZMINX,ZMAXX,ZMINY,ZMAXY,1)
683       ENDIF
684 !!!PROVI
685     ENDIF
686   ENDIF
687 ENDIF
688
689 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
690 XCURVPTL=ZVL;XCURVPTR=ZVR;XCURVPTB=ZVB;XCURVPTT=ZVT
691
692 CALL FORMATXY(ZWL,ZWR,ZWB,ZWT)
693 IF(LCOLINE)CALL TABCOL_FORDIACHRO
694 CALL AGSETF('SET.',4.)
695 CALL AGSETF('BAC.',4.)
696 CALL AGSETF('FRA.',2.)
697
698 CALL GSCLIP(1)
699
700
701 DO J = 1,ISUPERDIA
702 !DO J = 1,NSUPERDIA
703
704   ALLOCATE(ZWT1(ICOMPTSZ(J)),ZWT2(ICOMPTSZ(J)))
705   ZWT1(:)=ZTEMX2D(:,J)
706   ZWT2(:)=ZTEMY2D(:,J)
707 ! Mai 2000
708   IF(LSPVALT)THEN
709     WHERE(ZWT1 == XSPVALT)
710       ZWT1=ZE36
711     ENDWHERE
712     WHERE(ZWT2 == XSPVALT)
713       ZWT2=ZE36
714     ENDWHERE
715   ENDIF
716
717   CALL GSLN(1)
718   CALL GSLWSC(1.)
719   CALL GSTXCI(1)
720   CALL GSPLCI(1)
721   CALL GSCLIP(0)
722
723 !!!!!!JD Avril 2009
724               IF(LXYNVARTOP)THEN
725 !!!!!!JD Avril 2009
726 ! G.TANGUY Juin 2010
727     IF(LVARNPHUSER)THEN
728       IF(J == 1)THEN
729         IF(CVARNPH1 == 'WHITE' .OR. CVARNPH1 == 'white')THEN
730           YTITGAL(1)(1:LEN_TRIM(YTITGAL(1)))=' '
731         ELSEIF(CVARNPH1 /= ' ')THEN
732           YTITGAL(1)(1:LEN_TRIM(YTITGAL(1)))=' '
733           YTITGAL(1)=ADJUSTL(CVARNPH1)
734           YTITGAL(1)=ADJUSTL(YTITGAL(1))
735         ENDIF
736       ELSEIF(J == 2)THEN
737         IF(CVARNPH2 == 'WHITE' .OR. CVARNPH2 == 'white')THEN
738           YTITGAL(2)(1:LEN_TRIM(YTITGAL(2)))=' '
739           print *,' NSUPER=2 YTITGAL(2) ',YTITGAL(2)
740         ELSEIF(CVARNPH2 /= ' ')THEN
741           YTITGAL(2)(1:LEN_TRIM(YTITGAL(2)))=' '
742           YTITGAL(2)=CVARNPH2
743           YTITGAL(2)=ADJUSTL(YTITGAL(2))
744         ENDIF
745       ELSEIF(J == 3)THEN
746         IF(CVARNPH3 == 'WHITE' .OR. CVARNPH3 == 'white')THEN
747           YTITGAL(3)(1:LEN_TRIM(YTITGAL(3)))=' '
748         ELSEIF(CVARNPH3 /= ' ')THEN
749           YTITGAL(3)(1:LEN_TRIM(YTITGAL(3)))=' '
750           YTITGAL(3)=CVARNPH3
751           YTITGAL(3)=ADJUSTL(YTITGAL(3))
752         ENDIF
753       ELSEIF(J == 4)THEN
754         IF(CVARNPH4 == 'WHITE' .OR. CVARNPH4 == 'white')THEN
755           YTITGAL(4)(1:LEN_TRIM(YTITGAL(4)))=' '
756         ELSEIF(CVARNPH4 /= ' ')THEN
757           YTITGAL(4)(1:LEN_TRIM(YTITGAL(4)))=' '
758           YTITGAL(4)=CVARNPH4
759           YTITGAL(4)=ADJUSTL(YTITGAL(4))
760         ENDIF
761       ELSEIF(J == 5)THEN
762         IF(CVARNPH5 == 'WHITE' .OR. CVARNPH5 == 'white')THEN
763           YTITGAL(5)(1:LEN_TRIM(YTITGAL(5)))=' '
764         ELSEIF(CVARNPH5 /= ' ')THEN
765           YTITGAL(5)(1:LEN_TRIM(YTITGAL(5)))=' '
766           YTITGAL(5)=CVARNPH5
767           YTITGAL(5)=ADJUSTL(YTITGAL(5))
768         ENDIF
769       ELSEIF(J == 6)THEN
770         IF(CVARNPH6 == 'WHITE' .OR. CVARNPH6 == 'white')THEN
771           YTITGAL(6)(1:LEN_TRIM(YTITGAL(6)))=' '
772         ELSEIF(CVARNPH6 /= ' ')THEN
773           YTITGAL(6)(1:LEN_TRIM(YTITGAL(6)))=' '
774           YTITGAL(6)=CVARNPH6
775           YTITGAL(6)=ADJUSTL(YTITGAL(6))
776         ENDIF
777       ELSEIF(J == 7)THEN
778         IF(CVARNPH7 == 'WHITE' .OR. CVARNPH7 == 'white')THEN
779           YTITGAL(7)(1:LEN_TRIM(YTITGAL(7)))=' '
780         ELSEIF(CVARNPV7 /= ' ')THEN
781           YTITGAL(7)(1:LEN_TRIM(YTITGAL(7)))=' '
782           YTITGAL(7)=CVARNPH7
783           YTITGAL(7)=ADJUSTL(YTITGAL(7))
784         ENDIF
785       ELSEIF(J == 8)THEN
786         IF(CVARNPH8 == 'WHITE' .OR. CVARNPH8 == 'white')THEN
787           YTITGAL(8)(1:LEN_TRIM(YTITGAL(8)))=' '
788         ELSEIF(CVARNPV8 /= ' ')THEN
789           YTITGAL(8)(1:LEN_TRIM(YTITGAL(8)))=' '
790           YTITGAL(8)=CVARNPH8
791           YTITGAL(8)=ADJUSTL(YTITGAL(8))
792         ENDIF
793       ENDIF
794     ENDIF
795 ! fin G.TANGUY juin 2010    
796   SELECT CASE(CTYPE)
797
798     CASE ('CART','MASK','SPXY')
799       IF(LMINUS .OR. LPLUS)THEN
800       ELSE
801         IF(NHISTORY(KLOOP) == 3)THEN
802           DO JA=1,MAX(1,KLOOP-1)
803             IF(NHISTORY(J) == 1)THEN
804 ! Pour placer le titre au dessus de la + gde fenetre
805               IF(ZZVT /= ZVT)THEN
806                 ZZT=(ZZVT-ZVT)*(ZWT-ZWB)/(ZVT-ZVB)
807                 CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+ZZT+(ZWT+ZZT-ZWB)/38.,YTITGAL(J)(1:LEN_TRIM(YTITGAL(J))),.008,0.,-1.)
808               ELSE
809                 CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+(ZWT-ZWB)/38.,YTITGAL(J)(1:LEN_TRIM(YTITGAL(J))),.008,0.,-1.)
810               ENDIF
811               EXIT
812             ENDIF
813             CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+(ZWT-ZWB)/38.,YTITGAL(J)(1:LEN_TRIM(YTITGAL(J))),.008,0.,-1.)
814           ENDDO
815         ELSE
816           CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+(ZWT-ZWB)/38.,YTITGAL(J)(1:LEN_TRIM(YTITGAL(J))),.008,0.,-1.)
817         ENDIF
818       ENDIF
819     CASE DEFAULT
820   SELECT CASE(IST(J))
821     CASE(1:9)
822       WRITE(YC1,'(I1)')IST(J)
823       CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+(ZWT-ZWB)/38.,YC1,.008,0.,-1.)
824     CASE(10:99)
825       WRITE(YC2,'(I2)')IST(J)
826       CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+(ZWT-ZWB)/38.,YC2,.008,0.,-1.)
827     CASE(100:999)
828       WRITE(YC3,'(I3)')IST(J)
829       CALL PLCHHQ(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+(ZWT-ZWB)/38.,YC3,.008,0.,-1.)
830     CASE DEFAULT
831       print *,' Numero de station IMPREVU ou INVALIDE : ',IST(J)
832   END SELECT
833
834   END SELECT
835 !!!!!!JD Avril 2009
836       ENDIF
837 !!!!!!JD Avril 2009
838
839   IF(LCOLINE)THEN
840     CALL GSPLCI(J+1)
841     CALL GSTXCI(J+1)
842   ELSE
843     CALL GSPLCI(1)
844     CALL GSTXCI(1)
845
846     SELECT CASE(J)
847       CASE(1:4)
848         CALL GSLWSC(1.)
849       CASE(5:8)
850         CALL GSLWSC(2.)
851       CASE(9:12)
852         CALL GSLWSC(3.)
853     END SELECT
854     IF(LPHSTYUSER)THEN
855     CALL AGSETR('DAS/SE.',1.)
856       IF(KLOOP == 1 .OR. J == 1)THEN
857         ISTYL=NPHSTY1
858       ELSEIF(KLOOP == 2 .OR. J == 2)THEN
859         ISTYL=NPHSTY2
860       ELSEIF(KLOOP == 3 .OR. J == 3)THEN
861         ISTYL=NPHSTY3
862       ELSEIF(KLOOP == 4 .OR. J == 4)THEN
863         ISTYL=NPHSTY4
864       ELSEIF(KLOOP == 5 .OR. J == 5)THEN
865         ISTYL=NPHSTY5
866       ELSEIF(KLOOP == 6 .OR. J == 6)THEN
867         ISTYL=NPHSTY6
868       ELSEIF(KLOOP == 7 .OR. J == 7)THEN
869         ISTYL=NPHSTY7
870       ELSEIF(KLOOP == 8 .OR. J == 8)THEN
871         ISTYL=NPHSTY8
872       ENDIF
873 IF(ISTYL == 1)CALL AGSETR('DAS/PA/1.',65535.)
874 IF(ISTYL == 2)CALL AGSETR('DAS/PA/1.',30583.)
875 IF(ISTYL == 3)CALL AGSETR('DAS/PA/1.',21845.)
876 IF(ISTYL == 4)CALL AGSETR('DAS/PA/1.',10023.)
877 IF(ISTYL == 5)CALL AGSETR('DAS/PA/1.',16191.)
878 IF(ISTYL == 6)CALL AGSETR('DAS/PA/1.',990.)
879 IF(ISTYL == 7)CALL AGSETR('DAS/PA/1.',3855.)
880 IF(ISTYL == 8)CALL AGSETR('DAS/PA/1.',24415.)
881 IF(ISTYL == 9)CALL AGSETR('DAS/PA/1.',13107.)
882 IF(ISTYL == 10)CALL AGSETR('DAS/PA/1.',63903.)
883     ELSE
884     CALL GSLN(MOD(J,4))
885     IF(MOD(J,4) == 0)CALL GSLN(4)
886     ENDIF
887
888   ENDIF
889
890 !!!!!!JD Avril 2009
891       IF(LXYSTYLTOP)THEN
892 !!!!!!JD Avril 2009
893   CALL FRSTPT(ZWL+(J-1)*(ZWR-ZWL)/6.,ZWT+ZZT+(ZWT+ZZT-ZWB)/70.)
894   CALL VECTOR(ZWL+(J-1)*(ZWR-ZWL)/6.+(ZWR-ZWL)/20.,ZWT+ZZT+(ZWT+ZZT-ZWB)/70.)
895   CALL SFLUSH
896 !!!!!!JD Avril 2009
897       ENDIF
898 !!!!!!JD Avril 2009
899
900   CALL GSCLIP(1)
901
902   DO JI=1,IBRECOUV(J)
903
904     JD=IRECOUV(JI*2-1,J)
905     JF=IRECOUV(JI*2,J)
906
907     IF(PTIMED /= PTIMEF)THEN
908
909 !             print *,' JD JF AVANT ',JD,JF
910
911       SELECT CASE(CTYPE)
912         CASE('DRST','RSPL','RAPL')
913           J2=IST(J)  
914         CASE DEFAULT
915           J2=1
916       END SELECT
917
918       IF(.NOT. LTINCRDIA(J,J2))THEN
919
920         DO JE=1,NBTIMEDIA(J,J2)
921                 IF(NTIMEDIA(JE,J,J2) >= JD)THEN
922                   JD=JE
923                   EXIT
924                 ENDIF
925         ENDDO
926
927         DO JE=1,NBTIMEDIA(J,J2)
928           IF(NTIMEDIA(JE,J,J2) == JF)THEN
929             JF=JE
930             EXIT
931           ELSE IF(NTIMEDIA(JE,J,J2) > JF)THEN
932             JF=JE-1
933             EXIT
934           ENDIF
935         ENDDO
936
937         JF=MIN(JF,NBTIMEDIA(J,J2))
938 !       print *,' JD JF APRES ',JD,JF
939
940       ELSE
941
942         JJE=0
943         DO JE=NTIMEDIA(1,J,J2),NTIMEDIA(2,J,J2),NTIMEDIA(3,J,J2)
944           JJE=JJE+1
945           IF(JE >= JD)THEN
946             JD=JJE
947             EXIT
948           ENDIF
949         ENDDO
950
951         JJE=0
952         DO JE=NTIMEDIA(1,J,J2),NTIMEDIA(2,J,J2),NTIMEDIA(3,J,J2)
953           JJE=JJE+1
954           IF(JE == JF)THEN
955             JF=JJE
956             EXIT
957           ELSE IF(JE > JF)THEN
958             JF=MIN(JF,JJE-1)
959             EXIT
960           ENDIF
961         ENDDO
962
963         JJE=0
964         DO JE=NTIMEDIA(1,J,J2),NTIMEDIA(2,J,J2),NTIMEDIA(3,J,J2)
965           JJE=JJE+1
966         ENDDO
967         JF=MIN(JF,JJE)
968       ENDIF
969
970     ENDIF
971     CALL GQLWSC(IER,ZW)
972     IF(LXYDIA .AND. LCONT)THEN
973       CALL GSLWSC(3.)
974     ELSE IF(LXT .OR. LYT .OR. LXYDIA)THEN
975       CALL GSLWSC(2.)
976     ELSE
977       CALL GSLWSC(2.)
978       IF(KLOOP == 1 .OR. J == 1)THEN
979         CALL GSLWSC(XLWPH1)
980       ELSEIF(KLOOP == 2 .OR. J == 2)THEN
981         CALL GSLWSC(XLWPH2)
982       ELSEIF(KLOOP == 3 .OR. J == 3)THEN
983         CALL GSLWSC(XLWPH3)
984       ELSEIF(KLOOP == 4 .OR. J == 4)THEN
985         CALL GSLWSC(XLWPH4)
986       ELSEIF(KLOOP == 5 .OR. J == 5)THEN
987         CALL GSLWSC(XLWPH5)
988       ELSEIF(KLOOP == 6 .OR. J == 6)THEN
989         CALL GSLWSC(XLWPH6)
990       ELSEIF(KLOOP == 7 .OR. J == 7)THEN
991         CALL GSLWSC(XLWPH7)
992       ELSEIF(KLOOP == 8 .OR. J == 8)THEN
993         CALL GSLWSC(XLWPH8)
994       ENDIF
995     ENDIF
996     CALL GQLWSC(IERR,ZLWSC)
997     if(nverbia > 0)then
998     print *,' ** traxy KLOOP XLWPH ',KLOOP,ZLWSC
999     endif
1000 !   IF(CTYPE == 'RSPL')THEN
1001 !   CALL GQCLIP(IER,ICLIP,ZCL)
1002 !   IF(ICLIP == 0)THEN
1003 !     CALL GSCLIP(1)
1004 !   ENDIF
1005 !   ENDIF
1006     CALL EZXY(ZWT1(JD:JF),ZWT2(JD:JF),JF-JD+1,0)
1007     CALL SFLUSH
1008 !   IF(CTYPE == 'RSPL')THEN
1009 !     CALL GSCLIP(ICLIP)
1010 !   ENDIF
1011     CALL GSLWSC(ZW)
1012
1013   ENDDO
1014   DEALLOCATE(ZWT1,ZWT2)
1015
1016 ENDDO   ! Fin Do J=1,NSUPERDIA
1017 !!! Avril 2009  JD
1018   IF(.NOT.LNOLABELX .AND. .NOT.LNOLABELY)THEN
1019     IF(LAXEXUSER)THEN
1020       CALL SET(ZVL,ZVR,ZVB,ZVT,XAXEXUSERD,XAXEXUSERF,ZWB,ZWT,ID)
1021     ENDIF
1022   ENDIF
1023 !!! Avril 2009  JD
1024
1025 CALL GSLWSC(1.)
1026 CALL GSPLCI(1)
1027 CALL GSTXCI(1)
1028 CALL GSLN(1)
1029 !G.TANGUY juin 2010
1030   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWLL,ZWRR,ZWBB,ZWTT,IDD)
1031   IF(LFACTAXEX)THEN
1032     IF(LFACTAXEY)THEN
1033       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL*XFACTAXEX,ZWRR*XFACTAXEX,&
1034                ZWBB*XFACTAXEY,ZWTT*XFACTAXEY,IDD)
1035     ELSE
1036       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL*XFACTAXEX,ZWRR*XFACTAXEX,&
1037                ZWBB,ZWTT,IDD)
1038     ENDIF
1039   ELSEIF(LFACTAXEY)THEN
1040       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL,ZWRR,&
1041                ZWBB*XFACTAXEY,ZWTT*XFACTAXEY,IDD)
1042   ENDIF
1043 !fin G.TANGUY juin 2010  
1044 !!!PROVI
1045 !go to 10
1046 IF(.NOT.LXYWINCUR)THEN
1047 IF(.NOT.GOK)THEN
1048   IF(NHISTORY(KLOOP) == 3)THEN
1049     DO JA=1,MAX(1,KLOOP-1)
1050     IF(NHISTORY(J) == 1)THEN
1051 !Avril 2002
1052       IF(LNOLABELX .AND.LNOLABELY)THEN
1053        CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,0,0,5,0.,0.)
1054       ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
1055        CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,0,1,5,0.,0.)
1056       ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
1057        CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,-1,0,5,0.,0.)
1058       ELSE
1059        CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,-1,1,5,0.,0.)
1060       ENDIF
1061 !Avril 2002
1062       EXIT
1063     ELSE
1064 !Avril 2002
1065       IF(LNOLABELX .AND.LNOLABELY)THEN
1066         CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,0,0,5,0.,0.)
1067       ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
1068         CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,0,1,5,0.,0.)
1069       ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
1070         CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,1,0,5,0.,0.)
1071       ELSE
1072         CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,1,1,5,0.,0.)
1073       ENDIF
1074 !Avril 2002
1075     ENDIF
1076     ENDDO
1077   ELSE
1078 !Avril 2002
1079     IF(LNOLABELX .AND.LNOLABELY)THEN
1080       CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,0,0,5,0.,0.)
1081     ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
1082       CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,0,1,5,0.,0.)
1083     ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
1084       CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,1,0,5,0.,0.)
1085     ELSE
1086       CALL GRIDAL(NXYITVXMJ,NXYITVXMN,NXYITVYMJ,NXYITVYMN,1,1,5,0.,0.)
1087     ENDIF
1088 !Avril 2002
1089   ENDIF
1090 ! CALL GRIDAL(5,1,5,1,1,1,5,0.,0.)
1091 ENDIF
1092 ENDIF
1093 !G.TANGUY juin 2010
1094
1095 IF(LFACTAXEX .OR. LFACTAXEY)THEN
1096   CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL,ZWRR,ZWBB,ZWTT,IDD)
1097 ENDIF
1098 ! fin G.TANGUY juin 2010
1099 !10 continue
1100 !!!PROVI
1101 ! Titres
1102 !
1103 SELECT CASE(CTYPE)
1104   CASE('CART','MASK','SPXY')
1105     YCAR(1:LEN(YCAR))=' '
1106   CASE('SSOL')
1107   CASE DEFAULT
1108     YCAR(1:LEN(YCAR))=' '
1109     YCAR(1:4)=CTYPE
1110 !   YCAR(5:7)=' N.'
1111 !   WRITE(YCAR(8:10),'(I3)')IST(1)
1112 !   ISUIT=11
1113 !   DO J=2,ICOMPT
1114 !     DO JE=1,J-1
1115 !       IF(IST(J) == IST(JE))THEN
1116 !        EXIT
1117 !       ELSE
1118 !  WRITE(YCAR(ISUIT:ISUIT+4),'(I5)')IST(J)
1119 !       ISUIT=ISUIT+5
1120 !       ENDIF
1121 !     ENDDO
1122 !   ENDDO
1123 END SELECT
1124
1125 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
1126 IF(LFACTIMP)THEN
1127   CALL FACTIMP
1128 ENDIF
1129 ! Titres en X
1130 YTEM(1:LEN(YTEM))=' '
1131 CALL RESOLV_TIT('CTITXL',YTEM)
1132 IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1133   CALL RESOLV_TIT('CTITXL',YTEM)
1134   CALL PLCHHQ(ZVL,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
1135 ! CALL PLCHHQ(ZVL,ZVB/2.,YTEM,.008,0.,-1.)
1136 ENDIF
1137 YTEM(1:LEN(YTEM))=' '
1138 CALL RESOLV_TIT('CTITXM',YTEM)
1139 IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1140   CALL RESOLV_TIT('CTITXM',YTEM)
1141   CALL PLCHHQ((ZVL+ZVR)/2.,ZVB-MIN(ZVB/2.,.05),YTEM(1:LEN_TRIM(YTEM)),.008,0.,0.)
1142 ! CALL PLCHHQ((ZVL+ZVR)/2.,ZVB/2.,YTEM(1:LEN_TRIM(YTEM)),.008,0.,0.)
1143 ENDIF
1144 YTEM(1:LEN(YTEM))=' '
1145 IF(.NOT.GOK)THEN
1146 YTEM=ADJUSTL(HTITX)
1147 ENDIF
1148 CALL RESOLV_TIT('CTITXR',YTEM)
1149 IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1150   CALL RESOLV_TIT('CTITXR',YTEM)
1151   IF(NHISTORY(KLOOP) == 3)THEN
1152     DO J=1,MAX(1,KLOOP-1)
1153       IF(NHISTORY(J) == 1)THEN
1154         EXIT
1155       ENDIF
1156       CALL PLCHHQ(ZVR-ZVB/2.,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
1157     ENDDO
1158   ELSE
1159     CALL PLCHHQ(ZVR-ZVB/2.,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
1160   ENDIF
1161 ! CALL PLCHHQ(ZVR-ZVB/2.,ZVB/2.,YTEM,.008,0.,-1.)
1162 ENDIF
1163 ! Titres en Y
1164 YTEM(1:LEN(YTEM))=' '
1165 IF(.NOT.GOK)THEN
1166 YTEM=ADJUSTL(HTITY)
1167 ENDIF
1168 CALL RESOLV_TITY('CTITYT',ZVL,ZVR,ZVB,ZVT,YTEM)
1169 YTEM(1:LEN(YTEM))=' '
1170 CALL RESOLV_TITY('CTITYM',ZVL,ZVR,ZVB,ZVT,YTEM)
1171 YTEM(1:LEN(YTEM))=' '
1172 CALL RESOLV_TITY('CTITYB',ZVL,ZVR,ZVB,ZVT,YTEM)
1173
1174 ! TitresTOP
1175 YTEM(1:LEN(YTEM))=' '
1176 CALL RESOLV_TIT('CTITT3',YTEM)
1177 ZXPOSTITT3=.002
1178 ZXYPOSTITT3=.93
1179 IF(XPOSTITT3 /= 0.)THEN
1180   ZXPOSTITT3=XPOSTITT3
1181 ENDIF
1182 IF(XYPOSTITT3 /= 0.)THEN
1183 ZXYPOSTITT3=XYPOSTITT3
1184 ENDIF
1185
1186 IF(CTITT3 /= ' ')THEN
1187   IF(XSZTITT3 /= 0.)THEN
1188     CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM,XSZTITT3,0.,-1.)
1189 !   CALL PLCHHQ(0.002,0.93,YTEM,XSZTITT3,0.,-1.)
1190   ELSE
1191     CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM,.008,0.,-1.)
1192 !   CALL PLCHHQ(0.002,0.93,YTEM,.008,0.,-1.)
1193   ENDIF
1194 ENDIF
1195 YTEM(1:LEN(YTEM))=' '
1196 CALL RESOLV_TIT('CTITT2',YTEM)
1197 ZXPOSTITT2=.002
1198 ZXYPOSTITT2=.95
1199 IF(XPOSTITT2 /= 0.)THEN
1200   ZXPOSTITT2=XPOSTITT2
1201 ENDIF
1202 IF(XYPOSTITT2 /= 0.)THEN
1203 ZXYPOSTITT2=XYPOSTITT2
1204 ENDIF
1205 IF(CTITT2 /= ' ')THEN
1206   IF(XSZTITT2 /= 0.)THEN
1207     CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM,XSZTITT2,0.,-1.)
1208 !   CALL PLCHHQ(0.002,0.95,YTEM,XSZTITT2,0.,-1.)
1209   ELSE
1210     CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM,.008,0.,-1.)
1211 !   CALL PLCHHQ(0.002,0.95,YTEM,.008,0.,-1.)
1212   ENDIF
1213 ENDIF
1214 YTEM(1:LEN(YTEM))=' '
1215 YTEM=ADJUSTL(YCAR)
1216 CALL RESOLV_TIT('CTITT1',YTEM)
1217 ZXPOSTITT1=.002
1218 ZXYPOSTITT1=.98
1219 IF(XPOSTITT1 /= 0.)THEN
1220   ZXPOSTITT1=XPOSTITT1
1221 ENDIF
1222 IF(XYPOSTITT1 /= 0.)THEN
1223 ZXYPOSTITT1=XYPOSTITT1
1224 ENDIF
1225 !IF(CTITT1 /= ' ')THEN
1226 ! 230498
1227 IF(YTEM /= ' ' .AND. CTITT1 /= 'DEFAULT')THEN
1228   IF(XSZTITT1 /= 0.)THEN
1229     CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YTEM,XSZTITT1,0.,-1.)
1230 !   CALL PLCHHQ(0.002,0.98,YTEM,XSZTITT1,0.,-1.)
1231   ELSE
1232     CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YTEM,.012,0.,-1.)
1233 !   CALL PLCHHQ(0.002,0.98,YTEM,.012,0.,-1.)
1234   ENDIF
1235 ELSE
1236   IF(YTEM ==' ')THEN
1237
1238   IF(LCV .AND. LCH)THEN
1239   ELSE IF(LCH)THEN
1240   IF(NIINF /= 0 .AND. NJINF /=0 .AND. NJSUP /= 0 .AND. NISUP /= 0)THEN
1241     YTEM(1:LEN(YTEM))=' '
1242     WRITE(YTEM,'(''NIINF='',I4,2X,''NISUP='',I4,2X,''NJINF='',I4,2X,''NJSUP='',I4)')NIINF,NISUP,NJINF,NJSUP
1243     YTEM=ADJUSTL(YTEM)
1244     IF(XSZTITT1 /= 0.)THEN
1245       CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YTEM,XSZTITT1,0.,-1.)
1246 !     CALL PLCHHQ(0.002,0.98,YTEM,XSZTITT1,0.,-1.)
1247     ELSE
1248       CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YTEM,.012,0.,-1.)
1249 !     CALL PLCHHQ(0.002,0.98,YTEM,.012,0.,-1.)
1250     ENDIF
1251   ENDIF
1252   ENDIF
1253
1254   ENDIF
1255 ENDIF
1256 ! TitresBOTTOM
1257 ! Titre N3 BOTTOM
1258 YTEM(1:LEN(YTEM))=' '
1259 IF(PTIMED == PTIMEF)THEN
1260  WRITE(YTEM,'(''Time'',F10.0)')PTIMED
1261 ELSE
1262  WRITE(YTEM,'(''Time'',F10.0,'' - '',F10.0)')PTIMED,PTIMEF
1263 ENDIF
1264 CALL RESOLV_TIT('CTITB3',YTEM)
1265 ZXPOSTITB3=.002
1266 ZXYPOSTITB3=.05
1267 IF(XPOSTITB3 /= 0.)THEN
1268   ZXPOSTITB3=XPOSTITB3
1269 ENDIF
1270 IF(XYPOSTITB3 /= 0.)THEN
1271 ZXYPOSTITB3=XYPOSTITB3
1272 ENDIF
1273 !IF(CTITB3 /= ' ')THEN
1274 IF(YTEM /= ' ')THEN
1275   IF(NHISTORY(KLOOP) == 3)THEN
1276     DO J=1,MAX(1,KLOOP-1)
1277       IF(NHISTORY(J) == 1)THEN
1278         EXIT
1279       ENDIF
1280       IF(XSZTITB3 /= 0.)THEN
1281         CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,XSZTITB3,0.,-1.)
1282       ELSE
1283         CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,.008,0.,-1.)
1284       ENDIF
1285     ENDDO
1286   ELSE
1287     IF(XSZTITB3 /= 0.)THEN
1288       CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,XSZTITB3,0.,-1.)
1289 !   CALL PLCHHQ(0.002,0.05,YTEM,XSZTITB3,0.,-1.)
1290     ELSE
1291       CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,.008,0.,-1.)
1292 !   CALL PLCHHQ(0.002,0.05,YTEM,.008,0.,-1.)
1293     ENDIF
1294   ENDIF
1295 ENDIF
1296 ! Titre N2 BOTTOM
1297 YTEM(1:LEN(YTEM))=' '
1298 IF(LCH)THEN
1299   YTEM=ADJUSTL(CLEGEND2)
1300 ENDIF
1301 CALL RESOLV_TIT('CTITB2',YTEM)
1302 ZXPOSTITB2=.002
1303 ZXYPOSTITB2=.025
1304 IF(XPOSTITB2 /= 0.)THEN
1305   ZXPOSTITB2=XPOSTITB2
1306 ENDIF
1307 IF(XYPOSTITB2 /= 0.)THEN
1308   ZXYPOSTITB2=XYPOSTITB2
1309 ENDIF
1310 IF(YTEM/= ' ')THEN
1311   IF(XSZTITB2 /= 0.)THEN
1312     CALL PLCHHQ(ZXPOSTITB2,ZXYPOSTITB2,YTEM,XSZTITB2,0.,-1.)
1313 !   CALL PLCHHQ(0.002,0.025,YTEM,XSZTITB2,0.,-1.)
1314   ELSE
1315     CALL PLCHHQ(ZXPOSTITB2,ZXYPOSTITB2,YTEM,.007,0.,-1.)
1316 !   CALL PLCHHQ(0.002,0.025,YTEM,.007,0.,-1.)
1317   ENDIF
1318 ENDIF
1319 ! Titre N1 BOTTOM
1320 YTEM(1:LEN(YTEM))=' '
1321 IF(LCH)THEN
1322   YTEM=ADJUSTL(CLEGEND)
1323 ENDIF
1324 CALL RESOLV_TIT('CTITB1',YTEM)
1325 ZXPOSTITB1=.002
1326 ZXYPOSTITB1=.005
1327 IF(XPOSTITB1 /= 0.)THEN
1328   ZXPOSTITB1=XPOSTITB1
1329 ENDIF
1330 IF(XYPOSTITB1 /= 0.)THEN
1331   ZXYPOSTITB1=XYPOSTITB1
1332 ENDIF
1333 IF(YTEM /= ' ')THEN
1334   IF(XSZTITB1 /= 0.)THEN
1335     CALL PLCHHQ(ZXPOSTITB1,ZXYPOSTITB1,YTEM,XSZTITB1,0.,-1.)
1336 !   CALL PLCHHQ(0.002,0.005,YTEM,XSZTITB1,0.,-1.)
1337   ELSE
1338     CALL PLCHHQ(ZXPOSTITB1,ZXYPOSTITB1,YTEM,.007,0.,-1.)
1339 !   CALL PLCHHQ(0.002,0.005,YTEM,.007,0.,-1.)
1340   ENDIF
1341 ENDIF
1342
1343 DEALLOCATE(ZTEMX2D,ZTEMY2D,ICOMPTSZ,IBRECOUV,IST,IRECOUV,ZTIMD,ZTIMF,YTITGAL)
1344 ICOMPT=0
1345 if(nverbia > 0)then
1346 print *,' Sortie TRAXY'
1347 endif
1348 RETURN
1349 !
1350 !----------------------------------------------------------------------------
1351 !
1352 !*       4.     EXIT
1353 !               ----
1354 !
1355 END SUBROUTINE  TRAXY