Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / image_fordiachro.f90
1 !     ######spl
2       SUBROUTINE IMAGE_FORDIACHRO(PTAB,KLREF,PTABINT,KNHI,KNDOT,HTEXTE)
3 !     #################################################################
4 !
5 !!****  *IMAGE_FORDIACHRO* - Isoncontour plots manager for horizontal 
6 !!                           cross-sections
7 !!
8 !!    PURPOSE
9 !!    -------
10 !       Calls the NCAR contour routines and defines the display environment
11 !    for the horizontal cross-section case
12 !
13 !!**  METHOD
14 !!    ------
15 !!      First, the field is checked for extrema, and the plot geometry is
16 !!   generated, drawing a cartographic stencil and the continental/state 
17 !!   outlines when required by the 'LCARTESIAN' parameters. Next, NCAR 
18 !!   variables are set according to the user requests, and  contours are 
19 !!   drawn by a call to Conpack utilities (CPRECT/CPCLDR). If a 'Z' section
20 !!   is requested, the topography outlines are examined to mask the contours 
21 !!   where map altitude intercepts terrain.
22 !!
23 !!     Notice that a TRACE-provided CPMPXY routine is used within the NCAR
24 !!   Conpack call to map the contoured array matrix onto the stretched model 
25 !!   cartographic space. The plotted data are NOT interpolated onto a regular 
26 !!   grid before plotting, instead a coordinate stretching technique is used.
27 !!   Basically, the contour calculation are made in a "grid index space"
28 !!   where the meshsize is uniform and equal to 1 between successive model 
29 !!   points (this corresponds to the x_hat_* and y_hat_* coordinates of the
30 !!   Meso-NH technical specification book, page 41). In this "grid index space"
31 !!   contourlines points are located by two floating-point index coordinates 
32 !!   vaying between 1 and the corresponding array dimension. This "grid index"
33 !!   coordinates are latter converted back to screen coordinates by CPMPXY to 
34 !!   obtain a correct display.  
35 !!
36 !!    EXTERNAL
37 !!    --------
38 !!      GMNMX     : computes min, max and contour increment for current field
39 !!      BCGRD     : when a cartographic projection applies, defines displayed
40 !!                  window and draws the continent/state outlines
41 !!      DEFENETRE : when cartesian geometry applies, defines the display window
42 !!      TRACEXY   : draws the model gridpont stencil as a dashline overlay
43 !!
44 !!      CPSETI !                                          INTEGER   !
45 !!      CPSETR !  : sets the value of a NCAR parameter,   REEL      !
46 !!      CPSETC !                                          CHARACTER ! NCAR
47 !!                                                                  !
48 !!      CPGETI !                                          INTEGER   !
49 !!      CPGETR !  : gets the value of a NCAR parameter,   REEL      !
50 !!      CPGETC !                                          CHARACTER !
51 !!                                                                  !
52 !!      CPRECT    : Conpack initialization                          !
53 !!      CPPKCL    : contour level selection                         !
54 !!      CPCLDR    : draws contours                                  ! Routines
55 !!      GSLWSC    : sets line width                                 !
56 !!                                                                  !
57 !!      ARINAM    : initialize the contour calculation as a subset  !
58 !!                  of areas, which may be adressed individually to !
59 !!                  modify their display characteristics (used for  !
60 !!                  topography masking here).                       ! 
61 !!      ARSCAM    : scans the plotting domain and defines the       !
62 !!                  different areas, then performs the processing   !
63 !!                  defined in the SFILL routine (here, hatch fill) ! 
64 !!      CPCLAM    : adds contour in a  previously defined area      ! NCAR
65 !!                                                                  ! 
66 !!      SET       : defines the display window in normalized and    !
67 !!                  user NCAR coordinates                           !
68 !!      GETSET    : retrieves the normalized and user NCAR          !
69 !!                  coordinates of a previously used window         ! Routines
70 !!      PLCHHQ    : prints high-quality character strings           !
71 !!      GSCLIP    : clips items getting out of the drawing window   !
72 !!
73 !!      CPMPXY    : TRACE provided FORTRAN-77 routine directly called
74 !!                  within CONPACK to map the array space onto the
75 !!                  cartographic space
76 !!      SFILL     : TRACE provided FORTAN-77 routine directly called 
77 !!                  CONPACK to define the hatched area used to locate
78 !!                  points  where the plot level intercepts topography
79 !!
80 !!    IMPLICIT ARGUMENTS
81 !!    ------------------
82 !!
83 !!      Module MODD_TITLE  : Declares heading variables for the plots (TRACE)
84 !!         NCONT  :  Current plot number
85 !!         CLEGEND:  Current plot heading title
86 !!
87 !!      Module MODD_COORD  : declares gridpoint coordinates (TRACE use)
88 !!       XXX,XXY  : coordinate values for all the MESO-NH grids
89 !!       XXZS     : topography values for all the MESO_NH grids
90 !!
91 !!      Module MODD_CONF   : declares configuration variables of all models 
92 !!       LCARTESIAN: Logical for cartesian geometry :
93 !!                   .TRUE.  = cartesian geometry
94 !!                   .FALSE. = conformal projection
95 !!
96 !!      Module MODD_NMGRID  : declares global variable  NMGRID
97 !!         NMGRID    : Current MESO-NH grid indicator
98 !!
99 !!      Module MODN_PARA   : defines NAM_DOMAIN_POS namelist
100 !!         LHORIZ    : must be .TRUE. to perform horizontal cross esctions
101 !!         LVERTI    : must be .FALSE. to perform horizontal cross sections
102 !!         Module MODD_DIM1   : Contains dimensions
103 !!            NIMAX, NJMAX :  x, and y array dimensions
104 !!            NIINF, NISUP :  Lower and upper array bounds in x direction
105 !!            NJINF, NJSUP :  Lower bound and upper bound  in y direction
106 !!
107 !!      Module MODN_NCAR : defines NAM_DIRTRA_POS namelist
108 !!                         (former NCAR common)
109 !!        NIOFFD     : Label normalisation (=0 none, =/=0 active)
110 !!        NULBLL     : Nb of contours between 2 labelled contours
111 !!        NIOFFM     : =0    --> message at picture bottom
112 !!                     =/= 0 --> no message
113 !!        NIOFFP     : Special point value detection
114 !!                    (=0 none, =/=0 active)
115 !!        CTYPHOR    : Horizontal cross-section type
116 !!                     (='K' --> model level section;
117 !!                      ='Z' --> constant-altitude section;
118 !!                      ='P' --> isobar section (planned)
119 !!                      ='T' --> isentrope section (planned)
120 !!        XSPVAL     : Special value
121 !!        XSIZEL     : Label size
122 !!        LXY        : If =.TRUE., plots  a grid-mesh stencil background
123 !!
124 !!      Module MODD_OUT       : Defines a log. unit for printing
125 !!        NIMAXT : x-size of the displayed section of the model array
126 !!        NJMAXT : y-size of the displayed section of the model array
127 !!
128 !!      Module MODD_SUPER   : defines plot overlay control variables
129 !!         LSUPER   : =.TRUE. --> plot overlay is active
130 !!                    =.FALSE. --> plot overlay is not active
131 !!         NSUPER   : Rank of the current plot in the overlay
132 !!                    sequence. The initial plot is rank 1.
133 !!
134 !!
135 !!    REFERENCE
136 !!    ---------
137 !!
138 !!      MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
139 !!       + Book1: Concepts and Fundamentals, to appear in 1994;
140 !!       + Book2: Technical Reference and Flowcharts, to appear in 1994;
141 !!       + Book3: Tutorial, November 1994.
142 !!
143 !!    AUTHOR
144 !!    ------
145 !!
146 !!      J. Duron    * Laboratoire d'Aerologie *
147 !!
148 !!    MODIFICATIONS
149 !!    -------------
150 !!      Original       06/06/94
151 !!      Updated   PM   06/12/94
152 !-------------------------------------------------------------------------------
153 !
154 !*       0.    DECLARATIONS
155 !              ------------
156 !
157 #ifdef NAGf95
158 USE F90_UNIX  ! for FLUSH and GETENV
159 #endif
160
161 USE MODD_TITLE
162 USE MODD_MASK3D
163 USE MODD_COORD
164 USE MODD_NMGRID
165 USE MODD_CONF
166 USE MODN_PARA
167 USE MODN_NCAR
168 USE MODD_TIME
169 USE MODD_TIME1
170 USE MODD_OUT
171 USE MODD_SUPER
172 USE MODD_LUNIT1
173 USE MODD_RESOLVCAR
174 USE MODD_HACH
175 USE MODD_TIT
176 USE MODD_ALLOC_FORDIACHRO
177 USE MODD_PT_FOR_CH_FORDIACHRO
178 USE MODI_READMNMXINT_ISO
179 USE MODI_READREFINT_ISO
180 USE MODI_READXISOLEVP
181 USE MODD_CTL_AXES_AND_STYL
182 USE MODD_RSISOCOL
183 !
184 USE MODI_CREATLINK
185 USE MODI_WRITEDIR
186 !
187 IMPLICIT NONE
188 !
189 !        0.0   TRACE interface with the "CPMPXY" routine of the NCAR package
190 !
191 ! NOTICE:  The CPMPXY and the NCAR graphical utilities are NOT written
192 ! ------   in Fortran 90, but in Fortran 77.. This sub-section of TRACE 
193 !          does not follow the Meso-NH usual rules: it has to be made using 
194 !          a COMMON stack with  static memory allocation of XZZXX and
195 !          XZZXY arrays.
196 !
197 COMMON/TEMH/XZZXX,XZZXY,NIIMAX,NIJMAX
198 COMMON/LOGI/LVERT,LHOR,LPT,LXABS
199 COMMON/COLAREA/ICOL(300)
200 COMMON/HACHAREA/IHACH(300)
201 #include "big.h"
202 !
203 REAL,DIMENSION(N2DVERTX) :: XZZXX
204 REAL,DIMENSION(N2DVERTX) ::  XZZXY
205 INTEGER             :: NIIMAX, NIJMAX
206 LOGICAL             :: LVERT, LHOR, LPT, LXABS
207 INTEGER             :: ICOL
208 INTEGER             :: IHACH
209 !
210 !*       0.1   Declarations of dummy arguments and results
211 !
212 INTEGER             :: KNHI       ! Extrema processing option
213 INTEGER             :: KNDOT      ! Line style option 
214 INTEGER             :: KLREF      ! Cross-section altitude (or Model Level
215                                   ! or Pressure depending on user's vertical
216                                   ! coordinate choice)
217
218 CHARACTER(LEN=*)    :: HTEXTE     ! Plot heading with variable name
219
220 REAL                :: PTABINT    ! Contour increments for current plot
221
222 REAL,DIMENSION(:,:) :: PTAB       ! Variable array to be plotted
223
224 !
225 !*       0.2   Local variables
226 !
227 INTEGER             :: IM, IL, ILE
228 INTEGER             :: J, JJ, JI, JU, JK
229 INTEGER             :: JLBL, JL
230 INTEGER             :: I, ICLD, INCL
231 INTEGER             :: INBC
232 INTEGER             :: INBX,INBY
233 INTEGER,SAVE        :: IDX
234 INTEGER,SAVE        :: INBCT
235 INTEGER,SAVE        :: ILUCOL, IRESP
236 INTEGER,DIMENSION(:),ALLOCATABLE :: ICOL2
237 INTEGER             :: ILENT
238 INTEGER             :: ISTA, IER, IWK, INB, INBB
239 INTEGER             :: INUM, ILOOP, JLOOPI, JLOOPJ, IDEB, IFIN, II
240 INTEGER,SAVE        :: IH, IHT
241 INTEGER,DIMENSION(32):: INDHACHREF=(/0,54,52,60,14,59,58,1,57,56,55,54,53,52,51,50, &
242                         1,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35/)
243 #ifdef RHODES
244 INTEGER          :: ISTAF
245 #endif
246 CHARACTER(LEN=80)               :: YCAR80 
247 CHARACTER(LEN=320)               :: YCAR320
248 CHARACTER(LEN=70)               :: YPLANH 
249 CHARACTER(LEN=100)               :: YTEM
250 CHARACTER(LEN=40)                :: YTEM40
251 CHARACTER(LEN=8),DIMENSION(300) :: YLLBS  
252 CHARACTER(LEN=32),SAVE          :: YNAMTABCOL
253 CHARACTER(LEN=32)               :: YLBL
254 CHARACTER(LEN=32)               :: YTEXT
255 CHARACTER(LEN=20)               :: YCAR20
256 CHARACTER(LEN=4)                :: YC4, YC42
257 CHARACTER(LEN=1)                :: YREP
258
259 LOGICAL :: GISO
260
261 REAL,DIMENSION(300) :: ZLEV, ZISOLEVP
262 REAL                :: ZTABMIN, ZTABMAX, ZTABINT
263 REAL                :: ZTABMN, ZTABMX
264 REAL                :: ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT
265 REAL                :: ZZSPVAL, ZISO
266 REAL                :: ZLREF,ZWIDTH
267 REAL                :: ZCLV
268 REAL                :: RED,GREEN,BLUE
269 REAL                :: ZINTERV
270 REAL                :: ZMIN, ZMAX
271 REAL,SAVE           :: ZSC
272 REAL,SAVE           :: ZVLDEF, ZVRDEF, ZVBDEF, ZVTDEF
273 REAL,SAVE           :: ZD, ZF, ZVERA, ZINTE
274 REAL                :: ZX, ZY
275 REAL                :: ZXPOSTITT1, ZXYPOSTITT1
276 REAL                :: ZXPOSTITT2, ZXYPOSTITT2
277 REAL                :: ZXPOSTITT3, ZXYPOSTITT3
278 REAL                :: ZXPOSTITB1, ZXYPOSTITB1
279 REAL                :: ZXPOSTITB2, ZXYPOSTITB2
280 REAL,SAVE           :: ZXPOSTITB3, ZXYPOSTITB3
281 REAL                :: ZSZTITVAR1, ZSZTITVAR
282 REAL,DIMENSION(5)   :: ZX5, ZY5
283 REAL                :: ZEPX, ZEPY
284 !
285 !       0.3    Work arrays for NCAR 
286 !
287 ! See aforementioned notice. The dimensions of these arrays are 
288 ! subject to possible tuning, but have to be prescribed. Add
289 ! extra size if necessary.
290 !
291
292 INTEGER                 :: ID, ICL, III
293 INTEGER,PARAMETER       :: JPLRWK=50000, JPLIWK=50000
294 INTEGER,PARAMETER       :: JPMAP=8000000, JPAREAGRP=300, JPWRK=50000
295
296 INTEGER,DIMENSION(JPLIWK)   :: IWRK
297 INTEGER,DIMENSION(JPMAP)    :: IIMAP
298 INTEGER,DIMENSION(JPAREAGRP):: IAREA, IGRP
299
300 REAL,DIMENSION(JPLRWK)      :: ZRWRK
301 REAL,DIMENSION(JPWRK)       :: ZXWRK, ZYWRK
302 !
303 ! SFILL subroutine declared as external provides area control
304 ! in some parts of the contour plot.
305 !
306 EXTERNAL SFILL
307 EXTERNAL SFILLH
308 EXTERNAL CCOLR
309 !
310 !---------------------------------------------------------------------------
311 !
312 !*      1.    DISPLAY ENVIRONMENT SETUP
313 !             -------------------------
314 !
315 ! Recuperation du nom du processus dans YTEXT
316 !
317 NLUOUT=6
318 YTEXT(1:LEN(YTEXT))=' '
319 HTEXTE=ADJUSTL(HTEXTE)
320 DO JJ=1,LEN_TRIM(HTEXTE)
321   IF(HTEXTE(JJ:JJ) == ' ')THEN
322     YTEXT(1:JJ-1)=HTEXTE(1:JJ-1)
323     EXIT
324   ENDIF
325   IF(JJ == LEN_TRIM(HTEXTE))THEN
326     YTEXT=HTEXTE
327   ENDIF
328 ENDDO
329 YTEXT=ADJUSTL(YTEXT)
330 !
331 !*      1.1   Size computations and gridpoint location loading for NCAR  
332 !
333 IM=SIZE(PTAB,1)
334 IL=SIZE(PTAB,2)
335 ZTABINT=PTABINT
336 LHORIZ=.TRUE.; LVERTI=.FALSE.
337 LVERT=LVERTI
338 LHOR=LHORIZ
339 LPT=LPXT
340 ! Min and max
341 ZMIN=PTAB(IM/2,IL/2); ZMAX=PTAB(IM/2,IL/2)
342 IF(ZMIN == XSPVAL)ZMIN=1.E16
343 IF(ZMAX == XSPVAL)ZMAX=-1.E16
344 !ZMIN=999999.; ZMAX=-999999.
345 if(nverbia > 0)then
346   print *,' ** image AV DO JJ=1,IL'
347 endif
348 DO JJ=1,IL
349   DO JI=1,IM
350     IF(PTAB(JI,JJ) /= 888. .AND. PTAB(JI,JJ) /= XSPVAL)THEN
351       IF(PTAB(JI,JJ) < ZMIN)ZMIN=PTAB(JI,JJ)
352       IF(PTAB(JI,JJ) > ZMAX)ZMAX=PTAB(JI,JJ)
353     ENDIF
354   ENDDO
355 ENDDO
356 YLBL(1:5)='(Min:'
357 WRITE(YLBL(6:15),'(E10.3)')ZMIN
358 YLBL(16:21)=', Max:'
359 WRITE(YLBL(22:31),'(E10.3)')ZMAX
360 YLBL(32:32)=')'
361
362 !
363
364 !NIIMAX=NIMAXT
365 !NIJMAX=NJMAXT
366 NIIMAX=SIZE(PTAB,1)
367 NIJMAX=SIZE(PTAB,2)
368 XZZXX(1:NIIMAX)=XXX(NIINF:NISUP,NMGRID)
369 XZZXY(1:NIJMAX)=XXY(NJINF:NJSUP,NMGRID)
370 !
371
372 IF(LPRINT)THEN
373   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
374   IF(IRESP /= 0)THEN
375     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
376     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
377     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
378   ENDIF
379   ILOOP=SIZE(PTAB,1)/5
380  
381 !!Octobre 2001 Cas des trajectoires ??
382   print *,' ** image, ILOOP,NLOOPT, SIZE(PTAB,1) ',ILOOP,NLOOPT, SIZE(PTAB,1)
383 !!Octobre 2001
384   IF(ILOOP * 5 < SIZE(PTAB,1))ILOOP=ILOOP+1
385   WRITE(INUM,'(''CH  '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'')')CGROUP,&
386 & CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
387   IF(LMINUS .OR. LPLUS)THEN
388     WRITE(INUM,'(A55,''(NIINF-NISUP,NJINF-NJSUP)'')')CTITB3(1:55)
389   ELSE
390     WRITE(INUM,'(A40,''(NIINF-NISUP,NJINF-NJSUP)'')')CTITGAL
391   ENDIF
392   WRITE(INUM,'(''niinf'',i4,'' njinf'',i4,'' nisup'',i4,'' njsup'',i4,&
393 &''   '',A1,'' '',i6)')&
394   &NIINF,NJINF,NISUP,NJSUP,CTYPHOR,KLREF
395   WRITE(INUM,'(''NBVAL en I '',i4,''  NBVAL en J '',i4,''   iter'',i3)') &
396   &NISUP-NIINF+1,NJSUP-NJINF+1,ILOOP
397 ! JUin 2001 Ecriture des dates (Demande G.Jaubert ) si LPRDAT=T
398   IF(LPRDAT)THEN
399     IF(.NOT.ALLOCATED(XPRDAT))THEN
400       print *,'**IMAGE XPRDAT NON ALLOUE.Dates non ecrites ds FICVAL .Prevenir J.Duron'
401     ELSE
402       WRITE(INUM,'(1X,75(1H*))')
403       WRITE(INUM,'(1X,''    Dates courante   *     modele      *   experience    *      segment'')')
404       WRITE(INUM,'(1X,'' J   An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.'')')
405       WRITE(INUM,'(1X,75(1H*))')
406       DO J=1,SIZE(XPRDAT,2)
407         WRITE(INUM,'(1X,I3,1X,3(I4,I3,I3,I6,'' *''),I4,I3,I3,I6)')J,INT(XPRDAT(:,J))
408       ENDDO
409     ENDIF
410   ENDIF
411 ! JUin 2001 Ecriture des dates 
412   DO JLOOPI=1,ILOOP
413     IF(JLOOPI == 1)THEN
414       IDEB=1; IFIN=5
415       IDEB=IDEB+NIINF-1; IFIN=IFIN+NIINF-1
416     ELSE
417       IDEB=IFIN+1; IFIN=IFIN+5
418     ENDIF
419     IF(JLOOPI == ILOOP)THEN
420       IFIN=SIZE(PTAB,1)+NIINF-1
421     ENDIF
422     
423     WRITE(INUM,'(1X,78(1H*))')
424     WRITE(INUM,'('' J   I-> '',3X,I4,6X,4(6X,I4,6X))')(/(II,II=IDEB,IFIN)/)
425     WRITE(INUM,'(''.'',78(1H*))')
426     DO JLOOPJ=SIZE(PTAB,2),1,-1
427       WRITE(INUM,'(I4,2X,5(1X,E14.7))')JLOOPJ+NJINF-1,(PTAB(II,JLOOPJ),II=IDEB-NIINF+1,IFIN-NIINF+1)
428 !     WRITE(INUM,'(I3,2X,5E15.8)')JLOOPJ+NJINF-1,(PTAB(II,JLOOPJ),II=IDEB-NIINF+1,IFIN-NIINF+1)
429     ENDDO
430     WRITE(INUM,'(1X,78(1H*))')
431   ENDDO
432 ENDIF
433 IF(LPRINTXY)THEN
434   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
435   IF(IRESP /= 0)THEN
436     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
437     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
438     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
439   ENDIF
440   WRITE(INUM,'(''CH XY  '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'')')CGROUP,&
441 & CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
442   IF(LMINUS .OR. LPLUS)THEN
443     WRITE(INUM,'(A55,''(NIINF-NISUP,NJINF-NJSUP)'')')CTITB3(1:55)
444   ELSE
445     WRITE(INUM,'(A40,''(NIINF-NISUP,NJINF-NJSUP)'')')CTITGAL
446   ENDIF
447   WRITE(INUM,'(''niinf'',i4,'' njinf'',i4,'' nisup'',i4,'' njsup'',i4,&
448 &'' '',A1,'' '',i6)')&
449   &NIINF,NJINF,NISUP,NJSUP,CTYPHOR,KLREF
450   WRITE(INUM,'(''NBVAL en I '',i4,''  NBVAL en J '',i4)') &
451   &NISUP-NIINF+1,NJSUP-NJINF+1
452
453   II=MAX(SIZE(PTAB,1),SIZE(PTAB,2))
454   WRITE(INUM,'(1X,73(1H*))')
455   WRITE(INUM,'(26X,''X'',38X,''Y'')')
456   WRITE(INUM,'(1X,73(1H*))')
457   DO JLOOPJ=1,II
458     IF(JLOOPJ ==1)THEN
459         YC4='    '
460         YC42='    '
461         WRITE(YC4,'(I4,'')'')')NIINF
462         WRITE(YC42,'(I4,'')'')')NJINF
463         WRITE(INUM,'(''NIINF('',A4,I4,5X,E15.8,5X,''NJINF('',A4,I4,5X,E15.8)') &
464         YC4,JLOOPJ,XZZXX(JLOOPJ),YC42,JLOOPJ,XZZXY(JLOOPJ)
465         YC4='    '
466         YC42='    '
467         WRITE(YC4,'(I4,'')'')')NISUP
468         WRITE(YC42,'(I4,'')'')')NJSUP
469     ELSE
470         IF(SIZE(PTAB,1) > SIZE(PTAB,2))THEN
471           IF(JLOOPJ < SIZE(PTAB,2))THEN
472             WRITE(INUM,'(5X,I9,5X,E15.8,5X,5X,I9,5X,E15.8)')JLOOPJ,XZZXX(JLOOPJ), &
473             JLOOPJ,XZZXY(JLOOPJ)
474           ELSE IF(JLOOPJ == SIZE(PTAB,1))THEN
475             WRITE(INUM,'(''NISUP('',A4,I4,5X,E15.8)')YC4,JLOOPJ,XZZXX(JLOOPJ)
476             WRITE(INUM,'(1X,73(1H*))')
477           ELSE IF(JLOOPJ == SIZE(PTAB,2))THEN
478             WRITE(INUM,'(5X,I9,5X,E15.8,5X,''NJSUP('',A4,I4,5X,E15.8)')&
479             JLOOPJ,XZZXX(JLOOPJ), &
480             YC42,JLOOPJ,XZZXY(JLOOPJ)
481           ELSE IF(JLOOPJ > SIZE(PTAB,2))THEN
482             WRITE(INUM,'(5X,I9,5X,E15.8)')JLOOPJ,XZZXX(JLOOPJ)
483           ENDIF
484         ELSE IF(SIZE(PTAB,2) > SIZE(PTAB,1))THEN
485           IF(JLOOPJ < SIZE(PTAB,1))THEN
486             WRITE(INUM,'(5X,I9,5X,E15.8,5X,5X,I9,5X,E15.8)')JLOOPJ,XZZXX(JLOOPJ), &
487             JLOOPJ,XZZXY(JLOOPJ)
488           ELSE IF(JLOOPJ == SIZE(PTAB,2))THEN
489             WRITE(INUM,'(29X,5X,5X,''NJSUP('',A4,I4,5X,E15.8)') &
490             YC42,JLOOPJ,XZZXY(JLOOPJ)
491             WRITE(INUM,'(1X,73(1H*))')
492           ELSE IF(JLOOPJ > SIZE(PTAB,1))THEN
493             WRITE(INUM,'(29X,5X,5X,5X,I9,5X,E15.8)')JLOOPJ,XZZXY(JLOOPJ)
494           ELSE
495             WRITE(INUM,'(''NISUP('',A4,I4,5X,E15.8,5X,5X,I9,5X,E15.8)') &
496             YC4,JLOOPJ,XZZXX(JLOOPJ), &
497             JLOOPJ,XZZXY(JLOOPJ)
498           ENDIF
499         ELSE
500           IF(JLOOPJ == SIZE(PTAB,2))THEN
501             WRITE(INUM,'(''NISUP('',A4,I4,5X,E15.8,5X,''NJSUP('',A4,I4,5X,E15.8)') &
502             YC4,JLOOPJ,XZZXX(JLOOPJ), &
503             YC42,JLOOPJ,XZZXY(JLOOPJ)
504             WRITE(INUM,'(1X,73(1H*))')
505           ELSE
506             WRITE(INUM,'(5X,I9,5X,E15.8,5X,5X,I9,5X,E15.8)')JLOOPJ,XZZXX(JLOOPJ), &
507             JLOOPJ,XZZXY(JLOOPJ)
508           ENDIF
509         ENDIF
510     ENDIF
511   ENDDO
512 ENDIF
513 !
514 !*      1.2  Scans for data extrema. Selects display window.
515 !            If required by LCARTESIAN: selects cartographic projection 
516 !            and draws coastlines. 
517 !            If required by LXY: draws a gripoint stencil over the contours.
518 !
519
520 ! Modifs for diachro
521 !
522 !CALL GMNMX(ZTABMIN,ZTABMAX,ZTABINT)
523
524 if(nverbia > 0)then
525   print *,' ** image IF(NIMNMX == '
526 endif
527 IF(NIMNMX == 0 .OR. NIMNMX == 1)THEN
528   LISOK=.FALSE.
529   ZTABMIN=0.; ZTABMAX=0.
530   CALL READMNMXINT_ISO(NIMNMX,YTEXT(1:LEN_TRIM(YTEXT)),ZTABMIN,ZTABMAX,ZTABINT)
531
532 ELSE IF(NIMNMX == 2)THEN
533   ZISOLEVP(:)=9999.
534   CALL READXISOLEVP(YTEXT(1:LEN_TRIM(YTEXT)),ILE,ZISOLEVP)
535   IF(NVERBIA > 5)THEN
536     print *,' IMAGE YTEXT,ILE,ZISOLEVP ',YTEXT(1:LEN_TRIM(YTEXT)),ILE,ZISOLEVP(1:ILE)
537   ENDIF
538
539 ELSE IF (NIMNMX==3) THEN  ! compute contour values from XISOREF and XDIAINT
540   ZISOLEVP(:)=9999.
541   ZTABMN=MINVAL(PTAB,MASK=PTAB/=XSPVAL) 
542   ZTABMX=MAXVAL(PTAB,MASK=PTAB/=XSPVAL)
543   CALL READREFINT_ISO(YTEXT(1:LEN_TRIM(YTEXT)),ZTABMN,ZTABMX,ZTABINT,ZISOLEVP)
544 ENDIF
545
546 IF(LCARTESIAN)THEN
547   ZVLDEF=.1; ZVRDEF=.9; ZVBDEF=.1; ZVTDEF=.9
548 ELSE
549   ZVLDEF=.05; ZVRDEF=.95; ZVBDEF=.05; ZVTDEF=.95
550 ENDIF
551 XLWIDTH=XLWDEF
552 IF(LSUPER)THEN
553   NSUPER=NSUPER+1
554   SELECT CASE(NSUPER)
555     CASE(1)
556       IF(XLW >= 0)THEN
557         XLWIDTH=XLW
558       ENDIF
559       IF(XLW1 >= 0)THEN
560         XLWIDTH=XLW1
561       ENDIF
562
563       IH=0; IHT=0
564
565       IF(LHACH2 .AND. LHACH3 .AND. LHACH4)THEN
566         IHT=3
567       ELSE IF((LHACH2 .AND. LHACH3 .AND. .NOT.LHACH4) .OR.  &
568               (LHACH2 .AND. LHACH4 .AND. .NOT.LHACH3) .OR.  &
569               (LHACH3 .AND. LHACH4 .AND. .NOT.LHACH2))THEN
570         IHT=2
571       ELSE IF((LHACH2 .AND. .NOT.LHACH3 .AND. .NOT.LHACH4) .OR.  &
572               (LHACH3 .AND. .NOT.LHACH2 .AND. .NOT.LHACH4) .OR.  &
573               (LHACH4 .AND. .NOT.LHACH2 .AND. .NOT.LHACH3))THEN
574         IHT=1
575       ENDIF
576
577     CASE(2)
578       IF(XLW2 >= 0)THEN
579         XLWIDTH=XLW2
580       ENDIF
581     CASE(3)
582       IF(XLW3 >= 0)THEN
583         XLWIDTH=XLW3
584       ENDIF
585     CASE(4)
586       IF(XLW4 >= 0)THEN
587         XLWIDTH=XLW4
588       ENDIF
589   END SELECT
590   IF(NSUPER == 1)THEN
591     IF(.NOT.LCARTESIAN)CALL BCGRD_FORDIACHRO(1)   
592     IF(LCARTESIAN)CALL DEFENETRE
593   END IF
594 ELSE
595   IF(XLW >= 0)THEN
596     XLWIDTH=XLW
597   ENDIF
598   IF(XLW1 >= 0)THEN
599     XLWIDTH=XLW1
600   ENDIF
601   IH=0; IHT=0
602   IF(.NOT.LCARTESIAN)CALL BCGRD_FORDIACHRO(1)   
603   IF(LCARTESIAN)CALL DEFENETRE
604 END IF
605 !
606 !IF(LXY)THEN
607 ! CALL GSCLIP(0)
608 ! CALL TRACEXY
609 !END IF
610 !
611 if(nverbia > 0)then
612   print *,' ** image AV CALL GSLWSC(1.)'
613 endif
614 CALL GSLWSC(1.)
615 !CALL CPSETI('CFC',1)
616 !
617 !
618 !*      1.3  Selects contour range and increment according to NIMNMX
619 !
620 SELECT CASE(NIMNMX)
621     
622   CASE(-1)                           ! Fully automatic scanning
623     CALL CPSETI('CLS',+16)
624     IF((LHACH1 .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))) .OR. &
625       (LHACH2 .AND. NSUPER == 2)                                   .OR. &
626       (LHACH3 .AND. NSUPER == 3)                                   .OR. &
627       (LHACH4 .AND. NSUPER == 4))CALL CPSETI('CLS',+7)
628     CALL CPSETR('CIS',-ZTABINT)
629
630   CASE(0)                            ! Automatic range and given increment
631     CALL CPSETI('CLS',16)
632     CALL CPSETR('CIS',ZTABINT)
633     CALL CPSETI('LIS',NULBLL+1)
634     CALL CPSETR('CMN',10000000000.)
635 !   CALL CPSETR('CMN',MAXVAL(PTAB))
636     CALL CPSETR('CMX',1000000000.)
637 !   CALL CPSETR('CMX',MINVAL(PTAB))
638
639   CASE(1)                            ! Given range and increment
640     IF(ZTABMAX == ZTABMIN)THEN
641       ICL=1
642       CALL CPSETI('NCL',ICL)
643     ELSE
644       ICL=NINT((ZTABMAX-ZTABMIN)/ZTABINT)
645       IF(NVERBIA >= 5)THEN
646       print *,' ztabmin  max, int,ICL ',ZTABMIN,ZTABMAX,ZTABINT,ICL
647       ENDIF
648 ! mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
649       IF(ZTABMIN + ICL*ZTABINT <= ZTABMAX)ICL=ICL+1
650       IF(NVERBIA >= 5)THEN
651       print *,' ztabmin  max, int,ICL ',ZTABMIN,ZTABMAX,ZTABINT,ICL
652       ENDIF
653 !     IF(ZTABMIN + ICL*ZTABINT < ZTABMAX)ICL=ICL+1
654       CALL CPSETI('NCL',ICL)
655 ! mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
656 !     IF((LCOLAREA .OR. LHACH1) .AND. (.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))) CALL CPSETI('NCL',ICL+1)
657     ENDIF
658     CALL CPSETI('CLS',0)
659     ZISO=ZTABMIN-ZTABINT
660     DO I=1,ICL
661     CALL CPSETI('PAI',I)
662     CALL CPSETI('AIA',I+1)
663     CALL CPSETI('AIB',I)
664     ZISO=ZISO+ZTABINT
665     IF(ABS(ZISO)<1.E-20)ZISO=0.
666     CALL CPSETR('CLV',ZISO)
667     CALL CPSETR('CLU',1.)
668     IF(.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))THEN
669       IF(LBLUSER1)THEN
670         DO JLBL=1,SIZE(XLBLUSER1)
671          DO JL=-20,20,1
672            IF(ZISO == XLBLUSER1(JLBL)*10.**FLOAT(JL))THEN
673              CALL CPSETR('CLU',3.)
674 !            print *,' ISO LABELLE ',ZISO
675              EXIT
676            ENDIF
677          ENDDO
678         ENDDO
679       ELSE
680         IF(.NOT.LABEL1)THEN
681           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
682         ELSE
683           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
684         ENDIF
685       ENDIF
686     ELSE IF(NSUPER == 2)THEN
687       IF(LBLUSER2)THEN
688         DO JLBL=1,SIZE(XLBLUSER2)
689          DO JL=-20,20,1
690            IF(ZISO == XLBLUSER2(JLBL)*10.**FLOAT(JL))THEN
691              CALL CPSETR('CLU',3.)
692              EXIT
693            ENDIF
694          ENDDO
695         ENDDO
696       ELSE
697         IF(.NOT.LABEL1)THEN
698           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
699         ELSE
700           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
701         ENDIF
702       ENDIF
703     ELSE IF(NSUPER == 3)THEN
704       IF(LBLUSER3)THEN
705         DO JLBL=1,SIZE(XLBLUSER3)
706          DO JL=-20,20,1
707            IF(ZISO == XLBLUSER3(JLBL)*10.**FLOAT(JL))THEN
708              CALL CPSETR('CLU',3.)
709              EXIT
710            ENDIF
711          ENDDO
712         ENDDO
713       ELSE
714         IF(.NOT.LABEL1)THEN
715           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
716         ELSE
717           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
718         ENDIF
719       ENDIF
720     ELSE IF(NSUPER == 4)THEN
721       IF(LBLUSER4)THEN
722         DO JLBL=1,SIZE(XLBLUSER4)
723          DO JL=-20,20,1
724            IF(ZISO == XLBLUSER4(JLBL)*10.**FLOAT(JL))THEN
725              CALL CPSETR('CLU',3.)
726              EXIT
727            ENDIF
728          ENDDO
729         ENDDO
730       ELSE
731         IF(.NOT.LABEL1)THEN
732           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
733         ELSE
734           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
735         ENDIF
736       ENDIF
737     ELSE
738       IF(.NOT.LABEL1)THEN
739         IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
740       ELSE
741         IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
742       ENDIF
743     ENDIF
744     ENDDO
745 ! mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
746 !   IF(ICL /= 1)THEN
747 !     IF((LCOLAREA .OR. LHACH1) .AND. (.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1)))THEN
748 !       ICL=ICL+1
749 !       CALL CPSETI('PAI',ICL)
750 !       CALL CPSETI('AIB',ICL)
751 !mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
752 !       CALL CPSETI('AIA',ICL+1)
753 !       ZISO=ZISO+ZTABINT
754 !       IF(ABS(ZISO)<1.E-20)ZISO=0.
755 !       CALL CPSETR('CLV',ZISO)
756 !     END IF
757 !   END IF
758
759 ! mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
760   CASE(2,3)                   
761     ICL=0
762     DO I=1,10000
763       ICL=ICL+1
764       IF(NIMNMX==3 .OR. (NIMNMX==2 .AND.LISOLEVP))THEN
765         ZLEV(ICL)=ZISOLEVP(ICL)
766         IF(NVERBIA > 5)then
767           print *,' ICL ZLEV ',ICL,ZLEV(ICL)
768         ENDIF
769       ELSE IF (NIMNMX==2 .AND. .NOT.LISOLEVP) THEN ! Given contour values     
770         IF(I == 1 .AND. XISOLEV(1) == 9999.)THEN
771           print *,' NIMNMX=2 . ABSENCE DE VALEURS DANS XISOLEV='
772           print *,' RENTREZ LES AU CLAVIER PAR ORDRE CROISSANT ET A RAISON D''1'
773           print *,' VALEUR PAR LIGNE. TERMINEZ PAR 9999.'
774           print *,' (REMARQUE : elles ne sont pas memorisees et donc valides pour le seul parametre'
775           print *,' en cours :',YTEXT(1:LEN_TRIM(YTEXT)),')'
776         ENDIF
777         IF(XISOLEV(1) == 9999.)THEN
778           READ(5,*)ZLEV(ICL)
779         ELSE
780           ZLEV(ICL)=XISOLEV(ICL)
781         ENDIF
782       ENDIF
783       IF(ZLEV(ICL) == 9999.)EXIT
784     ENDDO
785     !
786     ICL=ICL-1
787     CALL CPSETI('NCL',ICL)
788     CALL CPSETI('CLS',0)
789     DO I=1,ICL
790       CALL CPSETI('PAI',I)
791       CALL CPSETI('AIA',I+1)
792       CALL CPSETI('AIB',I)
793       CALL CPSETR('CLV',ZLEV(I))
794       CALL CPSETR('CLU',1.)
795       IF(.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))THEN
796         IF(LBLUSER1)THEN
797           DO JLBL=1,SIZE(XLBLUSER1)
798            DO JL=-20,20,1
799              IF(ZLEV(I) == XLBLUSER1(JLBL)*10.**FLOAT(JL))THEN
800                CALL CPSETR('CLU',3.)
801 !            print *,' ISO LABELLE ',ZLEV(I)
802                EXIT
803              ENDIF
804            ENDDO
805           ENDDO
806         ELSE
807           IF(.NOT.LABEL1)THEN
808             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
809           ELSE
810             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
811           ENDIF
812         ENDIF
813       ELSE IF(NSUPER == 2)THEN
814         IF(LBLUSER2)THEN
815           DO JLBL=1,SIZE(XLBLUSER2)
816            DO JL=-20,20,1
817              IF(ZLEV(I) == XLBLUSER2(JLBL)*10.**FLOAT(JL))THEN
818                CALL CPSETR('CLU',3.)
819                EXIT
820              ENDIF
821            ENDDO
822           ENDDO
823         ELSE
824           IF(.NOT.LABEL1)THEN
825             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
826           ELSE
827             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
828           ENDIF
829         ENDIF
830       ELSE IF(NSUPER == 3)THEN
831         IF(LBLUSER3)THEN
832           DO JLBL=1,SIZE(XLBLUSER3)
833            DO JL=-20,20,1
834              IF(ZLEV(I) == XLBLUSER3(JLBL)*10.**FLOAT(JL))THEN
835                CALL CPSETR('CLU',3.)
836                EXIT
837              ENDIF
838            ENDDO
839           ENDDO
840         ELSE
841           IF(.NOT.LABEL1)THEN
842             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
843           ELSE
844             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
845           ENDIF
846         ENDIF
847       ELSE IF(NSUPER == 4)THEN
848         IF(LBLUSER4)THEN
849           DO JLBL=1,SIZE(XLBLUSER4)
850            DO JL=-20,20,1
851              IF(ZLEV(I) == XLBLUSER4(JLBL)*10.**FLOAT(JL))THEN
852                CALL CPSETR('CLU',3.)
853                EXIT
854              ENDIF
855            ENDDO
856           ENDDO
857         ELSE
858           IF(.NOT.LABEL1)THEN
859             IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
860           ELSE
861             IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
862           ENDIF
863         ENDIF
864       ELSE
865         IF(.NOT.LABEL1)THEN
866           IF((MOD(I,NULBLL+1)==0))CALL CPSETR('CLU',3.)
867         ELSE
868           IF((MOD(I-1,NULBLL+1)==0).OR.I==1)CALL CPSETR('CLU',3.)
869         ENDIF
870       ENDIF
871     ENDDO
872 END SELECT
873 !
874 !*      1.4  A few cosmetic parameter settings
875 !
876 ! Label format and normalization
877 !
878 if(nverbia > 0)then
879   print *,' ** image AV CASE(NIOFFD)',NIOFFD
880 endif
881 SELECT CASE(NIOFFD)        
882     
883 CASE(0)                     !! No label normalisation, decimal point kept
884     III=9                   ! 'Numeric exponent use flag'
885     CALL CPSETI('NEU',III)  ! III > 0 --> decimal point kept if the number of
886                             ! significant digits < III; else form requiring the 
887                             ! fewest character is used
888     CALL CPSETI('NOF',7)
889     IF(NSD /= 0)THEN
890       CALL CPSETI('NSD',-NSD)
891     ELSE
892       CALL CPSETI('NSD',-6)
893     ENDIF
894 CASE DEFAULT                !! Label normalisation, scale factor right of the plot
895     CALL CPSETI('NEU',-2)   ! Exponential notation forced, in any case 
896     CALL CPSETI('NOF',7)
897     CALL CPSETI('NET',0)    ! Exponent shown as a "E"
898
899 END SELECT
900 !
901 ! Special value handling
902 !
903 SELECT CASE(NIOFFP)
904     
905 CASE(0)                          ! No special value used
906     CALL CPSETR('SPV',0.)
907 CASE DEFAULT                     ! XSPVAL used as a special value
908     CALL CPSETR('SPV',XSPVAL)
909
910 END SELECT
911 !
912 ! Information label under the plot
913 !
914 SELECT CASE(NIOFFM)
915     
916 CASE(0)               ! A label is printed to the plot bottom
917 CASE DEFAULT          ! No label
918     CALL CPSETC('ILT',' ')
919
920 END SELECT
921 !
922 !!!!!!!! PROVI
923 CALL GSCLIP(1)              ! Display clipping activated
924 !CALL GSCLIP(0)              ! Display clipping activated
925 !!!!!!!! PROVI
926 CALL CPSETI('MAP',4)        ! A specific map projection is used, as provided in
927                             ! the user-provided "CPMPXY" routine. This important
928                             ! parameter informs Conpack of the kind of geographic
929                             ! transformation actually made.
930 CALL CPSETI('SET',0)        ! No "SET" issued by conpack
931 CALL CPSETR('SPV',XSPVAL)
932 !
933 !-------------------------------------------------------------------------------
934 !
935 !*      3.   FIELD CONTOURS DRAWING
936 !            ----------------------       
937 !
938 !*      3.1  Conpack initialization
939 !
940 if(nverbia > 0)then
941   print *,' ** image AV CPRECT(PTAB,IM,IM',IM,IL
942 endif
943 CALL CPRECT(PTAB,IM,IM,IL,ZRWRK,JPLRWK,IWRK,JPLIWK)
944 CALL CPSETR('CWM',XSIZEL/.01)
945
946 INCL=0
947 CALL CPPKCL(PTAB,ZRWRK,IWRK)
948 CALL CPGETI('NCL',INCL)
949
950 !
951 !*    3.1a     High and low handling
952 !
953 SELECT CASE(KNHI)
954     
955   CASE(0)                           ! H + L   are displayed
956 ! Test rajoute pour eviter la superposition de CONSTANT FIELD ici et ensuite
957 ! avec le 2eme CPLBDR utile en cas de surfaces colorees
958     IF(INCL /= 0)THEN
959       CALL CPLBDR(PTAB,ZRWRK,IWRK)
960     ENDIF
961   CASE DEFAULT                      ! TO BE REVISED*********************
962                                     ! <0  --> no action (:-1 to be set)
963                                     ! >0  --> gridpoint value displayed
964                                     !         (1: to be set)
965 END SELECT
966 !
967 !*     3.2   Line style and color handling
968 !
969 !INCL=0
970 !CALL CPPKCL(PTAB,ZRWRK,IWRK)
971 !CALL CPGETI('NCL',INCL)
972 IF(NIMNMX < 0)THEN
973   DO J=1,INCL
974     CALL CPSETI('PAI',J)
975     CALL CPSETR('CLU',1.)
976     CALL CPGETR('CLV',ZISO)
977     IF(.NOT.LSUPER.OR. (LSUPER .AND. NSUPER == 1))THEN
978       IF(LBLUSER1)THEN
979         DO JLBL=1,SIZE(XLBLUSER1)
980          DO JL=-20,20,1
981            IF(ZISO == XLBLUSER1(JLBL)*10.**FLOAT(JL))THEN
982              CALL CPSETR('CLU',3.)
983              print *,' ISO LABELLE ',ZISO
984              EXIT
985            ENDIF
986          ENDDO
987         ENDDO
988       ELSE
989         IF(.NOT.LABEL1)THEN
990           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
991         ELSE
992           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
993         ENDIF
994       ENDIF
995     ELSE IF(NSUPER == 2)THEN
996       IF(LBLUSER2)THEN
997         DO JLBL=1,SIZE(XLBLUSER2)
998          DO JL=-20,20,1
999            IF(ZISO == XLBLUSER2(JLBL)*10.**FLOAT(JL))THEN
1000              CALL CPSETR('CLU',3.)
1001              EXIT
1002            ENDIF
1003          ENDDO
1004         ENDDO
1005       ELSE
1006         IF(.NOT.LABEL1)THEN
1007           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1008         ELSE
1009           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1010         ENDIF
1011       ENDIF
1012     ELSE IF(NSUPER == 3)THEN
1013       IF(LBLUSER3)THEN
1014         DO JLBL=1,SIZE(XLBLUSER3)
1015          DO JL=-20,20,1
1016            IF(ZISO == XLBLUSER3(JLBL)*10.**FLOAT(JL))THEN
1017              CALL CPSETR('CLU',3.)
1018              EXIT
1019            ENDIF
1020          ENDDO
1021         ENDDO
1022       ELSE
1023         IF(.NOT.LABEL1)THEN
1024           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1025         ELSE
1026           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1027         ENDIF
1028       ENDIF
1029     ELSE IF(NSUPER == 4)THEN
1030       IF(LBLUSER4)THEN
1031         DO JLBL=1,SIZE(XLBLUSER4)
1032          DO JL=-20,20,1
1033            IF(ZISO == XLBLUSER4(JLBL)*10.**FLOAT(JL))THEN
1034              CALL CPSETR('CLU',3.)
1035              EXIT
1036            ENDIF
1037          ENDDO
1038         ENDDO
1039       ELSE
1040         IF(.NOT.LABEL1)THEN
1041           IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1042         ELSE
1043           IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1044         ENDIF
1045       ENDIF
1046     ELSE
1047       IF(.NOT.LABEL1)THEN
1048         IF((MOD(J,NULBLL+1)==0))CALL CPSETR('CLU',3.)
1049       ELSE
1050         IF((MOD(J-1,NULBLL+1)==0).OR.J==1)CALL CPSETR('CLU',3.)
1051       ENDIF
1052     ENDIF
1053   ENDDO
1054 END IF
1055 SELECT CASE(KNDOT)
1056   CASE(0,1,1023,65535)           ! Solid lines
1057     DO J=1,INCL
1058       CALL CPSETI('PAI',J)
1059       CALL CPSETI('CLD',65535)
1060     ENDDO
1061   CASE (:-1)                     ! <0 Negative value dashed, positive value solid
1062       ICLD=ABS(KNDOT)
1063 !     write(0,*)' KNDOT',KNDOT,' INCL ',INCL
1064         DO J=1,INCL
1065           CALL CPSETI('PAI',J)
1066           CALL CPGETR('CLV',ZCLV)
1067           IF(ZCLV.GE.0.)CALL CPSETI('CLD',65535)
1068           IF(ZCLV.LT.0.)CALL CPSETI('CLD',ICLD)
1069 !         write(0,*)' J ZCLV',I,ZCLV
1070         ENDDO
1071   CASE DEFAULT                   ! KNDOT used as a dash pattern
1072       ICLD=ABS(KNDOT)
1073         DO J=1,INCL
1074           CALL CPSETI('PAI',J)
1075           CALL CPSETI('CLD',ICLD)
1076         ENDDO
1077 END SELECT
1078
1079 !
1080 ! **************************************************************
1081 ! Surfaces en hachures ; LHACHx=.TRUE. (avec x=1 ou 2 ou 3 ou 4)
1082 ! **************************************************************
1083
1084 IF((LHACH1 .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))) .OR. &
1085    (LHACH2 .AND. NSUPER == 2)                                   .OR. &
1086    (LHACH3 .AND. NSUPER == 3)                                   .OR. &
1087    (LHACH4 .AND. NSUPER == 4))THEN !++++++++++++++++++++++++++++++++++++++++++
1088
1089   IF(NSUPER > 1)THEN
1090     IH=IH+1
1091     if(nverbia >0)then
1092       print *,' image: HACHures IHT IH ',IHT,IH
1093     endif
1094   ENDIF
1095
1096   WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' VALEURS:'
1097   DO J=1,INCL
1098     CALL CPSETI('PAI',J)
1099     CALL CPSETI('AIB',J)
1100     CALL CPSETI('AIA',J+1)
1101     CALL CPGETR('CLV',ZCLV)
1102     ZLEV(J)=ZCLV
1103     CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
1104   ENDDO
1105
1106   IF(.NOT.LHACHSEL)THEN
1107     IF(INCL+1 <= 8)THEN
1108       DO J=1,INCL
1109         IHACH(J)=INDHACHREF(J)
1110       ENDDO
1111       IHACH(INCL+1)=INDHACHREF(8)
1112     ELSE
1113       IHACH(1:2)=INDHACHREF(1:2)
1114       IHACH(3)=INDHACHREF(2)
1115       IHACH(INCL-1:INCL+1)=INDHACHREF(6:8)
1116
1117       IF(INCL+1 < 13)THEN
1118         IHACH(4)=INDHACHREF(3)
1119       ELSE
1120         IHACH(4)=INDHACHREF(2)
1121       ENDIF
1122
1123       IF(INCL+1 == 9)THEN
1124         IHACH(5)=INDHACHREF(4)
1125         IHACH(6)=INDHACHREF(5)
1126       ELSE
1127         IHACH(5)=INDHACHREF(3)
1128         IF(INCL+1 < 13)THEN
1129           IHACH(6)=INDHACHREF(4)
1130         ELSE
1131           IHACH(6)=INDHACHREF(3)
1132         ENDIF
1133       ENDIF
1134
1135       IF(INCL+1 == 10)THEN
1136         IHACH(7)=INDHACHREF(5)
1137       ELSE IF(INCL+1 >= 11 .AND. INCL+1 < 14)THEN
1138         IHACH(7)=INDHACHREF(4)
1139       ELSE IF(INCL+1 >= 14)THEN
1140         IHACH(7)=INDHACHREF(3)
1141       ENDIF
1142
1143       IF(INCL+1 >= 11 .AND. INCL+1 < 13)THEN
1144         IHACH(8)=INDHACHREF(5)
1145       ELSE IF(INCL+1 >= 13)THEN
1146         IHACH(8)=INDHACHREF(4)
1147       ENDIF
1148
1149       IF(INCL+1 >= 12 .AND. INCL+1 < 14)THEN
1150         IHACH(9)=INDHACHREF(5)
1151       ELSE IF(INCL+1 >= 14)THEN
1152         IHACH(9)=INDHACHREF(4)
1153       ENDIF
1154
1155       IF(INCL+1 == 13)THEN
1156         IHACH(10)=INDHACHREF(5)
1157       ELSE IF(INCL+1 >= 14 .AND. INCL+1 < 15)THEN
1158         IHACH(10)=INDHACHREF(5)
1159       ELSE IF(INCL+1 >= 15)THEN
1160         IHACH(10)=INDHACHREF(4)
1161       ENDIF
1162
1163       IF(INCL+1 >= 14)THEN
1164         IHACH(11)=INDHACHREF(5)
1165       ENDIF
1166
1167       IF(INCL+1 >= 15)THEN
1168         IHACH(12)=INDHACHREF(5)
1169       ENDIF
1170
1171       IF(INCL+1 == 16)THEN
1172         IHACH(13)=INDHACHREF(5)
1173       ENDIF
1174     ENDIF
1175
1176   ELSE
1177
1178     DO J=1,300
1179       IHACH(J)=0
1180     ENDDO
1181     WRITE(NLUOUT,*)' >>>>>>>SELECTION DES HACHURES PAR L''UTILISATEUR'
1182     WRITE(NLUOUT,*)' >>>>>>>VOUS DEVEZ FOURNIR ',INCL+1,' INDICES'
1183     WRITE(NLUOUT,*)' Rentrez sur 1 premiere ligne le nombre d''indices fournis dans la ligne suivante'
1184     WRITE(NLUOUT,*)' Puis sur la(es) ligne(s) suivante(s) les indices des figures pris dans la table' 
1185     WRITE(NLUOUT,*)' de reference correspondant aux isocontours ranges par ordre croissant'
1186     WRITE(NLUOUT,*)' (Entiers separes par 1 blanc)'
1187     READ(5,*,END=10)INBC
1188     GO TO 11
1189     10 CONTINUE
1190     CLOSE(5)
1191     CALL GETENV("VARTTY",YCAR20)
1192     YCAR20=ADJUSTL(YCAR20)
1193     OPEN(5,FILE=YCAR20)
1194     print *,' INTERACTIF : Entrez le nombre d indices '
1195     READ(5,*)INBC
1196     11 CONTINUE
1197     !WRITE(YCAR80,*)INBC
1198     !WRITE(NDIR,'(A80)')YCAR80
1199     CALL WRITEDIR(NDIR,INBC)
1200 #ifdef RHODES
1201     CALL FLUSH(NDIR,ISTAF)
1202 #else
1203     CALL FLUSH(NDIR)
1204 #endif
1205     READ(5,*,END=12)(IHACH(J),J=1,INBC)
1206     GO TO 13
1207     12 CONTINUE
1208     CLOSE(5)
1209     CALL GETENV("VARTTY",YCAR20)
1210     YCAR20=ADJUSTL(YCAR20)
1211     OPEN(5,FILE=YCAR20)
1212     print *,' INTERACTIF : Entrez la valeur des indices '
1213     READ(5,*)(IHACH(J),J=1,INBC)
1214     13 CONTINUE
1215    ! WRITE(YCAR320,*)IHACH(1:INBC)
1216    ! YCAR320=ADJUSTL(YCAR320)
1217    ! ILENT=LEN_TRIM(YCAR320)
1218    ILENT=INBC*4
1219    !! car plantage dans le cas ELSE si ILENT=80 !!
1220     IF(ILENT == 80 ) THEN
1221      ! YCAR320=TRIM(YCAR320)//' '
1222       ILENT=ILENT+1
1223     END IF
1224     IF(ILENT > 240 )THEN
1225       !WRITE(YCAR80,*)IHACH(1:INBC/4)
1226       CALL WRITEDIR(NDIR,IHACH(1:INBC/4))
1227       !WRITE(YCAR80,*)IHACH(INBC/4+1:INBC/2)
1228       CALL WRITEDIR(NDIR,IHACH(INBC/4+1:INBC/2))
1229       !WRITE(YCAR80,*)IHACH(INBC/2+1:3*INBC/4)
1230       CALL WRITEDIR(NDIR,IHACH(INBC/2+1:3*INBC/4))
1231       !WRITE(YCAR80,*)IHACH(3*INBC/4+1:INBC)
1232       CALL WRITEDIR(NDIR,IHACH(3*INBC/4+1:INBC))
1233 #ifdef RHODES
1234       CALL FLUSH(NDIR,ISTAF)
1235 #else
1236       CALL FLUSH(NDIR)
1237 #endif
1238     ELSE IF(ILENT > 160 )THEN
1239      ! WRITE(YCAR80,*)IHACH(1:INBC/3)
1240       CALL WRITEDIR(NDIR,IHACH(1:INBC/3))
1241      ! WRITE(YCAR80,*)IHACH(INBC/3+1:2*INBC/3)
1242       CALL WRITEDIR(NDIR,IHACH(INBC/3+1:2*INBC/3))
1243      ! WRITE(YCAR80,*)IHACH(2*INBC/3+1:INBC)
1244       CALL WRITEDIR(NDIR,IHACH(2*INBC/3+1:INBC))
1245 #ifdef RHODES
1246       CALL FLUSH(NDIR,ISTAF)
1247 #else
1248       CALL FLUSH(NDIR)
1249 #endif
1250     ELSE IF(ILENT > 80 )THEN
1251     !  WRITE(YCAR80,*)IHACH(1:INBC/2)
1252       CALL WRITEDIR(NDIR,IHACH(1:INBC/2))
1253    !   WRITE(YCAR80,*)IHACH(INBC/2+1:INBC)
1254       CALL WRITEDIR(NDIR,IHACH(INBC/2+1:INBC))
1255 #ifdef RHODES
1256       CALL FLUSH(NDIR,ISTAF)
1257 #else
1258       CALL FLUSH(NDIR)
1259 #endif
1260     ELSE
1261       !WRITE(YCAR80,*)IHACH(1:INBC)
1262       CALL WRITEDIR(NDIR,IHACH(1:INBC))
1263 #ifdef RHODES
1264       CALL FLUSH(NDIR,ISTAF)
1265 #else
1266       CALL FLUSH(NDIR)
1267 #endif
1268     ENDIF
1269   ENDIF
1270
1271   IF(LCOLZERO)THEN
1272     IHACH(NCOLZERO)=0
1273   ENDIF
1274   WRITE(NLUOUT,*)(ZLEV(J),IHACH(J),J=1,INCL)
1275   WRITE(NLUOUT,*)IHACH(INCL+1)
1276
1277 ! Trace des zones hachurees
1278     CALL GSFAIS(1)
1279     CALL GSLN(1)
1280 !   CALL GSFACI(1)
1281     CALL GSPLCI(1)
1282     CALL ARINAM(IIMAP,JPMAP)
1283 !   call mapbla(iimap)
1284     CALL CPCLAM(PTAB,ZRWRK,IWRK,IIMAP)
1285     CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,SFILLH)
1286     print *,' Hach: MAP 1 6 5 ',IIMAP(1),IIMAP(6),IIMAP(5)
1287     CALL GSFAIS(0)
1288 !
1289 ! Trace des valeurs
1290
1291     CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1292     CALL GSFAIS(1)
1293     CALL LBSETI('CBL',1)
1294 !   CALL LBSETI('CBL',0)
1295     DO J=1,INCL
1296       YLLBS(J)=ADJUSTL(YLLBS(J))
1297     ENDDO
1298     IF(.NOT.LSUPER .OR. NSUPER == 1 .OR. (NSUPER == 2 .AND. LARROVL .AND. NSUPERDIA == 2))THEN
1299     IF(ZVR < .8999999)THEN
1300       print *,' ZVR < .9 ',ZVR
1301       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)
1302     ELSE
1303         IF(INCL <= 8)THEN
1304           if(nverbia >0)then
1305           print *,' INCL <= 8 ',INCL
1306           endif
1307           CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB+(ZVT-ZVB)/4.,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,1)
1308         ELSE
1309           if(nverbia >0)then
1310           print *,' INCL > 8 ',INCL
1311           endif
1312           CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,1)
1313         ENDIF
1314 !       CALL LBLBAR_FORDIACHRO(1,ZVR,1.,ZVB,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,2)
1315     ENDIF
1316
1317     ELSE
1318
1319       ZVERA=ZVR-(ZVR-ZVL)/3.
1320
1321       IF(IHT == 0)THEN
1322         IF(NSUPER == 2 .AND. LARROVL .AND. NSUPERDIA > 2)THEN
1323           ZD=ZVL; ZF=ZVERA
1324           IF(INCL == 1)THEN
1325             ZF=ZF-(ZF-ZD)/2.
1326           ELSE IF(INCL <= 4)THEN
1327             ZF=ZF-(ZF-ZD)/4.
1328           ENDIF
1329           CALL LBLBAR_FORDIACHRO(0,ZD,ZF,ZVT+.01,ZVT+.04,INCL+1,1.,.33,IHACH,2,YLLBS,INCL,2)
1330         ELSE
1331         print *,' ** Image IHT=0 -> pas de trace de la table de hachures. Cas imprevu .. A voir.. '
1332         ENDIF
1333       ELSE
1334
1335       ZINTE=(ZVERA-ZVLDEF)/FLOAT(IHT)
1336       IF(IHT == 1)THEN
1337         ZD=ZVL; ZF=ZVERA
1338       ELSE IF(IHT == 2 .OR. IHT == 3)THEN
1339         ZD=ZVLDEF+ZINTE*(IH-1)
1340         ZF=ZVLDEF+ZINTE*(IH)-.01
1341       ENDIF
1342       IF(INCL == 1)THEN
1343         ZF=ZF-(ZF-ZD)/2.
1344       ELSE IF(INCL <= 4)THEN
1345         ZF=ZF-(ZF-ZD)/4.
1346       ENDIF
1347       CALL LBLBAR_FORDIACHRO(0,ZD,ZF,ZVT+.01,ZVT+.04,INCL+1,1.,.33,IHACH,2,YLLBS,INCL,2)
1348
1349       ENDIF
1350     ENDIF
1351     CALL GSFAIS(0)
1352 !
1353 ! Definition de la couleur des isos (0 -> blanc sur papier; 1 -> noir sur papier)
1354     IF(LISOWHI)CALL GSPLCI(0)
1355     IF(LISOWHI)CALL GSTXCI(0)
1356
1357 !
1358 ELSE IF(LCOLAREA)THEN   !+++++++++++++++++++++++++++++++++++++++++++++++++++++
1359
1360 ! **************************************************************************
1361 ! Surfaces couleur (reservees aux dessins avec ou sans superpositions;
1362 ! LCOLAREA=.TRUE.) . En cas de superpositions, obligatoirement le 1er dessin
1363 ! **************************************************************************
1364
1365   IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN        !00000000000000000000000000000000000000000000
1366
1367     IF(.NOT.LCOLAREASEL)THEN     !====================================
1368 !
1369 ! Selection automatique des couleurs par le programme
1370 ! ***************************************************
1371 !
1372 if(nverbia > 0)then
1373   print *,' ** image AV COLOR_FORDIACHRO(INCL+1) ,INCL',INCL
1374 endif
1375        CALL COLOR_FORDIACHRO(INCL+1,1)
1376        WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' VALEURS:'
1377        IF(INCL /= 0)then
1378        DO J=1,INCL
1379          CALL CPSETI('PAI',J)
1380          CALL CPSETI('AIB',J)
1381          CALL CPSETI('AIA',J+1)
1382          CALL CPGETR('CLV',ZCLV)
1383          ZLEV(J)=ZCLV
1384          ICOL(J)=J+2
1385 if(nverbia > 2)then
1386   print *,' ** image AV GENFORMAT ZCLV ',ZCLV
1387 endif
1388          CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
1389        ENDDO
1390        ENDIF
1391        ICOL(INCL+1)=INCL+3
1392 if(nverbia > 0)then
1393   print *,' ** image ICOL(INCL+1) ',ICOL(INCL+1)
1394 endif
1395        IF(LCOLBR)THEN
1396          IF(ZLEV(MAX(1,INCL)) > ZLEV(1) .AND. ICOL(INCL+1) > ICOL(1))THEN
1397            ALLOCATE(ICOL2(INCL+1))
1398            ICOL2(1:INCL+1)=ICOL(INCL+1:1:-1)
1399            ICOL(1:INCL+1)=ICOL2
1400 !          ICOL(:)=ICOL2
1401            DEALLOCATE(ICOL2)
1402          END IF
1403        END IF
1404        IF(LCOLZERO)THEN
1405          ICOL(NCOLZERO)=0
1406        ENDIF
1407        WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
1408        WRITE(NLUOUT,*)ICOL(INCL+1)
1409     ELSE                         !====================================
1410 !
1411 ! Selection des couleurs par l'utilisateur
1412 ! ****************************************
1413 !
1414       IF(LTABCOLDEF)THEN
1415 ! Choix de la table de couleurs par defaut
1416         WRITE(NLUOUT,*)' <<< TABCOLDEF >>>'
1417         CALL TABCOL_FORDIACHRO
1418       ELSE
1419 ! Choix d'une table creee par l'utilisateur
1420         CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
1421         IF(IRESP == -54)THEN
1422           YNAMTABCOL(1:32)=' '
1423 ! Lecture du nom de la table de couleurs (1 seule fois)
1424           print *,' Entrez le nom de VOTRE TABLE de COULEURS '
1425           READ(5,*,END=14)YNAMTABCOL
1426     GO TO 15
1427     14 CONTINUE
1428     CLOSE(5)
1429     CALL GETENV("VARTTY",YCAR20)
1430     YCAR20=ADJUSTL(YCAR20)
1431     OPEN(5,FILE=YCAR20)
1432     print *,' INTERACTIF : Entrez le nom de VOTRE TABLE de COULEURS'
1433     READ(5,*)YNAMTABCOL
1434     15 CONTINUE
1435           YNAMTABCOL=ADJUSTL(YNAMTABCOL)
1436           !WRITE(NDIR,'(A80)')YNAMTABCOL
1437           CALL WRITEDIR(NDIR,YNAMTABCOL)
1438 #ifdef RHODES
1439           CALL FLUSH(NDIR,ISTAF)
1440 #else
1441           CALL FLUSH(NDIR)
1442 #endif
1443 ! Janv 2001
1444           CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
1445           IF(IRESP /= 0)THEN
1446 ! Janv 2001
1447             CALL CREATLINK('DIRCOL',YNAMTABCOL,'CREAT',NVERBIA)
1448             CALL FMATTR(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
1449             OPEN(UNIT=ILUCOL,FILE=YNAMTABCOL,FORM='FORMATTED')
1450 ! Janv 2001
1451           ENDIF
1452 ! Janv 2001
1453         END IF
1454         WRITE(NLUOUT,*)' <<< ',YNAMTABCOL,' >>>'
1455         REWIND (ILUCOL)
1456 ! Lecture du nb de couleurs de la table, des index de couleur et des
1457 ! proportions relatives de rouge, vert, bleu
1458         CALL GQOPS(ISTA)
1459         CALL GQACWK(1,IER,INB,IWK)
1460 !print *,' COLOR_FORDIACHRO AP GQACWK INB IWK ',INB,IWK
1461         CALL GQOPWK(1,IER,INB,IWK)
1462         READ(ILUCOL,*)INBCT
1463         DO J=1,INBCT
1464           READ(ILUCOL,*)IDX,RED,GREEN,BLUE
1465           DO JU=1,INB
1466             CALL GQOPWK(JU,IER,INBB,IWK)
1467             IF(IWK == 9)THEN
1468               CYCLE
1469             ELSE
1470               CALL GSCR(IWK,IDX,RED,GREEN,BLUE)
1471 !             CALL GSCR(1,IDX,RED,GREEN,BLUE)
1472             ENDIF
1473           ENDDO
1474         ENDDO
1475       ENDIF ! fin d'une table creee par l'utilisateur
1476       WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' VALEURS:'
1477       DO J=1,INCL
1478         CALL CPSETI('PAI',J)
1479         CALL CPSETI('AIB',J)
1480         CALL CPSETI('AIA',J+1)
1481         CALL CPGETR('CLV',ZCLV)
1482         ZLEV(J)=ZCLV
1483         CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
1484       ENDDO
1485       DO J=1,300
1486         ICOL(J)=0
1487       ENDDO
1488 ! Pour 1 dessin donne, lecture du nb d'indices de couleurs et de leur valeur
1489 ! sur la ligne suivante
1490       READ(5,*,END=16)INBC
1491     GO TO 17
1492     16 CONTINUE
1493     CLOSE(5)
1494     CALL GETENV("VARTTY",YCAR20)
1495     YCAR20=ADJUSTL(YCAR20)
1496     OPEN(5,FILE=YCAR20)
1497     print *,' INTERACTIF : Entrez le nb d indices de couleur'
1498     READ(5,*)INBC
1499     17 CONTINUE
1500       !WRITE(YCAR80,*)INBC
1501       !WRITE(NDIR,'(A80)')YCAR80
1502       CALL WRITEDIR(NDIR,INBC)
1503 #ifdef RHODES
1504       CALL FLUSH(NDIR,ISTAF)
1505 #else
1506       CALL FLUSH(NDIR)
1507 #endif
1508       
1509       READ(5,*,END=18)(ICOL(J),J=1,INBC)
1510     GO TO 19
1511     18 CONTINUE
1512     CLOSE(5)
1513     CALL GETENV("VARTTY",YCAR20)
1514     YCAR20=ADJUSTL(YCAR20)
1515     OPEN(5,FILE=YCAR20)
1516     print *,' INTERACTIF : Entrez la valeur des indices de couleur'
1517     READ(5,*)(ICOL(J),J=1,INBC)
1518     19 CONTINUE
1519    ! WRITE(YCAR320,*)ICOL(1:INBC)
1520    ! YCAR320=ADJUSTL(YCAR320)
1521    ! ILENT=LEN_TRIM(YCAR320)
1522    ! print*,"YCAR320=",YCAR320
1523    ! print*,"ILENT=",ILENT
1524    ILENT=INBC*4
1525     IF(ILENT == 80 ) THEN
1526      ! YCAR320=TRIM(YCAR320)//' '
1527       ILENT=ILENT+1
1528     END IF
1529     IF(ILENT > 240 )THEN
1530      ! WRITE(YCAR80,*)ICOL(1:INBC/4)
1531       CALL WRITEDIR(NDIR,ICOL(1:INBC/4))
1532      ! WRITE(YCAR80,*)ICOL(INBC/4+1:INBC/2)
1533       CALL WRITEDIR(NDIR,ICOL(INBC/4+1:INBC/2))
1534      ! WRITE(YCAR80,*)ICOL(INBC/2+1:3*INBC/4)
1535       CALL WRITEDIR(NDIR,ICOL(INBC/2+1:3*INBC/4))
1536      ! WRITE(YCAR80,*)ICOL(3*INBC/4+1:INBC)
1537       CALL WRITEDIR(NDIR,ICOL(3*INBC/4+1:INBC))
1538 #ifdef RHODES
1539       CALL FLUSH(NDIR,ISTAF)
1540 #else
1541       CALL FLUSH(NDIR)
1542 #endif
1543     ELSE IF(ILENT > 160 )THEN
1544      ! WRITE(YCAR80,*)ICOL(1:INBC/3)
1545       CALL WRITEDIR(NDIR,ICOL(1:INBC/3))
1546      ! WRITE(YCAR80,*)ICOL(INBC/3+1:2*INBC/3)
1547       CALL WRITEDIR(NDIR,ICOL(INBC/3+1:2*INBC/3))
1548      ! WRITE(YCAR80,*)ICOL(2*INBC/3+1:INBC)
1549       CALL WRITEDIR(NDIR,ICOL(2*INBC/3+1:INBC))
1550 #ifdef RHODES
1551       CALL FLUSH(NDIR,ISTAF)
1552 #else
1553       CALL FLUSH(NDIR)
1554 #endif
1555     ELSE IF(ILENT > 80 )THEN
1556       !WRITE(YCAR80,*)ICOL(1:INBC/2)
1557       CALL WRITEDIR(NDIR,ICOL(1:INBC/2))
1558      ! WRITE(YCAR80,*)ICOL(INBC/2+1:INBC)
1559       CALL WRITEDIR(NDIR,ICOL(INBC/2+1:INBC))
1560 #ifdef RHODES
1561       CALL FLUSH(NDIR,ISTAF)
1562 #else
1563       CALL FLUSH(NDIR)
1564 #endif
1565     ELSE
1566       !WRITE(YCAR80,*)ICOL(1:INBC)
1567       CALL WRITEDIR(NDIR,ICOL(1:INBC))
1568 #ifdef RHODES
1569       CALL FLUSH(NDIR,ISTAF)
1570 #else
1571       CALL FLUSH(NDIR)
1572 #endif
1573     ENDIF
1574       print*,(ZLEV(J),ICOL(J),J=1,INCL)
1575       print*,ICOL(INCL+1)
1576
1577       WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
1578       WRITE(NLUOUT,*)ICOL(INCL+1)
1579 ! fin de la selection des couleurs par l'utilisateur
1580     ENDIF                        !====================================
1581 !
1582 ! Trace des zones colorees
1583 ! ************************
1584     !IF(LMSKTOP .AND. LMARKER)THEN
1585     IF(LMARKER .AND. .NOT. LSPOT)THEN
1586     ! en etoiles colorees
1587       CALL GSMK(3)  ! asterisk is the type of marker
1588       DO JJ=1,NIJMAX
1589       DO JI=1,NIIMAX
1590         IF(PTAB(JI,JJ) /= XSPVAL)THEN
1591           IF(PTAB(JI,JJ) < ZLEV(1))THEN
1592             CALL GSPMCI(ICOL(1))
1593           ELSE IF(PTAB(JI,JJ) >= ZLEV(INCL))THEN
1594             CALL GSPMCI(ICOL(INCL+1))
1595           ELSE
1596             DO JK=1,INCL-1
1597               IF(PTAB(JI,JJ) >= ZLEV(JK) .AND. &
1598                  PTAB(JI,JJ) < ZLEV(JK+1))THEN
1599                 CALL GSPMCI(ICOL(JK+1))
1600                 EXIT
1601               ENDIF
1602             ENDDO
1603           ENDIF
1604           ZX=XZZXX(JI)
1605           ZY=XZZXY(JJ)
1606           CALL GPM(1,ZX,ZY)
1607         ENDIF
1608       ENDDO
1609       ENDDO
1610
1611     ELSE IF (LSPOT .AND. .NOT. LMARKER) THEN
1612     ! en paves de couleur
1613       CALL  GSFAIS(1)  ! solid filling of the polygon
1614       ZEPX=(XZZXX(NIIMAX/2+1)-XZZXX(NIIMAX/2))*0.5
1615       ZEPY=(XZZXY(NIJMAX/2+1)-XZZXY(NIJMAX/2))*0.5
1616       print *,'LSPOT: taille differente de la maille?'
1617       print *,'       (n/N recommande pour trace de champs modeles)'
1618       print *,'       (avec contour: o/O/y/Y recommande pour trace d observations '
1619       print *,'        epaisseur du contour gere avec XLW1)'
1620       print *,'       (sans contour: a/A recommande pour trace d observations)'
1621       read(5,*) YREP
1622       CALL WRITEDIR(NDIR,YREP)
1623       IF(YREP=='o' .OR. YREP=='O' .OR. YREP=='y' .OR. YREP=='Y' .OR.&
1624          YREP=='a' .OR. YREP=='A'                               ) THEN
1625         ! essai de redimensionnement
1626         print *,'taille du pixel: NIMAX/nx et NJMAX/ny'
1627         print *,'indiquez nx et ny (2 entiers) ?'
1628         print *,'      si <=0 le defaut (50) est utilise'
1629         read(5,*) INBX,INBY
1630         CALL WRITEDIR(NDIR,INBX)
1631         CALL WRITEDIR(NDIR,INBY)
1632         IF(INBX<=0) INBX=50
1633         IF(INBY<=0) INBY=50
1634         ZEPX=ZEPX*NIIMAX/INBX ; ZEPY=ZEPY*NIJMAX/INBY
1635         ! contour en trait plein noir
1636         CALL DASHDB(65535)
1637       ENDIF
1638       DO JJ=1,NIJMAX
1639       DO JI=1,NIIMAX
1640         IF(PTAB(JI,JJ) /= XSPVAL)THEN
1641           IF(PTAB(JI,JJ) < ZLEV(1))THEN
1642             CALL GSFACI(ICOL(1))
1643           ELSE IF(PTAB(JI,JJ) >= ZLEV(INCL)) THEN
1644             CALL GSFACI(ICOL(INCL+1))
1645           ELSE
1646             DO JK=1,INCL-1
1647               IF(PTAB(JI,JJ) >= ZLEV(JK) .AND. &
1648                  PTAB(JI,JJ) < ZLEV(JK+1))THEN
1649                 CALL GSFACI(ICOL(JK+1))
1650                 EXIT
1651               ENDIF
1652             ENDDO
1653           ENDIF
1654           ZX5(1)=XZZXX(JI)-ZEPX ; ZY5(1)=XZZXY(JJ)-ZEPY
1655           ZX5(2)=XZZXX(JI)-ZEPX ; ZY5(2)=XZZXY(JJ)+ZEPY
1656           ZX5(3)=XZZXX(JI)+ZEPX ; ZY5(3)=XZZXY(JJ)+ZEPY
1657           ZX5(4)=XZZXX(JI)+ZEPX ; ZY5(4)=XZZXY(JJ)-ZEPY
1658           ZX5(5)=XZZXX(JI)-ZEPX ; ZY5(5)=XZZXY(JJ)-ZEPY
1659           ! paves
1660           CALL GFA(5,ZX5,ZY5)
1661           IF(YREP=='o' .OR. YREP=='O' .OR. YREP=='y' .OR. YREP=='Y') THEN
1662             ! contour
1663             CALL GQLWSC(IER,ZWIDTH)
1664             CALL GSLWSC(XLWIDTH)
1665             CALL CURVED(ZX5,ZY5,5)
1666             CALL GSLWSC(ZWIDTH)
1667           ENDIF
1668         ENDIF
1669       ENDDO
1670       ENDDO
1671     ELSE
1672     ! Trace des surfaces couleurs
1673       CALL GSFAIS(1)
1674 if(nverbia > 0)then
1675   print *,' ** image AV CALL ARINAM ',JPMAP
1676 endif
1677       CALL ARINAM(IIMAP,JPMAP)
1678 !     call mapbla(iimap)
1679       CALL CPCLAM(PTAB,ZRWRK,IWRK,IIMAP)
1680       CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,CCOLR)
1681       print *,' Col: MAP 1 6 5 ',IIMAP(1),IIMAP(6),IIMAP(5)
1682       CALL GSPLCI(1)
1683       CALL GSFAIS(0)
1684     ENDIF
1685 !   CALL GSLN(1)
1686     ! Trace des valeurs (legende)
1687     CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1688     CALL GSFAIS(1)
1689     CALL LBSETI('CBL',0)
1690     DO J=1,INCL
1691       YLLBS(J)=ADJUSTL(YLLBS(J))
1692     ENDDO
1693     IF(ZVR < .9)THEN
1694       CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(ZVR+.2,1.)-ZVR)/10.,MIN(ZVR+.2,1.),ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
1695     ELSE
1696       CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
1697 !     CALL LBLBAR_FORDIACHRO(1,ZVR,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,2)
1698     ENDIF
1699     CALL GSFAIS(0)
1700 !
1701 ! Definition de la couleur des isos (0 -> blanc sur papier; 1 -> noir sur papier)
1702     IF(LISOWHI)CALL GSPLCI(0)
1703     IF(LISOWHI)CALL GSTXCI(0)
1704 !
1705   ELSE IF(LCOLINE)THEN       !00000000000000000000000000000000000000000000
1706
1707 ! Traits couleur dans le cas de superpositions (LCOLAREA=.TRUE. et LCOLINE=.TRUE.)
1708 ! **************************************************************************
1709
1710 ! Modifs 220396
1711     CALL TABCOL_FORDIACHRO
1712 !   IF((LSUPER .AND. NSUPER == 1) .OR. .NOT.LSUPER)CALL TABCOL_FORDIACHRO
1713     IF(LSUPER)THEN
1714 !Mars 2000
1715       IF(LCOLISONE)THEN
1716         IF(NSUPER == 1)CALL GSPLCI(NCOLISONE1)
1717         IF(NSUPER == 1)CALL GSTXCI(NCOLISONE1)
1718         IF(NSUPER == 2)CALL GSPLCI(NCOLISONE2)
1719         IF(NSUPER == 2)CALL GSTXCI(NCOLISONE2)
1720         IF(NSUPER == 3)CALL GSPLCI(NCOLISONE3)
1721         IF(NSUPER == 3)CALL GSTXCI(NCOLISONE3)
1722         IF(NSUPER == 4)CALL GSPLCI(NCOLISONE4)
1723         IF(NSUPER == 4)CALL GSTXCI(NCOLISONE4)
1724         IF(NSUPER == 5)CALL GSPLCI(NCOLISONE5)
1725         IF(NSUPER == 5)CALL GSTXCI(NCOLISONE5)
1726       ELSE
1727 !Mars 2000
1728       IF(NSUPER == 1)CALL GSPLCI(2)
1729       IF(NSUPER == 1)CALL GSTXCI(2)
1730       IF(NSUPER == 2)CALL GSPLCI(4)
1731       IF(NSUPER == 2)CALL GSTXCI(4)
1732       IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==2) &
1733         CALL GSPLCI(2)
1734       IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==2) &
1735         CALL GSTXCI(2)
1736       IF(NSUPER == 3)CALL GSPLCI(3)
1737       IF(NSUPER == 3)CALL GSTXCI(3)
1738       IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==3) &
1739         CALL GSPLCI(4)
1740       IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==3) &
1741         CALL GSTXCI(4)
1742       IF(NSUPER == 4)CALL GSPLCI(7)
1743       IF(NSUPER == 4)CALL GSTXCI(7)
1744       IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==4) &
1745         CALL GSPLCI(3)
1746       IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==4) &
1747         CALL GSTXCI(3)
1748       IF(NSUPER > 4)CALL GSPLCI(NSUPER*2-1)
1749       IF(NSUPER > 4)CALL GSTXCI(NSUPER*2-1)
1750 !!!!!!!! PROVI
1751 !CALL FRSTPT(XXX(NIINF,NMGRID),XXY(NJINF,NMGRID))
1752 !CALL VECTOR(XXX(NIINF,NMGRID),XXY(NJSUP,NMGRID))
1753 !CALL VECTOR(XXX(NISUP,NMGRID),XXY(NJSUP,NMGRID))
1754 !CALL VECTOR(XXX(NISUP,NMGRID),XXY(NJINF,NMGRID))
1755 !CALL VECTOR(XXX(NIINF,NMGRID),XXY(NJINF,NMGRID))
1756 !!!!!!!! PROVI
1757        ENDIF
1758
1759     END IF
1760   ELSE                       !00000000000000000000000000000000000000000000
1761
1762 ! Traits noir et blanc dans le cas de superpositions (LCOLAREA=.TRUE. et LCOLINE=.FALSE.)
1763 ! ********************************************************************************
1764
1765     CALL GSPLCI(1)
1766     CALL GSLN(1)
1767     IF(LSUPER)THEN
1768       IF(NSUPER == 1)CALL GSLN(1)
1769       IF(NSUPER == 2)CALL GSLN(1)
1770
1771       IF(LINVPTIR)THEN
1772
1773         IF(NSUPER == 3)THEN
1774           CALL GSLN(2)
1775           IF((LCOLAREA.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
1776         ENDIF
1777         IF(NSUPER == 4)CALL GSLN(3)
1778
1779       ELSE
1780
1781         IF(NSUPER == 3)THEN
1782           CALL GSLN(3)
1783           IF((LCOLAREA.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
1784         ENDIF
1785         IF(NSUPER == 4)CALL GSLN(2)
1786
1787       ENDIF
1788
1789     END IF
1790
1791   END IF                     !00000000000000000000000000000000000000000000
1792
1793 ELSE IF( LGREY .AND. .NOT.LCOLAREA ) THEN
1794 ! **************************************************************
1795 ! Surfaces en grises ( LGREY=.TRUE.)
1796 !  En cas de superpositions, obligatoirement le 1er dessin
1797 ! **************************************************************
1798   IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN        !000000000000000000
1799 !
1800 ! Selection automatique des grises par le programme
1801 ! **************************************************
1802 !
1803 if(nverbia > 0)then
1804   print *,' ** image GREY av COLOR_FORDIACHRO(INCL+1,2) ,INCL',INCL
1805 endif
1806      CALL COLOR_FORDIACHRO(INCL+1,2)
1807      WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' VALEURS:'
1808      IF(INCL /= 0)then
1809        DO J=1,INCL
1810          CALL CPSETI('PAI',J)
1811          CALL CPSETI('AIB',J)
1812          CALL CPSETI('AIA',J+1)
1813          CALL CPGETR('CLV',ZCLV)
1814          ZLEV(J)=ZCLV
1815          ICOL(J)=J+2
1816          CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
1817        ENDDO
1818      ENDIF
1819      ICOL(INCL+1)=INCL+3
1820 if(nverbia > 0)then
1821   print *,' ** image ICOL(INCL+1) ',ICOL(INCL+1)
1822 endif
1823      IF(LCOLBR)THEN
1824        IF(ZLEV(MAX(1,INCL)) > ZLEV(1) .AND. ICOL(INCL+1) > ICOL(1))THEN
1825              print*,zlev(incl),zlev(1),icol(incl+1),icol(1)
1826          ALLOCATE(ICOL2(INCL+1))
1827          ICOL2(1:INCL+1)=ICOL(INCL+1:1:-1)
1828          ICOL(1:INCL+1)=ICOL2
1829 !          ICOL(:)=ICOL2
1830          DEALLOCATE(ICOL2)
1831        END IF
1832      END IF
1833      IF(LCOLZERO)THEN
1834        ICOL(NCOLZERO)=0
1835      ENDIF
1836      WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
1837      WRITE(NLUOUT,*)ICOL(INCL+1)
1838     ! Trace des zones grisees
1839     CALL GSFAIS(1)
1840     CALL ARINAM(IIMAP,JPMAP)
1841 !   call mapbla(iimap)
1842     CALL CPCLAM(PTAB,ZRWRK,IWRK,IIMAP)
1843     CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,CCOLR)
1844     print *,' Grey: MAP 1 6 5 ',IIMAP(1),IIMAP(6),IIMAP(5)
1845     CALL GSPLCI(1)
1846     CALL GSFAIS(0)
1847 !   CALL GSLN(1)
1848     ! Trace des valeurs (legende)
1849     CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1850     CALL GSFAIS(1)
1851     CALL LBSETI('CBL',0)
1852     DO J=1,INCL
1853       YLLBS(J)=ADJUSTL(YLLBS(J))
1854     ENDDO
1855       IF(ZVR < .8999999)THEN
1856         print *,' ZVR < .9 ',ZVR
1857         CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(ZVR+.2,1.)-ZVR)/10.,MIN(ZVR+.2,1.),ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
1858       ELSE
1859         IF(INCL <= 8)THEN
1860           if(nverbia >0)then
1861           print *,' INCL <= 8 ',INCL
1862           endif
1863           CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB+(ZVT-ZVB)/4.,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
1864         ELSE
1865           if(nverbia >0)then
1866           print *,' INCL > 8 ',INCL
1867           endif
1868           CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,INCL+1,.15,1.,ICOL,1,YLLBS,INCL,1)
1869         ENDIF
1870 !       CALL LBLBAR_FORDIACHRO(1,ZVR,1.,ZVB,ZVT,INCL+1,.15,1.,IHACH,2,YLLBS,INCL,2)
1871       ENDIF
1872       CALL GSFAIS(0)
1873 !
1874 ! Definition de la couleur des isos (0 -> blanc sur papier; 1 -> noir sur papier)
1875     IF(LISOWHI)CALL GSPLCI(0)
1876     IF(LISOWHI)CALL GSTXCI(0)
1877
1878   ELSE IF(LCOLINE)THEN       !00000000000000000000000000000000000000000000
1879
1880 ! Traits couleur dans le cas de superpositions (LGREY=.TRUE. et LCOLINE=.TRUE.)
1881 ! **************************************************************************
1882
1883 ! Modifs 220396
1884     CALL TABCOL_FORDIACHRO
1885 !   IF((LSUPER .AND. NSUPER == 1) .OR. .NOT.LSUPER)CALL TABCOL_FORDIACHRO
1886     IF(LSUPER)THEN
1887 !Mars 2000
1888       IF(LCOLISONE)THEN
1889         IF(NSUPER == 1)CALL GSPLCI(NCOLISONE1)
1890         IF(NSUPER == 1)CALL GSTXCI(NCOLISONE1)
1891         IF(NSUPER == 2)CALL GSPLCI(NCOLISONE2)
1892         IF(NSUPER == 2)CALL GSTXCI(NCOLISONE2)
1893         IF(NSUPER == 3)CALL GSPLCI(NCOLISONE3)
1894         IF(NSUPER == 3)CALL GSTXCI(NCOLISONE3)
1895         IF(NSUPER == 4)CALL GSPLCI(NCOLISONE4)
1896         IF(NSUPER == 4)CALL GSTXCI(NCOLISONE4)
1897         IF(NSUPER == 5)CALL GSPLCI(NCOLISONE5)
1898         IF(NSUPER == 5)CALL GSTXCI(NCOLISONE5)
1899       ELSE
1900 !Mars 2000
1901       IF(NSUPER == 1)CALL GSPLCI(2)
1902       IF(NSUPER == 1)CALL GSTXCI(2)
1903       IF(NSUPER == 2)CALL GSPLCI(4)
1904       IF(NSUPER == 2)CALL GSTXCI(4)
1905       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==2) &
1906         CALL GSPLCI(2)
1907       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==2) &
1908         CALL GSTXCI(2)
1909       IF(NSUPER == 3)CALL GSPLCI(3)
1910       IF(NSUPER == 3)CALL GSTXCI(3)
1911       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==3) &
1912         CALL GSPLCI(4)
1913       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==3) &
1914         CALL GSTXCI(4)
1915       IF(NSUPER == 4)CALL GSPLCI(7)
1916       IF(NSUPER == 4)CALL GSTXCI(7)
1917       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==4) &
1918         CALL GSPLCI(3)
1919       IF((LARROVL .OR. LGREY .OR. LHACH1) .AND. NSUPER ==4) &
1920         CALL GSTXCI(3)
1921       IF(NSUPER > 4)CALL GSPLCI(NSUPER*2-1)
1922       IF(NSUPER > 4)CALL GSTXCI(NSUPER*2-1)
1923 !!!!!!!! PROVI
1924 !CALL FRSTPT(XXX(NIINF,NMGRID),XXY(NJINF,NMGRID))
1925 !CALL VECTOR(XXX(NIINF,NMGRID),XXY(NJSUP,NMGRID))
1926 !CALL VECTOR(XXX(NISUP,NMGRID),XXY(NJSUP,NMGRID))
1927 !CALL VECTOR(XXX(NISUP,NMGRID),XXY(NJINF,NMGRID))
1928 !CALL VECTOR(XXX(NIINF,NMGRID),XXY(NJINF,NMGRID))
1929 !!!!!!!! PROVI
1930        ENDIF
1931
1932     END IF
1933   ELSE                       !00000000000000000000000000000000000000000000
1934
1935 ! Traits noir et blanc dans le cas de superpositions (LGREY=.TRUE. et LCOLINE=.FALSE.)
1936 ! ********************************************************************************
1937
1938     CALL GSPLCI(1)
1939     CALL GSLN(1)
1940     IF(LSUPER)THEN
1941       IF(NSUPER == 1)CALL GSLN(1)
1942       IF(NSUPER == 2)CALL GSLN(1)
1943
1944       IF(LINVPTIR)THEN
1945
1946         IF(NSUPER == 3)THEN
1947           CALL GSLN(2)
1948           IF((LGREY.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
1949         ENDIF
1950         IF(NSUPER == 4)CALL GSLN(3)
1951
1952       ELSE
1953
1954         IF(NSUPER == 3)THEN
1955           CALL GSLN(3)
1956           IF((LGREY.OR.LHACH1) .AND. LHACH2)CALL GSLN(1)
1957         ENDIF
1958         IF(NSUPER == 4)CALL GSLN(2)
1959
1960       ENDIF
1961
1962     END IF
1963
1964   END IF                     !00000000000000000000000000000000000000000000
1965
1966 ELSE IF(LCOLINE)THEN    !+++++++++++++++++++++++++++++++++++++++++++++++++++++
1967
1968 ! **********************************************
1969 ! Traits couleur   (LCOLAREA=.FALSE. et LCOLINE=.TRUE.)
1970 ! **********************************************
1971 ! Cas de superpositions
1972 ! *********************
1973
1974 ! Modifs 220396
1975     CALL TABCOL_FORDIACHRO
1976 !   IF((LSUPER .AND. NSUPER == 1) .OR. .NOT.LSUPER)CALL TABCOL_FORDIACHRO
1977 ! Modifs 260198
1978 ! IF(LSUPER)THEN             !............................................
1979   IF(LSUPER .AND. &          !............................................
1980      .NOT.((LHACH1.OR.LHACH2) .AND. NSUPERDIA == 2) .AND. &
1981      .NOT.( LARROVL .AND. NSUPERDIA == 2          )       )THEN
1982 !Mars 2000
1983       IF(LCOLISONE)THEN
1984         IF(NSUPER == 1)CALL GSPLCI(NCOLISONE1)
1985         IF(NSUPER == 1)CALL GSTXCI(NCOLISONE1)
1986         IF(NSUPER == 2)CALL GSPLCI(NCOLISONE2)
1987         IF(NSUPER == 2)CALL GSTXCI(NCOLISONE2)
1988         IF(NSUPER == 3)CALL GSPLCI(NCOLISONE3)
1989         IF(NSUPER == 3)CALL GSTXCI(NCOLISONE3)
1990         IF(NSUPER == 4)CALL GSPLCI(NCOLISONE4)
1991         IF(NSUPER == 4)CALL GSTXCI(NCOLISONE4)
1992         IF(NSUPER == 5)CALL GSPLCI(NCOLISONE5)
1993         IF(NSUPER == 5)CALL GSTXCI(NCOLISONE5)
1994       ELSE
1995 !Mars 2000
1996     IF(NSUPER == 1)CALL GSPLCI(2)
1997     IF(NSUPER == 1)CALL GSTXCI(2)
1998     IF(NSUPER == 2)CALL GSPLCI(4)
1999     IF(NSUPER == 2)CALL GSTXCI(4)
2000     IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==2) &
2001       CALL GSPLCI(2)
2002     IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==2) &
2003       CALL GSTXCI(2)
2004     IF(NSUPER == 3)CALL GSPLCI(3)
2005     IF(NSUPER == 3)CALL GSTXCI(3)
2006     IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==3) &
2007       CALL GSPLCI(4)
2008     IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==3) &
2009       CALL GSTXCI(4)
2010     IF(NSUPER == 4)CALL GSPLCI(7)
2011     IF(NSUPER == 4)CALL GSTXCI(7)
2012     IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==4) &
2013       CALL GSPLCI(3)
2014     IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==4) &
2015       CALL GSTXCI(3)
2016     IF(NSUPER > 4)CALL GSPLCI(NSUPER*2-1)
2017     IF(NSUPER > 4)CALL GSTXCI(NSUPER*2-1)
2018
2019 !Mars 2000
2020     ENDIF
2021 !Mars 2000
2022   
2023   ELSE                       !............................................
2024 ! Pas de superpositions
2025 ! *********************
2026
2027 ! Selection automatique des couleurs par le programme
2028 ! ***************************************************
2029
2030     IF(.NOT.LCOLINESEL)THEN      !::::::::::::::::::::::::::::::::::::
2031 !Mars 2000
2032        IF(LCOLISONE)THEN
2033          ICOL(1:INCL)=NCOLISONE1
2034        DO J=1,INCL
2035          CALL CPSETI('PAI',J)
2036          CALL CPSETI('CLC',ICOL(J))
2037          CALL CPGETR('CLV',ZCLV)
2038          ZLEV(J)=ZCLV
2039        ENDDO
2040        WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' COULEUR UNIQUE : ',ICOL(1)
2041        WRITE(NLUOUT,*)(ZLEV(J),J=1,INCL)
2042        ELSE
2043 !Mars 2000
2044
2045        CALL COLOR_FORDIACHRO(INCL,1)
2046        WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' VALEURS:'
2047        DO J=1,INCL
2048          CALL CPSETI('PAI',J)
2049          CALL CPSETI('CLC',J+2)
2050          CALL CPGETR('CLV',ZCLV)
2051          ZLEV(J)=ZCLV
2052          ICOL(J)=J+2
2053          CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
2054        ENDDO
2055        IF(LCOLBR)THEN
2056          IF(ZLEV(MAX(1,INCL)) > ZLEV(1) .AND. ICOL(INCL) > ICOL(1))THEN
2057            ALLOCATE(ICOL2(INCL))
2058            ICOL2(1:INCL)=ICOL(INCL:1:-1)
2059            ICOL(1:INCL)=ICOL2
2060 !          ICOL(:)=ICOL2
2061            DEALLOCATE(ICOL2)
2062          END IF
2063        END IF
2064        WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
2065        DO J=1,INCL
2066          CALL CPSETI('PAI',J)
2067          CALL CPSETI('CLC',ICOL(J))
2068        ENDDO
2069
2070 !Mars 2000
2071        ENDIF
2072 !Mars 2000
2073     ELSE                         !::::::::::::::::::::::::::::::::::::
2074
2075 ! Selection des couleurs par l'utilisateur
2076 ! ****************************************
2077
2078 ! Choix de la table de couleurs par defaut
2079 ! ****************************************
2080
2081        IF(LTABCOLDEF)THEN
2082          WRITE(NLUOUT,*)' <<< TABCOLDEF >>>'
2083          CALL TABCOL_FORDIACHRO
2084
2085        ELSE
2086
2087 ! Choix d'une table creee par l'utilisateur
2088 ! *****************************************
2089
2090          CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
2091          IF(IRESP == -54)THEN
2092            YNAMTABCOL(1:32)=' '
2093 ! Lecture du nom de la table de couleurs (1 seule fois)
2094            print *,' Entrez le nom de VOTRE TABLE de COULEURS '
2095            READ(5,*,END=20)YNAMTABCOL
2096     GO TO 21
2097     20 CONTINUE
2098     CLOSE(5)
2099     CALL GETENV("VARTTY",YCAR20)
2100     YCAR20=ADJUSTL(YCAR20)
2101     OPEN(5,FILE=YCAR20)
2102     print *,' INTERACTIF : Entrez le nom de VOTRE TABLE de COULEURS'
2103     READ(5,*)YNAMTABCOL
2104     21 CONTINUE
2105            YNAMTABCOL=ADJUSTL(YNAMTABCOL)
2106            !WRITE(NDIR,'(A80)')YNAMTABCOL
2107            CALL WRITEDIR(NDIR,YNAMTABCOL)
2108 #ifdef RHODES
2109       CALL FLUSH(NDIR,ISTAF)
2110 #else
2111       CALL FLUSH(NDIR)
2112 #endif
2113 ! Janv 2001
2114            CALL FMLOOK(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
2115            IF(IRESP /= 0)THEN
2116 ! Janv 2001
2117            CALL CREATLINK('DIRCOL',YNAMTABCOL,'CREAT',NVERBIA)
2118            CALL FMATTR(YNAMTABCOL,CLUOUT,ILUCOL,IRESP)
2119            OPEN(UNIT=ILUCOL,FILE=YNAMTABCOL,FORM='FORMATTED')
2120 ! Janv 2001
2121            ENDIF
2122 ! Janv 2001
2123          END IF
2124          WRITE(NLUOUT,*)' <<< ',YNAMTABCOL,' >>>'
2125          REWIND (ILUCOL)
2126          CALL GQOPS(ISTA)
2127          CALL GQACWK(1,IER,INB,IWK)
2128 !print *,' COLOR_FORDIACHRO AP GQACWK INB IWK ',INB,IWK
2129          CALL GQOPWK(1,IER,INB,IWK)
2130 ! Lecture du nb de couleurs de la table, des index de couleur et des
2131 ! proportions relatives de rouge, vert, bleu
2132          READ(ILUCOL,*)INBCT
2133          DO J=1,INBCT
2134            READ(ILUCOL,*)IDX,RED,GREEN,BLUE
2135            DO JU=1,INB
2136            CALL GQOPWK(JU,IER,INBB,IWK)
2137            IF(IWK == 9)THEN
2138              CYCLE
2139            ELSE
2140              CALL GSCR(IWK,IDX,RED,GREEN,BLUE)
2141 !          CALL GSCR(1,IDX,RED,GREEN,BLUE)
2142            ENDIF
2143            ENDDO
2144          ENDDO
2145        END IF
2146 ! Pour 1 dessin donne, lecture du nb d'indices de couleurs et de leur valeur
2147 ! sur la ligne suivante
2148          DO J=1,300
2149            ICOL(J)=1
2150          ENDDO
2151          READ(5,*,END=22)INBC
2152     GO TO 23
2153     22 CONTINUE
2154     CLOSE(5)
2155     CALL GETENV("VARTTY",YCAR20)
2156     YCAR20=ADJUSTL(YCAR20)
2157     OPEN(5,FILE=YCAR20)
2158     print *,' INTERACTIF : Entrez le nb d indices de couleur'
2159     READ(5,*)INBC
2160     23 CONTINUE
2161          !WRITE(YCAR80,*)INBC
2162          !WRITE(NDIR,'(A80)')YCAR80
2163          CALL WRITEDIR(NDIR,INBC)
2164 #ifdef RHODES
2165          CALL FLUSH(NDIR,ISTAF)
2166 #else
2167          CALL FLUSH(NDIR)
2168 #endif
2169          READ(5,*,END=24)(ICOL(J),J=1,INBC)
2170     GO TO 25
2171     24 CONTINUE
2172     CLOSE(5)
2173     CALL GETENV("VARTTY",YCAR20)
2174     YCAR20=ADJUSTL(YCAR20)
2175     OPEN(5,FILE=YCAR20)
2176     print *,' INTERACTIF : Entrez la valeur des indices de couleur'
2177     READ(5,*)(ICOL(J),J=1,INBC)
2178     25 CONTINUE
2179         ! WRITE(YCAR320,*)ICOL(1:INBC)
2180         ! YCAR320=ADJUSTL(YCAR320)
2181         ! ILENT=LEN_TRIM(YCAR320)
2182         ILENT=INBC*4
2183     IF(ILENT == 80 ) THEN
2184      ! YCAR320=TRIM(YCAR320)//' '
2185       ILENT=ILENT+1
2186     END IF
2187     IF(ILENT > 240 )THEN
2188      ! WRITE(YCAR80,*)ICOL(1:INBC/4)
2189       CALL WRITEDIR(NDIR,ICOL(1:INBC/4))
2190      ! WRITE(YCAR80,*)ICOL(INBC/4+1:INBC/2)
2191       CALL WRITEDIR(NDIR,ICOL(INBC/4+1:INBC/2))
2192      ! WRITE(YCAR80,*)ICOL(INBC/2+1:3*INBC/4)
2193       CALL WRITEDIR(NDIR,ICOL(INBC/2+1:3*INBC/4))
2194      ! WRITE(YCAR80,*)ICOL(3*INBC/4+1:INBC)
2195       CALL WRITEDIR(NDIR,ICOL(3*INBC/4+1:INBC))
2196 #ifdef RHODES
2197       CALL FLUSH(NDIR,ISTAF)
2198 #else
2199       CALL FLUSH(NDIR)
2200 #endif
2201     ELSE IF(ILENT > 160 )THEN
2202      ! WRITE(YCAR80,*)ICOL(1:INBC/3)
2203       CALL WRITEDIR(NDIR,ICOL(1:INBC/3))
2204      ! WRITE(YCAR80,*)ICOL(INBC/3+1:2*INBC/3)
2205       CALL WRITEDIR(NDIR,ICOL(INBC/3+1:2*INBC/3))
2206      ! WRITE(YCAR80,*)ICOL(2*INBC/3+1:INBC)
2207       CALL WRITEDIR(NDIR,ICOL(2*INBC/3+1:INBC))
2208 #ifdef RHODES
2209       CALL FLUSH(NDIR,ISTAF)
2210 #else
2211       CALL FLUSH(NDIR)
2212 #endif
2213     ELSE IF(ILENT > 80 )THEN
2214      ! WRITE(YCAR80,*)ICOL(1:INBC/2)
2215       CALL WRITEDIR(NDIR,ICOL(1:INBC/2))
2216      ! WRITE(YCAR80,*)ICOL(INBC/2+1:INBC)
2217       CALL WRITEDIR(NDIR,ICOL(INBC/2+1:INBC))
2218 #ifdef RHODES
2219       CALL FLUSH(NDIR,ISTAF)
2220 #else
2221       CALL FLUSH(NDIR)
2222 #endif
2223     ELSE
2224      ! WRITE(YCAR80,*)ICOL(1:INBC)
2225       CALL WRITEDIR(NDIR,ICOL(1:INBC))
2226 #ifdef RHODES
2227       CALL FLUSH(NDIR,ISTAF)
2228 #else
2229       CALL FLUSH(NDIR)
2230 #endif
2231     ENDIF
2232          DO J=1,INCL
2233            CALL CPSETI('PAI',J)
2234            CALL CPSETI('CLC',ICOL(J))
2235            CALL CPGETR('CLV',ZCLV)
2236            ZLEV(J)=ZCLV
2237            CALL GENFORMAT_FORDIACHRO(ZCLV,YLLBS(J))
2238          ENDDO
2239          WRITE(NLUOUT,*)' >>>>>>>IMAGE_FORDIACHRO VARIABLE : ',HTEXTE,' NB ISOC. : ',INCL,' VALEURS:'
2240          WRITE(NLUOUT,*)(ZLEV(J),ICOL(J),J=1,INCL)
2241
2242     END IF                       !::::::::::::::::::::::::::::::::::::
2243
2244 !Mai 2009
2245       IF(LNOLBLBAR)THEN
2246       ELSE
2247 !Mai 2009
2248 !Mars 2000
2249        IF(LCOLISONE)THEN
2250        ELSE
2251 !Mars 2000
2252        CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2253        CALL GSFAIS(0)
2254        CALL SET(ZVR,1.,ZVB,ZVT,ZVR,1.,ZVB,ZVT,1)
2255        IF(INCL <= 1)THEN
2256          ZINTERV=0.
2257        ELSE
2258          ZINTERV=(ZVT-ZVB-.009)/(INCL-1)
2259        ENDIF
2260        CALL GSCLIP(0)
2261        DO J=1,INCL
2262          YLLBS(J)=ADJUSTL(YLLBS(J))
2263          CALL GSPLCI(ICOL(J))
2264          CALL GSTXCI(ICOL(J))
2265          IF(ZVR < .9 .AND. INCL < 25)THEN
2266            CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.015,0.,-1.)
2267          ELSEIF(ZVR < .9 .AND. INCL < 30 .AND. INCL >= 25)THEN
2268            CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.012,0.,-1.)
2269          ELSEIF(ZVR >= .95 )THEN
2270            CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.007,0.,-1.)
2271          ELSE
2272            CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.009,0.,-1.)
2273          ENDIF
2274 !        CALL PLCHHQ(ZVR+(MIN(1.-ZVR,.2))/10.,ZVB+.004+(J-1)*ZINTERV,YLLBS(J),.007,0.,-1.)
2275        ENDDO
2276        CALL GSCLIP(1)
2277        CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2278 !Mars 2000
2279        ENDIF
2280 !Mars 2000
2281 !Mai 2009
2282        ENDIF
2283 !Mai 2009
2284        CALL GSTXCI(1)
2285        CALL GSPLCI(1)
2286        
2287
2288   END IF                     !............................................
2289
2290 ELSE                    !+++++++++++++++++++++++++++++++++++++++++++++++++++++
2291
2292 !***************************************************
2293 ! Traits noir et blanc (LCOLAREA=.FALSE. et LCOLINE=.FALSE.)
2294 !***************************************************
2295
2296   CALL GSPLCI(1)
2297
2298   IF(LSUPER)THEN                   !!!  Overlay case
2299
2300
2301     IF(NSUPER == 1)THEN            ! If first plot of an overlay: default 
2302       CALL GSLN(1)                 ! Line is solid
2303
2304     ELSE                           ! If subsequent plots of an overlay: default
2305       IF(LINVPTIR)THEN
2306
2307         IF(NSUPER ==2)CALL GSLN(2)    ! line is a special dash type
2308         IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==2)CALL GSLN(1)
2309         IF(NSUPER ==3)CALL GSLN(3)
2310         IF((LARROVL .OR. LCOLAREA .OR. LHACH1) .AND. NSUPER ==3)THEN
2311           CALL GSLN(1)
2312           CALL GSLN(2)
2313           IF(LHACH2)CALL GSLN(1)
2314         ENDIF
2315
2316       ELSE
2317
2318         IF(NSUPER ==2)CALL GSLN(3)    ! line is a special dash type
2319         IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==2) &
2320           CALL GSLN(1)
2321         IF(NSUPER ==3)CALL GSLN(2)
2322         IF((LARROVL .OR. LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER ==3)THEN
2323           CALL GSLN(1)
2324           CALL GSLN(3)
2325           IF(LHACH2)CALL GSLN(1)
2326         ENDIF
2327
2328       ENDIF
2329
2330     END IF
2331
2332   END IF                           !!!  Not an overlay case
2333 !
2334 END IF                  !+++++++++++++++++++++++++++++++++++++++++++++++++++++
2335 !
2336 !*    3.3     High and low handling
2337 !
2338 IF (nverbia >=5) THEN
2339   print *,'image KNHI=',KNHI
2340 END IF
2341 SELECT CASE(KNHI)
2342     
2343   CASE(0)                           ! H + L   are displayed
2344 ! Test rajoute pour eviter la superposition de CONSTANT FIELD ici et ensuite
2345 ! avec le 2eme CPLBDR utile en cas de surfaces colorees
2346     IF(INCL /= 0)THEN
2347       CALL CPLBDR(PTAB,ZRWRK,IWRK)
2348     ENDIF
2349   CASE DEFAULT                      ! TO BE REVISED*********************
2350                                     ! <0  --> no action (:-1 to be set)
2351                                     ! >0  --> gridpoint value displayed
2352                                     !         (1: to be set)
2353 END SELECT
2354 !
2355 !*     3.4   Effective contour drawing and line width selection
2356 !    
2357 IF(ZMIN == 999999. .AND. ZMAX == -999999.)THEN
2358   CALL CPSETC('CFT','CONSTANT FIELD - SPECIAL VALUE 999.')
2359 ENDIF
2360 GISO=LISO .AND. .NOT.(LSPOT .OR. LMARKER)
2361 IF((LCOLAREA .AND. .NOT.GISO .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))&
2362   .OR.(LHACH1 .AND. .NOT.LISO .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))&
2363   .OR.(LGREY .AND. .NOT.LISO .AND. (.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1)))&
2364   .OR. (LHACH2 .AND. .NOT.LISO .AND. NSUPER == 2) &
2365   .OR. (LHACH3 .AND. .NOT.LISO .AND. NSUPER == 3) &
2366   .OR. (LHACH4 .AND. .NOT.LISO .AND. NSUPER == 4) ) THEN
2367 ELSE
2368   CALL GSLWSC(XLWIDTH)
2369   IF(NSUPER == 2 .AND. LISOWHI2)THEN
2370     CALL GSLN(1)
2371     CALL GSPLCI(0)
2372     CALL GSTXCI(0)
2373   ELSE IF(NSUPER == 3 .AND. LISOWHI3)THEN
2374     CALL GSLN(1)
2375     CALL GSPLCI(0)
2376     CALL GSTXCI(0)
2377   ENDIF
2378   IF (nverbia >=5) THEN
2379     print *,'image av CPCLDR'
2380   END IF
2381   CALL CPCLDR(PTAB,ZRWRK,IWRK)
2382   ! message d erreur pour grd tableau: comment corriger ??
2383   !CPGIWS   50100 WORDS REQUESTED   50000 WORDS AVAILABLE
2384   IF (nverbia >=5) THEN
2385     print *,'image ap CPCLDR'
2386   END IF
2387 END IF
2388 IF((NSUPER == 2 .AND. LISOWHI2) .OR. (NSUPER == 3 .AND. LISOWHI3))THEN
2389 ! CALL GSPLCI(1)
2390   CALL GSTXCI(1)
2391 ENDIF
2392 IF(INCL == 0)THEN
2393   CALL CPLBDR(PTAB,ZRWRK,IWRK)
2394 ENDIF
2395
2396 IF (nverbia >=5) THEN
2397   print *,'image avant CALL GSCLIP '
2398 END IF
2399 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2400 CALL SET(ZVL,ZVR,ZVB,ZVT,ZVL,ZVR,ZVB,ZVT,1)
2401 CALL GSCLIP(0)
2402
2403 YTEM40(1:LEN(YTEM40))=' '
2404 IF(NLOOPSUPER == 1)THEN
2405   CALL RESOLV_TIT('CTITVAR1',YTEM40)
2406 ELSE IF(NLOOPSUPER == 2)THEN
2407   CALL RESOLV_TIT('CTITVAR2',YTEM40)
2408 ELSE IF(NLOOPSUPER == 3)THEN
2409   CALL RESOLV_TIT('CTITVAR3',YTEM40)
2410 ELSE IF(NLOOPSUPER == 4)THEN
2411   CALL RESOLV_TIT('CTITVAR4',YTEM40)
2412 ELSE IF(NLOOPSUPER == 5)THEN
2413   CALL RESOLV_TIT('CTITVAR5',YTEM40)
2414 ELSE IF(NLOOPSUPER == 6)THEN
2415   CALL RESOLV_TIT('CTITVAR6',YTEM40)
2416 ELSE IF(NLOOPSUPER == 7)THEN
2417   CALL RESOLV_TIT('CTITVAR7',YTEM40)
2418 ELSE IF(NLOOPSUPER == 8)THEN
2419   CALL RESOLV_TIT('CTITVAR8',YTEM40)
2420 ENDIF
2421 if(nverbia > 0)then
2422   print *,' image  CTITVAR ',YTEM40(1:LEN_TRIM(YTEM40))
2423 endif
2424
2425   IF(NSUPER < 4)THEN
2426
2427     IF((LHACH1 .AND. NSUPER == 1) .OR. (LHACH2 .AND. NSUPER == 2) .OR. &
2428        (LHACH3 .AND. NSUPER == 3) .OR. (LHACH4 .AND. NSUPER == 4) ) THEN
2429     ELSE
2430       IF((LCOLAREA .AND. NSUPER > 1) .OR. &
2431          (.NOT.LCOLAREA  .AND. &
2432           .NOT.((LHACH1.OR.LHACH2) .AND. NSUPERDIA == 2)))THEN
2433         CALL GSLWSC(XLWIDTH)
2434
2435         IF(YTEM40  /= ' ')THEN
2436         CALL FRSTPT(.95,.007+(NSUPER-1)*.017)
2437         CALL VECTOR(.95+.03,.007+(NSUPER-1)*.017)
2438         ENDIF
2439
2440       ENDIF
2441     ENDIF
2442
2443   ELSE
2444
2445       IF((LCOLAREA .AND. NSUPER > 1) .OR. &
2446          (.NOT.LCOLAREA  .AND. &
2447           .NOT.((LHACH1.OR.LHACH2) .AND. NSUPERDIA == 2)))THEN
2448
2449         IF(YTEM40  /= ' ')THEN
2450           CALL PLCHHQ(ZVLDEF+(NSUPER-4)*.25,ZVT+.01,ADJUSTL(CTIMEC(8:15)),.007,0.,-1.)
2451           CALL FRSTPT(ZVLDEF+(NSUPER-4)*.25+.08,ZVT+.01)
2452           CALL VECTOR(ZVLDEF+(NSUPER-4)*.25+.08+.03,ZVT+.01)
2453         ENDIF
2454
2455       ENDIF
2456
2457   ENDIF
2458
2459 CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,1)
2460 CALL GSLWSC(1.)
2461 CALL GSLN(1)
2462 CALL GSPLCI(1)
2463 CALL GSTXCI(1)
2464 IF(NSUPER == 1 .OR. .NOT.LSUPER .OR. (NSUPER == 2 .AND. LISOWHI2) .OR.  &
2465 (NSUPER == 3 .AND. LISOWHI3))THEN
2466   IF(LCARTESIAN)THEN
2467     CALL DEFENETRE
2468   ELSE
2469     CALL BCGRD_FORDIACHRO(2)
2470   END IF
2471   IF(LXY)THEN
2472     CALL GSCLIP(0)
2473     CALL TRACEXY
2474   END IF
2475 END IF
2476 !------------------------------------------------------------------------------
2477 !
2478 !*     4.  TOPOGRAPHY MASKING WHEN PLOTTED LEVEL INTERCEPTS TERRAIN
2479 !          --------------------------------------------------------
2480 !
2481 ! Initialization of a topographic mask using 
2482 ! the NCAR "area" features (see NCAR manual)
2483 !
2484 if(nverbia > 0)then
2485   print *,' ** image AV CTYPHOR.EQ.Z'
2486 endif
2487 IF(CTYPHOR.EQ.'Z' .AND. (.NOT.LSUPER .OR. NSUPER == 1))THEN
2488   ZLREF=KLREF
2489   !                            ! If terrain higher -> a 888. mask value is forced
2490   DO J=NIINF,NISUP
2491      DO JJ=NJINF,NJSUP
2492         IF(ZLREF.LT.XXZS(J,JJ,NMGRID))PTAB(J-NIINF+1,JJ-NJINF+1)=888.
2493      ENDDO
2494   ENDDO
2495   !
2496   ICL=1                        ! A single contour will be drawn
2497   CALL CPSETI('CLS',0)         ! User provided contour value
2498   CALL CPSETI('HCF',1)         ! Area within contour will be hatched
2499   CALL CPSETC('CFT',' ')       ! No 'CONSTANT FIELD' message issued
2500   CALL CPSETI('NCL',ICL)       ! A single contour will be drawn
2501   CALL CPSETI('PAI',ICL)       ! A single contour will be drawn
2502   CALL CPSETI('AIA',ICL+1)     ! Area number where field values are > 888.
2503   CALL CPSETI('AIB',ICL)       ! Area number where field values are < 888. 
2504   CALL CPSETI('CLU',1)         ! Area without contour, if =1 unlabeled contour
2505   CALL CPSETR('SPV',0.)        ! Resets SPV, erases the special value setting
2506   CALL CPSETR('CLV',888.)      ! Value of the single contour drawn
2507   !
2508   ! As the topography-intercepted area has been set to 888., the rest of the
2509   ! field array is set to ZZSPVAL to hide it in the subsequent processing
2510   !
2511   ZZSPVAL=7777.
2512     WHERE(PTAB(:,:)/=888.)PTAB(:,:)=ZZSPVAL
2513     WHERE(PTAB(:,::2)==888.)PTAB(:,::2)=PTAB(:,::2)+1.E-3
2514   CALL CPSETR('SPV',ZZSPVAL)    ! Special value =  ZZSPVAL
2515   !
2516   ! Effective area computation and contour drawing
2517   !
2518   CALL ARINAM(IIMAP,JPMAP)                              ! Initialize areas
2519 !   call mapbla(iimap)
2520 if(nverbia > 0)then
2521   print *,' ** image AV CPRECT'
2522 endif
2523   CALL CPRECT(PTAB,IM,IM,IL,ZRWRK,JPLRWK,IWRK,JPLIWK)   ! Initialize conpack
2524   CALL CPCLAM(PTAB,ZRWRK,IWRK,IIMAP)                    ! Contours terrain area
2525   CALL CPCLDR(PTAB,ZRWRK,IWRK)                          ! Contours outside field
2526   CALL ARSCAM(IIMAP,ZXWRK,ZYWRK,JPWRK,IAREA,IGRP,JPAREAGRP,SFILL)! Hatches 
2527   !                                                              !terrain area
2528 END IF
2529 !
2530 !-----------------------------------------------------------------------------
2531 !
2532 !*    5.    COMPLETING THE PLOT
2533 !           -------------------
2534 !
2535 !*    5.1   Page information labels
2536 !
2537 CALL GSCLIP(0)
2538 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
2539 XCURVPTL=ZVL;XCURVPTR=ZVR;XCURVPTB=ZVB;XCURVPTT=ZVT
2540
2541 CALL SET(ZVL,ZVR,ZVB,ZVT,ZVL,ZVR,ZVB,ZVT,1)
2542 IF(CTYPHOR == 'T')THEN
2543   IF(.NOT.LTHSTAB)THEN
2544     CALL PLCHHQ(ZVL+.04,ZVT-.04,'*** UNSTABLE THETA ***',.011,0.,-1.)
2545   ENDIF
2546 ELSE IF(CTYPHOR == 'E')THEN
2547   IF(.NOT.LTHSTAB)THEN
2548       CALL PLCHHQ(ZVL+.04,ZVT-.04,'*** VORTICITE NON MONOTONE ***',.011,0.,-1.)
2549   ENDIF
2550 ELSE IF(CTYPHOR == 'V')THEN
2551   IF(.NOT.LTHSTAB)THEN
2552       CALL PLCHHQ(ZVL+.04,ZVT-.04,'*** FONCTION NON MONOTONE ***',.011,0.,-1.)
2553   ENDIF
2554
2555 ENDIF
2556 IF(.NOT.LSUPER)THEN
2557
2558 ! Modifs du 03/04/96
2559   IF(LEN_TRIM(HTEXTE) > 25)THEN                      !+++++++++++++
2560     ZSZTITVAR1=.009
2561   ELSE
2562     ZSZTITVAR1=.011
2563   ENDIF
2564   IF(XSZTITVAR1 /= 0.)THEN
2565     ZSZTITVAR1=XSZTITVAR1
2566   ENDIF
2567   IF(LCOLAREA .OR. LHACH1 .OR. LGREY)THEN
2568 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2569
2570     CALL RESOLV_TIT('CTITVAR1',HTEXTE)
2571     IF(HTEXTE /= ' ')THEN
2572       CALL PLCHHQ(MAX(ZVR,.99),.007,HTEXTE,ZSZTITVAR1,0.,+1.)
2573 !     CALL PLCHHQ(MAX(ZVR,.99),.007,HTEXTE,.011,0.,+1.)
2574     ENDIF
2575
2576   ELSE
2577 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2578
2579     CALL RESOLV_TIT('CTITVAR1',HTEXTE)
2580     IF(HTEXTE /= ' ')THEN
2581       CALL PLCHHQ(.93,.007,HTEXTE,ZSZTITVAR1,0.,+1.)
2582 !     CALL PLCHHQ(.93,.007,HTEXTE,.011,0.,+1.)
2583     ENDIF
2584
2585   ENDIF
2586   IF(LMINMAX)THEN
2587     CALL PCSETC('FC','/')
2588     CAll PLCHHQ(ZVR,ZVT+.03,YLBL,.009,0.,+1.)
2589     CALL PCSETC('FC',':')
2590   ENDIF
2591
2592 ELSE
2593
2594   ZSZTITVAR=0.
2595   IF(NLOOPSUPER == 1)THEN
2596     CALL RESOLV_TIT('CTITVAR1',HTEXTE)
2597     IF(XSZTITVAR1 /= 0.)THEN
2598       ZSZTITVAR=XSZTITVAR1
2599     ENDIF
2600   ELSE IF(NLOOPSUPER == 2)THEN
2601     CALL RESOLV_TIT('CTITVAR2',HTEXTE)
2602     IF(XSZTITVAR2 /= 0.)THEN
2603       ZSZTITVAR=XSZTITVAR2
2604     ENDIF
2605   ELSE IF(NLOOPSUPER == 3)THEN
2606     CALL RESOLV_TIT('CTITVAR3',HTEXTE)
2607     IF(XSZTITVAR3 /= 0.)THEN
2608       ZSZTITVAR=XSZTITVAR3
2609     ENDIF
2610   ELSE IF(NLOOPSUPER == 4)THEN
2611     CALL RESOLV_TIT('CTITVAR4',HTEXTE)
2612     IF(XSZTITVAR4 /= 0.)THEN
2613       ZSZTITVAR=XSZTITVAR4
2614     ENDIF
2615   ELSE IF(NLOOPSUPER == 5)THEN
2616     CALL RESOLV_TIT('CTITVAR5',HTEXTE)
2617     IF(XSZTITVAR5 /= 0.)THEN
2618       ZSZTITVAR=XSZTITVAR5
2619     ENDIF
2620   ELSE IF(NLOOPSUPER == 6)THEN
2621     CALL RESOLV_TIT('CTITVAR6',HTEXTE)
2622     IF(XSZTITVAR6 /= 0.)THEN
2623       ZSZTITVAR=XSZTITVAR6
2624     ENDIF
2625   ELSE IF(NLOOPSUPER == 7)THEN
2626     CALL RESOLV_TIT('CTITVAR7',HTEXTE)
2627     IF(XSZTITVAR7 /= 0.)THEN
2628       ZSZTITVAR=XSZTITVAR7
2629     ENDIF
2630   ELSE IF(NLOOPSUPER == 8)THEN
2631     CALL RESOLV_TIT('CTITVAR8',HTEXTE)
2632     IF(XSZTITVAR8 /= 0.)THEN
2633       ZSZTITVAR=XSZTITVAR8
2634     ENDIF
2635   ENDIF
2636 if(nverbia > 0)then
2637   print *,' image  CTITVAR ',HTEXTE(1:LEN_TRIM(HTEXTE))
2638 endif
2639
2640 ! Modifs du 03/04/96 NON NON REFLECHIR EN CAS DE SUPERPOSITIONS
2641   IF(NSUPER < 4)THEN
2642
2643     IF(NSUPER == 1)ZSC=999.
2644     IF(LEN_TRIM(HTEXTE) > 25)THEN                      !+++++++++++++
2645 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2646       IF((LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER == 1)THEN !000000000000
2647
2648         IF(HTEXTE /= ' ')THEN
2649           IF(ZSZTITVAR /= 0.)THEN
2650             CALL PLCHHQ(MAX(ZVR,.99),.007+(NSUPER-1)*.017,HTEXTE,ZSZTITVAR,0.,+1.)
2651           ELSE
2652             CALL PLCHHQ(MAX(ZVR,.99),.007+(NSUPER-1)*.017,HTEXTE,.005,0.,+1.)
2653           ENDIF
2654         ENDIF
2655
2656       ELSE                                       !00000000000000000000
2657         IF((LHACH2 .AND. NSUPER == 2) .OR. (LHACH3 .AND. NSUPER == 3) .OR. &
2658            (LHACH4 .AND. NSUPER == 4) ) THEN
2659
2660           IF(IHT == 1)THEN
2661             IF(HTEXTE /= ' ')THEN
2662               IF(ZSZTITVAR /= 0.)THEN
2663                 CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,ZSZTITVAR,0.,-1.)
2664               ELSE
2665                 CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,.007,0.,-1.)
2666               ENDIF
2667             ENDIF
2668           ELSE
2669             IF(HTEXTE /= ' ')THEN
2670               IF(ZSZTITVAR /= 0.)THEN
2671                 CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,ZSZTITVAR,0.,-1.)
2672               ELSE
2673                 CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,.005,0.,-1.)
2674               ENDIF
2675             ENDIF
2676           ENDIF
2677         ELSE
2678
2679           IF(HTEXTE /= ' ')THEN
2680             IF(ZSZTITVAR /= 0.)THEN
2681               CALL PLCHHQ(.93,.007+(NSUPER-1)*.017,HTEXTE,ZSZTITVAR,0.,+1.)
2682             ELSE
2683               CALL PLCHHQ(.93,.007+(NSUPER-1)*.017,HTEXTE,.005,0.,+1.)
2684             ENDIF
2685           ENDIF
2686
2687         ENDIF
2688       ENDIF                                      !0000000000000000000
2689
2690       ZSC=.005
2691
2692     ELSE                                               !+++++++++++++
2693
2694 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2695       IF((LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER == 1)THEN
2696
2697         IF(HTEXTE /= ' ')THEN
2698           IF(ZSZTITVAR /= 0.)THEN
2699             CALL PLCHHQ(MAX(ZVR,.99),.007+(NSUPER-1)*.017,HTEXTE,ZSZTITVAR,0.,+1.)
2700           ELSE
2701             CALL PLCHHQ(MAX(ZVR,.99),.007+(NSUPER-1)*.017,HTEXTE,.007,0.,+1.)
2702           ENDIF
2703         ENDIF
2704
2705       ELSE
2706
2707         IF((LHACH2 .AND. NSUPER == 2) .OR. (LHACH3 .AND. NSUPER == 3) .OR. &
2708            (LHACH4 .AND. NSUPER == 4))THEN
2709
2710           IF(HTEXTE /= ' ')THEN
2711             IF(ZSZTITVAR /= 0.)THEN
2712               CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,ZSZTITVAR,0.,-1.)
2713             ELSE
2714               CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,.005,0.,-1.)
2715             ENDIF
2716           ENDIF
2717
2718         ELSE
2719
2720           IF(HTEXTE /= ' ')THEN
2721             IF(ZSZTITVAR /= 0.)THEN
2722               CALL PLCHHQ(.93,.007+(NSUPER-1)*.017,HTEXTE,ZSZTITVAR,0.,+1.)
2723             ELSE
2724               CALL PLCHHQ(.93,.007+(NSUPER-1)*.017,HTEXTE,.007,0.,+1.)
2725             ENDIF
2726           ENDIF
2727
2728         ENDIF
2729       ENDIF
2730
2731     ENDIF                                              !+++++++++++++
2732 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2733     IF((LCOLAREA .OR. LHACH1 .OR. LGREY) .AND. NSUPER == 1)THEN
2734
2735       IF(HTEXTE /= ' ')THEN
2736         CALL PLCHHQ(1.-((LEN_TRIM(HTEXTE)+5)*.007),.007+(NSUPER-1)*.017,CTIMEC(8:15),.007,0.,+1.)
2737       ENDIF
2738
2739     ELSE
2740
2741       IF((LHACH2 .AND. NSUPER == 2) .OR. (LHACH3 .AND. NSUPER == 3) .OR. &
2742          (LHACH4 .AND. NSUPER == 4))THEN
2743 !!!!!!! REFLECHIR
2744 !       CALL PLCHHQ(ZD,ZVT+.04,HTEXTE,.005,0.,-1.)
2745       ELSE
2746         IF(HTEXTE /= ' ')THEN
2747           CALL PLCHHQ(.93-((LEN_TRIM(HTEXTE)+4)*.007),.007+(NSUPER-1)*.017,CTIMEC(8:15),.007,0.,+1.)
2748         ENDIF
2749       ENDIF
2750
2751     ENDIF
2752
2753     IF(LMINMAX)THEN
2754       CALL PCSETC('FC','/')
2755       CAll PLCHHQ(ZVRDEF,ZVT+.01+(NSUPER-1)*.02,YLBL,.007,0.,+1.)
2756       CALL PCSETC('FC',':')
2757     ENDIF
2758
2759   ELSE
2760
2761     IF(ZSC /= 999.)THEN
2762       IF(HTEXTE /= ' ')THEN
2763         CALL PLCHHQ(ZVLDEF+(NSUPER-4)*.25,ZVT+.03,HTEXTE,ZSC,0.,-1.)
2764       ENDIF
2765     ELSE
2766       IF(HTEXTE /= ' ')THEN
2767         CALL PLCHHQ(ZVLDEF+(NSUPER-4)*.25,ZVT+.03,HTEXTE,.007,0.,-1.)
2768       ENDIF
2769     ENDIF
2770
2771   ENDIF
2772
2773
2774 END IF
2775 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
2776 CALL GSLWSC(1.)
2777 CALL GSLN(1)
2778 CALL GSPLCI(1)
2779 CALL GSTXCI(1)
2780 ! Oct 99
2781
2782 !IF(LFACTIMP)THEN
2783 ! CALL FACTIMP
2784 !ENDIF
2785 ! Oct 99
2786 if(nverbia > 0)then
2787   print *,' ** image AV NOT LSUPER'
2788 endif
2789 IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN
2790 ! Mars 2000
2791 IF(LFACTIMP)THEN
2792   CALL FACTIMP
2793 ENDIF
2794 ! Modifs for diachro
2795 ! Remodifs le 170596
2796 ! Titres en X
2797   YTEM(1:LEN(YTEM))=' '
2798   CALL RESOLV_TIT('CTITXL',YTEM)
2799   IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
2800     CALL RESOLV_TIT('CTITXL',YTEM)
2801     IF(XSZTITXL /= 0.)THEN
2802       CALL PLCHHQ(ZVL,ZVB-MIN(ZVB/2.,.05),YTEM,XSZTITXL,0.,-1.)
2803 !     CALL PLCHHQ(ZVL,ZVB/2.,YTEM,XSZTITXL,0.,-1.)
2804     ELSE
2805       CALL PLCHHQ(ZVL,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
2806 !     CALL PLCHHQ(ZVL,ZVB/2.,YTEM,.008,0.,-1.)
2807     ENDIF
2808   ENDIF
2809   YTEM(1:LEN(YTEM))=' '
2810   CALL RESOLV_TIT('CTITXM',YTEM)
2811   IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
2812     CALL RESOLV_TIT('CTITXM',YTEM)
2813     IF(XSZTITXM /= 0.)THEN
2814       CALL PLCHHQ((ZVL+ZVR)/2.,ZVB-MIN(ZVB/2.,.05),YTEM(1:LEN_TRIM(YTEM)),XSZTITXM,0.,0.)
2815 !     CALL PLCHHQ((ZVL+ZVR)/2.,ZVB/2.,YTEM(1:LEN_TRIM(YTEM)),XSZTITXM,0.,0.)
2816 !     CALL PLCHHQ((ZVL+ZVR)/2.-ZVB/2.,ZVB/2.,YTEM,XSZTITXM,0.,-1.)
2817     ELSE
2818       CALL PLCHHQ((ZVL+ZVR)/2.,ZVB-MIN(ZVB/2.,.05),YTEM(1:LEN_TRIM(YTEM)),.008,0.,0.)
2819 !     CALL PLCHHQ((ZVL+ZVR)/2.,ZVB/2.,YTEM(1:LEN_TRIM(YTEM)),.008,0.,0.)
2820 !     CALL PLCHHQ((ZVL+ZVR)/2.-ZVB/2.,ZVB/2.,YTEM,.008,0.,-1.)
2821     ENDIF
2822   ENDIF
2823   YTEM(1:LEN(YTEM))=' '
2824   CALL RESOLV_TIT('CTITXR',YTEM)
2825   IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
2826     CALL RESOLV_TIT('CTITXR',YTEM)
2827     IF(XSZTITXR /= 0.)THEN
2828       CALL PLCHHQ(ZVR-ZVB/2.,ZVB-MIN(ZVB/2.,.05),YTEM,XSZTITXR,0.,-1.)
2829 !     CALL PLCHHQ(ZVR-ZVB/2.,ZVB/2.,YTEM,XSZTITXR,0.,-1.)
2830     ELSE
2831       CALL PLCHHQ(ZVR-ZVB/2.,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
2832 !     CALL PLCHHQ(ZVR-ZVB/2.,ZVB/2.,YTEM,.008,0.,-1.)
2833     ENDIF
2834   ENDIF
2835 ! Titres en Y
2836   YTEM(1:LEN(YTEM))=' '
2837   CALL RESOLV_TITY('CTITYT',ZVL,ZVR,ZVB,ZVT,YTEM)
2838   YTEM(1:LEN(YTEM))=' '
2839   CALL RESOLV_TITY('CTITYM',ZVL,ZVR,ZVB,ZVT,YTEM)
2840   YTEM(1:LEN(YTEM))=' '
2841   CALL RESOLV_TITY('CTITYB',ZVL,ZVR,ZVB,ZVT,YTEM)
2842 ! Titres  TOP
2843   YTEM(1:LEN(YTEM))=' '
2844   ZXPOSTITT2=.002
2845   ZXYPOSTITT2=.95
2846   IF(XPOSTITT2 /= 0.)THEN
2847     ZXPOSTITT2=XPOSTITT2
2848   ENDIF
2849   IF(XYPOSTITT2 /= 0.)THEN
2850     ZXYPOSTITT2=XYPOSTITT2
2851   ENDIF
2852   CALL RESOLV_TIT('CTITT2',YTEM)
2853   IF(YTEM /= ' ')THEN
2854     IF(XSZTITT2 /= 0.)THEN
2855       CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM,XSZTITT2,0.,-1.)
2856 !     CALL PLCHHQ(0.002,0.95,YTEM,XSZTITT2,0.,-1.)
2857     ELSE
2858       CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM,.008,0.,-1.)
2859 !     CALL PLCHHQ(0.002,0.95,YTEM,.008,0.,-1.)
2860     ENDIF
2861   ENDIF
2862   ZXPOSTITT3=.002
2863   ZXYPOSTITT3=.93
2864   IF(XPOSTITT3 /= 0.)THEN
2865     ZXPOSTITT3=XPOSTITT3
2866   ENDIF
2867   IF(XYPOSTITT3 /= 0.)THEN
2868     ZXYPOSTITT3=XYPOSTITT3
2869   ENDIF
2870   YTEM(1:LEN(YTEM))=' '
2871   CALL RESOLV_TIT('CTITT3',YTEM)
2872   IF(YTEM /= ' ')THEN
2873     IF(XSZTITT3 /= 0.)THEN
2874       CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM,XSZTITT3,0.,-1.)
2875 !     CALL PLCHHQ(0.002,0.93,YTEM,XSZTITT3,0.,-1.)
2876     ELSE
2877       CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM,.008,0.,-1.)
2878 !     CALL PLCHHQ(0.002,0.93,YTEM,.008,0.,-1.)
2879     ENDIF
2880   ENDIF
2881
2882 ! Titre N1 BOTTOM
2883   ZXPOSTITB1=.002
2884   ZXYPOSTITB1=.005
2885   IF(XPOSTITB1 /= 0.)THEN
2886     ZXPOSTITB1=XPOSTITB1
2887   ENDIF
2888   IF(XYPOSTITB1 /= 0.)THEN
2889     ZXYPOSTITB1=XYPOSTITB1
2890   ENDIF
2891   CALL RESOLV_TIT('CTITB1',CLEGEND)
2892   IF(CLEGEND /= ' ')THEN
2893     IF(XSZTITB1 /= 0.)THEN
2894       CALL PLCHHQ(ZXPOSTITB1,ZXYPOSTITB1,CLEGEND,XSZTITB1,0.,-1.)
2895     ELSE
2896       CALL PLCHHQ(ZXPOSTITB1,ZXYPOSTITB1,CLEGEND,.007,0.,-1.)
2897     ENDIF
2898   ENDIF
2899 ! Titre N3 BOTTOM
2900   ZXPOSTITB3=.002
2901   ZXYPOSTITB3=.045
2902   IF(XPOSTITB3 /= 0.)THEN
2903     ZXPOSTITB3=XPOSTITB3
2904   ENDIF
2905   IF(XYPOSTITB3 /= 0.)THEN
2906     ZXYPOSTITB3=XYPOSTITB3
2907   ENDIF
2908   IF(LCNCUM .OR. LCNSUM)THEN
2909     CALL RESOLV_TIT('CTITB3',CTIMECS)
2910     IF(CTIMECS /= ' ')THEN
2911       IF(XSZTITB3 /= 0.)THEN
2912         CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,CTIMECS,XSZTITB3,0.,-1.)
2913       ELSE
2914         CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,CTIMECS,.009,0.,-1.)
2915       ENDIF
2916     ENDIF
2917   ELSE
2918     IF(LMINUS .OR. LPLUS)THEN
2919       IF(.NOT.LTITDEFM .AND. CTITB3MEM /= 'DEFAULT' .AND. &
2920       CTITB3MEM /= 'default' .AND. CTITB3MEM /= 'DEFAUT' .AND. &
2921       CTITB3MEM /= 'defaut')THEN
2922 ! Il ne faut pas mettre l'instruction suivante
2923 !       CALL RESOLV_TIT('CTITB3',CTITB3MEM)
2924           if(nverbia > 0)then
2925           print *,' image  CTITB3MEM ',CTITB3MEM(1:LEN_TRIM(CTITB3MEM))
2926           endif
2927           IF(CTITB3MEM /= ' ' .AND. CTITB3MEM /= 'WHITE' .AND. &
2928           CTITB3MEM /= 'white' .AND. CTITB3MEM /= 'BLANC' .AND. &
2929           CTITB3MEM /= 'blanc')THEN
2930             IF(XSZTITB3 /= 0.)THEN
2931               CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,CTITB3MEM(1:LEN_TRIM(CTITB3MEM)),XSZTITB3,0.,-1.)
2932           ELSE
2933               CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,CTITB3MEM(1:LEN_TRIM(CTITB3MEM)),.009,0.,-1.)
2934           ENDIF
2935         ENDIF
2936       ELSE
2937 ! ******************** 200697 ***************
2938           CALL RESOLV_TIT('CTITB3',CTITB3)
2939           if(nverbia > 0)then
2940           print *,' image  CTITB3 ',CTITB3(1:LEN_TRIM(CTITB3))
2941           endif
2942           IF(CTITB3 /= ' ')THEN
2943             IF(XSZTITB3 /= 0.)THEN
2944               CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,CTITB3,XSZTITB3,0.,-1.)
2945             ELSE
2946               CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,CTITB3,.009,0.,-1.)
2947             ENDIF
2948           ENDIF
2949       ENDIF
2950 ! ******************** 200697 ***************
2951     ELSE
2952
2953       IF(CSTORAGE_TYPE /= 'PG')THEN
2954 ! NBPMT=nb de + et -
2955         IF(NBPMT == 0)THEN
2956           YTEM(1:LEN(YTEM))=' '
2957           YTEM=CTIMEC
2958           YTEM=ADJUSTL(YTEM)
2959           CALL RESOLV_TIT('CTITB3',YTEM)
2960           if(nverbia > 0)then
2961           print *,' image LEN et CTIMEC ',LEN(CTIMEC),CTIMEC
2962           print *,' image LEN et YTEM ',LEN(YTEM),YTEM
2963           endif
2964           IF(YTEM/= ' ')THEN
2965             IF(XSZTITB3 /= 0.)THEN
2966               CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,XSZTITB3,0.,-1.)
2967             ELSE
2968               CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,.009,0.,-1.)
2969             ENDIF
2970           ENDIF
2971         ENDIF
2972       ENDIF
2973
2974     ENDIF
2975   ENDIF
2976 ! Titre N2 BOTTOM
2977   ZXPOSTITB2=.002
2978   ZXYPOSTITB2=.025
2979   IF(XPOSTITB2 /= 0.)THEN
2980     ZXPOSTITB2=XPOSTITB2
2981   ENDIF
2982   IF(XYPOSTITB2 /= 0.)THEN
2983     ZXYPOSTITB2=XYPOSTITB2
2984   ENDIF
2985   CALL RESOLV_TIT('CTITB2',CLEGEND2)
2986   IF(CLEGEND2 /= ' ')THEN
2987     IF(XSZTITB2 /= 0.)THEN
2988       CALL PLCHHQ(0.002,0.025,CLEGEND2,XSZTITB2,0.,-1.)
2989     ELSE
2990       CALL PLCHHQ(0.002,0.025,CLEGEND2,.007,0.,-1.)
2991     ENDIF
2992   ENDIF
2993 ! Titre N1 TOP
2994   ZXPOSTITT1=.002
2995   ZXYPOSTITT1=.98
2996   IF(XPOSTITT1 /= 0.)THEN
2997     ZXPOSTITT1=XPOSTITT1
2998   ENDIF
2999   IF(XYPOSTITT1 /= 0.)THEN
3000     ZXYPOSTITT1=XYPOSTITT1
3001   ENDIF
3002   WRITE(YPLANH,1001)NIINF,NISUP,NJINF,NJSUP
3003   CALL RESOLV_TIT('CTITT1',YPLANH)
3004   IF(YPLANH /= ' ')THEN
3005     IF(XSZTITT1 /= 0.)THEN
3006       CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YPLANH,XSZTITT1,0.,-1.)
3007 !     CALL PLCHHQ(0.002,0.98,YPLANH,XSZTITT1,0.,-1.)
3008     ELSE
3009       CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YPLANH,.012,0.,-1.)
3010 !     CALL PLCHHQ(0.002,0.98,YPLANH,.012,0.,-1.)
3011     ENDIF
3012   ENDIF
3013   IF(LDATFILE)CALL DATFILE_FORDIACHRO
3014 ENDIF
3015 !
3016 1001 FORMAT('HORIZONTAL SECTION NIINF=',I4,' NISUP=',I4,' NJINF=',I4,' NJSUP=',I4)
3017 !
3018 CALL GSCLIP(1)
3019 CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
3020 !
3021 !*    5.2   NCAR parameter reset
3022 !
3023 CALL CPSETI('CLS',16)
3024 CALL CPRSET
3025 CALL GSLN(1)
3026 !
3027 !--------------------------------------------------------------------------------
3028 !
3029 !*    6.    EXIT
3030 !           ----
3031 !
3032 RETURN
3033 END SUBROUTINE IMAGE_FORDIACHRO