Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / imcou_fordiachro.f90
1 !     ######spl
2       SUBROUTINE IMCOU_FORDIACHRO(PTABV,PINT,HLEGEND,HTEXT)
3 !     #####################################################
4 !
5 !!****  *IMCOU_FORDIACHRO* - Contour plot manager for vertical cross-sections
6 !!
7 !!    PURPOSE
8 !!    -------
9 !       Draws contour plots in the vertical cross-section case
10 !
11 !!**  METHOD
12 !!    ------
13 !!       Calls the NCAR contour routines and defines the display environment
14 !!      for the vertical cross-sections
15 !!
16 !!    EXTERNAL
17 !!    --------
18 !!      GMNMX    computes min, max and contour increment for current field
19 !!      TRACEXZ  draws a model-level stencil background if i) the current
20 !!               plot is a East-West cross-section, ii) the section origin
21 !!               is directly defined by grid indexes, and iii) if LXZ = .TRUE.
22 !!
23 !!      CURVE    draws a curve made by a series of data points      !
24 !!      SFSETR   sets parameters for NCAR softfill environment      !
25 !!      SFWRLD   fills the inside of a closed curve as requested by !
26 !!               the previous SFSETR calls                          !
27 !!                                                                  !
28 !!      CPSETI !                                          INTEGER   !
29 !!      CPSETR ! gives a value to a NCAR variabe, type:   REEL      !
30 !!      CPSETC !                                          CHARACTER !
31 !!      CPGETI !                                          INTEGER   !Routines
32 !!      CPGETI !                                          INTEGER   !
33 !!      CPGETR ! retrieves a NCAR parmeter value, type    REEL      !
34 !!      CPGETC !                                          CHARACTER !
35 !!      CPRECT   initialize contour drawing                         !
36 !!      CPPKCL   selects the contour values                         !
37 !!      CPCLDR   draws the contours                                 !
38 !!      CPLBDR   activates High and Low option                      !
39 !!      CPRSET   restores NCAR default values                       !
40 !!                                                                  !
41 !!      GSLWSC   sets line widths                                   !
42 !!      SET      defines the display window limits in both          !
43 !!               normalised and user coordinates                    !
44 !!      GETSET   retrieves the user and normalized coordinate ranges!
45 !!               for current window  for the current display window.! 
46 !!      PLCHHQ   prints high qualty text                            !
47 !!      GSCLIP   CLIPS the display window                           !
48 !!
49 !!      CPMPXY   TRACE provided FORTRAN-77 routine directly called  
50 !!               within CONPACK to map the array space onto the    
51 !!               Gal-Chen stretched  space
52 !!
53 !!    IMPLICIT ARGUMENTS
54 !!    ------------------
55 !!      Module MODN_PARA  : Defines NAM_DOMAIN_POS namelist
56 !!                          (former PARA common)
57 !!          XIDEBCOU, XJDEBCOU : Origin of a vertical cross-section
58 !!                               in cartesian (or conformal) real values
59 !!          XHMIN      : Altitude of the vert. cross-section
60 !!                       bottom (in meters above sea-level)
61 !!          XHMAX      : Altitude of the vert. cross-section
62 !!                       top (in meters above sea-level)
63 !!          LHORIZ     : Horizontal mode selector
64 !!                       =.TRUE. to perform horizontal cross-sections
65 !!                       (LVERTI must be = to .FALSE.)
66 !!          LVERTI     : Vertical mode selector 
67 !!                       =.TRUE. to perform vertical cross-sections, 
68 !!                       including vert. 1D profiles. 
69 !!                       (LHORIZ must be = to .FALSE.)
70 !!          NIDEBCOU,  : Origin of a vertical cross-section
71 !!          NJDEBCOU     in grid index integer values
72 !!                       (XIDEBCOU and XJDEBCOU must be = to -999.)
73 !!          NLANGLE    : Angle between X Meso-NH axis and
74 !!                       cross-section direction in degrees
75 !!                       (Integer value anticlockwise)
76 !!          NLMAX      : Number of points horizontally along
77 !!                       the vertical section
78 !!          Module MODD_DIM1 : contains dimensions of data arrays
79 !!              NKMAX       : z array dimension
80 !!
81 !!      Module MODD_PARAMETERS : Contains array border depths
82 !!          JPHEXT : Horizontal external points number
83 !!          JPVEXT : Vertical external points number
84 !!
85 !!      Module MODD_NMGRID  : declares global variable  NMGRID
86 !!         NMGRID    : Current MESO-NH grid indicator
87 !!
88 !!     Module MODD_CVERT:  Declares work arrays for vertical cross-sections
89 !!          XWORKZ   : working array for true altitude storage (all grids)
90 !!          XWZ      : working array for topography (all grids)
91 !!
92 !!      Module MODD_COORD  : declares gridpoint coordinates
93 !!                           (TRACE use only)
94 !!          XDS      : Abscissa array along the horizontal axis of an oblique
95 !!                     vertical cross-section (meters), for all grid locations
96 !!
97 !!      Module MODN_NCAR : defines NAM_DIRTRA_POS namelist
98 !!                         (former NCAR common)
99 !!          NIOFFD     : Label normalisation (=0 none, =/=0 active)
100 !!          NULBLL     : Nb of contours between 2 labelled contours
101 !!          NIOFFM     : =0    --> message at picture bottom
102 !!                       =/= 0 --> no message
103 !!          NDOT       : Line style
104 !!                        (=0|1|1023|65535 --> solid lines;
105 !!                        <0 --> solid lines for positive values and
106 !!                        dotted lines(ABS(NDOT))for negative values;
107 !!                        >0 --> dotted lines(ABS(NDOT)) )
108 !!          NHI        : Extrema detection
109 !!                       (=0 --> H+L, <0 nothing)
110 !!          NIMNMX     : Contour selection option
111 !!                       (=-1 Min, max and inc. automatically set;
112 !!                       =0 Min, max automatically set; inc. given;
113 !!                       >0 Min, max, inc. given by user)
114 !!          XSPVAL     : Special value
115 !!          XSIZEL     : Label size
116 !!
117 !!      Module MODD_SUPER   : defines plot overlay control variables
118 !!         LSUPER   : =.TRUE. --> plot overlay is active
119 !!                    =.FALSE. --> plot overlay is not active
120 !!         NSUPER   : Rank of the current plot in the overlay
121 !!                    sequence. The initial plot is rank 1.
122 !!
123 !!      Module MODD_ALLVAR
124 !!         >>>>>>>>>>DRAGOON QUERY: Is this one really necessary????
125 !!
126 !!    REFERENCE
127 !!    ---------
128 !!
129 !!      MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
130 !!       + Book1: Concepts and Fundamentals, to appear in 1994;
131 !!       + Book2: Technical Reference and Flowcharts, to appear in 1994;
132 !!       + Book3: Tutorial, November 1994.
133 !!
134 !!     NCAR Graphics Technical documentation, UNIX version 3.2,
135 !!     Scientific computing division, NCAR/UCAR, Boulder, USA.
136 !!      Volume 1: Fundamentals, Vers. 1, May 1993
137 !!      Volume 2: Contouring and mapping tutorial, Vers. 2, May 1993
138 !!
139 !!
140 !!    AUTHOR
141 !!    ------
142 !!
143 !!      J. Duron    * Laboratoire d'Aerologie *
144 !!
145 !!    MODIFICATIONS
146 !!    -------------
147 !!      Original       06/06/94
148 !!      Updated   PM   19/12/94
149 !-------------------------------------------------------------------------------
150 !
151 !*       0.    DECLARATIONS
152 !              ------------
153 !
154 #ifdef NAGf95
155 USE F90_UNIX  ! for FLUSH and GETENV
156 #endif
157
158 USE MODN_PARA
159 USE MODD_PARAMETERS
160 USE MODD_NMGRID
161 USE MODD_CVERT
162 USE MODD_COORD
163 USE MODD_CONF
164 USE MODD_GRID
165 USE MODD_GRID1
166 USE MODD_DIM1
167 USE MODD_TYPE_AND_LH
168 USE MODN_NCAR
169 USE MODD_SUPER
170 USE MODD_ALLVAR
171 USE MODD_TITLE
172 USE MODD_LUNIT1
173 USE MODD_OUT
174 USE MODD_PVT
175 USE MODD_RSISOCOL
176 USE MODD_RESOLVCAR
177 USE MODD_ALLOC_FORDIACHRO
178 USE MODI_RESOLV_TIT
179 USE MODI_RESOLV_TITY
180 USE MODD_PT_FOR_CH_FORDIACHRO
181 USE MODI_READMNMXINT_ISO
182 USE MODI_READREFINT_ISO
183 USE MODI_READXISOLEVP
184 USE MODD_TIT
185 USE MODD_HACH
186 USE MODD_DEFCV
187 USE MODE_GRIDPROJ
188 USE MODD_CTL_AXES_AND_STYL
189 USE MODD_MASK3D
190 !
191 USE MODI_CREATLINK
192 USE MODI_WRITEDIR
193 !      
194 IMPLICIT NONE
195 INTERFACE
196 SUBROUTINE AXELOGPRES(PHMIN,PHMAX)
197 REAL :: PHMIN,PHMAX
198 END SUBROUTINE AXELOGPRES
199 END INTERFACE
200 !
201 !*        0.0   TRACE interface with the "CPMPXY" routine of the NCAR package
202 !
203 ! NOTICE:  The CPMPXY and the NCAR graphical utilities are NOT written
204 ! ------   in Fortran 90, but in Fortran 77.. This sub-section of TRACE
205 !          does not follow the Meso-NH usual rules: it has to be made using
206 !          a COMMON stack with  static memory allocation of XZZXX and
207 !          XZZXY arrays.
208 !
209 COMMON/TEMV/XZWORKZ,XZZDS,NINX,NINY
210 COMMON/LOGI/LVERT,LHOR,LPT,LXABS
211 COMMON/COLAREA/ICOL(300)
212 COMMON/HACHAREA/IHACH(300)
213 #include "big.h"
214 REAL,DIMENSION(N2DVERTX,2500) :: XZWORKZ
215 !REAL,DIMENSION(1000,400) :: XZWORKZ
216 !REAL,DIMENSION(200,200) :: XZWORKZ
217 REAL,DIMENSION(N2DVERTX)     :: XZZDS
218 !REAL,DIMENSION(1000)     :: XZZDS
219 !REAL,DIMENSION(200)     :: XZZDS
220 INTEGER                 :: NINX, NINY
221 LOGICAL                 :: LVERT, LHOR, LPT, LXABS
222 INTEGER  :: ICOL
223 !
224 !*       0.1    Work arrays for NCAR
225 !
226 INTEGER,PARAMETER       :: JPLRWK=50000, JPLIWK=50000
227 INTEGER,PARAMETER       :: JPRSCR=20000, JPISCR=20000
228 INTEGER,PARAMETER       :: JPMAP=NPMAP, JPAREAGRP=300, JPWRK=50000
229 !INTEGER,PARAMETER       :: JPMAP=800000, JPAREAGRP=300, JPWRK=50000
230 !
231 REAL,DIMENSION(JPLRWK)      :: ZRWRK
232 INTEGER,DIMENSION(JPLIWK)      :: IWRK
233 REAL,DIMENSION(JPRSCR)      :: ZRSCR
234 INTEGER,DIMENSION(JPISCR)      :: ISCR
235 INTEGER,DIMENSION(JPMAP)    :: IIMAP
236 INTEGER,DIMENSION(JPAREAGRP):: IAREA, IGRP
237 REAL,DIMENSION(JPWRK)       :: ZXWRK, ZYWRK
238 INTEGER                     :: IHACH
239 !
240 !*       0.2   Dummy arguments and results
241 !
242 REAL,DIMENSION(:,:) :: PTABV            !  Vertical section data array 
243                                         !  to be plotted
244 REAL                :: PINT             !  Contour increment fo the 
245                                         !  current plot
246 CHARACTER(LEN=*)    :: HTEXT            !  PLot heading with section location 
247 CHARACTER(LEN=*)    :: HLEGEND          !  PLot heading with variable name
248 !CHARACTER(LEN=8) :: YDAT8, YTIM8, YTEM8
249 CHARACTER(LEN=32):: YLBL
250 CHARACTER(LEN=80)               :: YCAR80 
251 CHARACTER(LEN=160)               :: YCAR160,YCAR161
252 !
253 !*       0.3   Local variables
254 !
255 INTEGER :: IA, IB
256 INTEGER :: IKU, IKB, IKE, JILOOP, JKLOOP, J, JU
257 INTEGER :: ICL, INCL2, ILMAX
258 INTEGER :: INCL, I, ICLD, III, IO
259 INTEGER :: INBC, IDX, INBCT
260 INTEGER :: JJD, JJF, JI, JJ
261 INTEGER :: JB, ISTOK
262 INTEGER,SAVE :: ILUCOL, IRESP, ID, IDD
263 INTEGER,SAVE :: ISUIT, ISUI, INDISTM
264 INTEGER :: ILENT, IND, II2,IJ2
265 INTEGER             :: JLBL, JL
266 INTEGER             :: ISTA, IER, IWK, INB, INBB
267 INTEGER,SAVE        :: IH, IHT, IMI, ILE
268 INTEGER,DIMENSION(32):: INDHACHREF=(/0,54,52,60,14,59,58,1,57,56,55,54,53,52,51,50, &
269                         1,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35/)
270 INTEGER :: INUM, ILOOP, JLOOPI, IDEB,IFIN, II, JLOOPJ
271 INTEGER,DIMENSION(:),ALLOCATABLE       :: ICOL2
272 INTEGER,DIMENSION(:),ALLOCATABLE       :: IE
273 INTEGER,DIMENSION(:),ALLOCATABLE,SAVE  :: ISTM
274 #ifdef RHODES
275 INTEGER          :: ISTAF
276 #endif
277
278 REAL    :: ZWLC, ZWRC, ZWBC, ZWTC
279 REAL    :: ZTA, ZTB, ZTD, ZTF, ZTINT,ZINTV
280 REAL    :: ZINT, ZMIN, ZMAX
281 REAL    :: ZINTT, ZH, ZJ, ZJJ, ZWBBB
282 REAL    :: ZISO
283 REAL    :: ZTEMP
284 REAL,SAVE :: ZWL, ZWR, ZWB, ZWT
285 REAL,SAVE :: ZWLL, ZWRR, ZWBB, ZWTT
286 REAL,SAVE :: ZVL, ZVR, ZVB, ZVT
287 REAL    :: ZCLV, ZINTERV, ZCLV2
288 REAL    :: ZCLVD, ZCLVF
289 REAL    :: RED, GREEN, BLUE
290 REAL    :: ZMN, ZMX
291 REAL    :: ZDIXEPS 
292 REAL    :: ZX, ZY, ZXE, ZYE
293 REAL    :: ZLAT, ZLON
294 REAL    :: ZMI, ZMA, ZMIG, ZMAG
295 REAL    :: ZVLDEF, ZWIDTH
296 REAL    :: ZSC
297 REAL    :: ZXPOSTITT1, ZXYPOSTITT1
298 REAL    :: ZXPOSTITT2, ZXYPOSTITT2
299 REAL    :: ZXPOSTITT3, ZXYPOSTITT3
300 REAL    :: ZXPOSTITB1, ZXYPOSTITB1
301 REAL    :: ZXPOSTITB2, ZXYPOSTITB2
302 REAL    :: ZXPOSTITB3, ZXYPOSTITB3
303 REAL,DIMENSION(5)   :: ZX5, ZY5
304 REAL                :: ZEPX, ZEPYD, ZEPYU
305 !
306 REAL,SAVE           :: ZD, ZF, ZVERA, ZINTE
307 REAL,DIMENSION(SIZE(PTABV,1),SIZE(PTABV,2)):: ZTEMV, ZTEMV2
308 REAL,DIMENSION(N2DVERTX+20)                        :: ZDS, ZWZ
309 !REAL,DIMENSION(1020)                        :: ZDS, ZWZ
310 REAL,DIMENSION(:),ALLOCATABLE,SAVE       :: ZDS2, ZWZ2
311 REAL,DIMENSION(:),ALLOCATABLE,SAVE       :: ZLA, ZLO
312 REAL,DIMENSION(:),ALLOCATABLE,SAVE       :: ZZCLV2, ZTDX
313
314 !REAL,DIMENSION(300)                        :: ZDS, ZWZ
315 REAL,DIMENSION(300)                        :: ZLEV, ZISOLEVP
316 !
317 CHARACTER(LEN=5)   :: YFORMAT
318 CHARACTER(LEN=82),SAVE :: YCARCOU, YCAR
319 CHARACTER(LEN=100) :: YTEM
320 CHARACTER(LEN=1)   :: YREP
321 CHARACTER(LEN=2)   :: YC2
322 CHARACTER(LEN=3)   :: YC3  
323 CHARACTER(LEN=4)   :: YC4  
324 CHARACTER(LEN=8),DIMENSION(300) :: YLLBS
325 CHARACTER(LEN=32),SAVE          :: YNAMTABCOL
326 CHARACTER(LEN=40)  :: YTEXT
327 CHARACTER(LEN=45)  :: YTEX  ! 45=40+5
328 CHARACTER(LEN=8)   :: YC8  
329 CHARACTER(LEN=20)  :: YXYO 
330 CHARACTER(LEN=20)  :: YCAR20
331 CHARACTER(LEN=10) :: FORMAX, FORMAY,FORMA160
332 !
333 EXTERNAL SFILL     
334 EXTERNAL SFILLH     
335 EXTERNAL CCOLR
336 !
337 !-----------------------------------------------------------------------------
338 !
339 !*       1.     DISPLAY ENVIRONMENT SETUP
340 !               -------------------------
341 !
342 !-----------------------------------------------------------------------------
343 if(nverbia > 0)then
344   print *,' ENTREE IMCOU'
345   print *,'  LEN_TRIM(HTEXT) ',LEN_TRIM(HTEXT),HTEXT(1:LEN_TRIM(HTEXT))
346   print *,'  LPRESY,XHMIN,XHMAX CTIMEC ',LPRESY,XHMIN,XHMAX,CTIMEC
347   print *,'  CLEGEND2 ',CLEGEND2
348 endif
349 ZVLDEF=.1
350 YTEXT(1:LEN(YTEXT))=' '
351 YTEX(1:LEN(YTEX))=' '
352 !HTEXT=ADJUSTL(HTEXT)
353 JU=0
354 DO J=1,LEN_TRIM(HTEXT)
355   IF(HTEXT(J:J) == ' ')THEN
356     JU=JU+1
357     YTEXT(1:J-1)=HTEXT(1:J-1)
358     IF(YTEXT(1:4) == 'MASK')THEN
359       IF(JU == 2)THEN
360         IF(YTEXT(1:4) == 'MASK')THEN
361           IF(YTEXT(6:6) /= ' ')THEN
362             YTEXT(1:6)=' '
363           ELSE
364             YTEXT(1:5)=' '
365           ENDIF
366           YTEXT=ADJUSTL(YTEXT)
367           EXIT
368         ENDIF
369       ENDIF
370     ELSE
371     EXIT
372     ENDIF
373   ENDIF
374   IF(J == LEN_TRIM(HTEXT))THEN
375     YTEXT=HTEXT
376     YTEXT=ADJUSTL(YTEXT)
377     IF(YTEXT(1:4) == 'MASK')THEN
378       IF(YTEXT(6:6) /= ' ')THEN
379         YTEXT(1:6)=' '
380       ELSE
381         YTEXT(1:5)=' '
382       ENDIF
383       YTEXT=ADJUSTL(YTEXT)
384     ENDIF
385   ENDIF
386 ENDDO
387
388 IF(nverbia > 0)then
389   print *,' IMCOU NMGRID YTEXT ',NMGRID,YTEXT
390   print *,' PTABV',size(PTABV,1),size(PTABV,2),PTABV(1,1),PTABV(size(PTABV,1),6)
391 endif
392 NLUOUT=6
393
394 IF(LPRINT)THEN
395   
396 ! IF(LDEFCV2CC)THEN                    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
397 ! print *,' Pour l''instant, cette operation n''est prevue que pour une coupe definie avec :'
398 ! print *,' NIDEBCOU= NJDEBCOU= NLANGLE= NLMAX= '
399 ! print *,' A suivre ........ '
400 ! ELSE                                 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
401   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
402   IF(IRESP /= 0)THEN
403     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
404     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
405     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
406   ENDIF
407   ILOOP=SIZE(PTABV,1)/5
408   IF(ILOOP * 5 < SIZE(PTABV,1))ILOOP=ILOOP+1
409   IF(.NOT.LPVT)THEN
410     WRITE(INUM,'(''CV  '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'',''   (1-NLMAX,1-IKU)'')')CGROUP,&
411 &   CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
412   ELSE
413     WRITE(INUM,'(''CV  '',''G:'',A16,'' P:'',A25)')CGROUP,&
414 &   CTITRE(NLOOPP)(1:25)
415   ENDIF
416   IF(LMINUS .OR. LPLUS)THEN
417     WRITE(INUM,'(A70)')CTITB3
418   ELSE
419     WRITE(INUM,'(A40)')CTITGAL
420   ENDIF
421   IF(.NOT.LPVT)THEN
422     IF(LDEFCV2CC)THEN
423       IF(LDEFCV2)THEN
424         WRITE(INUM,'(''cc(deb)-(fin)=('',F8.0,'','',F8.0,'')-('',F8.0,'','',F8.0,'')'','' nlmax'',i5,&
425     &'' iku'',i4,'' iter'',i3)')&
426        &XIDEBCV,XJDEBCV,XIFINCV,XJFINCV,NLMAX,SIZE(PTABV,2),ILOOP
427       ELSE IF(LDEFCV2LL)THEN
428         WRITE(INUM,'(''ll(deb)-(fin)=('',F8.3,'','',F8.3,'')-('',F8.3,'','',F8.3,'')'','' nlmax'',i5,&
429     &'' iku'',i4,'' iter'',i3)')&
430        &XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL,NLMAX,SIZE(PTABV,2),ILOOP
431       ELSE IF(LDEFCV2IND)THEN
432         WRITE(INUM,'(''ij(deb)-(fin)=('',I4,'','',I4,'')-('',I4,'','',I4,'')'','' nlmax'',i5,&
433     &'' iku'',i4,'' iter'',i3)')&
434        &NIDEBCV,NJDEBCV,NIFINCV,NJFINCV,NLMAX,SIZE(PTABV,2),ILOOP
435       ENDIF
436     ELSE
437       IF(XIDEBCOU /= -999.)THEN
438         WRITE(INUM,'(''xidebcou'',F8.0,'' xjdebcou'',F8.0,'' nlmax'',i5,'' nlangle'',i4,&
439     &'' iku'',i4,''    iter'',i3)')&
440        &XIDEBCOU,XJDEBCOU,NLMAX,NLANGLE,SIZE(PTABV,2),ILOOP
441       ELSE
442         WRITE(INUM,'(''nidebcou'',i4,'' njdebcou'',i4,'' nlmax'',i5,'' nlangle'',i4,&
443     &'' iku'',i4,''    iter'',i3)')&
444        &NIDEBCOU,NJDEBCOU,NLMAX,NLANGLE,SIZE(PTABV,2),ILOOP
445       ENDIF
446     ENDIF
447   ELSE
448     WRITE(INUM,'(''NBVAL en I (TIME): '',i4, &
449 &  '' NBVAL en K (Z)'',i4,''    iter'',i3)') &
450   & SIZE(PTABV,1),SIZE(PTABV,2),ILOOP
451   ENDIF
452   DO JLOOPI=1,ILOOP
453     IF(JLOOPI == 1)THEN
454       IDEB=1; IFIN=5
455     ELSE
456       IDEB=IFIN+1; IFIN=IFIN+5
457     ENDIF
458     IF(JLOOPI == ILOOP)THEN
459       IFIN=SIZE(PTABV,1)
460     ENDIF
461     
462 ! JUin 2001 Ecriture des dates (Demande G.Jaubert ) si LPRDAT=T
463   IF(LPRDAT)THEN
464     IF(.NOT.ALLOCATED(XPRDAT))THEN
465       print *,'** IMCOU XPRDAT NON ALLOUE.Dates non ecrites ds FICVAL .Prevenir J.Duron'
466     ELSE
467       WRITE(INUM,'(1X,75(1H*))')
468       WRITE(INUM,'(1X,''    Dates courante   *     modele      *   experience    *      segment'')')
469       WRITE(INUM,'(1X,'' J   An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.'')')
470       WRITE(INUM,'(1X,75(1H*))')
471       DO J=1,SIZE(XPRDAT,2)
472         WRITE(INUM,'(1X,I3,1X,3(I4,I3,I3,I6,'' *''),I4,I3,I3,I6)')J,INT(XPRDAT(:,J))
473       ENDDO
474     ENDIF
475   ENDIF
476     WRITE(INUM,'(1X,79(1H*))')
477     WRITE(INUM,'(''  K  I->   '',I4,6X,4(6X,I4,6X))')(/(II,II=IDEB,IFIN)/)
478     WRITE(INUM,'(''.'',79(1H*))')
479     DO JLOOPJ=SIZE(PTABV,2),1,-1
480       WRITE(INUM,'(I4,1X,5(1X,E14.7))')JLOOPJ,(PTABV(II,JLOOPJ),II=IDEB,IFIN)
481 !     WRITE(INUM,'(I4,1X,5E15.8)')JLOOPJ,(PTABV(II,JLOOPJ),II=IDEB,IFIN)
482     ENDDO
483     WRITE(INUM,'(1X,79(1H*))')
484   ENDDO
485 ! ENDIF                                !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
486 ENDIF
487
488
489 ZDIXEPS=1.E-11 
490 !print *,' ZDIXEPS ',ZDIXEPS
491 IKU=NKMAX+2*JPVEXT
492 IKB=1+JPVEXT
493 IKE=IKU-JPVEXT
494 LVERTI=.TRUE.; LHORIZ=.FALSE.
495 !IF(.NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
496 !
497 !*       1.1    Window definition, NDC and user coordinate setting
498 !
499 XLWIDTH=XLWDEF
500 IF(LSUPER)THEN
501   NSUPER=NSUPER+1
502   SELECT CASE(NSUPER)
503     CASE(1)
504       IF(XLW >= 0)THEN
505         XLWIDTH=XLW
506       ENDIF
507       IF(XLW1 >= 0)THEN
508         XLWIDTH=XLW1
509       ENDIF
510
511       IH=0; IHT=0
512
513       IF(LHACH2 .AND. LHACH3 .AND. LHACH4)THEN
514      
515         IHT=3
516       ELSE IF((LHACH2 .AND. LHACH3 .AND. .NOT.LHACH4) .OR.  &
517               (LHACH2 .AND. LHACH4 .AND. .NOT.LHACH3) .OR.  &
518               (LHACH3 .AND. LHACH4 .AND. .NOT.LHACH2))THEN
519               IHT=2
520       ELSE IF((LHACH2 .AND. .NOT.LHACH3 .AND. .NOT.LHACH4) .OR.  &
521               (LHACH3 .AND. .NOT.LHACH2 .AND. .NOT.LHACH4) .OR.  &
522               (LHACH4 .AND. .NOT.LHACH2 .AND. .NOT.LHACH3))THEN
523               IHT=1
524       ENDIF
525
526     CASE(2)
527       IF(XLW2 >= 0)THEN
528         XLWIDTH=XLW2
529       ENDIF
530     CASE(3)
531       IF(XLW3 >= 0)THEN
532         XLWIDTH=XLW3
533       ENDIF
534     CASE(4)
535       IF(XLW4 >= 0)THEN
536         XLWIDTH=XLW4
537       ENDIF
538   END SELECT
539 ELSE
540   IF(XLW >= 0)THEN
541     XLWIDTH=XLW
542   ENDIF
543   IF(XLW1 >= 0)THEN
544     XLWIDTH=XLW1
545   ENDIF
546   IH=0; IHT=0
547 END IF
548
549 LPT=LPXT
550 IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT .AND. .NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
551
552   IF((.NOT.LSUPER) .OR. (LSUPER .AND. NSUPER == 1))THEN
553     ZWL=XDS(1,NMGRID)
554     ZWR=XDS(NLMAX,NMGRID)
555 ! Nov 2000
556     IF(LPRESY)THEN
557       IF(XHMIN<=XHMAX)THEN
558 ! Bornes en altitude -> besoin de calculer bornes en pression +loin
559         !XHMIN=0.
560         !XHMAX=XWORKZ(1,IKE,NMGRID)
561         IF(XPMIN==XPMAX)THEN
562           print*,' ordonnee en Log(P): indiquez XPMIN et XPMAX'
563           read(5,*) XPMIN,XPMAX
564           CALL WRITEDIR(NDIR,XPMIN)
565           CALL WRITEDIR(NDIR,XPMAX)
566         ENDIF
567         IF(XPMIN<XPMAX) THEN
568           ZTEMP=XPMIN
569           XPMIN=XPMAX
570           XPMAX=ZTEMP
571         ENDIF
572         XHMIN=XPMIN
573         XHMAX=XPMAX
574       ENDIF
575 ! Bornes fournies en pression . Verifier qu'elles sont en pascals
576 ! Besoin de calculer les bornes en altitudes +loin
577       IF (XHMIN < 1500)THEN
578         XHMIN=XHMIN*100
579       ENDIF
580       IF (XHMAX < 1500)THEN
581         XHMAX=XHMAX*100
582       ENDIF
583     ELSE
584       IF((XHMIN==0..AND.XHMAX==0.).OR.(XHMAX<=XHMIN))THEN
585 ! Nov 2000 -> Petite modif a signaler aux utilisateurs
586         XHMIN=0.
587 !       XHMIN=XWORKZ(1,IKB,NMGRID)
588         XHMAX=XWORKZ(1,IKE,NMGRID)
589       ENDIF
590     ENDIF
591     ZWB=XHMIN
592     ZWT=XHMAX
593     IF (.NOT. LPRESY .AND. ZWB==ZWT) THEN
594       print *,' min, max identiques pour la 2e direction: ',XHMIN,XHMAX
595       print *,'entrez 2 valeurs telles que XHMIN < XHMAX '
596       read(5,*) ZWB,ZWT
597       CALL WRITEDIR(NDIR,ZWB)
598       CALL WRITEDIR(NDIR,ZWT)
599     END IF
600 !
601     if(nverbia > 0)then
602       print *,' ****** IMCOU_FORDIACHRO ZWL R B T',ZWL,ZWR,ZWB,ZWT
603     endif
604     LVERT=LVERTI
605     LHOR=LHORIZ
606 !
607 ! Nov 2000
608     IF(LPRESY)THEN
609       CALL SETUSV('MI',1)
610       CALL SETUSV('LS',2)
611       IF(LVPTVUSER)THEN
612         CALL SET(XVPTVL,XVPTVR,XVPTVB,XVPTVT,ZWL,ZWR,ZWB,ZWT,2)
613       ELSE
614         CALL SET(.1,.9,.1,.9,ZWL,ZWR,ZWB,ZWT,2)
615       ENDIF
616     ELSE
617 ! Nov 2000
618       CALL SETUSV('MI',1)
619       IF(LVPTVUSER)THEN
620         CALL SET(XVPTVL,XVPTVR,XVPTVB,XVPTVT,ZWL,ZWR,ZWB,ZWT,1)
621       ELSE
622         CALL SET(.1,.9,.1,.9,ZWL,ZWR,ZWB,ZWT,1)
623       ENDIF
624 ! Nov 2000
625     ENDIF
626 ! Nov 2000
627   END IF
628
629 ELSE
630
631   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
632     
633   IF(LCVXZ .OR. LCVYZ)THEN
634     IF(LVPTVUSER)THEN
635       CALL SET(XVPTVL,XVPTVR,XVPTVB,XVPTVT,ZWL,ZWR,ZWB,ZWT,1)
636     ELSE
637 ! Dans ce cas definition de la fenetre ds OPER avec .1,.9,.1,.9
638       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,1)
639     ENDIF
640   ELSE 
641 !!!!!PROVI
642   IF(LPXT .AND. .NOT.LXABSC .AND. LXMINTOP)THEN
643     CALL SETUSV('MI',2)
644 ! Attention ici inversion de ZWB et ZWT
645     CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWT,ZWB,ID)
646   ELSEIF(LPVT .AND. LPRESY)THEN
647     CALL SETUSV('MI',1)
648     CALL SETUSV('LS',2)
649     CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,2)
650 !   CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
651   ELSE
652     CALL SETUSV('MI',1)
653     CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
654   ENDIF
655   ENDIF
656
657 ENDIF
658 CALL GETUSV('MI',IMI)
659 !
660 IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT .AND. .NOT.(LCVXZ.AND.LJCP) .AND. .NOT.(LCVYZ.AND.LICP))THEN
661   CALL GSCLIP(1)              ! Display clipping activated
662 !
663   CALL CPSETI('SET',0)  ! Compack keeps user's call to set
664   CALL CPSETI('MAP',4)  ! Customized vertical z-stretching used in CPMPXY
665 !
666 !*      1.2    Topography outline drawing
667
668   
669   ZDS(1)=XDS(1,NMGRID)
670   ZWZ(1)=XHMIN
671   IF(LCVYZ .AND.LICP)THEN
672     ZWZ(1)=0.
673   ENDIF
674   IF(LCVYZ .AND. .NOT.LICP)THEN
675     ZWZ(2:NLMAX+1)=XXZS(NIDEBCOU,NJDEBCOU:NJDEBCOU+NLMAX-1,NMGRID)
676   ENDIF
677   DO JILOOP=2,NLMAX+1
678     ZDS(JILOOP)=XDS(JILOOP-1,NMGRID)
679     IF(LCVYZ .AND. .NOT.LICP)THEN
680     ELSEIF(LCVYZ .AND.LICP)THEN
681       ZWZ(JILOOP)=0.
682     ELSE
683       ZWZ(JILOOP)=XWZ(JILOOP-1,NMGRID)
684     ENDIF
685   ENDDO
686   ZDS(NLMAX+2)=ZDS(NLMAX+1)
687   ZWZ(NLMAX+2)=XHMIN
688   IF(LCVYZ .AND.LICP)THEN
689     ZWZ(NLMAX+2)=0.
690   ENDIF
691 !
692   IF(ALLOCATED(ZDS2))THEN
693    DEALLOCATE(ZDS2)
694   ENDIF
695   IF(ALLOCATED(ZWZ2))THEN
696    DEALLOCATE(ZWZ2)
697   ENDIF
698   ALLOCATE(ZDS2(NLMAX+2))
699   ALLOCATE(ZWZ2(NLMAX+2))
700   ZDS2=ZDS(1:NLMAX+2)
701   ZWZ2=ZWZ(1:NLMAX+2)
702   if(nverbia > 4)then
703 print *,' ********IMCOU_FORDIACHRO NLMAX  ZDS',NLMAX
704 print *,(ZDS(JILOOP),JILOOP=1,NLMAX)
705 print *,' ********IMCOU_FORDIACHRO ZWZ'
706 print *,(ZWZ(JILOOP),JILOOP=1,NLMAX)
707   endif
708 !
709   IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN
710   IF(.NOT. LPRESY) THEN
711     CALL CURVE(ZDS2,ZWZ2,NLMAX+2)                          ! draws Topo outline 
712 !   CALL CURVE(ZDS,ZWZ,NLMAX+2)                            ! draws Topo outline 
713     CALL SFSETR('SP',.008)                                 ! Softfill setting
714     CALL SFSETR('AN',45.)                                  ! Softfill setting
715     CALL SFSETI('DO',0)                                  ! Softfill setting
716     CALL SFWRLD(ZDS2,ZWZ2,NLMAX+2,ZRSCR,JPRSCR,ISCR,JPISCR)  ! Hatched under 
717 !   CALL SFWRLD(ZDS,ZWZ,NLMAX+2,ZRSCR,JPRSCR,ISCR,JPISCR)  ! Hatched under 
718 !                                                      ! topography
719   ENDIF
720 !
721 !*     1.3     If required, draws a model-level background
722 !
723     IF(.NOT.LDEFCV2CC)THEN              !%%%%%%%%%%%%%%%%%%%%%%
724
725     IF(NLANGLE.EQ.0.AND.XIDEBCOU.EQ.-999..AND.LXZ)THEN
726       CALL GSCLIP(0)
727       CALL TRACEXZ
728       CALL GSCLIP(1)
729     END IF
730
731     ENDIF                               !%%%%%%%%%%%%%%%%%%%%%%
732
733   ENDIF
734
735 ENDIF
736 !
737 !-----------------------------------------------------------------------------
738 !
739 !*     2.        CONTOUR DRAWING 
740 !                ---------------
741 !
742 !*     2.1       Loads abscissa and true-altitudes along
743 !*               the section in work arrays 
744
745 IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT .AND. .NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
746
747   NINX=NLMAX
748   NINY=IKU
749   DO JILOOP=1,NLMAX
750     XZZDS(JILOOP)=XDS(JILOOP,NMGRID)
751   ENDDO
752 !print *,' ********IMCOU_FORDIACHRO NLMAX  XZZDS',NLMAX
753 !print *,(XZZDS(JILOOP),JILOOP=1,NLMAX)
754   DO JILOOP=1,NLMAX
755     DO JKLOOP=1,IKU
756       XZWORKZ(JILOOP,JKLOOP)=XWORKZ(JILOOP,JKLOOP,NMGRID)
757     ENDDO
758   ENDDO
759
760 ENDIF
761 !-----------------------------------------------------------------------------
762 IF(LPRINTXY)THEN
763 ! IF(LDEFCV2CC .OR. XIDEBCOU /= -999.)THEN   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
764 ! print *,' Pour l''instant, cette operation n''est prevue que pour une coupe definie avec :'
765 ! print *,' NIDEBCOU= NJDEBCOU= NLANGLE= NLMAX= '
766 ! print *,' A suivre ........ '
767 ! ELSE                                 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
768   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
769   IF(IRESP /= 0)THEN
770     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
771     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
772     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
773   ENDIF
774   ILOOP=SIZE(PTABV,1)/5
775   IF(ILOOP * 5 < SIZE(PTABV,1))ILOOP=ILOOP+1
776   IF(.NOT. LPVT)THEN
777 !!Oct 2002
778     IF(LCVYZ)THEN
779     WRITE(INUM,'(''CV YZ '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'','' (1-NLMAX,1-IKU)'')')CGROUP, &
780 &   CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
781     ELSE
782 !!Oct 2002
783     WRITE(INUM,'(''CV XZ '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'','' (1-NLMAX,1-IKU)'')')CGROUP, &
784 &   CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
785     ENDIF
786   ELSE
787     WRITE(INUM,'(''CV TIMEZ '',''   G:'',A16,'' P:'',A40)')CGROUP, &
788 !&   CTITGAL
789 &   CTITRE(NLOOPP)(1:40)
790   ENDIF
791   IF(LMINUS .OR. LPLUS)THEN
792     WRITE(INUM,'(A70)')CTITB3
793   ELSE
794     WRITE(INUM,'(A40)')CTITGAL
795   ENDIF
796   IF(.NOT. LPVT)THEN
797     IF(.NOT.LCARTESIAN)THEN
798       ALLOCATE(ZLA(NLMAX),ZLO(NLMAX))
799       DO J=1,NLMAX
800         ZX=XDSX(J,NMGRID)
801         ZY=XDSY(J,NMGRID)
802         CALL SM_LATLON_S(XLATORI,XLONORI,ZX,ZY,ZLAT,ZLON)
803         ZLA(J)=ZLAT
804         ZLO(J)=ZLON
805       ENDDO
806       IF(LDEFCV2LL)THEN
807         ZLA(1)=XIDEBCVLL
808         ZLO(1)=XJDEBCVLL
809       ENDIF
810       if(nverbia > 0)then
811 !     print *,' ZLA'
812 !     print *,ZLA
813 !     print *,' ZLO'
814 !     print *,ZLO
815       endif
816 !     DEALLOCATE(ZLA,ZLO)
817     ENDIF
818     IF(LDEFCV2CC)THEN
819       IF(LDEFCV2)THEN
820         WRITE(INUM,'(''cc(deb)-(fin)=('',F8.0,'','',F8.0,'')-('',F8.0,'','',F8.0,'')'','' nlmax'',i5,&
821     &'' iku'',i4,'' iter'',i3)')&
822        &XIDEBCV,XJDEBCV,XIFINCV,XJFINCV,NLMAX,SIZE(PTABV,2),ILOOP
823       ELSE IF(LDEFCV2LL)THEN
824         WRITE(INUM,'(''ll(deb)-(fin)=('',F8.3,'','',F8.3,'')-('',F8.3,'','',F8.3,'')'','' nlmax'',i5,&
825     &'' iku'',i4,'' iter'',i3)')&
826        &XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL,NLMAX,SIZE(PTABV,2),ILOOP
827       ELSE IF(LDEFCV2IND)THEN
828         WRITE(INUM,'(''ij(deb)-(fin)=('',I4,'','',I4,'')-('',I4,'','',I4,'')'','' nlmax'',i5,&
829     &'' iku'',i4,'' iter'',i3)')&
830        &NIDEBCV,NJDEBCV,NIFINCV,NJFINCV,NLMAX,SIZE(PTABV,2),ILOOP
831       ENDIF
832     ELSE
833       IF(XIDEBCOU /= -999.)THEN
834         WRITE(INUM,'(''xidebcou'',F8.0,'' xjdebcou'',F8.0,'' nlmax'',i5,'' nlangle'',i4,&
835     &'' iku'',i4,''    iter'',i3)')&
836        &XIDEBCOU,XJDEBCOU,NLMAX,NLANGLE,SIZE(PTABV,2),ILOOP
837       ELSE
838     WRITE(INUM,'(''nidebcou'',i4,'' njdebcou'',i4,'' nlmax'',i5,'' nlangle'',i4, &
839 &  '' iku'',i4,''    iter'',i3)') &
840   & NIDEBCOU,NJDEBCOU,NLMAX,NLANGLE,SIZE(PTABV,2),ILOOP
841       ENDIF
842     ENDIF
843     IF(LCARTESIAN)THEN
844       WRITE(INUM,'(1X,41(1H*))')
845       WRITE(INUM,'(18X,''X'',12X,''RELIEF'')')
846       WRITE(INUM,'(1X,41(1H*))')
847       DO JLOOPI=1,NLMAX
848         IF(JLOOPI == 1)THEN
849           WRITE(INUM,'(''   1 '',I5,2(1X,E15.8))')JLOOPI,XDS(JLOOPI,NMGRID), &
850           XWZ(JLOOPI,NMGRID)
851         ELSE IF(JLOOPI == NLMAX)THEN
852           WRITE(INUM,'(''NLMAX'',I5,2(1X,E15.8))')JLOOPI,XDS(JLOOPI,NMGRID), &
853           XWZ(JLOOPI,NMGRID)
854         ELSE
855           WRITE(INUM,'(''     '',I5,2(1X,E15.8))')JLOOPI,XDS(JLOOPI,NMGRID), &
856           XWZ(JLOOPI,NMGRID)
857         ENDIF
858       ENDDO
859       WRITE(INUM,'(1X,41(1H*))')
860     ELSE
861       WRITE(INUM,'(1X,66(1H*))')
862       WRITE(INUM,'(18X,''X'',12X,''RELIEF'',11X,''LAT'',10X,''LONG'')')
863       WRITE(INUM,'(1X,66(1H*))')
864       DO JLOOPI=1,NLMAX
865         IF(JLOOPI == 1)THEN
866           IF(LCVYZ)THEN
867             WRITE(INUM,'(''   1 '',I5,2(1X,E15.8),2(2X,F10.5))')JLOOPI,XDS(JLOOPI,NMGRID), &
868             ZWZ(JLOOPI+1),ZLA(JLOOPI),ZLO(JLOOPI)
869           ELSE
870             WRITE(INUM,'(''   1 '',I5,2(1X,E15.8),2(2X,F10.5))')JLOOPI,XDS(JLOOPI,NMGRID), &
871             XWZ(JLOOPI,NMGRID),ZLA(JLOOPI),ZLO(JLOOPI)
872           END IF
873         ELSE IF(JLOOPI == NLMAX)THEN
874           IF(LCVYZ)THEN
875             WRITE(INUM,'(''NLMAX'',I5,2(1X,E15.8),2(2X,F10.5))')JLOOPI,XDS(JLOOPI,NMGRID), &
876             ZWZ(JLOOPI+1),ZLA(JLOOPI),ZLO(JLOOPI)
877           ELSE
878             WRITE(INUM,'(''NLMAX'',I5,2(1X,E15.8),2(2X,F10.5))')JLOOPI,XDS(JLOOPI,NMGRID), &
879             XWZ(JLOOPI,NMGRID),ZLA(JLOOPI),ZLO(JLOOPI)
880           END IF
881         ELSE
882           IF(LCVYZ)THEN
883             WRITE(INUM,'(''     '',I5,2(1X,E15.8),2(2X,F10.5))')JLOOPI,XDS(JLOOPI,NMGRID), &
884             ZWZ(JLOOPI+1),ZLA(JLOOPI),ZLO(JLOOPI)
885           ELSE
886             WRITE(INUM,'(''     '',I5,2(1X,E15.8),2(2X,F10.5))')JLOOPI,XDS(JLOOPI,NMGRID), &
887             XWZ(JLOOPI,NMGRID),ZLA(JLOOPI),ZLO(JLOOPI)
888           END IF
889         ENDIF
890       ENDDO
891       WRITE(INUM,'(1X,66(1H*))')
892       DEALLOCATE(ZLA,ZLO)
893     ENDIF
894   
895     DO JLOOPI=1,ILOOP
896       IF(JLOOPI == 1)THEN
897         IDEB=1; IFIN=5
898       ELSE
899         IDEB=IFIN+1; IFIN=IFIN+5
900       ENDIF
901       IF(JLOOPI == ILOOP)THEN
902         IFIN=SIZE(PTABV,1)
903       ENDIF
904       
905       WRITE(INUM,'(''ALTITUDES   (1-NLMAX,1-IKU)'')')
906       WRITE(INUM,'(1X,79(1H*))')
907       WRITE(INUM,'(''  K  X->   '',I4,6X,4(6X,I4,6X))')(/(II,II=IDEB,IFIN)/)
908       WRITE(INUM,'(''.'',79(1H*))')
909       DO JLOOPJ=SIZE(PTABV,2),1,-1
910         IF(LCVYZ)THEN
911         WRITE(INUM,'(I4,1X,5(1X,E14.7))')JLOOPJ,(XZWORKZ(II,JLOOPJ),II=IDEB,IFIN)
912         ELSE
913         WRITE(INUM,'(I4,1X,5(1X,E14.7))')JLOOPJ,(XWORKZ(II,JLOOPJ,NMGRID),II=IDEB,IFIN)
914 !       WRITE(INUM,'(I4,1X,5E15.8)')JLOOPJ,(XWORKZ(II,JLOOPJ,NMGRID),II=IDEB,IFIN)
915         ENDIF
916       ENDDO
917       WRITE(INUM,'(1X,79(1H*))')
918     ENDDO
919
920   ELSE
921
922     WRITE(INUM,'(''NBVAL en I (TIME): '',i4, &
923 &  '' NBVAL en K (Z)'',i4)') &
924   & SIZE(PTABV,1),SIZE(PTABV,2)
925     ZMIG=MINVAL(XZWORKZ(1:NINX,1:NINY))
926     ZMAG=MAXVAL(XZWORKZ(1:NINX,1:NINY))
927     ZMI=MINVAL(XZWORKZ(NINX/2,1:NINY))
928     ZMA=MAXVAL(XZWORKZ(NINX/2,1:NINY))
929 !   print *,' ZMIG,ZMAG,ZMI,ZMA ',ZMIG,ZMAG,ZMI,ZMA
930
931     IF(ZMIG == ZMI .AND. ZMAG == ZMA)THEN
932
933       II=MAX(SIZE(PTABV,1),SIZE(PTABV,2))
934       WRITE(INUM,'(1X,43(1H*))')
935       WRITE(INUM,'(2X,''  I'',7X,''TIME'',10X,''K'',9X,''Z'')')
936       WRITE(INUM,'(1X,43(1H*))')
937       DO JLOOPJ=1,II
938         IF(SIZE(PTABV,1) > SIZE(PTABV,2))THEN
939           IF(JLOOPJ <= SIZE(PTABV,2))THEN
940              WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
941             JLOOPJ,XZWORKZ(1,JLOOPJ)
942           ELSE
943             WRITE(INUM,'(I5,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ)
944           ENDIF
945         ELSE IF(SIZE(PTABV,2) > SIZE(PTABV,1))THEN
946           IF(JLOOPJ <= SIZE(PTABV,1))THEN
947             WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
948             JLOOPJ,XZWORKZ(1,JLOOPJ)
949           ELSE
950             WRITE(INUM,'(23X,I4,2X,E15.8)')JLOOPJ,XZWORKZ(1,JLOOPJ)
951           ENDIF
952         ELSE
953           WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
954           JLOOPJ,XZWORKZ(1,JLOOPJ)
955         ENDIF
956       ENDDO
957       WRITE(INUM,'(1X,43(1H*))')
958
959     ELSE
960
961       DO JLOOPI=1,ILOOP
962         IF(JLOOPI == 1)THEN
963           IDEB=1; IFIN=5
964         ELSE
965           IDEB=IFIN+1; IFIN=IFIN+5
966         ENDIF
967         IF(JLOOPI == ILOOP)THEN
968           IFIN=SIZE(PTABV,1)
969         ENDIF
970
971         WRITE(INUM,'(''TEMPS - ALTITUDES '')')
972         WRITE(INUM,'(1X,79(1H*))')
973 !       WRITE(INUM,'("  K  I->  ",I5,5X,4(5X,I5,5X))')
974         ALLOCATE(IE(IFIN-IDEB+1))
975         DO III=IDEB,IFIN
976         IE(III-IDEB+1)=III
977         ENDDO
978         WRITE(INUM,'("  K  I->  ",I5,5X,4(5X,I5,5X))')IE
979 !       WRITE(INUM,'("  K  I->  ",I5,5X,4(5X,I5,5X))')(/(III,III=IDEB,IFIN)/)
980         DEALLOCATE(IE)
981         WRITE(INUM,'(1X,79(1H.))')
982         WRITE(INUM,'("   . TIME->",F7.0,3X,4(4X,F7.0,4X))')(XZZDS(II),II=IDEB,IFIN)
983 !       WRITE(INUM,'("           ")')
984 !       WRITE(INUM,'(F7.0,3X,4(4X,F7.0,4X))')(XZZDS(II),II=IDEB,IFIN)
985         WRITE(INUM,'(''.'',79(1H*))')
986         DO JLOOPJ=SIZE(PTABV,2),1,-1
987           WRITE(INUM,'(I4,2X,5(1X,E14.7))')JLOOPJ,(XZWORKZ(II,JLOOPJ),II=IDEB,IFIN)
988 !         WRITE(INUM,'(I3,2X,5E15.8)')JLOOPJ,(XZWORKZ(II,JLOOPJ),II=IDEB,IFIN)
989         ENDDO
990         WRITE(INUM,'(1X,79(1H*))')
991       ENDDO
992     ENDIF
993
994   ENDIF
995 ! ENDIF                                !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
996 ENDIF
997 !-----------------------------------------------------------------------------
998 !
999 !*    2.2       If required, the user provides Max and Min of the field
1000 !*              to be plotted (within section)
1001
1002 ZINT=PINT
1003
1004 IF(NIMNMX == 0 .OR. NIMNMX == 1)THEN
1005
1006 ! Modifs for Diachro
1007 !
1008 !CALL GMNMX(ZMIN,ZMAX,ZINT)
1009   LISOK=.FALSE.
1010   ZMIN=0.; ZMAX=0.
1011   CALL READMNMXINT_ISO(NIMNMX,YTEXT(1:LEN_TRIM(YTEXT)),ZMIN,ZMAX,ZINT)
1012
1013 ELSE IF(NIMNMX == 2)THEN
1014   CALL READXISOLEVP(YTEXT(1:LEN_TRIM(YTEXT)),ILE,ZISOLEVP)
1015   IF(NVERBIA > 5)THEN
1016     print *,' IMCOU YTEXT,ILE,ZISOLEVP ',YTEXT(1:LEN_TRIM(YTEXT)),ILE,ZISOLEVP(1:ILE)
1017   ENDIF
1018
1019 ELSE IF (NIMNMX==3) THEN  ! compute contour values from XISOREF and XDIAINT
1020   ZISOLEVP(:)=9999.
1021   ZMN=MINVAL(PTABV,MASK=PTABV/=XSPVAL) 
1022   ZMX=MAXVAL(PTABV,MASK=PTABV/=XSPVAL)
1023   CALL READREFINT_ISO(YTEXT(1:LEN_TRIM(YTEXT)),ZMN,ZMX,ZINT,ZISOLEVP)
1024 ENDIF
1025
1026 IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT)THEN
1027 ! min + max matrice
1028 if(nverbia >0)then
1029 print *,' ** imcou NLMAX ',NLMAX
1030 endif
1031 ZMN=PTABV(NLMAX/2,SIZE(PTABV,2)/2)
1032 ZMX=PTABV(NLMAX/2,SIZE(PTABV,2)/2)
1033 if(nverbia >0)then
1034 print *,' ** imcou AP ZMN=PTABV(NLMAX/2,SIZE(PTABV,2)/2); ZM...'
1035 endif
1036 ELSE
1037 II2=MAX(1,SIZE(PTABV,1)/2); IJ2=MAX(1,SIZE(PTABV,2)/2)
1038 ZMN=PTABV(II2,IJ2); ZMX=ZMN
1039 !ZMN=999999.; ZMX=-999999.
1040 ENDIF
1041 !-----------------------------------------------------------------------------
1042 IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT)THEN
1043 DO JILOOP=1,NLMAX
1044   DO JKLOOP=1,IKU
1045     IF(LPRESY)THEN
1046 ! en log(pression)
1047       IF(XZWORKZ(JILOOP,JKLOOP) < XHMAX)CYCLE
1048       IF(XZWORKZ(JILOOP,JKLOOP) > XHMIN)CYCLE
1049     ELSE
1050       IF(XZWORKZ(JILOOP,JKLOOP) > XHMAX)CYCLE
1051       IF(XZWORKZ(JILOOP,JKLOOP) < XHMIN)CYCLE
1052     ENDIF
1053     IF(PTABV(JILOOP,JKLOOP) == XSPVAL)CYCLE
1054     IF(PTABV(JILOOP,JKLOOP) < ZMN)ZMN=PTABV(JILOOP,JKLOOP)
1055     IF(PTABV(JILOOP,JKLOOP) > ZMX)ZMX=PTABV(JILOOP,JKLOOP)
1056   ENDDO
1057 ENDDO
1058 !-----------------------------------------------------------------------------
1059 ELSE
1060 IF(.NOT.LPXT .AND..NOT.LPYT)THEN
1061 DO JILOOP=1,SIZE(PTABV,1)
1062   DO JKLOOP=1,SIZE(PTABV,2)
1063     IF(LPRESY)THEN
1064 ! en log(pression)
1065       IF(XZWORKZ(JILOOP,JKLOOP) < XHMAX)CYCLE
1066       IF(XZWORKZ(JILOOP,JKLOOP) > XHMIN)CYCLE
1067     ELSE
1068       IF(XZWORKZ(JILOOP,JKLOOP) > XHMAX)CYCLE
1069       IF(XZWORKZ(JILOOP,JKLOOP) < XHMIN)CYCLE
1070     ENDIF
1071     IF(PTABV(JILOOP,JKLOOP) == XSPVAL)CYCLE
1072     IF(PTABV(JILOOP,JKLOOP) < ZMN)ZMN=PTABV(JILOOP,JKLOOP)
1073     IF(PTABV(JILOOP,JKLOOP) > ZMX)ZMX=PTABV(JILOOP,JKLOOP)
1074   ENDDO
1075 ENDDO
1076 ELSE
1077   ZMN=MINVAL(PTABV)
1078   ZMX=MAXVAL(PTABV)
1079 ENDIF
1080 ENDIF
1081 !-----------------------------------------------------------------------------
1082 YLBL(1:5)='(Min:'
1083 WRITE(YLBL(6:15),'(E10.3)')ZMN
1084 YLBL(16:21)=', Max:'
1085 WRITE(YLBL(22:31),'(E10.3)')ZMX
1086 YLBL(32:32)=')'
1087 !
1088 !*    2.3       Conpack display options 
1089 !
1090 CALL GSLWSC(1.)             ! Line width
1091 !
1092 !
1093 !*    2.4       Contour selection rules
1094 !
1095 !print *,' ** imcou AV SELECT CASE(NIMNMX) '
1096 SELECT CASE(NIMNMX)
1097   CASE(-1)             ! Automatic contour scanning
1098     CALL CPSETI('CLS',+16)
1099     IF((LHACH1 .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))) .OR. &
1100        (LHACH2 .AND. NSUPER == 2)                                   .OR. &
1101        (LHACH3 .AND. NSUPER == 3)                                   .OR. &
1102        (LHACH4 .AND. NSUPER == 4))CALL CPSETI('CLS',+7)
1103
1104     CALL CPSETR('CIS',-ZINT)
1105 !
1106   CASE(0)               ! Automatic range with given increment
1107     CALL CPSETI('CLS',16)
1108     CALL CPSETR('CIS',ZINT)
1109     CALL CPSETI('LIS',NULBLL+1)
1110     CALL CPSETR('CMN',100000000000.)
1111 !   CALL CPSETR('CMN',MAXVAL(PTAB))
1112     CALL CPSETR('CMX',10000000000.)
1113 !   CALL CPSETR('CMX',MINVAL(PTAB))
1114 !
1115   CASE(1)               ! Given min, max and increment
1116     IF(ZMAX == ZMIN)THEN
1117       ICL=1
1118       CALL CPSETI('NCL',ICL)
1119     ELSE
1120     ICL=NINT((ZMAX-ZMIN)/ZINT)
1121     IF(ZMIN + ICL*ZINT <= ZMAX)ICL=ICL+1
1122     CALL CPSETI('NCL',ICL)
1123 !   IF(LCOLAREA .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))CALL CPSETI('NCL',ICL+1)
1124     ENDIF
1125     CALL CPSETI('CLS',0)
1126     ZISO=ZMIN-ZINT
1127     DO I=1,ICL
1128     CALL CPSETI('PAI',I)
1129     CALL CPSETI('AIA',I+1)
1130     CALL CPSETI('AIB',I)
1131     ZISO=ZISO+ZINT
1132     IF(ABS(ZISO)<1.E-20)ZISO=0.
1133     CALL CPSETR('CLV',ZISO)
1134     CALL CPSETR('CLU',1.)
1135     IF(.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))THEN
1136       IF(LBLUSER1)THEN
1137         DO JLBL=1,SIZE(XLBLUSER1)
1138          DO JL=-20,20,1
1139            IF(ZISO == XLBLUSER1(JLBL)*10.**FLOAT(JL))THEN
1140              CALL CPSETR('CLU',3.)
1141              if(nverbia > 0)then
1142              print *,' ISO LABELLE ',ZISO
1143              endif
1144              EXIT
1145            ENDIF
1146          ENDDO
1147         ENDDO
1148       ELSE
1149         IF(.NOT.LABEL1)THEN
1150           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1151         ELSE
1152           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1153         ENDIF
1154       ENDIF
1155     ELSE IF(NSUPER == 2)THEN
1156       IF(LBLUSER2)THEN
1157         DO JLBL=1,SIZE(XLBLUSER2)
1158          DO JL=-20,20,1
1159            IF(ZISO == XLBLUSER2(JLBL)*10.**FLOAT(JL))THEN
1160              CALL CPSETR('CLU',3.)
1161              EXIT
1162            ENDIF
1163          ENDDO
1164         ENDDO
1165       ELSE
1166         IF(.NOT.LABEL1)THEN
1167           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1168         ELSE
1169           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1170         ENDIF
1171       ENDIF
1172     ELSE IF(NSUPER == 3)THEN
1173       IF(LBLUSER3)THEN
1174         DO JLBL=1,SIZE(XLBLUSER3)
1175          DO JL=-20,20,1
1176            IF(ZISO == XLBLUSER3(JLBL)*10.**FLOAT(JL))THEN
1177              CALL CPSETR('CLU',3.)
1178              EXIT
1179            ENDIF
1180          ENDDO
1181         ENDDO
1182       ELSE
1183         IF(.NOT.LABEL1)THEN
1184           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1185         ELSE
1186           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1187         ENDIF
1188       ENDIF
1189     ELSE IF(NSUPER == 4)THEN
1190       IF(LBLUSER4)THEN
1191         DO JLBL=1,SIZE(XLBLUSER4)
1192          DO JL=-20,20,1
1193            IF(ZISO == XLBLUSER4(JLBL)*10.**FLOAT(JL))THEN
1194              CALL CPSETR('CLU',3.)
1195              EXIT
1196            ENDIF
1197          ENDDO
1198         ENDDO
1199       ELSE
1200         IF(.NOT.LABEL1)THEN
1201           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1202         ELSE
1203           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1204         ENDIF
1205       ENDIF
1206     ELSE
1207       IF(.NOT.LABEL1)THEN
1208         IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1209       ELSE
1210         IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1211       ENDIF
1212     ENDIF
1213     ENDDO
1214
1215   CASE(2,3)                            ! Given contour values     
1216     ICL=0
1217     DO I=1,1000
1218       ICL=ICL+1
1219 ! modifs for diachro
1220       IF(NIMNMX==3 .OR. (NIMNMX==2 .AND.LISOLEVP))THEN
1221         ZLEV(ICL)=ZISOLEVP(ICL)
1222         IF(NVERBIA > 5)then
1223           print *,' ** imcou ICL ZLEV ',ICL,ZLEV(ICL)
1224         ENDIF
1225       ELSE  IF (NIMNMX==2 .AND. .NOT.LISOLEVP) THEN 
1226         IF(I == 1 .AND. XISOLEV(1) == 9999.)THEN
1227           print *,' NIMNMX=2 . ABSENCE DE VALEURS DANS XISOLEV='
1228           print *,' RENTREZ LES AU CLAVIER PAR ORDRE CROISSANT ET A RAISON D''1'
1229           print *,' VALEUR PAR LIGNE. TERMINEZ PAR 9999.'
1230           print *,' (REMARQUE : elles ne sont pas memorisees et donc valides pour le seul parametre'
1231           print *,' en cours :',YTEXT(1:LEN_TRIM(YTEXT)),')'
1232         ENDIF
1233         IF(XISOLEV(1) == 9999.)THEN
1234           READ(5,*)ZLEV(ICL)
1235         ELSE
1236           ZLEV(ICL)=XISOLEV(ICL)
1237         ENDIF
1238       ENDIF
1239       IF(ZLEV(ICL) == 9999.)EXIT
1240     ENDDO
1241     IF(NVERBIA > 5) PRINT*,'ICL= ',ICL
1242     ICL=ICL-1
1243     CALL CPSETI('NCL',ICL)
1244 !   IF(LCOLAREA .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))CALL CPSETI('NCL',ICL+1)
1245     CALL CPSETI('CLS',0)
1246     DO I=1,ICL
1247       CALL CPSETI('PAI',I)
1248       CALL CPSETI('AIA',I+1)
1249       CALL CPSETI('AIB',I)
1250       CALL CPSETR('CLV',ZLEV(I))
1251       CALL CPSETR('CLU',1.)
1252       IF(.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))THEN
1253         IF(LBLUSER1)THEN
1254           DO JLBL=1,SIZE(XLBLUSER1)
1255            DO JL=-20,20,1
1256              IF(ZLEV(I) == XLBLUSER1(JLBL)*10.**FLOAT(JL))THEN
1257                CALL CPSETR('CLU',3.)
1258                if(nverbia > 0)then
1259                  print *,' ISO LABELLE ',ZLEV(I)
1260                endif
1261                EXIT
1262              ENDIF
1263            ENDDO
1264           ENDDO
1265         ELSE
1266           IF(.NOT.LABEL1)THEN
1267             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1268           ELSE
1269             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1270           ENDIF
1271         ENDIF
1272       ELSE IF(NSUPER == 2)THEN
1273         IF(LBLUSER2)THEN
1274           DO JLBL=1,SIZE(XLBLUSER2)
1275            DO JL=-20,20,1
1276              IF(ZLEV(I) == XLBLUSER2(JLBL)*10.**FLOAT(JL))THEN
1277                CALL CPSETR('CLU',3.)
1278                EXIT
1279              ENDIF
1280            ENDDO
1281           ENDDO
1282         ELSE
1283           IF(.NOT.LABEL1)THEN
1284             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1285           ELSE
1286             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1287           ENDIF
1288         ENDIF
1289       ELSE IF(NSUPER == 3)THEN
1290         IF(LBLUSER3)THEN
1291           DO JLBL=1,SIZE(XLBLUSER3)
1292            DO JL=-20,20,1
1293              IF(ZLEV(I) == XLBLUSER3(JLBL)*10.**FLOAT(JL))THEN
1294                CALL CPSETR('CLU',3.)
1295                EXIT
1296              ENDIF
1297            ENDDO
1298           ENDDO
1299         ELSE
1300           IF(.NOT.LABEL1)THEN
1301             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1302           ELSE
1303             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1304           ENDIF
1305         ENDIF
1306       ELSE IF(NSUPER == 4)THEN
1307         IF(LBLUSER4)THEN
1308           DO JLBL=1,SIZE(XLBLUSER4)
1309            DO JL=-20,20,1
1310              IF(ZLEV(I) == XLBLUSER4(JLBL)*10.**FLOAT(JL))THEN
1311                CALL CPSETR('CLU',3.)
1312                EXIT
1313              ENDIF
1314            ENDDO
1315           ENDDO
1316         ELSE
1317           IF(.NOT.LABEL1)THEN
1318             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1319           ELSE
1320             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1321           ENDIF
1322         ENDIF
1323       ELSE
1324         IF(.NOT.LABEL1)THEN
1325           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1326         ELSE
1327           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
1328         ENDIF
1329       ENDIF
1330     ENDDO
1331 !
1332 END SELECT
1333 !
1334 !*    2.5    Further Conpack cosmetic parameters
1335 !
1336 SELECT CASE(NIOFFD)
1337   CASE(0)                 !! No label normalisation, decimal point kept
1338     III=8                 !
1339     CALL CPSETI('NEU',III)! 'Numeric exponent use flag'
1340     CALL CPSETI('NOF',7)! 
1341     CALL CPSETI('NET',0)  ! Exponent shown as "E"
1342                           ! III > 0 --> decimal point kept if the number of
1343                           ! significant digits is  << III; else form requiring
1344                           ! the fewest character is used
1345     IF(NSD /= 0)THEN
1346       CALL CPSETI('NSD',-NSD)  ! Nb de digits significatifs
1347     ELSE
1348       CALL CPSETI('NSD',-6)  ! Nb de digits significatifs
1349     ENDIF
1350   CASE DEFAULT            !! Label normalization, exponent to the right 
1351     CALL CPSETI('NEU',-2) ! Exponent notation forced in any case
1352     CALL CPSETI('NOF',7)! 
1353     CALL CPSETI('NET',0)  ! Exponent shown as "E"
1354 END SELECT
1355 !
1356 !*   2.6      Special value handling
1357 !
1358 SELECT CASE(NIOFFP)
1359     
1360   CASE(0)                     ! No special value used
1361     CALL CPSETR('SPV',0.)
1362   CASE DEFAULT                ! XSPVAL used as a special value
1363     CALL CPSETR('SPV',XSPVAL)
1364
1365 END SELECT
1366 !
1367 !*   2.7     Information label under the plot
1368 !
1369 SELECT CASE(NIOFFM)
1370     
1371   CASE(0)                    ! a label is printed under the plot
1372   CASE DEFAULT               ! no label
1373     CALL CPSETC('ILT',' ')
1374
1375 END SELECT
1376
1377 ZTEMV=PTABV
1378 CALL CPSETR('SPV',XSPVAL)
1379 !
1380 !*   2.8      Conpack initialization
1381 !
1382 !-----------------------------------------------------------------------------
1383   IF(LPVT .OR. LPXT .OR. LPYT)THEN
1384     ILMAX=NLMAX
1385     NLMAX=SIZE(PTABV,1)
1386   ENDIF
1387 !-----------------------------------------------------------------------------
1388 IF(NIMNMX <= 0)THEN
1389
1390   ZTEMV2=ZTEMV
1391   IF(.NOT.LPXT .AND. .NOT.LPYT)THEN
1392     IF(LPRESY)THEN
1393 ! En log(P)
1394       WHERE(XZWORKZ(1:NLMAX,1:SIZE(ZTEMV2,2)) < XHMAX+ZDIXEPS)
1395       ZTEMV2=XSPVAL
1396       END WHERE
1397       WHERE(XZWORKZ(1:NLMAX,1:SIZE(ZTEMV2,2)) > XHMIN-ZDIXEPS)
1398       ZTEMV2=XSPVAL
1399       END WHERE
1400     ELSE
1401       WHERE(XZWORKZ(1:NLMAX,1:SIZE(ZTEMV2,2)) > XHMAX+ZDIXEPS)
1402       ZTEMV2=XSPVAL
1403       END WHERE
1404       WHERE(XZWORKZ(1:NLMAX,1:SIZE(ZTEMV2,2)) < XHMIN-ZDIXEPS)
1405       ZTEMV2=XSPVAL
1406       END WHERE
1407     ENDIF
1408   ENDIF
1409
1410 !print *,' ZTEMV2'
1411 !print *,ZTEMV2
1412 !print *,' XHMIN  XHMAX ',XHMIN-ZDIXEPS,XHMAX+ZDIXEPS
1413 !print *,XZWORKZ(1,1:IKU)
1414
1415 if(nverbia > 0)then
1416   print *,' BALISE1 IMCOU'
1417 endif
1418   CALL CPRECT(ZTEMV2,NLMAX,NLMAX,SIZE(ZTEMV2,2),ZRWRK,JPLRWK,IWRK,JPLIWK)
1419 ! CALL CPRECT(ZTEMV2,NLMAX,NLMAX,IKU,ZRWRK,JPLRWK,IWRK,JPLIWK)
1420   CALL CPPKCL(ZTEMV2,ZRWRK,IWRK)
1421   CALL CPGETI('NCL',INCL2)
1422 !Janv 2001
1423 ! print *,' INCL2 ZTEMV2 ',INCL2
1424   IF(ALLOCATED(ZZCLV2))THEN
1425     DEALLOCATE(ZZCLV2)
1426   ENDIF
1427   ALLOCATE(ZZCLV2(INCL2))
1428 !Janv 2001
1429   DO J=1,INCL2
1430     CALL CPSETI('PAI',J)
1431     CALL CPGETR('CLV',ZCLV2)
1432 !Janv 2001
1433 !   PRINT *,' ZCLV2 ',ZCLV2
1434     ZZCLV2(J)=ZCLV2
1435 !Janv 2001
1436     IF(J == 1)ZCLVD=ZCLV2
1437     IF(J == INCL2)ZCLVF=ZCLV2
1438   ENDDO
1439 END IF
1440 !Janv 2001
1441 !print *,' ZCLVD ZCLVF ',ZCLVD,ZCLVF
1442
1443 CALL CPRECT(ZTEMV,NLMAX,NLMAX,SIZE(ZTEMV,2),ZRWRK,JPLRWK,IWRK,JPLIWK)
1444
1445 !CALL CPRECT(ZTEMV,NLMAX,NLMAX,IKU,ZRWRK,JPLRWK,IWRK,JPLIWK)
1446 CALL CPSETR('CWM',XSIZEL/.01)
1447 if(nverbia > 0)then
1448   print *,' BALISE2 IMCOU NLMAX',NLMAX
1449 endif
1450 !-----------------------------------------------------------------------------
1451 IF(LPVT .OR. LPXT .OR. LPYT)THEN
1452   NLMAX=ILMAX
1453 ENDIF
1454 if(nverbia > 0)then
1455   print *,' BALISE3 IMCOU INCL2= ',INCL2
1456 endif
1457 !-----------------------------------------------------------------------------
1458 INCL=0
1459 CALL CPPKCL(ZTEMV,ZRWRK,IWRK)
1460 ! Janv 2001
1461 !CALL CPGETI('NCL',INCL)
1462 IF(LCVZOOM)THEN
1463   IF(NIMNMX <= 0)THEN
1464     CALL CPSETI('CLS',0)
1465     IF(INCL2==0)THEN
1466       CALL CPSETI('NCL',1)
1467     ELSE
1468       CALL CPSETI('NCL',INCL2)
1469     ENDIF
1470     DO J=1,INCL2
1471       CALL CPSETI('PAI',J)
1472       CALL CPSETR('CLV',ZZCLV2(J))
1473     ENDDO
1474   ENDIF
1475 ! DEALLOCATE(ZZCLV2)
1476 ENDIF
1477 CALL CPGETI('NCL',INCL)
1478 ! Janv 2001
1479 if(nverbia > 0)then
1480   print *,' BALISE3a IMCOU LCVZOOM= ',LCVZOOM
1481 endif
1482 !
1483 !*   2.9      High and low handling
1484 !
1485 SELECT CASE(NHI)
1486     
1487   CASE(0)                           ! H + L   are displayed
1488     IF(INCL /= 0)THEN
1489       CALL CPLBDR(ZTEMV,ZRWRK,IWRK)
1490     ENDIF
1491   CASE DEFAULT                      ! TO BE REVISED*********************
1492                                     ! <0  --> no action (:-1 to be set)
1493                                     ! >0  --> gridpoint value displayed
1494                                     !         (1: to be set)
1495 END SELECT
1496 !
1497 !print *,' ZTEMV in IMCOU_FORDIACHRO 2.9'    ! Technical message for developper's need
1498 !!print *,ZTEMV
1499 !*   2.10     Line style and color handling 
1500 !
1501 ! Janv 2001
1502 IF(NIMNMX <= 0)THEN
1503 !IF(NIMNMX < 0)THEN
1504   DO J=1,INCL
1505     CALL CPSETI('PAI',J)
1506     CALL CPSETR('CLU',1.)
1507     CALL CPGETR('CLV',ZISO)
1508     IF(.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))THEN
1509       IF(LBLUSER1)THEN
1510         DO JLBL=1,SIZE(XLBLUSER1)
1511          DO JL=-20,20,1
1512            IF(ZISO == XLBLUSER1(JLBL)*10.**FLOAT(JL))THEN
1513              CALL CPSETR('CLU',3.)
1514              if(nverbia > 0)then
1515                print *,' ISO LABELLE ',ZISO
1516              endif
1517              EXIT
1518            ENDIF
1519          ENDDO
1520         ENDDO
1521       ELSE
1522         IF(.NOT.LABEL1)THEN
1523           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1524         ELSE
1525           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1526         ENDIF
1527       ENDIF
1528     ELSE IF(NSUPER == 2)THEN
1529       IF(LBLUSER2)THEN
1530         DO JLBL=1,SIZE(XLBLUSER2)
1531          DO JL=-20,20,1
1532            IF(ZISO == XLBLUSER2(JLBL)*10.**FLOAT(JL))THEN
1533              CALL CPSETR('CLU',3.)
1534              EXIT
1535            ENDIF
1536          ENDDO
1537         ENDDO
1538       ELSE
1539         IF(.NOT.LABEL1)THEN
1540           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1541         ELSE
1542           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1543         ENDIF
1544       ENDIF
1545     ELSE IF(NSUPER == 3)THEN
1546       IF(LBLUSER3)THEN
1547         DO JLBL=1,SIZE(XLBLUSER3)
1548          DO JL=-20,20,1
1549            IF(ZISO == XLBLUSER3(JLBL)*10.**FLOAT(JL))THEN
1550              CALL CPSETR('CLU',3.)
1551              EXIT
1552            ENDIF
1553          ENDDO
1554         ENDDO
1555       ELSE
1556         IF(.NOT.LABEL1)THEN
1557           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1558         ELSE
1559           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1560         ENDIF
1561       ENDIF
1562     ELSE IF(NSUPER == 4)THEN
1563       IF(LBLUSER4)THEN
1564         DO JLBL=1,SIZE(XLBLUSER4)
1565          DO JL=-20,20,1
1566            IF(ZISO == XLBLUSER4(JLBL)*10.**FLOAT(JL))THEN
1567              CALL CPSETR('CLU',3.)
1568              EXIT
1569            ENDIF
1570          ENDDO
1571         ENDDO
1572       ELSE
1573         IF(.NOT.LABEL1)THEN
1574           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1575         ELSE
1576           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1577         ENDIF
1578       ENDIF
1579     ELSE
1580       IF(.NOT.LABEL1)THEN
1581         IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1582       ELSE
1583         IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1584       ENDIF
1585     ENDIF
1586   ENDDO
1587 END IF
1588
1589 if(nverbia > 0)then
1590   print *,' BALISE3b IMCOU '
1591 endif
1592 SELECT CASE(NDOT)
1593   
1594   CASE(0,1,1023,65535)        ! Solid line
1595       DO J=1,INCL
1596         CALL CPSETI('PAI',J)
1597         CALL CPSETI('CLD',65535)
1598       ENDDO
1599   CASE (:-1)                  !<0 Dashed negative values, 
1600                               !   solid positive values
1601     ICLD=ABS(NDOT)
1602 !     write(0,*)' NDOT',NDOT,' INCL ',INCL
1603       DO J=1,INCL
1604         CALL CPSETI('PAI',J)
1605         CALL CPGETR('CLV',ZCLV)
1606         IF(ZCLV.GE.0.)CALL CPSETI('CLD',65535)
1607         IF(ZCLV.LT.0.)CALL CPSETI('CLD',ICLD)
1608 !         write(0,*)' J ZCLV',J,ZCLV
1609       ENDDO
1610
1611   CASE DEFAULT                ! NDOT used as a dash pattern
1612     ICLD=ABS(NDOT)
1613       DO J=1,INCL
1614         CALL CPSETI('PAI',J)
1615         CALL CPSETI('CLD',ICLD)
1616       ENDDO
1617
1618 END SELECT
1619 !-----------------------------------------------------------------------------
1620 !
1621 ! **************************************************************************
1622 ! Surfaces en hachures ou/et grises; LHACHx=.TRUE. avec x=1 ou 2 ou 3 ou 4)
1623 ! **************************************************************************
1624
1625 IF((LHACH1 .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))) .OR. &
1626    (LHACH2 .AND. NSUPER == 2)                                   .OR. &
1627    (LHACH3 .AND. NSUPER == 3)                                   .OR. &
1628    (LHACH4 .AND. NSUPER == 4))THEN !++++++++++++++++++++++++++++++++++++++++++
1629
1630   IF(NSUPER > 1)THEN
1631     IH=IH+1
1632 !   print *,' IHT IH ',IHT,IH
1633   ENDIF
1634
1635   WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' VALEURS:'
1636   DO J=1,INCL
1637     CALL CPSETI('PAI',J)
1638     CALL CPSETI('AIB',J)
1639     CALL CPSETI('AIA',J+1)
1640     CALL CPGETR('CLV',ZCLV)
1641     ZLEV(J)=ZCLV
1642     CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
1643   ENDDO
1644
1645   IF(.NOT.LHACHSEL)THEN
1646     IF(INCL+1 <= 8)THEN
1647       DO J=1,INCL
1648         IHACH(J)=INDHACHREF(J)
1649       ENDDO
1650       IHACH(INCL+1)=INDHACHREF(8)
1651     ELSE
1652       IHACH(1:2)=INDHACHREF(1:2)
1653       IHACH(3)=INDHACHREF(2)
1654       IHACH(INCL-1:INCL+1)=INDHACHREF(6:8)
1655
1656       IF(INCL+1 < 13)THEN
1657         IHACH(4)=INDHACHREF(3)
1658       ELSE
1659         IHACH(4)=INDHACHREF(2)
1660       ENDIF
1661
1662       IF(INCL+1 == 9)THEN
1663         IHACH(5)=INDHACHREF(4)
1664         IHACH(6)=INDHACHREF(5)
1665       ELSE
1666         IHACH(5)=INDHACHREF(3)
1667         IF(INCL+1 < 13)THEN
1668           IHACH(6)=INDHACHREF(4)
1669         ELSE
1670           IHACH(6)=INDHACHREF(3)
1671         ENDIF
1672       ENDIF
1673
1674       IF(INCL+1 == 10)THEN
1675         IHACH(7)=INDHACHREF(5)
1676       ELSE IF(INCL+1 >= 11 .AND. INCL+1 < 14)THEN
1677         IHACH(7)=INDHACHREF(4)
1678       ELSE IF(INCL+1 >= 14)THEN
1679         IHACH(7)=INDHACHREF(3)
1680       ENDIF
1681
1682       IF(INCL+1 >= 11 .AND. INCL+1 < 13)THEN
1683         IHACH(8)=INDHACHREF(5)
1684       ELSE IF(INCL+1 >= 13)THEN
1685         IHACH(8)=INDHACHREF(4)
1686       ENDIF
1687
1688       IF(INCL+1 >= 12 .AND. INCL+1 < 14)THEN
1689         IHACH(9)=INDHACHREF(5)
1690       ELSE IF(INCL+1 >= 14)THEN
1691         IHACH(9)=INDHACHREF(4)
1692       ENDIF
1693
1694       IF(INCL+1 == 13)THEN
1695         IHACH(10)=INDHACHREF(5)
1696       ELSE IF(INCL+1 >= 14 .AND. INCL+1 < 15)THEN
1697         IHACH(10)=INDHACHREF(5)
1698       ELSE IF(INCL+1 >= 15)THEN
1699         IHACH(10)=INDHACHREF(4)
1700       ENDIF
1701
1702       IF(INCL+1 >= 14)THEN
1703         IHACH(11)=INDHACHREF(5)
1704       ENDIF
1705
1706       IF(INCL+1 >= 15)THEN
1707         IHACH(12)=INDHACHREF(5)
1708       ENDIF
1709
1710       IF(INCL+1 == 16)THEN
1711         IHACH(13)=INDHACHREF(5)
1712       ENDIF
1713     ENDIF
1714
1715   ELSE
1716
1717     DO J=1,300
1718       IHACH(J)=0
1719     ENDDO
1720     WRITE(NLUOUT,*)' >>>>>>>SELECTION DES GRISES ET HACHURES PAR L''UTILISATEUR'
1721     WRITE(NLUOUT,*)' >>>>>>>VOUS DEVEZ FOURNIR ',INCL+1,' INDICES'
1722     WRITE(NLUOUT,*)' Rentrez sur 1 premiere ligne le nombre d''indices fournis dans la ligne suivante'
1723     WRITE(NLUOUT,*)' Puis sur la(es) ligne(s) suivante(s) les indices des grises ou hachures' 
1724     WRITE(NLUOUT,*)' pris dans la table de reference (de grises ou hachures)'
1725     WRITE(NLUOUT,*)' correspondant aux isocontours ranges par ordre croissant'
1726     WRITE(NLUOUT,*)' (Entiers separes par 1 blanc)'
1727     READ(5,*,END=10)INBC
1728     GO TO 11
1729     10 CONTINUE
1730     CLOSE(5)
1731     CALL GETENV("VARTTY",YCAR20)
1732     YCAR20=ADJUSTL(YCAR20)
1733     OPEN(5,FILE=YCAR20)
1734     print *,' INTERACTIF : Entrez le nombre d indices '
1735     READ(5,*)INBC
1736     11 CONTINUE
1737     WRITE(YCAR80,*)INBC
1738     !WRITE(NDIR,'(A80)')YCAR80
1739     CALL WRITEDIR(NDIR,YCAR80)
1740 #ifdef RHODES
1741     CALL FLUSH(NDIR,ISTAF)
1742 #else
1743     CALL FLUSH(NDIR)
1744 #endif
1745     READ(5,*,END=12)(IHACH(J),J=1,INBC)
1746     GO TO 13
1747     12 CONTINUE
1748     CLOSE(5)
1749     CALL GETENV("VARTTY",YCAR20)
1750     YCAR20=ADJUSTL(YCAR20)
1751     OPEN(5,FILE=YCAR20)
1752     print *,' INTERACTIF : Entrez la valeur des indices '
1753     READ(5,*)(IHACH(J),J=1,INBC)
1754     13 CONTINUE
1755 !    WRITE(YCAR160,*)IHACH(1:INBC)
1756 !    YCAR160=ADJUSTL(YCAR160)
1757 !    IF(LEN_TRIM(YCAR160) > 80 .OR. INBC > 20)THEN
1758      IF(INBC > 20)THEN
1759 !Juillet 99
1760 !      WRITE(YCAR80,'(20I4)')IHACH(1:INBC/2)
1761 !     WRITE(YCAR80,*)IHACH(1:INBC/2)
1762       !WRITE(NDIR,'(A80)')YCAR80
1763       CALL WRITEDIR(NDIR,IHACH(1:INBC/2))
1764 !      WRITE(YCAR80,'(20I4)')IHACH(INBC/2+1:INBC)
1765 !     WRITE(YCAR80,*)IHACH(INBC/2+1:INBC)
1766       !WRITE(NDIR,'(A80)')YCAR80
1767       CALL WRITEDIR(NDIR,IHACH(INBC/2+1:INBC))
1768 #ifdef RHODES
1769     CALL FLUSH(NDIR,ISTAF)
1770 #else
1771     CALL FLUSH(NDIR)
1772 #endif
1773     ELSE
1774  !     WRITE(YCAR80,'(20I4)')IHACH(1:INBC)
1775 !     WRITE(YCAR80,*)IHACH(1:INBC)
1776       !WRITE(NDIR,'(A80)')YCAR80
1777       CALL WRITEDIR(NDIR,IHACH(1:INBC))
1778 #ifdef RHODES
1779     CALL FLUSH(NDIR,ISTAF)
1780 #else
1781     CALL FLUSH(NDIR)
1782 #endif
1783     ENDIF
1784   ENDIF
1785
1786   IF(LCOLZERO)THEN
1787     IHACH(NCOLZERO)=0
1788   ENDIF
1789   WRITE(NLUOUT,*)(ZLEV(J),IHACH(J),J=1,INCL)
1790   WRITE(NLUOUT,*)IHACH(INCL+1)
1791
1792 ! Trace des zones hachurees
1793     CALL GSFAIS(1)
1794     CALL GSLN(1)
1795 !   CALL GSFACI(1)
1796     CALL GSPLCI(1)
1797     CALL ARINAM(IIMAP,JPMAP)
1798     CALL CPCLAM(ZTEMV,ZRWRK,IWRK,IIMAP)
1799     CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,SFILLH)
1800     print *,' Hach: MAP 1 6 5 ',IIMAP(1),IIMAP(6),IIMAP(5)
1801     CALL GSFAIS(0)
1802 !
1803 ! Trace des valeurs
1804
1805     CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1806     CALL GSFAIS(1)
1807     CALL LBSETI('CBL',1)
1808 !   CALL LBSETI('CBL',0)
1809     DO J=1,INCL
1810       YLLBS(J)=ADJUSTL(YLLBS(J))
1811     ENDDO
1812     IF(NIMNMX <= 0)THEN
1813       DO J=1,INCL
1814         IF(ZLEV(J).GT.ZCLVD)EXIT
1815       ENDDO
1816       JJD=MAX(1,J-1)
1817       DO J=INCL,1,-1
1818         IF(ZLEV(J).LE.ZCLVF)EXIT
1819       ENDDO
1820       JJF=MIN(INCL,J)
1821       INCL2=JJF-JJD+1
1822     ENDIF
1823     IF(.NOT.LSUPER .OR. NSUPER == 1)THEN
1824       IF(ZVR < .8999999)THEN
1825         print *,' ZVR < .9 ',ZVR
1826         IF(NIMNMX <= 0)THEN
1827           CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(ZVR+.2,1.)-ZVR)/10.,MIN(ZVR+.2,1.),&
1828           ZVB,ZVT,INCL2+1,.15,1.,IHACH(JJD:JJF+1),2,YLLBS(JJD:JJF),INCL2,1)
1829         ELSE
1830           CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(ZVR+.2,1.)-ZVR)/10.,MIN(ZVR+.2,1.),ZVB,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,1)
1831         ENDIF
1832       ELSE
1833         IF(INCL <= 8)THEN
1834           print *,' INCL <= 8 ',INCL
1835           IF(NIMNMX <= 0)THEN
1836             CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB+(ZVT-ZVB)/4.,ZVT,&
1837             INCL2+1,.15,1.,IHACH(JJD:JJF+1),2,YLLBS(JJD:JJF),INCL2,1)
1838           ELSE
1839             CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB+(ZVT-ZVB)/4.,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,1)
1840           ENDIF
1841         ELSE
1842           print *,' INCL > 8 ',INCL
1843           IF(NIMNMX <= 0)THEN
1844             CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL2+1,.15,1.,IHACH(JJD:JJF+1),2,YLLBS(JJD:JJF),INCL2,1)
1845           ELSE
1846             CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,1)
1847           ENDIF
1848         ENDIF
1849       ENDIF
1850
1851     ELSE
1852
1853 !      IF(NSUPERDIA > 2)THEN
1854 !        ZVERA=ZVR-(ZVR-ZVL)/4.
1855 !      ELSE
1856 !        ZVERA=ZVR-(ZVR-ZVL)/3.
1857 !      ENDIF
1858 !      ZINTE=(ZVERA-ZVLDEF)/FLOAT(IHT)
1859 !      IF(IHT == 1)THEN
1860 !       ZD=ZVL; ZF=ZVERA
1861 !      ELSE IF(IHT == 2 .OR. IHT == 3)THEN
1862 !       ZD=ZVLDEF+ZINTE*(IH-1)
1863 !       ZF=ZVLDEF+ZINTE*(IH)-.01
1864 !      ENDIF
1865       IF(NSUPERDIA > 2)THEN
1866         ZVLDEF=.05
1867         ZINTE=.26
1868       ELSE
1869         ZVLDEF=.1
1870         ZINTE=.40
1871       ENDIF
1872       ZD=ZVLDEF+ZINTE*(NSUPER-2)
1873       ZF=ZD+ZINTE-.02
1874       IF(NIMNMX <= 0)THEN
1875         IF(INCL2 == 1)THEN
1876           ZF=ZF-(ZF-ZD)/2.
1877         ELSE IF(INCL2 <= 4)THEN
1878           ZF=ZF-(ZF-ZD)/4.
1879         ENDIF
1880       ELSE
1881         IF(INCL == 1)THEN
1882           ZF=ZF-(ZF-ZD)/2.
1883         ELSE IF(INCL <= 4)THEN
1884           ZF=ZF-(ZF-ZD)/4.
1885         ENDIF
1886       ENDIF
1887       IF(NIMNMX <= 0)THEN
1888         CALL LBLBAR_FORDIACHRO(0,ZD,ZF,ZVT+.01,ZVT+.04,INCL2+1,1.,.33,IHACH(JJD:JJF+1),2,YLLBS(JJD:JJF),INCL2,2)
1889       ELSE
1890         CALL LBLBAR_FORDIACHRO(0,ZD,ZF,ZVT+.01,ZVT+.04,INCL+1,1.,.33,IHACH,2,YLLBS,INCL,2)
1891       ENDIF
1892     ENDIF
1893
1894     CALL GSFAIS(0)
1895 !
1896 ! Definition de la couleur des isos (0 -> blanc sur papier; 1 -> noir sur papier)
1897     IF(LISOWHI)CALL GSPLCI(0)
1898     IF(LISOWHI)CALL GSTXCI(0)
1899
1900 !
1901 !
1902 ELSE IF(LCOLAREA)THEN        !+++++++++++++++++++++++++++++++++++++++++++++++++
1903
1904 ! **************************************************************************
1905 ! Surfaces couleur (reservees aux dessins avec ou sans superpositions; LCOLAREA=.TRUE.)
1906 ! **************************************************************************
1907
1908   IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN        !00000000000000000000000000000000000000000000
1909
1910 ! Selection automatique des couleurs par le programme
1911 ! ***************************************************
1912     IF(.NOT.LCOLAREASEL)THEN     !====================================
1913        CALL COLOR_FORDIACHRO(INCL+1,1)
1914        WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' VALEURS:'
1915        DO J=1,INCL
1916          CALL CPSETI('PAI',J)
1917          CALL CPSETI('AIB',J)
1918          CALL CPSETI('AIA',J+1)
1919          CALL CPGETR('CLV',ZCLV)
1920          ZLEV(J)=ZCLV
1921          ICOL(J)=J+2
1922          CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
1923          if(nverbia >5)then
1924            print *,' J ZLEV(J) ICOL(J) A ',J,ZLEV(J),ICOL(J)
1925          endif
1926        ENDDO
1927        ICOL(INCL+1)=INCL+3
1928        if(nverbia >0)then
1929          print *,' ICOL(INCL+1) A ',ICOL(INCL+1),' LCOLBR ',LCOLBR
1930          print *,' LCOLZERO NCOLZERO ',LCOLZERO,NCOLZERO
1931        endif
1932        IF(LCOLBR)THEN
1933          IF(ZLEV(MAX(1,INCL)) > ZLEV(1) .AND. ICOL(INCL+1) > ICOL(1))THEN
1934            ALLOCATE(ICOL2(INCL+1))
1935            if(nverbia >0)then
1936              print *,' APRES ALLOCATE(ICOL2) '
1937            endif
1938            ICOL2(1:INCL+1)=ICOL(INCL+1:1:-1)
1939            ICOL(1:INCL+1)=ICOL2
1940 !          ICOL(:)=ICOL2
1941            if(nverbia >0)then
1942              print *,' AVANT DEALLOCATE(ICOL2) '
1943            endif
1944            DEALLOCATE(ICOL2)
1945          END IF
1946        END IF
1947        if(nverbia >0)then
1948          print *,' LCOLZERO NCOLZERO ',LCOLZERO,NCOLZERO
1949        endif
1950        IF(LCOLZERO)THEN
1951          ICOL(NCOLZERO)=0
1952        ENDIF
1953        if(nverbia >0)then
1954          print *,' **imcou NLUOUT ',NLUOUT
1955        endif
1956        WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
1957        WRITE(NLUOUT,*)ICOL(INCL+1)
1958     ELSE                         !====================================
1959
1960 ! Selection des couleurs par l'utilisateur
1961 ! ****************************************
1962
1963        IF(LTABCOLDEF)THEN
1964        ! Choix de la table de couleurs par defaut
1965          WRITE(NLUOUT,*)' <<< TABCOLDEF >>>'
1966          CALL TABCOL_FORDIACHRO
1967        ELSE
1968        ! Choix d'une table creee par l'utilisateur
1969          CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
1970          IF(IRESP == -54)THEN
1971            YNAMTABCOL(1:32)=' '
1972            print *,' Entrez le nom de VOTRE TABLE de COULEURS '
1973 ! Lecture du nom de la table de couleurs (1 seule fois)
1974            READ(5,*,END=14)YNAMTABCOL
1975     GO TO 15
1976     14 CONTINUE
1977     CLOSE(5)
1978     CALL GETENV("VARTTY",YCAR20)
1979     YCAR20=ADJUSTL(YCAR20)
1980     OPEN(5,FILE=YCAR20)
1981     print *,' INTERACTIF : Entrez le nom de VOTRE TABLE de COULEURS'
1982     READ(5,*)YNAMTABCOL
1983     15 CONTINUE
1984            YNAMTABCOL=ADJUSTL(YNAMTABCOL)
1985            !WRITE(NDIR,'(A80)')YNAMTABCOL
1986            CALL WRITEDIR(NDIR,YNAMTABCOL)
1987 #ifdef RHODES
1988     CALL FLUSH(NDIR,ISTAF)
1989 #else
1990     CALL FLUSH(NDIR)
1991 #endif
1992 ! Janv 2001
1993            CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
1994            IF(IRESP /= 0)THEN
1995 ! Janv 2001
1996            CALL CREATLINK('DIRCOL',YNAMTABCOL,'CREAT',NVERBIA)
1997            CALL FMATTR(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
1998            OPEN(UNIT=ILUCOL,FILE=YNAMTABCOL,FORM='FORMATTED')
1999 ! Janv 2001
2000            ENDIF
2001 ! Janv 2001
2002          END IF
2003
2004          WRITE(NLUOUT,*)' <<< ',YNAMTABCOL,' >>>'
2005          REWIND (ILUCOL)
2006          CALL GQOPS(ISTA)
2007          CALL GQACWK(1,IER,INB,IWK)
2008 !print *,' COLOR_FORDIACHRO AP GQACWK INB IWK ',INB,IWK
2009          CALL GQOPWK(1,IER,INB,IWK)
2010 ! Lecture du nb de couleurs de la table, des index de couleur et des
2011 ! proportions relatives de rouge, vert, bleu
2012          READ(ILUCOL,*)INBCT
2013          DO J=1,INBCT
2014            READ(ILUCOL,*)IDX,RED,GREEN,BLUE
2015            DO JU=1,INB
2016            CALL GQOPWK(JU,IER,INBB,IWK)
2017            IF(IWK == 9)THEN
2018              CYCLE
2019            ELSE
2020              CALL GSCR(IWK,IDX,RED,GREEN,BLUE)
2021 !          CALL GSCR(1,IDX,RED,GREEN,BLUE)
2022            ENDIF
2023            ENDDO
2024          ENDDO
2025        ENDIF
2026        WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' VALEURS:'
2027        DO J=1,INCL
2028          CALL CPSETI('PAI',J)
2029          CALL CPSETI('AIB',J)
2030          CALL CPSETI('AIA',J+1)
2031          CALL CPGETR('CLV',ZCLV)
2032          ZLEV(J)=ZCLV
2033          if(nverbia >5)then
2034            print *,' J ZLEV(J) B ',J,ZLEV(J)
2035          endif
2036          CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
2037        ENDDO
2038        DO J=1,300
2039          ICOL(J)=0
2040        ENDDO
2041 ! Pour 1 dessin donne, lecture du nb d'indices de couleurs et de leur valeur
2042 ! sur la ligne suivante
2043        READ(5,*,END=16)INBC
2044     GO TO 17
2045     16 CONTINUE
2046     CLOSE(5)
2047     CALL GETENV("VARTTY",YCAR20)
2048     YCAR20=ADJUSTL(YCAR20)
2049     OPEN(5,FILE=YCAR20)
2050     print *,' INTERACTIF : Entrez le nb d indices de couleur'
2051     READ(5,*)INBC
2052     17 CONTINUE
2053       ! WRITE(YCAR80,*)INBC
2054        !WRITE(NDIR,'(A80)')YCAR80
2055        CALL WRITEDIR(NDIR,INBC)
2056 #ifdef RHODES
2057     CALL FLUSH(NDIR,ISTAF)
2058 #else
2059     CALL FLUSH(NDIR)
2060 #endif
2061        READ(5,*,END=18)(ICOL(J),J=1,INBC)
2062     GO TO 19
2063     18 CONTINUE
2064     CLOSE(5)
2065     CALL GETENV("VARTTY",YCAR20)
2066     YCAR20=ADJUSTL(YCAR20)
2067     OPEN(5,FILE=YCAR20)
2068     print *,' INTERACTIF : Entrez la valeur des indices de couleur'
2069     READ(5,*)(ICOL(J),J=1,INBC)
2070     19 CONTINUE
2071 !       WRITE(YCAR160,*) ICOL(1:INBC)
2072 !       YCAR160=ADJUSTL(YCAR160)
2073 !       IF(LEN_TRIM(YCAR160) > 80 .OR. INBC > 20)THEN
2074         IF(INBC > 20)THEN
2075 ! Juillet 99
2076        !  WRITE(YCAR80,'(20I4)')ICOL(1:INBC/2)
2077 !        WRITE(YCAR80,*)ICOL(1:INBC/2)
2078          !WRITE(NDIR,'(A80)')YCAR80
2079          CALL WRITEDIR(NDIR,ICOL(1:INBC/2))
2080         ! WRITE(YCAR80,'(20I4)')ICOL(INBC/2+1:INBC)
2081 !        WRITE(YCAR80,*)ICOL(INBC/2+1:INBC)
2082          !WRITE(NDIR,'(A80)')YCAR80
2083          CALL WRITEDIR(NDIR,ICOL(INBC/2+1:INBC))
2084 #ifdef RHODES
2085     CALL FLUSH(NDIR,ISTAF)
2086 #else
2087     CALL FLUSH(NDIR)
2088 #endif
2089        ELSE
2090 ! Juillet 99
2091        !  WRITE(YCAR80,'(20I4)')ICOL(1:INBC)
2092 !        WRITE(YCAR80,*)ICOL(1:INBC)
2093          !WRITE(NDIR,'(A80)')YCAR80
2094          CALL WRITEDIR(NDIR,ICOL(1:INBC))
2095 #ifdef RHODES
2096     CALL FLUSH(NDIR,ISTAF)
2097 #else
2098     CALL FLUSH(NDIR)
2099 #endif
2100        ENDIF
2101        WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
2102        WRITE(NLUOUT,*)ICOL(INCL+1)
2103 ! fin de la selection des couleurs par l'utilisateur
2104     ENDIF                        !====================================
2105 !
2106 ! Trace des zones colorees
2107 !*************************
2108     IF(LMARKER .AND. .NOT. LSPOT)THEN
2109     ! en etoiles colorees
2110       !IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT .AND. .NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
2111       IF(.NOT.LPYT .AND. .NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
2112       CALL GSMK(3)  ! asterisk is the type of marker
2113       DO JJ=1,SIZE(ZTEMV,2)
2114       DO JI=1,SIZE(ZTEMV,1)
2115         IF(ZTEMV(JI,JJ) /= XSPVAL)THEN
2116           IF(ZTEMV(JI,JJ) < ZLEV(1))THEN
2117             CALL GSPMCI(ICOL(1))
2118           ELSE IF(ZTEMV(JI,JJ) >= ZLEV(INCL))THEN
2119             CALL GSPMCI(ICOL(INCL+1))
2120           ELSE
2121             DO J=1,INCL-1
2122               IF(ZTEMV(JI,JJ) >= ZLEV(J) .AND. &
2123                  ZTEMV(JI,JJ) < ZLEV(J+1))THEN
2124                 CALL GSPMCI(ICOL(J+1))
2125                 EXIT
2126               ENDIF
2127             ENDDO
2128           ENDIF
2129           ZX=XZZDS(JI)
2130           ZY=XZWORKZ(JI,JJ)
2131           CALL GPM(1,ZX,ZY)
2132         ENDIF
2133       ENDDO
2134       ENDDO
2135       ELSE
2136         print *,'pas de LMARKER teste pour ce type de tracĂ© (PYT, 2D vert //X ou 2D vert //Y)'
2137         print *,'essayer en modifiant le test IF(.NOT.LPVT... dans imcou_fordiachro'
2138       ENDIF
2139
2140     ELSE IF (LSPOT .AND. .NOT. LMARKER) THEN
2141     ! en paves de couleur
2142       !IF(.NOT.LPVT .AND. .NOT.LPXT .AND. .NOT.LPYT .AND. .NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
2143       IF(.NOT.LPYT .AND. .NOT.LCVXZ .AND. .NOT.LCVYZ)THEN
2144       CALL  GSFAIS(1)  ! solid filling of the polygon
2145       IND=SIZE(ZTEMV,1)
2146       ZEPX=(XZZDS(IND/2+1)-XZZDS(IND/2))*0.5
2147       print *,'LSPOT: contour du pave en noir ?'
2148       print *,'       (o/O/y/Y recommande pour trace d observations '
2149       print *,'        epaisseur du contour gere avec XLW1)'
2150       read(5,*) YREP
2151       CALL WRITEDIR(NDIR,YREP)
2152       IF(YREP=='o' .OR. YREP=='O' .OR. YREP=='y' .OR. YREP=='Y') THEN
2153         ! contour en trait plein noir
2154         CALL DASHDB(65535)
2155       END IF
2156       DO JJ=1,SIZE(ZTEMV,2)-1
2157       DO JI=1,SIZE(ZTEMV,1)
2158         IF (JJ==1) THEN
2159           ZEPYD= XZWORKZ(JI,JJ) - ZWZ(JI+1) ! ZWZ(1:NLMAX+2)
2160         ELSE
2161           ZEPYD=XZWORKZ(JI,JJ) - (XZWORKZ(JI,JJ)+XZWORKZ(JI,JJ-1))*0.5
2162         ENDIF
2163         IF (JJ==SIZE(ZTEMV,2)-1) THEN
2164           ZEPYU=0
2165         ELSE
2166           ZEPYU=(XZWORKZ(JI,JJ+1)+XZWORKZ(JI,JJ))*0.5 - XZWORKZ(JI,JJ)
2167         ENDIF
2168         IF(ZTEMV(JI,JJ) /= XSPVAL)THEN
2169           IF(ZTEMV(JI,JJ) < ZLEV(1))THEN
2170             CALL GSFACI(ICOL(1))
2171           ELSE IF(ZTEMV(JI,JJ) >= ZLEV(INCL))THEN
2172             CALL GSFACI(ICOL(INCL+1))
2173           ELSE
2174             DO J=1,INCL-1
2175               IF(ZTEMV(JI,JJ) >= ZLEV(J) .AND. &
2176                  ZTEMV(JI,JJ) < ZLEV(J+1))THEN
2177                 CALL GSFACI(ICOL(J+1))
2178                 EXIT
2179               ENDIF
2180             ENDDO
2181           ENDIF
2182           ZX5(1)=XZZDS(JI)-ZEPX ; ZY5(1)=XZWORKZ(JI,JJ)-ZEPYD
2183           ZX5(2)=XZZDS(JI)-ZEPX ; ZY5(2)=XZWORKZ(JI,JJ)+ZEPYU
2184           ZX5(3)=XZZDS(JI)+ZEPX ; ZY5(3)=XZWORKZ(JI,JJ)+ZEPYU
2185           ZX5(4)=XZZDS(JI)+ZEPX ; ZY5(4)=XZWORKZ(JI,JJ)-ZEPYD
2186           ZX5(5)=XZZDS(JI)-ZEPX ; ZY5(5)=XZWORKZ(JI,JJ)-ZEPYD
2187           ! paves
2188           CALL GFA(5,ZX5,ZY5)
2189           IF(YREP=='o' .OR. YREP=='O' .OR. YREP=='y' .OR. YREP=='Y') THEN
2190             ! contour
2191             CALL GQLWSC(IER,ZWIDTH)
2192             CALL GSLWSC(XLWIDTH)
2193             CALL CURVED(ZX5,ZY5,5)
2194             CALL GSLWSC(ZWIDTH)
2195           ENDIF
2196         ENDIF
2197       ENDDO
2198       ENDDO
2199       ELSE
2200         print *,'pas de LSPOT teste pour ce type de tracĂ© (PYT, 2D vert //X ou 2D vert //Y)'
2201         print *,'essayer en modifiant le test IF(.NOT.LPVT... dans imcou_fordiachro'
2202       ENDIF
2203     ELSE
2204     ! Trace des surfaces colorees
2205     CALL GSFAIS(1)
2206     CALL ARINAM(IIMAP,JPMAP)
2207     CALL CPCLAM(ZTEMV,ZRWRK,IWRK,IIMAP)
2208     CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,CCOLR)
2209     print *,' Col: MAP 1 6 5 ',IIMAP(1),IIMAP(6),IIMAP(5)
2210     CALL GSPLCI(1)
2211     CALL GSFAIS(0)
2212 !   CALL GSLN(1)
2213     ENDIF
2214     ! Trace de la palette de couleurs (legende)
2215     CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2216     CALL GSFAIS(1)
2217     CALL LBSETI('CBL',0)
2218     DO J=1,INCL
2219       YLLBS(J)=ADJUSTL(YLLBS(J))
2220     ENDDO
2221     IF(NIMNMX <= 0)THEN
2222       DO J=1,INCL
2223         IF(ZLEV(J).GT.ZCLVD)EXIT
2224       ENDDO
2225       JJD=MAX(1,J-1)
2226       DO J=INCL,1,-1
2227         IF(ZLEV(J).LE.ZCLVF)EXIT
2228       ENDDO
2229       JJF=MIN(INCL,J)
2230       INCL2=JJF-JJD+1
2231 !print *,'ZLEV(1:INCL) ',ZLEV(1:INCL)
2232 !print *,' JJD JJF ZLEV(JJD:JJF) ',ZLEV(JJD:JJF)
2233       CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(1.-ZVR,.2))/10.,1.,ZVB,ZVT,INCL2+1,.15,1.,ICOL(JJD:JJF+1),1,YLLBS(JJD:JJF),INCL2,1)
2234 !     CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL2+1,.15,1.,ICOL(JJD:JJF+1),1,YLLBS(JJD:JJF),INCL2,1)
2235     ELSE
2236       CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(1.-ZVR,.2))/10.,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
2237 !     CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
2238     END IF
2239     CALL GSFAIS(0)
2240 !
2241 ! Definition de la couleur des isos (0 -> blanc sur papier; 1 -> noir sur papier)
2242     IF(LISOWHI)CALL GSPLCI(0)
2243     IF(LISOWHI)CALL GSTXCI(0)
2244 !
2245   ELSE IF(LCOLINE)THEN       !00000000000000000000000000000000000000000000
2246
2247 ! Traits couleur dans le cas de superpositions (LCOLAREA=.TRUE. et LCOLINE=.TRUE.)
2248 ! **************************************************************************
2249 ! Modifs 220396
2250     IF((LSUPER .AND. NSUPER == 1) .OR. .NOT.LSUPER)CALL TABCOL_FORDIACHRO
2251     IF(LSUPER)THEN
2252 !Mars 2000
2253       IF(LCOLISONE)THEN
2254         IF(NSUPER == 1)CALL GSPLCI(NCOLISONE1)
2255         IF(NSUPER == 1)CALL GSTXCI(NCOLISONE1)
2256         IF(NSUPER == 2)CALL GSPLCI(NCOLISONE2)
2257         IF(NSUPER == 2)CALL GSTXCI(NCOLISONE2)
2258         IF(NSUPER == 3)CALL GSPLCI(NCOLISONE3)
2259         IF(NSUPER == 3)CALL GSTXCI(NCOLISONE3)
2260         IF(NSUPER == 4)CALL GSPLCI(NCOLISONE4)
2261         IF(NSUPER == 4)CALL GSTXCI(NCOLISONE4)
2262         IF(NSUPER == 5)CALL GSPLCI(NCOLISONE5)
2263         IF(NSUPER == 5)CALL GSTXCI(NCOLISONE5)
2264       ELSE
2265 !Mars 2000
2266       IF(NSUPER == 1)CALL GSPLCI(2)
2267       IF(NSUPER == 1)CALL GSTXCI(2)
2268       IF(NSUPER == 2)CALL GSPLCI(4)
2269       IF(NSUPER == 2)CALL GSTXCI(4)
2270       IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==2)CALL GSPLCI(2)
2271       IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==2)CALL GSTXCI(2)
2272       IF(NSUPER == 3)CALL GSPLCI(3)
2273       IF(NSUPER == 3)CALL GSTXCI(3)
2274       IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==3)CALL GSPLCI(4)
2275       IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==3)CALL GSTXCI(4)
2276       IF(NSUPER == 4)CALL GSPLCI(7)
2277       IF(NSUPER == 4)CALL GSTXCI(7)
2278       IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==4)CALL GSPLCI(3)
2279       IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==4)CALL GSTXCI(3)
2280 !!!!!!!! PROVI
2281 !CALL FRSTPT(XDS(1,NMGRID),XHMIN)
2282 !CALL VECTOR(XDS(1,NMGRID),XHMAX)
2283 !CALL VECTOR(XDS(NLMAX,NMGRID),XHMAX)
2284 !CALL VECTOR(XDS(NLMAX,NMGRID),XHMIN)
2285 !CALL VECTOR(XDS(1,NMGRID),XHMIN)
2286 !!!!!!!! PROVI
2287 !Mars 2000
2288       ENDIF
2289 !Mars 2000
2290     END IF
2291   ELSE                       !00000000000000000000000000000000000000000000
2292
2293 ! Traits noir et blanc dans le cas de superpositions (LCOLAREA=.TRUE. et LCOLINE=.FALSE.)
2294 ! ********************************************************************************
2295 if(nverbia > 0)then
2296   print *,' BALISE3c IMCOU '
2297 endif
2298
2299     CALL GSPLCI(1)
2300     CALL GSLN(1)
2301     IF(LSUPER)THEN
2302       IF(NSUPER == 1)CALL GSLN(1)
2303       IF(NSUPER == 2)CALL GSLN(1)
2304
2305       IF(LINVPTIR)THEN
2306
2307         IF(NSUPER == 3)THEN
2308           CALL GSLN(2)
2309           IF((LCOLAREA.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
2310         ENDIF
2311         IF(NSUPER == 4)CALL GSLN(3)
2312
2313       ELSE
2314
2315         IF(NSUPER == 3)THEN
2316           CALL GSLN(3)
2317           IF((LCOLAREA.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
2318         ENDIF
2319         IF(NSUPER == 4)CALL GSLN(2)
2320
2321       ENDIF
2322
2323     END IF
2324
2325   END IF                     !00000000000000000000000000000000000000000000
2326
2327 ELSE IF( LGREY .AND. .NOT.LCOLAREA )   THEN !++++++++++++++++++++++++++++++
2328 ! **************************************************************
2329 ! Surfaces en grises ( LGREY=.TRUE.)
2330 !  En cas de superpositions, obligatoirement le 1er dessin
2331 ! **************************************************************
2332   IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN        !000000000000000000
2333 !
2334 ! Selection automatique des grises par le programme
2335 ! **************************************************
2336 !
2337   CALL COLOR_FORDIACHRO(INCL+1,2)
2338   WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' VALEURS:'
2339   DO J=1,INCL
2340     CALL CPSETI('PAI',J)
2341     CALL CPSETI('AIB',J)
2342     CALL CPSETI('AIA',J+1)
2343     CALL CPGETR('CLV',ZCLV)
2344     ZLEV(J)=ZCLV
2345     ICOL(J)=J+2
2346     CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
2347   ENDDO
2348   ICOL(INCL+1)=INCL+3
2349        if(nverbia >0)then
2350          print *,' Grey: ICOL(INCL+1) A ',ICOL(INCL+1),' LCOLBR ',LCOLBR
2351        endif
2352   IF(LCOLBR)THEN
2353     IF(ZLEV(MAX(1,INCL)) > ZLEV(1) .AND. ICOL(INCL+1) > ICOL(1))THEN
2354       ALLOCATE(ICOL2(INCL+1))
2355       ICOL2(1:INCL+1)=ICOL(INCL+1:1:-1)
2356       ICOL(1:INCL+1)=ICOL2
2357 !          ICOL(:)=ICOL2
2358       DEALLOCATE(ICOL2)
2359     END IF
2360   END IF
2361        if(nverbia >0)then
2362          print *,' Grey: LCOLZERO NCOLZERO ',LCOLZERO,NCOLZERO
2363        endif
2364   IF(LCOLZERO)THEN
2365     ICOL(NCOLZERO)=0
2366   ENDIF
2367   WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
2368   WRITE(NLUOUT,*)ICOL(INCL+1)
2369   ! Trace des surfaces grisees
2370   CALL GSFAIS(1)
2371   CALL ARINAM(IIMAP,JPMAP)
2372   CALL CPCLAM(ZTEMV,ZRWRK,IWRK,IIMAP)
2373   CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,CCOLR)
2374   print *,' Grey: MAP 1 6 5 ',IIMAP(1),IIMAP(6),IIMAP(5)
2375   CALL GSPLCI(1)
2376   CALL GSFAIS(0)
2377 !   CALL GSLN(1)
2378   ! Trace de la palette de couleurs (legende)
2379   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2380   CALL GSFAIS(1)
2381   CALL LBSETI('CBL',0)
2382   DO J=1,INCL
2383     YLLBS(J)=ADJUSTL(YLLBS(J))
2384   ENDDO
2385   IF(NIMNMX <= 0)THEN
2386     DO J=1,INCL
2387       IF(ZLEV(J).GT.ZCLVD)EXIT
2388     ENDDO
2389     JJD=MAX(1,J-1)
2390     DO J=INCL,1,-1
2391       IF(ZLEV(J).LE.ZCLVF)EXIT
2392     ENDDO
2393     JJF=MIN(INCL,J)
2394     INCL2=JJF-JJD+1
2395     CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(1.-ZVR,.2))/10.,1.,ZVB,ZVT,INCL2+1,.15,1.,ICOL(JJD:JJF+1),1,YLLBS(JJD:JJF),INCL2,1)
2396 !   CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL2+1,.15,1.,ICOL(JJD:JJF+1),1,YLLBS(JJD:JJF),INCL2,1)
2397   ELSE
2398     CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(1.-ZVR,.2))/10.,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
2399 !   CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
2400   ENDIF
2401   CALL GSFAIS(0)
2402 !
2403 ! Definition de la couleur des isos (0 -> blanc sur papier; 1 -> noir sur papier)
2404       IF(LISOWHI)CALL GSPLCI(0)
2405       IF(LISOWHI)CALL GSTXCI(0)
2406   
2407   ELSE IF(LCOLINE)THEN       !00000000000000000000000000000000000000000000
2408
2409 ! Traits couleur dans le cas de superpositions (LGREY=.TRUE. et LCOLINE=.TRUE.)
2410 ! **************************************************************************
2411     CALL TABCOL_FORDIACHRO
2412     IF(LSUPER)THEN
2413 !Mars 2000
2414       IF(LCOLISONE)THEN
2415         IF(NSUPER == 1)CALL GSPLCI(NCOLISONE1)
2416         IF(NSUPER == 1)CALL GSTXCI(NCOLISONE1)
2417         IF(NSUPER == 2)CALL GSPLCI(NCOLISONE2)
2418         IF(NSUPER == 2)CALL GSTXCI(NCOLISONE2)
2419         IF(NSUPER == 3)CALL GSPLCI(NCOLISONE3)
2420         IF(NSUPER == 3)CALL GSTXCI(NCOLISONE3)
2421         IF(NSUPER == 4)CALL GSPLCI(NCOLISONE4)
2422         IF(NSUPER == 4)CALL GSTXCI(NCOLISONE4)
2423         IF(NSUPER == 5)CALL GSPLCI(NCOLISONE5)
2424         IF(NSUPER == 5)CALL GSTXCI(NCOLISONE5)
2425       ELSE
2426 !Mars 2000
2427       IF(NSUPER == 1)CALL GSPLCI(2)
2428       IF(NSUPER == 1)CALL GSTXCI(2)
2429       IF(NSUPER == 2)CALL GSPLCI(4)
2430       IF(NSUPER == 2)CALL GSTXCI(4)
2431       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==2)CALL GSPLCI(2)
2432       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==2)CALL GSTXCI(2)
2433       IF(NSUPER == 3)CALL GSPLCI(3)
2434       IF(NSUPER == 3)CALL GSTXCI(3)
2435       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==3)CALL GSPLCI(4)
2436       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==3)CALL GSTXCI(4)
2437       IF(NSUPER == 4)CALL GSPLCI(7)
2438       IF(NSUPER == 4)CALL GSTXCI(7)
2439       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==4)CALL GSPLCI(3)
2440       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==4)CALL GSTXCI(3)
2441 !!!!!!!! PROVI
2442 !CALL FRSTPT(XDS(1,NMGRID),XHMIN)
2443 !CALL VECTOR(XDS(1,NMGRID),XHMAX)
2444 !CALL VECTOR(XDS(NLMAX,NMGRID),XHMAX)
2445 !CALL VECTOR(XDS(NLMAX,NMGRID),XHMIN)
2446 !CALL VECTOR(XDS(1,NMGRID),XHMIN)
2447 !!!!!!!! PROVI
2448 !Mars 2000
2449       ENDIF
2450 !Mars 2000
2451     END IF
2452
2453   ELSE                       !00000000000000000000000000000000000000000000
2454
2455 ! Traits noir et blanc dans le cas de superpositions (LGREY=.TRUE. et LCOLINE=.FALSE.)
2456 ! ********************************************************************************
2457
2458     CALL GSPLCI(1)
2459     CALL GSLN(1)
2460     IF(LSUPER)THEN
2461       IF(NSUPER == 1)CALL GSLN(1)
2462       IF(NSUPER == 2)CALL GSLN(1)
2463
2464       IF(LINVPTIR)THEN
2465
2466         IF(NSUPER == 3)THEN
2467           CALL GSLN(2)
2468           IF((LGREY.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
2469         ENDIF
2470         IF(NSUPER == 4)CALL GSLN(3)
2471
2472       ELSE
2473
2474         IF(NSUPER == 3)THEN
2475           CALL GSLN(3)
2476           IF((LGREY.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
2477         ENDIF
2478         IF(NSUPER == 4)CALL GSLN(2)
2479
2480       ENDIF
2481
2482     END IF
2483
2484   END IF                     !00000000000000000000000000000000000000000000
2485 !
2486
2487 ELSE IF(LCOLINE)THEN    !+++++++++++++++++++++++++++++++++++++++++++++++++++++
2488 ! **********************************************
2489 ! Traits couleur   (LCOLAREA=.FALSE. et LCOLINE=.TRUE.)
2490 ! **********************************************
2491
2492 ! Cas de superpositions
2493 ! *********************
2494 ! Modifs 220395=6
2495   CALL TABCOL_FORDIACHRO
2496 !   IF((LSUPER .AND. NSUPER == 1) .OR. .NOT.LSUPER)CALL TABCOL_FORDIACHRO
2497 ! Modifs 270198
2498 ! IF(LSUPER)THEN             !............................................
2499   IF(LSUPER .AND. &          !............................................
2500     !.NOT.((LHACH1.OR.LHACH2) .AND. NSUPERDIA == 2))THEN
2501      .NOT.((LHACH1.OR.LHACH2) .AND. NSUPERDIA == 2) .AND. &
2502      .NOT.( LARROVL .AND. NSUPERDIA == 2          )       )THEN
2503
2504 !Mars 2000
2505       IF(LCOLISONE)THEN
2506         IF(NSUPER == 1)CALL GSPLCI(NCOLISONE1)
2507         IF(NSUPER == 1)CALL GSTXCI(NCOLISONE1)
2508         IF(NSUPER == 2)CALL GSPLCI(NCOLISONE2)
2509         IF(NSUPER == 2)CALL GSTXCI(NCOLISONE2)
2510         IF(NSUPER == 3)CALL GSPLCI(NCOLISONE3)
2511         IF(NSUPER == 3)CALL GSTXCI(NCOLISONE3)
2512         IF(NSUPER == 4)CALL GSPLCI(NCOLISONE4)
2513         IF(NSUPER == 4)CALL GSTXCI(NCOLISONE4)
2514         IF(NSUPER == 5)CALL GSPLCI(NCOLISONE5)
2515         IF(NSUPER == 5)CALL GSTXCI(NCOLISONE5)
2516       ELSE
2517 !Mars 2000
2518
2519     IF(NSUPER == 1)CALL GSPLCI(2)
2520     IF(NSUPER == 1)CALL GSTXCI(2)
2521     IF(NSUPER == 2)CALL GSPLCI(4)
2522     IF(NSUPER == 2)CALL GSTXCI(4)
2523     IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==2)CALL GSPLCI(2)
2524     IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==2)CALL GSTXCI(2)
2525     IF(NSUPER == 3)CALL GSPLCI(3)
2526     IF(NSUPER == 3)CALL GSTXCI(3)
2527     IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==3)CALL GSPLCI(4)
2528     IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==3)CALL GSTXCI(4)
2529     IF(NSUPER == 4)CALL GSPLCI(7)
2530     IF(NSUPER == 4)CALL GSTXCI(7)
2531     IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==4)CALL GSPLCI(3)
2532     IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==4)CALL GSTXCI(3)
2533   
2534 !Mars 2000
2535       ENDIF
2536 !Mars 2000
2537   ELSE                       !............................................
2538 ! Pas de superpositions
2539 ! *********************
2540
2541 ! Selection automatique des couleurs par le programme
2542 ! ***************************************************
2543
2544     IF(.NOT.LCOLINESEL)THEN      !::::::::::::::::::::::::::::::::::::
2545
2546 !Mars 2000
2547        IF(LCOLISONE)THEN
2548          ICOL(1:INCL)=NCOLISONE1
2549        DO J=1,INCL
2550          CALL CPSETI('PAI',J)
2551          CALL CPSETI('CLC',ICOL(J))
2552          CALL CPGETR('CLV',ZCLV)
2553          ZLEV(J)=ZCLV
2554        ENDDO
2555        WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' COULEUR UNIQUE : ',ICOL(1)
2556        WRITE(NLUOUT,*)(ZLEV(J),J=1,INCL)
2557        ELSE
2558 !Mars 2000
2559
2560        CALL COLOR_FORDIACHRO(INCL,1)
2561        WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' VALEURS:'
2562        DO J=1,INCL
2563          CALL CPSETI('PAI',J)
2564          CALL CPGETR('CLV',ZCLV)
2565          ZLEV(J)=ZCLV
2566          ICOL(J)=J+2
2567          if(nverbia > 5)then
2568            print *,' J ZLEV(J) ICOL(J) C ',J,ZLEV(J),ICOL(J)
2569          endif
2570          CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
2571        ENDDO
2572        IF(LCOLBR)THEN
2573          IF(ZLEV(MAX(1,INCL)) > ZLEV(1) .AND. ICOL(INCL) > ICOL(1))THEN
2574            ALLOCATE(ICOL2(INCL))
2575            ICOL2(1:INCL)=ICOL(INCL:1:-1)
2576            ICOL(1:INCL)=ICOL2
2577 !          ICOL(:)=ICOL2
2578            DEALLOCATE(ICOL2)
2579          END IF
2580        END IF
2581        WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
2582        DO J=1,INCL
2583          CALL CPSETI('PAI',J)
2584          CALL CPSETI('CLC',ICOL(J))
2585        ENDDO
2586 !Mars 2000
2587      ENDIF
2588 !Mars 2000
2589
2590     ELSE                         !::::::::::::::::::::::::::::::::::::
2591
2592 ! Selection des couleurs par l'utilisateur
2593 ! ****************************************
2594
2595 ! Choix de la table de couleurs par defaut
2596 ! ****************************************
2597
2598        IF(LTABCOLDEF)THEN
2599          WRITE(NLUOUT,*)' <<< TABCOLDEF >>>'
2600          CALL TABCOL_FORDIACHRO
2601
2602        ELSE
2603
2604 ! Choix d'une table creee par l'utilisateur
2605 ! *****************************************
2606
2607          CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
2608          IF(IRESP == -54)THEN
2609            YNAMTABCOL(1:32)=' '
2610 ! Lecture du nom de la table de couleurs (1 seule fois)
2611            print *,' Entrez le nom de VOTRE TABLE de COULEURS '
2612            READ(5,*,END=20)YNAMTABCOL
2613     GO TO 21
2614     20 CONTINUE
2615     CLOSE(5)
2616     CALL GETENV("VARTTY",YCAR20)
2617     YCAR20=ADJUSTL(YCAR20)
2618     OPEN(5,FILE=YCAR20)
2619     print *,' INTERACTIF : Entrez le nom de VOTRE TABLE de COULEURS'
2620     READ(5,*)YNAMTABCOL
2621     21 CONTINUE
2622            YNAMTABCOL=ADJUSTL(YNAMTABCOL)
2623            !WRITE(NDIR,'(A80)')YNAMTABCOL
2624            CALL WRITEDIR(NDIR,YNAMTABCOL)
2625 #ifdef RHODES
2626     CALL FLUSH(NDIR,ISTAF)
2627 #else
2628     CALL FLUSH(NDIR)
2629 #endif
2630 ! Janv 2001
2631            CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
2632            IF(IRESP /= 0)THEN
2633 ! Janv 2001
2634            CALL CREATLINK('DIRCOL',YNAMTABCOL,'CREAT',NVERBIA)
2635            CALL FMATTR(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
2636            OPEN(UNIT=ILUCOL,FILE=YNAMTABCOL,FORM='FORMATTED')
2637 ! Janv 2001
2638            ENDIF
2639 ! Janv 2001
2640          END IF
2641          WRITE(NLUOUT,*)' <<< ',YNAMTABCOL,' >>>'
2642          REWIND (ILUCOL)
2643          CALL GQOPS(ISTA)
2644          CALL GQACWK(1,IER,INB,IWK)
2645 !print *,' COLOR_FORDIACHRO AP GQACWK INB IWK ',INB,IWK
2646          CALL GQOPWK(1,IER,INB,IWK)
2647 ! Lecture du nb de couleurs de la table, des index de couleur et des
2648 ! proportions relatives de rouge, vert, bleu
2649          READ(ILUCOL,*)INBCT
2650          DO J=1,INBCT
2651            READ(ILUCOL,*)IDX,RED,GREEN,BLUE
2652            DO JU=1,INB
2653            CALL GQOPWK(JU,IER,INBB,IWK)
2654            IF(IWK == 9)THEN
2655              CYCLE
2656            ELSE
2657              CALL GSCR(IWK,IDX,RED,GREEN,BLUE)
2658 !          CALL GSCR(1,IDX,RED,GREEN,BLUE)
2659            ENDIF
2660            ENDDO
2661          ENDDO
2662        END IF
2663 ! Pour 1 dessin donne, lecture du nb d'indices de couleurs et de leur valeur
2664 ! sur la ligne suivante
2665          DO J=1,300
2666            ICOL(J)=1
2667          ENDDO
2668          READ(5,*,END=22)INBC
2669     GO TO 23
2670     22 CONTINUE
2671     CLOSE(5)
2672     CALL GETENV("VARTTY",YCAR20)
2673     YCAR20=ADJUSTL(YCAR20)
2674     OPEN(5,FILE=YCAR20)
2675     print *,' INTERACTIF : Entrez le nb d indices de couleur'
2676     READ(5,*)INBC
2677     23 CONTINUE
2678          !WRITE(YCAR80,*)INBC
2679          !WRITE(NDIR,'(A80)')YCAR80
2680          CALL WRITEDIR(NDIR,INBC)
2681 #ifdef RHODES
2682     CALL FLUSH(NDIR,ISTAF)
2683 #else
2684     CALL FLUSH(NDIR)
2685 #endif
2686          READ(5,*,END=24)(ICOL(J),J=1,INBC)
2687     GO TO 25
2688     24 CONTINUE
2689     CLOSE(5)
2690     CALL GETENV("VARTTY",YCAR20)
2691     YCAR20=ADJUSTL(YCAR20)
2692     OPEN(5,FILE=YCAR20)
2693     print *,' INTERACTIF : Entrez la valeur des indices de couleur'
2694     READ(5,*)(ICOL(J),J=1,INBC)
2695     25 CONTINUE
2696 !         WRITE(YCAR160,*)ICOL(1:INBC)
2697 !         YCAR160=ADJUSTL(YCAR160)
2698 !         IF(LEN_TRIM(YCAR160) > 80 .OR. INBC > 20)THEN
2699           IF(INBC > 20)THEN
2700
2701 ! Juillet 99
2702          !  WRITE(YCAR80,'(20I4)')ICOL(1:INBC/2)
2703 !          WRITE(YCAR80,*)ICOL(1:INBC/2)
2704            !WRITE(NDIR,'(A80)')YCAR80
2705            CALL WRITEDIR(NDIR,ICOL(1:INBC/2))
2706            !WRITE(YCAR80,'(20I4)')ICOL(INBC/2+1:INBC)
2707 !          WRITE(YCAR80,*)ICOL(INBC/2+1:INBC)
2708            !WRITE(NDIR,'(A80)')YCAR80
2709            CALL WRITEDIR(NDIR,ICOL(INBC/2+1:INBC))
2710 #ifdef RHODES
2711     CALL FLUSH(NDIR,ISTAF)
2712 #else
2713     CALL FLUSH(NDIR)
2714 #endif
2715          ELSE
2716           ! WRITE(YCAR80,'(20I4)')ICOL(1:INBC)
2717 !          WRITE(YCAR80,*)ICOL(1:INBC)
2718            !WRITE(NDIR,'(A80)')YCAR80
2719            CALL WRITEDIR(NDIR,ICOL(1:INBC))
2720 #ifdef RHODES
2721     CALL FLUSH(NDIR,ISTAF)
2722 #else
2723     CALL FLUSH(NDIR)
2724 #endif
2725          ENDIF
2726          DO J=1,INCL
2727            CALL CPSETI('PAI',J)
2728            CALL CPSETI('CLC',ICOL(J))
2729            CALL CPGETR('CLV',ZCLV)
2730            ZLEV(J)=ZCLV
2731            if(nverbia > 5)then
2732              print *,' J ZLEV(J) ICOL(J) D ',J,ZLEV(J),ICOL(J)
2733            endif
2734            CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
2735          ENDDO
2736          WRITE(NLUOUT,*)' >>>>>>>IMCOU_FORDIACHRO VARIABLE : ',HTEXT,' NB ISOC. : ',INCL,' VALEURS:'
2737          WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
2738
2739     END IF                       !::::::::::::::::::::::::::::::::::::
2740
2741 !Mars 2000
2742        IF(LCOLISONE)THEN
2743        ELSE
2744 !Mars 2000
2745        CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2746        CALL GSFAIS(0)
2747        CALL SETUSV('MI',1)
2748        CALL SET(ZVR,1.,ZVB,ZVT,ZVR,1.,ZVB,ZVT,1)
2749        IF(NIMNMX <= 0)THEN
2750          DO J=1,INCL
2751            IF(ZLEV(J).GE.ZCLVD)EXIT
2752          ENDDO
2753          JJD=MAX(1,J)
2754          DO J=INCL,1,-1
2755            IF(ZLEV(J).LE.ZCLVF)EXIT
2756          ENDDO
2757          JJF=MIN(INCL,J)
2758          INCL2=JJF-JJD+1
2759          IF(INCL2 <= 1)THEN
2760            ZINTERV=0.
2761          ELSE
2762            ZINTERV=(ZVT-ZVB-.009)/(INCL2-1)
2763          ENDIF
2764          CALL GSCLIP(0)
2765          DO J=JJD,JJF
2766            YLLBS(J)=ADJUSTL(YLLBS(J))
2767            CALL GSPLCI(ICOL(J))
2768            CALL GSTXCI(ICOL(J))
2769            if(nverbia > 0)then
2770              print *,' BALISE3d IMCOU '
2771            endif
2772            IF(ZVR < .9 .AND. INCL < 25)THEN
2773              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.015,0.,-1.)
2774            ELSEIF (ZVR < .9 .AND. INCL < 30 .AND. INCL >= 25)THEN
2775              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.012,0.,-1.)
2776            ELSEIF (ZVR >= .95 )THEN
2777              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.007,0.,-1.)
2778            ELSE
2779              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.009,0.,-1.)
2780            ENDIF
2781 !          CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.007,0.,-1.)
2782          ENDDO
2783          CALL GSCLIP(1)
2784        ELSE
2785          IF(INCL <= 1)THEN
2786            ZINTERV=0.
2787          ELSE
2788            ZINTERV=(ZVT-ZVB-.009)/(INCL-1)
2789          ENDIF
2790          CALL GSCLIP(0)
2791            if(nverbia > 0)then
2792              print *,' BALISE3e IMCOU '
2793            endif
2794          DO J=1,INCL
2795            YLLBS(J)=ADJUSTL(YLLBS(J))
2796            CALL GSPLCI(ICOL(J))
2797            CALL GSTXCI(ICOL(J))
2798
2799            IF(ZVR < .9 .AND. INCL < 25)THEN
2800              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.015,0.,-1.)
2801            ELSEIF (ZVR < .9 .AND. INCL < 30 .AND. INCL >= 25)THEN
2802              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.012,0.,-1.)
2803            ELSEIF (ZVR >= .95 )THEN
2804              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.007,0.,-1.)
2805            ELSE
2806              CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.009,0.,-1.)
2807            ENDIF
2808 !          CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.007,0.,-1.)
2809          ENDDO
2810          CALL GSCLIP(1)
2811        END IF
2812        CALL SETUSV('MI',IMI)
2813        CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2814 !Mars 2000
2815       ENDIF
2816 !Mars 2000
2817        CALL GSTXCI(1)
2818        CALL GSPLCI(1)
2819        
2820
2821   END IF                     !............................................
2822
2823 ELSE                    !+++++++++++++++++++++++++++++++++++++++++++++++++++++
2824 if(nverbia > 0)then
2825   print *,' BALISE3f IMCOU'
2826 endif
2827
2828 !***************************************************
2829 ! Traits noir et blanc (LCOLAREA=.FALSE. et LCOLINE=.FALSE.)
2830 !***************************************************
2831
2832   CALL GSPLCI(1)
2833
2834   IF(LSUPER)THEN                   !!!  Overlay case
2835
2836
2837     IF(NSUPER == 1)THEN            ! If first plot of an overlay: default 
2838       CALL GSLN(1)                 ! Line is solid
2839
2840     ELSE                           ! If subsequent plots of an overlay: default
2841       
2842       IF(LINVPTIR)THEN
2843
2844         IF(NSUPER ==2)CALL GSLN(2)    ! line is a special dash type
2845         IF((LARROVL .OR. (LCOLAREA .OR. LHACH1)) .AND. NSUPER ==2)CALL GSLN(1)
2846         IF(NSUPER ==3)CALL GSLN(3)
2847         IF((LARROVL .OR. (LCOLAREA .OR. LHACH1)) .AND. NSUPER ==3)THEN
2848           CALL GSLN(1)
2849           CALL GSLN(2)
2850           IF(LHACH2)CALL GSLN(1)
2851         ENDIF
2852
2853       ELSE
2854
2855         IF(NSUPER ==2)CALL GSLN(3)    ! line is a special dash type
2856         IF((LARROVL .OR. (LCOLAREA .OR. LHACH1)) .AND. NSUPER ==2)CALL GSLN(1)
2857         IF(NSUPER ==3)CALL GSLN(2)
2858         IF((LARROVL .OR. (LCOLAREA .OR. LHACH1)) .AND. NSUPER ==3)THEN
2859           CALL GSLN(1)
2860           CALL GSLN(3)
2861           IF(LHACH2)CALL GSLN(1)
2862         ENDIF
2863
2864       ENDIF
2865
2866     END IF
2867
2868   END IF                           !!!  Not an overlay case
2869 !
2870 END IF                  !+++++++++++++++++++++++++++++++++++++++++++++++++++++
2871 if(nverbia > 0)then
2872   print *,' BALISE3g IMCOU'
2873 endif
2874 !
2875 !*      2.11 High and low handling
2876 !
2877 SELECT CASE(NHI)
2878     
2879 CASE(0)                          ! H + L ara displayed
2880     IF(INCL /=0)THEN
2881       CALL CPLBDR(ZTEMV,ZRWRK,IWRK)
2882     ENDIF
2883 CASE DEFAULT                     ! TO BE REVISED ********************
2884                                  ! <0  --> no action (:-1 to be set)
2885                                  ! >0  --> gridpoint value displayed (1: to be set)
2886 END SELECT
2887     
2888 !
2889 !*      2.12      Effective contour drawing, perimeter box, grid and labels
2890 !
2891 IF((LCOLAREA .AND. .NOT.LISO .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))&
2892    .OR.(LHACH1 .AND. .NOT.LISO .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))&
2893    .OR. (LHACH2 .AND. .NOT.LISO .AND. NSUPER == 2) &
2894    .OR. (LHACH3 .AND. .NOT.LISO .AND. NSUPER == 3) &
2895    .OR. (LHACH4 .AND. .NOT.LISO .AND. NSUPER == 4))THEN
2896 if(nverbia > 0)then
2897   print *,' BALISE3ha IMCOU'
2898 endif
2899
2900 ELSE
2901
2902 if(nverbia > 0)then
2903   print *,' BALISE3h IMCOU XLWIDTH ',XLWIDTH
2904 endif
2905   CALL GSLWSC(XLWIDTH)
2906 if(nverbia > 0)then
2907   print *,' BALISE3ha IMCOU APXLWIDTH '
2908 endif
2909   IF(NSUPER == 2 .AND. LISOWHI2)THEN
2910     CALL GSLN(1)
2911     CALL GSPLCI(0)
2912     CALL GSTXCI(0)
2913   ELSE IF(NSUPER == 3 .AND. LISOWHI3)THEN
2914     CALL GSLN(1)
2915     CALL GSPLCI(0)
2916     CALL GSTXCI(0)
2917   ENDIF
2918 if(nverbia > 0)then
2919   print *,' BALISE3ha IMCOU AV CPCLDR '
2920 endif
2921   CALL CPCLDR(ZTEMV,ZRWRK,IWRK)
2922 if(nverbia > 0)then
2923   print *,' BALISE3hb IMCOU AP CPCLDR '
2924 endif
2925 END IF
2926 IF((NSUPER == 2 .AND. LISOWHI2) .OR. (NSUPER == 3 .AND. LISOWHI3))THEN
2927 ! CALL GSPLCI(1)
2928   CALL GSTXCI(1)
2929 ENDIF
2930 if(nverbia > 0)then
2931   print *,' BALISE3I IMCOU INCL',INCL
2932 endif
2933 IF(INCL == 0)THEN
2934   CALL CPLBDR(ZTEMV,ZRWRK,IWRK)
2935 ENDIF
2936 IF(nverbia > 0)THEN
2937   print *,' **IMCOU AV GETSET'
2938 endif
2939 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2940 CALL SETUSV('MI',1)
2941 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
2942 IF((LHACH1 .AND. NSUPER == 1) .OR. (LHACH2 .AND. NSUPER == 2) .OR. &
2943    (LHACH3 .AND. NSUPER == 3) .OR. (LHACH4 .AND. NSUPER == 4))THEN
2944 ELSE
2945   IF(LSUPER .AND. NSUPER > 1)THEN
2946   IF((LCOLAREA .AND. NSUPER > 1) .OR. &
2947      (.NOT.LCOLAREA  .AND. &
2948       .NOT.((LHACH1.OR.LHACH2) .AND. NSUPERDIA == 2)))THEN
2949     ILENT=LEN_TRIM(HTEXT)+2
2950     IF(LPVT)THEN
2951       IF(NSUPERDIA >= 2 .AND. (LHACH2.OR.LHACH3))THEN
2952         CALL FRSTPT(.1+(NSUPER-2)*.24,ZVT+.036)
2953         CALL VECTOR(.1+(NSUPER-2)*.24+.03,ZVT+.036)
2954       ELSE
2955         CALL FRSTPT(.1+(NSUPER-2)*.24,ZVT+.016)
2956         CALL VECTOR(.1+(NSUPER-2)*.24+.03,ZVT+.016)
2957       ENDIF
2958     ELSE
2959       CALL GSLWSC(XLWIDTH)
2960       IF(NSUPERDIA >= 2 .AND. (LHACH2.OR.LHACH3))THEN
2961         CALL FRSTPT(.1+(NSUPER-2)*.24+ILENT*.009,ZVT+.05)
2962         CALL VECTOR(.1+(NSUPER-2)*.24+ILENT*.009+.03,ZVT+.05)
2963       ELSE
2964         CALL FRSTPT(.1+(NSUPER-2)*.24+ILENT*.009,ZVT+.03)
2965         CALL VECTOR(.1+(NSUPER-2)*.24+ILENT*.009+.03,ZVT+.03)
2966       ENDIF
2967     ENDIF
2968   ENDIF
2969   ENDIF
2970 ENDIF
2971
2972 CALL SETUSV('MI',IMI)
2973 !IF(LPRESY)THEN
2974 ! CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,2)
2975  if(nverbia > 0)then
2976   print *,' ** imcou vers FIN ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,2,ID ',ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID
2977  endif
2978 !ELSE
2979   CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2980 !ENDIF
2981 CALL GSLWSC(1.)
2982 CALL GSLN(1)
2983 CALL GSPLCI(1)
2984 CALL GSTXCI(1)
2985 !
2986 CALL GSCLIP(0)
2987 CALL GASETI('LTY',1)
2988 ! Mai 2000 Abscisses tps en heures si LHEURX=T
2989 IF(LPVT .AND. LHEURX)THEN
2990 ! CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL/3600.,ZWR/3600.,ZWB,ZWT,ID)
2991   FORMAX='          '
2992   IF(LFMTAXEX)THEN
2993     FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
2994   ELSE
2995     FORMAX='(F8.0)'
2996   ENDIF
2997   FORMAY='          '
2998   IF(LFMTAXEY)THEN
2999     FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
3000   ELSE
3001     FORMAY='(F7.0)'
3002   ENDIF
3003   CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
3004 ! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
3005 ! CALL LABMOD('(F8.0)','(F7.0)',0,0,10,10,0,0,0)
3006 !!!!!!!Avril 2002
3007   IF(LMYHEURX)THEN
3008     ZH=NHEURXGRAD*3600.
3009   ELSE
3010 !!!!!!!Avril 2002
3011
3012   IF((ZWR-ZWL)/3600. > 24.)THEN
3013     ZH=10800.
3014   ELSE
3015     ZH=3600.
3016   ENDIF
3017 !!!!!!!Avril 2002
3018   ENDIF
3019 !!!!!!!Avril 2002
3020
3021 ! CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
3022   DO J=INT(ZWL),INT(ZWR)
3023     ZJ=J
3024 !!!!!!!Avril 2002
3025   IF(LMYHEURX)THEN
3026     ZJJ=ZJ/ZH*NHEURXGRAD
3027     ZINTT=NHEURXLBL
3028   ELSE
3029 !!!!!!!Avril 2002
3030
3031       IF(ZH == 10800.)THEN
3032         ZJJ=ZJ/ZH*3.
3033         ZINTT=6.
3034       ELSE
3035         ZJJ=ZJ/ZH
3036         ZINTT=3.
3037       ENDIF
3038 !!!!!!!Avril 2002
3039   ENDIF
3040 !!!!!!!Avril 2002
3041 !!!! Mars 2009 pour labels = hhHmm .besoin fournir les extremes sous
3042 !!!! Mars 2009 forme reelle avec OBLIG. 2 decimales pour minutes ex 9.45
3043 !!!! Mars 2009 pour eviter superposition ticks differents
3044   IF(LHEURX .AND. LAXEXUSER .AND. LNOLABELX)THEN
3045   ELSE
3046 !!!! Mars 2009 pour eviter superposition ticks differents
3047     IF(MOD(ZJ,ZH) == 0.)THEN
3048       CALL FRSTPT(ZJ,ZWB)
3049       IF(LPRESY)THEN
3050         CALL VECTOR(ZJ,ZWB+(ZWT-ZWB)/60.)
3051       ELSE
3052         IF(MOD(ZJJ,ZINTT) == 0.)THEN
3053           CALL VECTOR(ZJ,ZWB+(ZWT-ZWB)/90.)
3054           if(nverbia > 0)then
3055             print *,' Ap VECTOR A IMCOU'
3056           endif
3057         ELSE
3058           CALL VECTOR(ZJ,ZWB+(ZWT-ZWB)/120.)
3059           if(nverbia > 0)then
3060             print *,' Ap VECTOR B IMCOU'
3061           endif
3062         ENDIF
3063       ENDIF
3064 !!!! Mars 2009
3065   ENDIF
3066 !!!! Mars 2009
3067  if(nverbia > 0)then
3068   print *,' ** imcou vers FIN ZJ ZJJ ZINT ',ZJ,ZJJ,ZINTT
3069  endif
3070
3071       ZWBBB=ZWB-((ZWT-ZWB)/((ZVT-ZVB)/.02))
3072       IF(LPRESY)THEN
3073         ZWBBB=ZWB-((ZWT-ZWB)/((ZVT-ZVB)/.05))
3074       ENDIF
3075       IF(.NOT.LNOLABELX)THEN
3076       IF(MOD(ZJJ,ZINTT) == 0.)THEN
3077         IF(ZJJ < 10.)THEN
3078           YC2='  '
3079           WRITE(YC2,'(F2.0)')ZJJ
3080           CALL PLCHHQ(ZJ,ZWBBB,YC2,.010,0.,0.)
3081         ELSEIF(ZJJ < 100.)THEN
3082           YC3='   '
3083           WRITE(YC3,'(F3.0)')ZJJ
3084           CALL PLCHHQ(ZJ,ZWBBB,YC3,.010,0.,0.)
3085         ELSE
3086           YC4='    '
3087           WRITE(YC4,'(F4.0)')ZJJ
3088           CALL PLCHHQ(ZJ,ZWBBB,YC4,.010,0.,0.)
3089         ENDIF
3090       ENDIF
3091       ENDIF
3092     ENDIF
3093   ENDDO
3094 ! Mars 2001
3095   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWLL,ZWRR,ZWBB,ZWTT,IDD)
3096   IF(LFACTAXEX)THEN
3097     IF(LFACTAXEY)THEN
3098       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL*XFACTAXEX,ZWRR*XFACTAXEX,&
3099                ZWBB*XFACTAXEY,ZWTT*XFACTAXEY,IDD)
3100     ELSE
3101       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL*XFACTAXEX,ZWRR*XFACTAXEX,&
3102                ZWBB,ZWTT,IDD)
3103     ENDIF
3104   ELSEIF(LFACTAXEY)THEN
3105       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL,ZWRR,&
3106                ZWBB*XFACTAXEY,ZWTT*XFACTAXEY,IDD)
3107   ELSEIF(LAXEXUSER)THEN
3108     IF(LAXEYUSER)THEN
3109       CALL SET(ZVL,ZVR,ZVB,ZVT,XAXEXUSERD,XAXEXUSERF,&
3110                XAXEYUSERD,XAXEYUSERF,IDD)
3111     ELSE
3112       CALL SET(ZVL,ZVR,ZVB,ZVT,XAXEXUSERD,XAXEXUSERF,&
3113                ZWBB,ZWTT,IDD)
3114     ENDIF
3115   ELSEIF(LAXEYUSER)THEN
3116       CALL SET(ZVL,ZVR,ZVB,ZVT,ZWLL,ZWRR,&
3117                XAXEYUSERD,XAXEYUSERF,IDD)
3118   ENDIF
3119 ! Mars 2001
3120   IF(LPRESY)THEN
3121     CALL AXELOGPRES(XHMIN,XHMAX)
3122     CALL GRIDAL(0,0,0,0,0,0,5,0.,0.)
3123 !   CALL GRIDAL(0,0,1,9,0,1,5,0.,0.)
3124  if(nverbia > 0)then