Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / imcoupv_fordiachro.f90
1 !     ######spl
2       SUBROUTINE IMCOUPV_FORDIACHRO(PU,PW,HLEGEND,HTEXT)
3 !     #################################################
4 !
5 !!****  *IMCOUPV_FORDIACHRO* - Draws a vector arrow plot for a vertical cross-section
6 !!
7 !!    PURPOSE
8 !!    -------
9 !       Draws an arrow plot of a UW vector field re-colocated at the
10 !     mass gridpoint for a vertical cross-section
11 !
12 !!**  METHOD
13 !!    ------
14 !!     
15 !!     Assumption is made that wind components were re-colocated onto the mass
16 !!   gridpoint location prior to calling IMCOUPV.
17 !!   The wind arrows are plotted using the VVECTR NCAR utility.
18 !!     
19 !!     Notice that a TRACE-provided VVUMXY routine is used within the NCAR
20 !!   vector VVECTR utility to map the wind vectors onto the stretched
21 !!   MESO-NH model space.  Wind vectors are given in m/s and scaled by VVUMXY
22 !!   to obtain arrow sizes in "NCAR fractional coordinate" (NCAR User Guide
23 !!   "Fundamentals", Appendix A, p345 section 1), notice this is different
24 !!   from what is required for Conpack... The final result is an automatic
25 !!   arrow scale selection on the plot.
26 !!   If a different procedure has to be followed VVUMXY should
27 !!   be updated accordingly. The parameters of the NCAR VVECTR utility can
28 !!   be printed online by typing "man vectors_params", these feature are not
29 !!   really documented elsewhere in NCAR user guide.
30 !!    
31 !!
32 !!    EXTERNAL
33 !!    --------
34 !!      GSCLIP    : clips items getting out of the drawing window   ! 
35 !!      GETSET    : retrieves the normalized and user NCAR          !
36 !!                  coordinates of a previously used window         ! 
37 !!      PLCHHQ    : prints high-quality character strings           !
38 !!                                                                  !
39 !!      VVSETR !  : gets the value of a NCAR parameter,   REEL      !
40 !!      VVSETI !                                          INTEGER   !
41 !!      VVINIT    : initialize a vector plot (arrows)               !
42 !!      VVECTR    : draws the arrows for a vector plot              !
43 !!                                                                  !
44 !!      GSLWSC    : sets line width                                 !
45 !!      VVRSET    : resets VVECTR parameters to default values     !
46 !!
47 !!
48 !!      VVUMXY    : TRACE provided FORTRAN-77 routine directly called
49 !!                  within the VVECTR NCAR utility to to map the wind
50 !!                  vectors onto the stretched MESO-NH model space.
51 !!
52 !!
53 !!    IMPLICIT ARGUMENTS
54 !!    ------------------
55 !!
56 !!      Module MODD_TITLE  : Declares heading variables for the plots (TRACE)
57 !!         CLEGEND:  Current plot heading title
58 !!
59 !!      Module MODD_COORD  : declares gridpoint coordinates (TRACE use)
60 !!       XXX,XXY  : coordinate values for all the MESO-NH grids
61 !!       XXZS     : topography values for all the MESO_NH grids
62 !!
63 !!      Module MODD_CONF   : declares configuration variables of all models 
64 !!       LCARTESIAN: Logical for cartesian geometry :
65 !!                   .TRUE.  = cartesian geometry
66 !!                   .FALSE. = conformal projection
67 !!
68 !!      Module MODN_PARA   : defines NAM_DOMAIN_POS namelist
69 !!         LHORIZ    : must be .FALSE. to perform vertical cross esctions
70 !!         LVERTI    : must be .TRUE. to perform vertical cross sections
71 !!         Module MODD_DIM1   : Contains dimensions
72 !!            NIMAX, NJMAX :  x, and y array dimensions
73 !!            NIINF, NISUP :  Lower and upper array bounds in x direction
74 !!            NJINF, NJSUP :  Lower bound and upper bound  in y direction
75 !!
76 !!      Module MODN_NCAR : defines NAM_DIRTRA_POS namelist
77 !!                         (former NCAR common)
78 !!        XSPVAL     : Special value
79 !!        NISKIP     : Sampling rate for drawing velocity vectors
80 !!
81 !!      Module MODD_OUT       : Defines a log. unit for printing
82 !!        NIMAXT : x-size of the displayed section of the model array
83 !!        NJMAXT : y-size of the displayed section of the model array
84 !!
85 !!      Module MODD_TIME   ! To be checked, useless..
86 !!      Module MODD_TIME1  ! To be checked, useless.
87 !!
88 !!    REFERENCE
89 !!    ---------
90 !!
91 !!      MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
92 !!       + Book1: Concepts and Fundamentals, to appear in 1994;
93 !!       + Book2: Technical Reference and Flowcharts, to appear in 1994;
94 !!       + Book3: Tutorial, November 1994.
95 !!
96 !!     NCAR Graphics Technical documentation, UNIX version 3.2,
97 !!     Scientific computing division, NCAR/UCAR, Boulder, USA.
98 !!      Volume 1: Fundamentals, Vers. 1, May 1993
99 !!      Volume 2: Contouring and mapping tutorial, Vers. 2, May 1993
100 !!
101 !!    AUTHOR
102 !!    ------
103 !!      J. Duron    * Laboratoire d'Aerologie *
104 !!
105 !!
106 !!    MODIFICATIONS
107 !!    -------------
108 !!      Original       19/09/95
109 !!      Updated   PM  
110 !-------------------------------------------------------------------------------
111 !
112 !*       0.    DECLARATIONS
113 !              ------------
114 !
115 USE MODD_COORD
116 USE MODD_ALLOC_FORDIACHRO
117 USE MODD_PARAMETERS
118 USE MODD_NMGRID
119 USE MODD_GRID
120 USE MODD_GRID1 
121 USE MODD_FIELD1_CV2D
122 USE MODD_SUPER
123 USE MODD_TITLE
124 USE MODD_OUT
125 USE MODN_PARA
126 USE MODN_NCAR
127 USE MODD_LUNIT1
128 USE MODD_CVERT
129 USE MODD_PVT
130 USE MODD_TYPE_AND_LH
131 USE MODD_CTL_AXES_AND_STYL
132 USE MODD_RESOLVCAR
133 USE MODD_TIT
134 USE MODD_DEFCV
135 USE MODD_PT_FOR_CH_FORDIACHRO
136 USE MODE_GRIDPROJ
137 USE MODI_RESOLV_TIT
138 USE MODI_RESOLV_TITY
139 !
140 IMPLICIT NONE
141 !
142 !*       0.0   TRACE interface with the "VVUMXY" routine of the NCAR package
143 !
144 ! NOTICE:  The TRACE provided VVUMXY routine and the NCAR graphical utilities 
145 ! ------   are NOT written in Fortran 90, but in Fortran 77.. This sub-section
146 !          of TRACE does not follow the Meso-NH usual rules: it has to be made 
147 !          using a COMMON stack with  static memory allocation of XZWORKZ and
148 !          XZZDS arrays.
149 !
150 !
151 INTERFACE
152
153 SUBROUTINE GENFORMAT_FORDIACHRO(PCLV,HLLBS)
154 REAL                :: PCLV
155 CHARACTER(LEN=*)    :: HLLBS
156 END SUBROUTINE
157 !
158 END INTERFACE
159 !
160 COMMON/LOGI/LVERT,LHOR,LPT,LXABS
161 COMMON/TEMV/XZWORKZ,XZZDS,NINX,NINY
162 #include "big.h"
163 REAL,DIMENSION(N2DVERTX,2500):: XZWORKZ
164 !REAL,DIMENSION(1000,400):: XZWORKZ
165 !REAL,DIMENSION(200,200) :: XZWORKZ
166 REAL,DIMENSION(N2DVERTX):: XZZDS
167 !REAL,DIMENSION(1000):: XZZDS
168 !REAL,DIMENSION(200) :: XZZDS
169 INTEGER :: NINX, NINY
170 LOGICAL :: LVERT, LHOR, LPT, LXABS
171 !
172 !*       0.1   NCAR work arrays
173 !
174 ! See aforementioned notice. The dimensions of these arrays are
175 ! subject to possible tuning, but have to be prescribed. Add
176 ! extra size if necessary.
177 !
178 INTEGER,PARAMETER       :: JPRSCR=50000, JPISCR=50000
179
180 REAL,DIMENSION(JPRSCR):: ZRSCR
181 INTEGER,DIMENSION(JPISCR):: ISCR
182 !
183 !*       0.2   Dummy arguments and results
184 !
185 REAL,DIMENSION(:,:) :: PU, PW
186 CHARACTER(LEN=*) :: HTEXT       ! Plot heading containing field name
187 CHARACTER(LEN=*) :: HLEGEND
188 !
189 !*       0.3   Local variables
190 !
191 INTEGER :: JLOOPI, JLOOPJ, ILOOP, INUM, IRESP,IDEB,IFIN
192 INTEGER :: JILOOP, JKLOOP, ID, J
193 INTEGER :: IKB, IKE, IKU
194 INTEGER      :: IKL, ILMAX, JLMAX
195 INTEGER      :: ILENYC, ILENHT
196 INTEGER      :: INBCOL, IIBID
197 INTEGER      :: JA, JILOOPD, JILOOPF
198 INTEGER      :: JJ, IJ, II, IUB1, IUB2, ITER, JTER
199 INTEGER      :: ISKIPX, ISKIPY, ITERM, ISKIPXM
200 INTEGER,DIMENSION(:),ALLOCATABLE      :: ICOL
201 !
202 REAL,DIMENSION(SIZE(PU,2),SIZE(PU,1)) :: ZZU, ZZV
203 REAL :: ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT
204 REAL :: ZY, ZJ, ZH, ZJJ, ZWBB
205 REAL :: ZDMX, ZVMX
206 REAL :: ZRAP
207 REAL :: ZXPOSTITT1, ZXYPOSTITT1
208 REAL :: ZXPOSTITT2, ZXYPOSTITT2
209 REAL :: ZXPOSTITT3, ZXYPOSTITT3
210 REAL :: ZXPOSTITB1, ZXYPOSTITB1
211 REAL :: ZXPOSTITB2, ZXYPOSTITB2
212 REAL :: ZXPOSTITB3, ZXYPOSTITB3
213 REAL,DIMENSION(1000) :: ZYY
214 REAL :: ZW,ZM,ZUMN,ZWMN,ZMN,ZWMX,ZMX
215 REAL,DIMENSION(:),ALLOCATABLE      :: ZPARCOLUV
216 REAL :: ZTEM, ZINT, ZRPK, ZLON0, ZBETA
217 REAL :: ZVINT, ZVY, ZINTX, ZINTY
218 REAL,DIMENSION(:,:),ALLOCATABLE    :: ZX, ZLAT, ZLON, ZZY,ZZYY
219 CHARACTER(LEN=4) :: YTE
220 REAL,DIMENSION(:,:),ALLOCATABLE    :: ZDIRU, ZDIRV, ZLA, ZLO  
221 REAL,DIMENSION(:),ALLOCATABLE    :: ZZDS
222 REAL,DIMENSION(18) :: ZCOL
223
224 CHARACTER(LEN=82) :: YCARCOU, YTEM
225 CHARACTER(LEN=80) :: YCAR
226 CHARACTER(LEN=40) :: YLBL
227 CHARACTER(LEN=40) :: YTIT
228 CHARACTER(LEN=8),DIMENSION(:),ALLOCATABLE :: YLBS
229 CHARACTER(LEN=8) :: YLBSTEM
230 CHARACTER(LEN=2) :: YC2
231 CHARACTER(LEN=3) :: YC3
232 CHARACTER(LEN=4) :: YC4
233 CHARACTER(LEN=10) :: YLBLMN,YLBLMX
234 CHARACTER(LEN=10) :: FORMAX, FORMAY
235 !
236 !*       0.4   External for NCAR use
237 !
238 ! SFILL subroutine declared as external provides area control
239 ! in some parts of the contour plot.
240 !
241 !EXTERNAL SFILL
242 !
243 !-------------------------------------------------------------------------------
244 !
245 !*       1.    DISPLAY ENVIRONMENT SETUP AND ARROWS PLOTTING
246 !              ---------------------------------------------
247 !
248 !*       1.1   Array sizes calculation and default field value
249 !
250 !
251 IKU=NKMAX+2*JPVEXT
252 IKB=1+JPVEXT
253 IKE=IKU-JPVEXT
254
255 !!!! ATTENTION  En entree ICI,PU (U) et PW (V ICI) ont comme 1ere dimension
256 !!!! Z (1:IKU) et comme 2eme le temps (qui au trace sera en X) -> besoin
257 !!!! de retablir l'ordre habituel : (Tps,Z) ce qui est fait ds ZZU et ZZV
258
259 ILMAX=SIZE(PU,2)
260 JLMAX=SIZE(PU,1)
261 if(nverbia > 0)then
262 print *, ' ENTREE imcoupv ',ILMAX,JLMAX
263 endif
264
265 ZZU=XSPVAL
266 ZZV=XSPVAL
267
268 ! Janvier 2001
269 !IF(.NOT.LUMVMPV)THEN
270
271   DO JKLOOP=1,JLMAX
272   DO JILOOP=1,ILMAX
273     ZZU(JILOOP,JKLOOP)=PU(JKLOOP,JILOOP)
274     ZZV(JILOOP,JKLOOP)=PW(JKLOOP,JILOOP)
275   ENDDO
276   ENDDO
277
278 !ELSE
279
280 ! Janvier 2001
281 ! DO JKLOOP=1,JLMAX,NISKIPVY
282 ! DO JILOOP=1,ILMAX,NISKIPVX
283 !   ZZU(JILOOP,JKLOOP)=PU(JKLOOP,JILOOP)
284 !   ZZV(JILOOP,JKLOOP)=PW(JKLOOP,JILOOP)
285 ! ENDDO
286 ! ENDDO
287
288 ! Janvier 2001
289 !ENDIF
290 ! Janvier 2001
291 !
292 !
293 !*       1.2  Collects X and Z values 
294 !
295 !*       1.3  Window definition and plot
296 !
297
298 LVERTI=.TRUE. ; LHORIZ=.FALSE.
299 LVERT=LVERTI
300 LHOR=LHORIZ
301
302 CALL GSCLIP(0)
303
304 CALL GSLN(1)
305 CALL GSPLCI(1)
306 CALL GSTXCI(1)
307
308 !IF(LSUPER)THEN
309 ! NSUPER=NSUPER+1
310 ! IF(NSUPER == 1)THEN
311 !   CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,1)
312 ! ELSE
313 !   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
314 ! END IF
315 !ELSE
316 ! CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,1)
317 !ENDIF
318
319 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
320
321 !!!!!!!!!!!!!!!
322 FORMAX='          '
323 IF(LFMTAXEX)THEN
324   FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
325 ELSE
326   FORMAX='(F8.1)'
327 ENDIF
328
329 FORMAY='          '
330 IF(LFMTAXEY)THEN
331   FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
332 ELSE
333   FORMAY='(F7.0)'
334 ENDIF
335 !!!!!!!OCt 2001
336 !IF(ZWL == ZWR)ZWR=ZWL*2
337 !!!!!!!OCt 2001
338
339 IF(LHEURX)THEN
340   CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL/3600.,ZWR/3600.,ZWB,ZWT,ID)
341   CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
342
343 !!!!!!!Avril 2002
344   IF(LMYHEURX)THEN
345     ZH=NHEURXGRAD*3600.
346   ELSE
347 !!!!!!!Avril 2002
348   IF((ZWR-ZWL)/3600. > 24.)THEN
349     ZH=10800.
350   ELSE
351     ZH=3600.
352   ENDIF
353 !!!!!!!Avril 2002
354   ENDIF
355 !!!!!!!Avril 2002
356
357 ELSE
358
359   CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
360 ENDIF
361 !!!!!!!!!!!!!!!
362
363 ! Utilisation de PLCHHQ pour ecriture des labels (sinon 0= WTSTR)
364 CALL GASETI('LTY',1)
365
366 IF(.NOT.LHEURX)THEN
367 ! Avril 2002
368   IF(LNOLABELX .AND. LNOLABELY)THEN
369     CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NCVITVYMJ,NCVITVYMN,0,0,5,0.,0)
370   ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
371     CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NCVITVYMJ,NCVITVYMN,0,1,5,0.,0)
372   ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
373     CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NCVITVYMJ,NCVITVYMN,1,0,5,0.,0)
374   ELSE
375     CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NCVITVYMJ,NCVITVYMN,1,1,5,0.,0)
376   ENDIF
377 ! Avril 2002
378 ENDIF
379
380 !!!!!!!!!!!!!!!
381 IF(LHEURX)THEN
382   CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
383   DO J=INT(ZWL),INT(ZWR)
384     ZJ=J
385
386     IF(MOD(ZJ,ZH) == 0.)THEN
387       CALL FRSTPT(ZJ,ZWB)
388       CALL VECTOR(ZJ,ZWB+(ZWT-ZWB)/90.)
389
390 !!!!!!!Avril 2002
391   IF(LMYHEURX)THEN
392     ZJJ=ZJ/ZH*NHEURXGRAD
393     ZINT=NHEURXLBL
394   ELSE
395 !!!!!!!Avril 2002
396       IF(ZH == 10800.)THEN
397         ZJJ=ZJ/ZH*3.
398         ZINT=6.
399       ELSE
400         ZJJ=ZJ/ZH
401         ZINT=3.
402       ENDIF
403
404 !!!!!!!Avril 2002
405   ENDIF
406 !!!!!!!Avril 2002
407       ZWBB=ZWB-((ZWT-ZWB)/((ZVT-ZVB)/.02))
408
409       IF(.NOT. LNOLABELX)THEN
410       IF(MOD(ZJJ,ZINT) == 0.)THEN
411         IF(ZJJ <10.)THEN
412           WRITE(YC2,'(F2.0)')ZJJ
413           CALL PLCHHQ(ZJ,ZWBB,YC2,.010,0.,0.)
414         ELSEIF(ZJJ <100.)THEN
415           WRITE(YC3,'(F3.0)')ZJJ
416           CALL PLCHHQ(ZJ,ZWBB,YC3,.010,0.,0.)
417         ELSE
418           WRITE(YC4,'(F4.0)')ZJJ
419           CALL PLCHHQ(ZJ,ZWBB,YC4,.010,0.,0.)
420         ENDIF
421       ENDIF
422       ENDIF
423
424     ENDIF
425   ENDDO
426 ! CALL GRIDAL(1,0,NCVITVYMJ,NCVITVYMN,1,1,5,0.,0)
427 ! Avril 2002
428   IF(LNOLABELX .AND. LNOLABELY)THEN
429     CALL GRIDAL(0,0,NCVITVYMJ,NCVITVYMN,0,0,5,0.,0)
430   ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
431     CALL GRIDAL(0,0,NCVITVYMJ,NCVITVYMN,0,1,5,0.,0)
432   ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
433     CALL GRIDAL(0,0,NCVITVYMJ,NCVITVYMN,0,0,5,0.,0)
434   ELSE
435     CALL GRIDAL(0,0,NCVITVYMJ,NCVITVYMN,0,1,5,0.,0)
436   ENDIF
437 ! Avril 2002
438 ENDIF
439 !!!!!!!!!!!!!!!
440
441 ! Janvier 2001
442 !!! Partie commune de LPRINT
443 IF(LPRINT)THEN
444                                        !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
445   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
446   IF(IRESP /= 0)THEN
447     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
448     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
449     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
450   ENDIF
451   ILOOP=SIZE(ZZU,1)/5
452   IF(ILOOP * 5 < SIZE(ZZU,1))ILOOP=ILOOP+1
453
454   IF(.NOT.LPVT)THEN
455     WRITE(INUM,'(''PV  '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'',''   (1-1,1-IKU)'')')CGROUP,&
456 &   CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
457   ELSE
458     IUB1=SIZE(ZZU,1)
459     WRITE(INUM,'(''PV  '',''G:'',A16,'' P:'',A25,'' TD-TF:'',F8.0,''-'',F8.0,''s'')')CGROUP,&
460     CTITRE(NLOOPP)(1:25),XZZDS(1),XZZDS(IUB1)
461     WRITE(INUM,'('' (1-NBTIME,1-IKU)'')')
462   ENDIF
463
464   IF(LMINUS .OR. LPLUS)THEN
465     WRITE(INUM,'(A70)')CTITB3
466   ELSE
467 !   WRITE(INUM,'(A40)')CTITGAL
468   ENDIF
469
470   IF(LUMVMPV)THEN
471     WRITE(INUM,'(''I='',I4,''J='',I4)')&
472     NIL,NJL
473   ELSE
474     IF(LDEFCV2CC)THEN
475       IF(LDEFCV2)THEN
476         WRITE(INUM,'(''cc(deb)-(fin)=('',F8.0,'','',F8.0,'')-('',F8.0,'','',F8.0,'')'','' nlmax'',i5,&
477     &'' profile='',I4)')&
478        &XIDEBCV,XJDEBCV,XIFINCV,XJFINCV,NLMAX,NPROFILE
479       ELSE IF(LDEFCV2LL)THEN
480         WRITE(INUM,'(''ll(deb)-(fin)=('',F8.3,'','',F8.3,'')-('',F8.3,'','',F8.3,'')'','' nlmax'',i5,&
481     &'' profile='',I4)')&
482        &XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL,NLMAX,NPROFILE
483       ELSE IF(LDEFCV2IND)THEN
484         WRITE(INUM,'(''ij(deb)-(fin)=('',I4,'','',I4,'')-('',I4,'','',I4,'')'','' nlmax'',i5,&
485     &'' profile='',i4)')&
486        &NIDEBCV,NJDEBCV,NIFINCV,NJFINCV,NLMAX,NPROFILE
487       ENDIF
488     ELSE
489       IF(XIDEBCOU /= -999.)THEN
490         WRITE(INUM,'(''xidebcou'',F8.0,'' xjdebcou'',F8.0,'' nlmax'',i5,'' nlangle'',i4,&
491     &'' profile='',i4)')&
492        &XIDEBCOU,XJDEBCOU,NLMAX,NLANGLE,NPROFILE
493       ELSE
494         WRITE(INUM,'(''nidebcou'',i4,'' njdebcou'',i4,'' nlmax'',i5,'' nlangle'',i4,&
495     &'' profile='',i4)')&
496        &NIDEBCOU,NJDEBCOU,NLMAX,NLANGLE,NPROFILE
497       ENDIF
498     ENDIF
499 !   WRITE(INUM,'(''nprofile='',I4)')NPROFILE
500   ENDIF
501
502     WRITE(INUM,'(''NBVAL en I (TIME): '',i4, &
503 &  '' NBVAL en K (Z)'',i4,''    iter'',i3)') &
504   & SIZE(ZZU,1),SIZE(ZZU,2),ILOOP
505                                          !%%%%%%%%%%%%%%%%%%%%%%%%%
506 ! JUin 2001 Ecriture des dates (Demande G.Jaubert ) si LPRDAT=T
507   IF(LPRDAT)THEN
508     IF(.NOT.ALLOCATED(XPRDAT))THEN
509       print *,'**IMCOUPV XPRDAT NON ALLOUE.Dates non ecrites ds FICVAL .Prevenir J.Duron'
510     ELSE
511       WRITE(INUM,'(1X,75(1H*))')
512       WRITE(INUM,'(1X,''    Dates courante   *     modele      *   experience    *      segment'')')
513       WRITE(INUM,'(1X,'' J   An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.  * An  M  J  Sec.'')')
514       WRITE(INUM,'(1X,75(1H*))')
515       DO J=1,SIZE(XPRDAT,2)
516         WRITE(INUM,'(1X,I3,1X,3(I4,I3,I3,I6,'' *''),I4,I3,I3,I6)')J,INT(XPRDAT(:,J))
517       ENDDO
518     ENDIF
519   ENDIF
520 ! JUin 2001 Ecriture des dates 
521 ENDIF 
522
523 !!!! Janvier 2001 + LDIRWIND
524 IF(LDIRWIND)THEN
525   if(nverbia > 0)then
526   print *,' imcoupv LDIRWIND ',LDIRWIND
527   endif
528   ISKIPX=NISKIPVX
529   ISKIPY=NISKIPVY
530   IUB1=SIZE(ZZU,1)
531 !!30/01/01
532 ! ITER=IUB1/ISKIPX+1
533 ! IF(1+(ITER-1)*ISKIPX > IUB1)ITER=ITER-1
534   ITERM=IUB1/ISKIPX+1
535   IF(1+(ITERM-1)*ISKIPX > IUB1)ITERM=ITERM-1
536   ITER=IUB1
537   ISKIPXM=ISKIPX
538   ISKIPX=1
539 !!30/01/01
540   IUB2=SIZE(ZZU,2)
541 ! 130101
542 !!! Essai de conservation de 1 a IKU en Y (pour LPRINT) mais
543 !!! de 1 a ITER en X
544 !!!  JTER=(IUB2-IKB)/ISKIPY+1
545 !!!  IF(IKB+(JTER-1)*ISKIPY > IUB2)JTER=JTER-1
546   JTER=IUB2
547 !!!
548   ALLOCATE(ZX(ITER,1),ZZY(ITER,JTER),ZZYY(ITER,1),ZLAT(ITER,1),ZLON(ITER,1))
549   ALLOCATE(ZLA(ITER,JTER),ZLO(ITER,JTER),ZDIRU(ITER,JTER),ZDIRV(ITER,JTER))
550   ALLOCATE(ZZDS(ITER))
551 ! 130101
552 ! print *,' IIIIIMCOUPV IUB1, ISKIPX, ITER, IUB2, ISKIPY, JTER,LPV ',IUB1,ISKIPX,ITER,IUB2,ISKIPY,JTER,LPV
553
554 !!!
555   ZDIRU=XSPVAL
556   ZDIRV=XSPVAL
557 !!!  ZDIRU=ZZU(1:IUB1:ISKIPX,IKB:IUB2:ISKIPY)
558 !!!  ZDIRV=ZZV(1:IUB1:ISKIPX,IKB:IUB2:ISKIPY)
559   ZDIRU=ZZU(1:IUB1:ISKIPX,1:IUB2:1)
560   ZDIRV=ZZV(1:IUB1:ISKIPX,1:IUB2:1)
561 !!!
562   if(nverbia > 0)then
563     print *,' ZDIRU AP CHARG. ZZU'
564     print *,ZDIRU 
565     print *,' ZDIRV AP CHARG. ZZV'
566     print *,ZDIRV
567   endif
568
569 ! Chargement des temps ICI .
570   ZZDS=XTDIRWIND(1:IUB1:ISKIPX)
571 ! print *,' IIIIIMCOUPV XDSX(1:IUB1) ',XDSX(1:IUB1,1)
572 ! print *,' IIIIIMCOUPV ZX(:,1) ',ZX(:,1)
573 ! 130101
574   JJ=0
575 !!!
576 !!!  DO JKLOOP=IKB,IUB2,ISKIPY
577   DO JKLOOP=1,IUB2
578 !!!
579     JJ=JJ+1
580     II=0
581     DO JILOOP=1,IUB1,ISKIPX
582       II=II+1
583       ZZY(II,JJ)=XZWORKZ(JILOOP,JKLOOP)
584     ENDDO
585   ENDDO
586
587 ! 130101
588 ! print *,' IIIIMCOUPV IUB1,ISKIPX,IKB,IUB2,ISKIPY ',IUB1,ISKIPX,IKB,IUB2
589 ! print *,' IIIIMCOUPV XZWORKZ(1:NLMAX,IKB) ',XZWORKZ(1:NLMAX,IKB)
590 ! print *,' IIIIMCOUPV ZZY(:,1) ',ZZY(:,1)
591 ! print *,' IIIIMCOUPV XZWORKZ(1:NLMAX,IKB+1) ',XZWORKZ(1:NLMAX,IKB+1)
592 ! print *,' IIIIMCOUPV ZZY(:,2) ',ZZY(:,2)
593
594 ! 130101
595   ZX(:,1)=XDSX(1,1)
596   ZZYY(:,1)=XDSY(1,1)
597
598   IF(ALLOCATED(ICOL))THEN
599     DEALLOCATE(ICOL)
600   ENDIF
601   ALLOCATE(ICOL(18))
602
603   DO JKLOOP=1,JTER
604     CALL SM_LATLON_A(XLATORI,XLONORI,ZX,ZZYY,ZLAT,ZLON)
605     ZLA(:,JKLOOP)=ZLAT(:,1)
606     ZLO(:,JKLOOP)=ZLON(:,1)
607   ENDDO
608
609   where(zdiru /= xspval .AND. zdirv /= xspval)
610     ZDIRU=ATAN2(ZDIRV,ZDIRU)*180./ACOS(-1.)
611   endwhere
612
613   if(nverbia > 0)then
614     print *,' ZDIRU AP ATAN2 '
615     print *,ZDIRU 
616     print *,' ZDIRU 1,1 ITER/2,1 1,JTER/2 ITER/2,JTER/2 ITER,JTER  '
617     print *,ZDIRU(1,1),  ZDIRU(ITER/2,1), ZDIRU(1,JTER/2), ZDIRU(ITER/2,JTER/2), &
618     ZDIRU(ITER,JTER)
619   endif
620
621   ZRPK=XRPK
622   ZBETA=XBETA
623   ZLON0=XLON0
624   where(zdiru /= xspval .AND. zdirv /= xspval)
625     ZDIRU=ZDIRU - (ZRPK*(ZLO-ZLON0)-ZBETA) + 90.
626   endwhere
627   WHERE(ZDIRU < 0.)ZDIRU=ZDIRU+360.
628   WHERE(ZDIRU > 360. .AND. ZDIRU /= XSPVAL)ZDIRU=ZDIRU-360.
629
630   if(nverbia > 0)then
631     print *,' ZDIRU AP WHERE(ZDIRU < 0.'
632     print *,ZDIRU 
633     print *,' ZDIRU 1,1 ITER/2,1 1,JTER/2 ITER/2,JTER/2 ITER,JTER '
634     print *,ZDIRU(1,1),  ZDIRU(ITER/2,1), ZDIRU(1,JTER/2), ZDIRU(ITER/2,JTER/2), &
635     ZDIRU(ITER,JTER)
636   endif
637
638   where(zdiru /= xspval .AND. zdirv /= xspval)
639     ZDIRV=360.-ZDIRU
640   elsewhere
641     ZDIRV=XSPVAL
642   endwhere
643
644   if(nverbia > 0)then
645     print *,' ZDIRV 1,1 ITER/2,1 1,JTER/2 ITER/2,JTER/2 ITER,JTER '
646     print *,ZDIRV(1,1),  ZDIRV(ITER/2,1), ZDIRV(1,JTER/2), ZDIRV(ITER/2,JTER/2), &
647     ZDIRV(ITER,JTER)
648   endif
649       if(nverbia > 0)then
650         print *,' AV LPRINT DIRWIND ZDIRU '
651         print *, ZDIRU
652         print *,' AV LPRINT DIRWIND ZDIRV '
653         print *, ZDIRV
654       endif
655
656   CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
657
658 if(nverbia > 0)then
659   print *,' ** imcoupv ap getset ZWL,ZWR,XDS(1,1),XDS(NLMAX,1),ZX(1,1),ZX(ITER,1) ',ZWL,ZWR,XDS(1,1),XDS(NLMAX,1),ZX(1,1),ZX(ITER,1)
660 endif
661 !! 30/01/01
662   IF(ITERM > 6)THEN
663 ! IF(ITER > 6)THEN
664     CALL GSCLIP(1)
665   ELSE
666     CALL GSCLIP(0)
667   ENDIF
668
669   CALL TABCOL_FORDIACHRO
670
671   IJ=1
672   DO J=15,345,30
673     IJ=IJ+1
674     ZCOL(IJ)=J
675   ENDDO
676   ZCOL(1)=0.
677   IJ=IJ+1
678   ZCOL(IJ)=360.
679
680   ICOL(1)=4; ICOL(13)=4; ICOL(2)=88; ICOL(3)=79; ICOL(4)=7
681   ICOL(5)=52; ICOL(6)=25; ICOL(7)=2; ICOL(8)=20; ICOL(9)=24
682   ICOL(10)=3; ICOL(11)=124; ICOL(12)=5; ICOL(13)=4
683
684   IF(LPV)THEN
685     JILOOPD=NPROFILE
686     JILOOPF=NPROFILE
687   ELSE
688     JILOOPD=1
689     JILOOPF=ITER
690   ENDIF
691
692 !!!
693 !!!  DO JKLOOP=1,JTER
694   DO JKLOOP=IKB,JTER,ISKIPY
695 !!!
696 !! 30/01/01
697     DO JILOOP=JILOOPD,JILOOPF,ISKIPXM
698 !   DO JILOOP=JILOOPD,JILOOPF
699 !! 30/01/01
700       IF(ZDIRV(JILOOP,JKLOOP) == XSPVAL)THEN
701 !       print *,J,' CYCLE  ',ZDIRV(JILOOP,JKLOOP),ZCOL(J),ZCOL(J-1)
702         CYCLE
703       ENDIF
704       DO J=2,IJ
705 !       print *,J,' ',ZDIRV(JILOOP,JKLOOP),ZCOL(J),ZCOL(J-1)
706         
707         IF(ZDIRV(JILOOP,JKLOOP) == 0. .OR. ZDIRV(JILOOP,JKLOOP) == 360.)THEN
708           CALL GSPMCI(ICOL(1))
709 !         print *,' ZDIRV(JILOOP,JKLOOP) J+2 ',ZDIRV(JILOOP,JKLOOP),ICOL(1)
710           EXIT
711         ELSE IF(ZDIRV(JILOOP,JKLOOP) < ZCOL(J).AND. &
712                 ZDIRV(JILOOP,JKLOOP) >= ZCOL(J-1))THEN
713           CALL GSPMCI(ICOL(J-1))
714 !         print *,' ZDIRV(JILOOP,JKLOOP) J+1 ',ZDIRV(JILOOP,JKLOOP),ICOL(J)
715           EXIT
716         ENDIF
717       ENDDO
718       CALL GSMK(2)
719
720 !!! Janvier 2001
721       IF(LPV)THEN
722 !       ZINTX=(ZWL+ZWR)/2
723         ZINTX=ZZDS(JILOOP)
724       ELSE
725         ZINTX=ZZDS(JILOOP)
726 !       print *,' **imcoupv ZINTX ',ZINTX
727       ENDIF
728
729       ZINTY=ZZY(JILOOP,JKLOOP)
730       IF(ZINTY < XHMIN .OR. ZINTY > XHMAX)THEN
731         CYCLE
732       ENDIF
733
734       CALL GPM(1,ZINTX,ZINTY)
735       CALL GSMK(3)
736       CALL GPM(1,ZINTX,ZINTY)
737       CALL GSMK(5)
738       CALL GPM(1,ZINTX,ZINTY)
739     ENDDO
740     CALL SFLUSH
741   ENDDO
742
743   CALL GSCLIP(0)
744
745 ! Legende couleurs
746
747   CALL SET(ZVL,ZVR,ZVB,ZVT,ZVL,ZVR,ZVB,ZVT,1)
748
749   ZVINT=(ZVT-ZVB)/12.
750   ZVY=ZVB
751   YTE='    '
752   WRITE(YTE,'(F4.0)')ZCOL(1)
753   CALL PLCHHQ(ZVR+.0002,ZVY,YTE,.012,0.,-1.)
754 ! print *,'ZVR,ZVY,YTE ',ZVR,ZVY,YTE
755   DO J=1,6
756     CALL GSPMCI(ICOL(1))
757     ZINTX=ZVR+.005*J
758     ZINTY=ZVY+.015
759     CALL GSMK(2)
760     CALL GPM(1,ZINTX,ZINTY)
761     CALL GSMK(3)
762     CALL GPM(1,ZINTX,ZINTY)
763     CALL GSMK(5)
764     CALL GPM(1,ZINTX,ZINTY)
765   ENDDO
766   ZVY=ZVY+ZVINT/2.
767   YTE='    '
768   WRITE(YTE,'(F4.0)')ZCOL(2)
769   CALL PLCHHQ(ZVR+.0002,ZVY,YTE,.012,0.,-1.)
770 ! print *,'ZVR,ZVY,YTE ',ZVR,ZVY,YTE
771   DO J=1,6
772     CALL GSPMCI(ICOL(2))
773     ZINTX=ZVR+.005*J
774     ZINTY=ZVY+.015
775     CALL GSMK(2)
776     CALL GPM(1,ZINTX,ZINTY)
777     CALL GSMK(3)
778     CALL GPM(1,ZINTX,ZINTY)
779     CALL GSMK(5)
780     CALL GPM(1,ZINTX,ZINTY)
781   ENDDO
782   DO J=3,13
783     ZVY=ZVY+ZVINT
784     YTE='    '
785     WRITE(YTE,'(F4.0)')ZCOL(J)
786     CALL PLCHHQ(ZVR+.0002,ZVY,YTE,.012,0.,-1.)
787 ! print *,'ZVR,ZVY,YTE ',ZVR,ZVY,YTE
788     DO JA=1,6
789       CALL GSPMCI(ICOL(J))
790       ZINTX=ZVR+.005*JA
791       ZINTY=ZVY+.015
792       CALL GSMK(2)
793       CALL GPM(1,ZINTX,ZINTY)
794       CALL GSMK(3)
795       CALL GPM(1,ZINTX,ZINTY)
796       CALL GSMK(5)
797       CALL GPM(1,ZINTX,ZINTY)
798     ENDDO
799   ENDDO
800   ZVY=ZVY+ZVINT/2.
801   YTE='    '
802   WRITE(YTE,'(F4.0)')ZCOL(14)
803   CALL PLCHHQ(ZVR+.0002,ZVY,YTE,.012,0.,-1.)
804
805
806   IF(LPRINT)THEN
807                                          !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
808     DO JLOOPI=1,ILOOP
809       IF(JLOOPI == 1)THEN
810         IDEB=1; IFIN=5
811       ELSE
812         IDEB=IFIN+1; IFIN=IFIN+5
813       ENDIF
814       IF(JLOOPI == ILOOP)THEN
815         IFIN=SIZE(ZZU,1)
816       ENDIF
817       
818       if(nverbia > 0)then
819         print *,' ds LPRINT DIRWIND ZDIRU '
820         print *, ZDIRU
821         print *,' ds LPRINT DIRWIND ZDIRV '
822         print *, ZDIRV
823       endif
824       WRITE(INUM,'(1X,79(1H*))')
825       WRITE(INUM,'(''  K  I->   '',I4,6X,4(6X,I4,6X))')(/(II,II=IDEB,IFIN)/)
826       WRITE(INUM,'(''.'',79(1H*))')
827       DO JLOOPJ=SIZE(ZZU,2),1,-1
828         WRITE(INUM,'(I4,1X,5(1X,E14.7))')JLOOPJ,(ZDIRV(II,JLOOPJ),II=IDEB,IFIN)
829   !     WRITE(INUM,'(I4,1X,5E15.8)')JLOOPJ,(ZDIRV(II,JLOOPJ),II=IDEB,IFIN)
830       ENDDO
831       WRITE(INUM,'(1X,79(1H*))')
832     ENDDO
833                                          !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
834   ENDIF
835
836   IF(LPRINTXY)THEN
837                                          !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
838     CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
839     IF(IRESP /= 0)THEN
840       CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
841       OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
842       PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
843     ENDIF
844
845     IF(.NOT.LPVT)THEN
846       WRITE(INUM,'(''PV  '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'',''   (1-1,1-IKU)'')')CGROUP,&
847   &   CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
848     ELSE
849       WRITE(INUM,'(''PV  '',''G:'',A16,'' P:'',A25,'' TD-TF:'',F8.0,''-'',F8.0,''s'')')CGROUP,&
850       CTITRE(NLOOPP)(1:25),XZZDS(1),XZZDS(IUB1)
851       WRITE(INUM,'('' (1-NBTIME,1-IKU)'')')
852     ENDIF
853   
854     IF(LMINUS .OR. LPLUS)THEN
855       WRITE(INUM,'(A70)')CTITB3
856     ELSE
857   !   WRITE(INUM,'(A40)')CTITGAL
858     ENDIF
859   
860     IF(LUMVMPV)THEN
861       WRITE(INUM,'(''I='',I4,''J='',I4)')&
862       NIL,NJL
863     ELSE
864       IF(LDEFCV2CC)THEN
865         IF(LDEFCV2)THEN
866           WRITE(INUM,'(''cc(deb)-(fin)=('',F8.0,'','',F8.0,'')-('',F8.0,'','',F8.0,'')'','' nlmax'',i5,&
867       &'' profile='',I4)')&
868          &XIDEBCV,XJDEBCV,XIFINCV,XJFINCV,NLMAX,NPROFILE
869         ELSE IF(LDEFCV2LL)THEN
870           WRITE(INUM,'(''ll(deb)-(fin)=('',F8.3,'','',F8.3,'')-('',F8.3,'','',F8.3,'')'','' nlmax'',i5,&
871       &'' profile='',I4)')&
872          &XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL,NLMAX,NPROFILE
873         ELSE IF(LDEFCV2IND)THEN
874           WRITE(INUM,'(''ij(deb)-(fin)=('',I4,'','',I4,'')-('',I4,'','',I4,'')'','' nlmax'',i5,&
875       &'' profile='',i4)')&
876          &NIDEBCV,NJDEBCV,NIFINCV,NJFINCV,NLMAX,NPROFILE
877         ENDIF
878       ELSE
879         IF(XIDEBCOU /= -999.)THEN
880           WRITE(INUM,'(''xidebcou'',F8.0,'' xjdebcou'',F8.0,'' nlmax'',i5,'' nlangle'',i4,&
881       &'' profile='',i4)')&
882          &XIDEBCOU,XJDEBCOU,NLMAX,NLANGLE,NPROFILE
883         ELSE
884           WRITE(INUM,'(''nidebcou'',i4,'' njdebcou'',i4,'' nlmax'',i5,'' nlangle'',i4,&
885       &'' profile='',i4)')&
886          &NIDEBCOU,NJDEBCOU,NLMAX,NLANGLE,NPROFILE
887         ENDIF
888       ENDIF
889   !   WRITE(INUM,'(''nprofile='',I4)')NPROFILE
890     ENDIF
891   
892       WRITE(INUM,'(''NBVAL en I (TIME): '',i4, &
893   &  '' NBVAL en K (Z)'',i4,''    iter'',i3)') &
894     & SIZE(ZZU,1),SIZE(ZZU,2),ILOOP
895   
896       II=MAX(SIZE(ZZU,1),SIZE(ZZU,2))
897       WRITE(INUM,'(1X,43(1H*))')
898       WRITE(INUM,'(2X,''  I'',7X,''TIME'',10X,''K'',9X,''Z'')')
899       WRITE(INUM,'(1X,43(1H*))')
900       DO JLOOPJ=1,II
901         IF(SIZE(ZZU,1) > SIZE(ZZU,2))THEN
902           IF(JLOOPJ <= SIZE(ZZU,2))THEN
903              WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
904             JLOOPJ,XZWORKZ(1,JLOOPJ)
905           ELSE
906             WRITE(INUM,'(I5,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ)
907           ENDIF
908         ELSE IF(SIZE(ZZU,2) > SIZE(ZZU,1))THEN
909           IF(JLOOPJ <= SIZE(ZZU,1))THEN
910             WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
911             JLOOPJ,XZWORKZ(1,JLOOPJ)
912           ELSE
913             WRITE(INUM,'(23X,I4,2X,E15.8)')JLOOPJ,XZWORKZ(1,JLOOPJ)
914           ENDIF
915         ELSE
916           WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
917           JLOOPJ,XZWORKZ(1,JLOOPJ)
918         ENDIF
919       ENDDO
920       WRITE(INUM,'(1X,43(1H*))')
921                                        !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
922   ENDIF
923
924   CALL GSCLIP(0)
925   DEALLOCATE(ZX,ZZY,ZZYY,ZLAT,ZLON,ZLA,ZLO,ZDIRU,ZDIRV,ICOL,ZZDS)
926
927 ELSE
928
929 !!!! Janvier 2001 + LDIRWIND
930   IF(LPRINT)THEN
931                                          !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
932     DO JLOOPI=1,ILOOP
933       IF(JLOOPI == 1)THEN
934         IDEB=1; IFIN=5
935       ELSE
936         IDEB=IFIN+1; IFIN=IFIN+5
937       ENDIF
938       IF(JLOOPI == ILOOP)THEN
939         IFIN=SIZE(ZZU,1)
940       ENDIF
941       
942       IF(INDEX(CGROUP,'UM') /= 0)THEN
943         WRITE(INUM,'(1X,20(1H*),'' UM  component '',34(1H*))')
944       ELSE
945         WRITE(INUM,'(1X,20(1H*),'' UT  component '',34(1H*))')
946       ENDIF
947       if(nverbia > 0)then
948         print *,' ds LPRINT ZZU'
949         print *, ZZU
950       endif
951 !     WRITE(INUM,'(1X,79(1H*))')
952       WRITE(INUM,'(''  K  I->   '',I4,6X,4(6X,I4,6X))')(/(II,II=IDEB,IFIN)/)
953       WRITE(INUM,'(''.'',79(1H*))')
954       DO JLOOPJ=SIZE(ZZU,2),1,-1
955         WRITE(INUM,'(I4,1X,5(1X,E14.7))')JLOOPJ,(ZZU(II,JLOOPJ),II=IDEB,IFIN)
956   !     WRITE(INUM,'(I4,1X,5E15.8)')JLOOPJ,(ZZU(II,JLOOPJ),II=IDEB,IFIN)
957       ENDDO
958       WRITE(INUM,'(1X,79(1H*))')
959
960       IF(INDEX(CGROUP,'VM') /= 0)THEN
961         WRITE(INUM,'(1X,20(1H*),'' VM  component '',34(1H*))')
962       ELSE
963         WRITE(INUM,'(1X,20(1H*),'' VT  component '',34(1H*))')
964       ENDIF
965       WRITE(INUM,'(''  K  I->   '',I4,6X,4(6X,I4,6X))')(/(II,II=IDEB,IFIN)/)
966       WRITE(INUM,'(''.'',79(1H*))')
967       DO JLOOPJ=SIZE(ZZV,2),1,-1
968         WRITE(INUM,'(I4,1X,5(1X,E14.7))')JLOOPJ,(ZZV(II,JLOOPJ),II=IDEB,IFIN)
969       ENDDO
970       WRITE(INUM,'(1X,79(1H*))')
971     ENDDO
972                                          !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
973   ENDIF
974
975   IF(LPRINTXY)THEN
976                                          !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
977     CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
978     IF(IRESP /= 0)THEN
979       CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
980       OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
981       PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
982     ENDIF
983
984     IF(.NOT.LPVT)THEN
985       WRITE(INUM,'(''PV  '',''G:'',A16,'' P:'',A25,'' T:'',F8.0,''s'',''   (1-1,1-IKU)'')')CGROUP,&
986   &   CTITRE(NLOOPP)(1:25),XTRAJT(NLOOPT,1)
987     ELSE
988       WRITE(INUM,'(''PV  '',''G:'',A16,'' P:'',A25,'' TD-TF:'',F8.0,''-'',F8.0,''s'')')CGROUP,&
989       CTITRE(NLOOPP)(1:25),XZZDS(1),XZZDS(IUB1)
990       WRITE(INUM,'('' (1-NBTIME,1-IKU)'')')
991     ENDIF
992   
993     IF(LMINUS .OR. LPLUS)THEN
994       WRITE(INUM,'(A70)')CTITB3
995     ELSE
996   !   WRITE(INUM,'(A40)')CTITGAL
997     ENDIF
998   
999     IF(LUMVMPV)THEN
1000       WRITE(INUM,'(''I='',I4,''J='',I4)')&
1001       NIL,NJL
1002     ELSE
1003       IF(LDEFCV2CC)THEN
1004         IF(LDEFCV2)THEN
1005           WRITE(INUM,'(''cc(deb)-(fin)=('',F8.0,'','',F8.0,'')-('',F8.0,'','',F8.0,'')'','' nlmax'',i5,&
1006       &'' profile='',I4)')&
1007          &XIDEBCV,XJDEBCV,XIFINCV,XJFINCV,NLMAX,NPROFILE
1008         ELSE IF(LDEFCV2LL)THEN
1009           WRITE(INUM,'(''ll(deb)-(fin)=('',F8.3,'','',F8.3,'')-('',F8.3,'','',F8.3,'')'','' nlmax'',i5,&
1010       &'' profile='',I4)')&
1011          &XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL,NLMAX,NPROFILE
1012         ELSE IF(LDEFCV2IND)THEN
1013           WRITE(INUM,'(''ij(deb)-(fin)=('',I4,'','',I4,'')-('',I4,'','',I4,'')'','' nlmax'',i5,&
1014       &'' profile='',i4)')&
1015          &NIDEBCV,NJDEBCV,NIFINCV,NJFINCV,NLMAX,NPROFILE
1016         ENDIF
1017       ELSE
1018         IF(XIDEBCOU /= -999.)THEN
1019           WRITE(INUM,'(''xidebcou'',F8.0,'' xjdebcou'',F8.0,'' nlmax'',i5,'' nlangle'',i4,&
1020       &'' profile='',i4)')&
1021          &XIDEBCOU,XJDEBCOU,NLMAX,NLANGLE,NPROFILE
1022         ELSE
1023           WRITE(INUM,'(''nidebcou'',i4,'' njdebcou'',i4,'' nlmax'',i5,'' nlangle'',i4,&
1024       &'' profile='',i4)')&
1025          &NIDEBCOU,NJDEBCOU,NLMAX,NLANGLE,NPROFILE
1026         ENDIF
1027       ENDIF
1028   !   WRITE(INUM,'(''nprofile='',I4)')NPROFILE
1029     ENDIF
1030   
1031       WRITE(INUM,'(''NBVAL en I (TIME): '',i4, &
1032   &  '' NBVAL en K (Z)'',i4,''    iter'',i3)') &
1033     & SIZE(ZZU,1),SIZE(ZZU,2),ILOOP
1034   
1035       II=MAX(SIZE(ZZU,1),SIZE(ZZU,2))
1036       WRITE(INUM,'(1X,43(1H*))')
1037       WRITE(INUM,'(2X,''  I'',7X,''TIME'',10X,''K'',9X,''Z'')')
1038       WRITE(INUM,'(1X,43(1H*))')
1039       DO JLOOPJ=1,II
1040         IF(SIZE(ZZU,1) > SIZE(ZZU,2))THEN
1041           IF(JLOOPJ <= SIZE(ZZU,2))THEN
1042              WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
1043             JLOOPJ,XZWORKZ(1,JLOOPJ)
1044           ELSE
1045             WRITE(INUM,'(I5,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ)
1046           ENDIF
1047         ELSE IF(SIZE(ZZU,2) > SIZE(ZZU,1))THEN
1048           IF(JLOOPJ <= SIZE(ZZU,1))THEN
1049             WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
1050             JLOOPJ,XZWORKZ(1,JLOOPJ)
1051           ELSE
1052             WRITE(INUM,'(23X,I4,2X,E15.8)')JLOOPJ,XZWORKZ(1,JLOOPJ)
1053           ENDIF
1054         ELSE
1055           WRITE(INUM,'(I5,2X,E15.8,1X,I4,2X,E15.8)')JLOOPJ,XZZDS(JLOOPJ), &
1056           JLOOPJ,XZWORKZ(1,JLOOPJ)
1057         ENDIF
1058       ENDDO
1059       WRITE(INUM,'(1X,43(1H*))')
1060                                        !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1061   ENDIF
1062 ! Janvier 2001
1063
1064   ZZU=XSPVAL
1065   ZZV=XSPVAL
1066   IF(.NOT.LUMVMPV)THEN
1067     DO JKLOOP=IKB,JLMAX,NISKIPVY
1068     DO JILOOP=1,ILMAX,NISKIPVX
1069       ZZU(JILOOP,JKLOOP)=PU(JKLOOP,JILOOP)
1070       ZZV(JILOOP,JKLOOP)=PW(JKLOOP,JILOOP)
1071     ENDDO
1072     ENDDO
1073
1074   ELSE
1075
1076     DO JKLOOP=1,JLMAX,NISKIPVY
1077     DO JILOOP=1,ILMAX,NISKIPVX
1078       ZZU(JILOOP,JKLOOP)=PU(JKLOOP,JILOOP)
1079       ZZV(JILOOP,JKLOOP)=PW(JKLOOP,JILOOP)
1080     ENDDO
1081     ENDDO
1082
1083   ENDIF
1084 ! Janvier 2001
1085
1086 !
1087 !*       1.4  Collects wind values within the user postprocessing
1088 !*            window with a sampling rate of NISKIP outside values 
1089 !*            are kept to default
1090 !
1091
1092 CALL GSCLIP(0)
1093 !
1094 !
1095 !*       1.5  Routine VVUMXY of provided by TRACE to locate and scale wind
1096 !*            arrows on the display
1097 !
1098 CALL VVSETI('MAP',4)
1099 CALL VVSETI('SET',0)
1100 CALL VVSETR('VPL',ZVL)    
1101 CALL VVSETR('VPR',ZVR)
1102 CALL VVSETR('VPB',ZVB)
1103 CALL VVSETR('VPT',ZVT)
1104 CALL VVSETR('WDL',ZWL)
1105 CALL VVSETR('WDR',ZWR)
1106 CALL VVSETR('WDB',ZWB)
1107 CALL VVSETR('WDT',ZWT)
1108
1109
1110 CALL VVSETR('AMX',XAMX)
1111 CALL VVSETR('VHC',XVHC)
1112 CALL VVSETR('VRL',XVRL)
1113 CALL VVSETR('VLC',XVLC)
1114
1115 IF(XVHC < 0. )THEN
1116   CALL VVSETC('MXT',' ')
1117   CALL VVSETC('MXT','Scale')
1118 END IF
1119 !
1120 !*      1.6   Masks vectors where wind coponents have XSPVAL values
1121 !
1122 CALL VVSETI('SVF',3)
1123 CALL VVSETR('USV',XSPVAL)
1124 CALL VVSETR('VSV',XSPVAL)
1125 !
1126 !*      1.6   Selects look and feel options for the vector display
1127 !             (Text strings, etc..)
1128 !
1129 CALL VVSETI('MNP',-4)
1130 CALL VVSETI('MXP',-4)
1131 CALL VVSETR('MNX',.75)
1132 !CALL VVSETR('MNX',-ZVL)
1133 !ZY=-1./5.
1134 !ZY=-MIN(0.12,ZVB+.02)
1135 IF(ZVB <= .15)THEN
1136   ZY=-ZVB-.020
1137 ! ZY=(-.08)/(ZVT-ZVB)
1138 ELSE
1139 !!! Octobre 2001
1140 ! ZY=(-.10)/(ZVT-ZVB)
1141   ZY=(-.13)/(ZVT-ZVB)
1142 !!! Octobre 2001
1143 ENDIF
1144 !IF(ZVB-(ZVT-ZVB)/5..LT.0.05)ZY=(0.05-ZVB)/(ZVT-ZVB)
1145 CALL VVSETR('MNY',ZY)
1146 IF(ZVR-ZVL >= .78)THEN
1147   CALL VVSETR('MXX',.75+.16)
1148 ELSE
1149   CALL VVSETR('MXX',.75+.27)
1150 ENDIF
1151 CALL VVSETR('MXY',ZY)
1152 CALL VVSETR('MXS',.008*.9/(ZVR-ZVL))
1153 CALL VVSETR('MNS',.008*.9/(ZVR-ZVL))
1154 !
1155 !*     1.7    Draws the arrows
1156 !
1157 IF(XLWV > 0.)THEN
1158   CALL VVSETR('LWD',XLWV)
1159 ELSE
1160   CALL VVSETR('LWD',XLWVDEF)
1161 ENDIF
1162
1163 IF(ILMAX > 6)THEN
1164 CALL GSCLIP(1)                                     ! Clipping off
1165 ENDIF
1166 CALL VVSETI('VPO',1)
1167 CALL VVINIT(ZZU,ILMAX,ZZV,ILMAX,0.,0,ILMAX,IKU,0.,0) ! Initializes VVECTR
1168 CALL VVECTR(ZZU,ZZV,0.,0,0,0.)                     ! Draws arrows
1169 CALL GSCLIP(0)                                     ! Clipping back on
1170 !
1171 CALL VVRSET
1172 !------------------------------------------------------------------------------
1173 !
1174 !*    2.    COMPLETING THE PLOT
1175 !           -------------------
1176 !
1177 !*    2.1   Page information labels
1178 !
1179
1180 CALL GSCLIP(0)
1181
1182 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1183 XCURVPTL=ZVL;XCURVPTR=ZVR;XCURVPTB=ZVB;XCURVPTT=ZVT
1184 !print *,' getset ',ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT
1185
1186 IF(LCOLPVT)THEN
1187 !print *,' ** imcoupv AP LCOLPVT '
1188
1189    IF(LCOLUSERUV)THEN
1190      INBCOL=NBPARCOLUV
1191      IF(ALLOCATED(ICOL))THEN
1192        DEALLOCATE(ICOL)
1193      ENDIF
1194      ALLOCATE(ICOL(NBCOLUV))
1195      ALLOCATE(YLBS(NBCOLUV-1))
1196      ALLOCATE(ZPARCOLUV(NBCOLUV-1))
1197      ICOL(:)=NINDCOLUV(1:NBCOLUV)
1198      ZPARCOLUV=XPARCOLUV(1:NBCOLUV-1)
1199    ELSE
1200      INBCOL=NBPARCOLUVSTD
1201      IF(ALLOCATED(ICOL))THEN
1202        DEALLOCATE(ICOL)
1203      ENDIF
1204      ALLOCATE(ICOL(NBCOLUVSTD))
1205      ALLOCATE(YLBS(NBCOLUVSTD-1))
1206      ALLOCATE(ZPARCOLUV(NBCOLUVSTD-1))
1207      ICOL(:)=NCOLUVSTD(1:NBCOLUVSTD)
1208      ZPARCOLUV=XPARCOLUVSTD(1:NBCOLUVSTD-1)
1209    ENDIF
1210
1211    YLBS(:)=' '
1212 !print *,' ** imcoupv AV GENFORMAT '
1213
1214    DO J=1,INBCOL
1215      ZTEM=ZPARCOLUV(J)
1216      CALL GENFORMAT_FORDIACHRO(ZTEM,YLBSTEM)
1217 !    CALL GENFORMAT_FORDIACHRO(ZPARCOLUV(J),YLBS(J))
1218      YLBS(J)=YLBSTEM
1219    ENDDO
1220
1221 !print *,' ** imcoupv AP GENFORMAT '
1222    CALL GSFAIS(1)
1223    CALL LBLBAR_FORDIACHRO(0,ZVL,ZVR,ZVT+.01,ZVT+.05,INBCOL+1,1.,.15,ICOL,&
1224    1,YLBS,INBCOL,2)
1225    CALL SET(ZVL,ZVR,ZVB,ZVT,ZVL,ZVR,ZVB,ZVT,ID)
1226    YTIT(1:LEN(YTIT))=' '
1227    YTIT=CTITRE(NLOOPP)
1228
1229    YTIT=ADJUSTR(YTIT)
1230 !  print *,' **imcoupv YTIT NLOOPP ',YTIT,NLOOPP
1231       CALL PLCHHQ(MIN(ZVR+.1,1.),ZVT+.02,YTIT(1:LEN_TRIM(YTIT)),.007,0.,+1.)
1232    CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1233    DEALLOCATE(ICOL)
1234    DEALLOCATE(YLBS)
1235    DEALLOCATE(ZPARCOLUV)
1236 ENDIF
1237
1238 !!! Janvier 2001
1239 ENDIF
1240 !print *,' **imcoupv AV SET(0.,1.,0.,1.,0.,1.,0.,1.,1)'
1241 !!! Janvier 2001
1242
1243 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
1244 !
1245 IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 1))THEN
1246
1247 !
1248 ! Titres en X
1249 !
1250 !-------------------------------------------------------------------
1251   YTEM(1:LEN(YTEM))=' '
1252   YTEM=ADJUSTL(YTEM)
1253   CALL RESOLV_TIT('CTITXL',YTEM)
1254   IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1255     CALL RESOLV_TIT('CTITXL',YTEM)
1256     IF(XSZTITXL /= 0.)THEN
1257       CALL PLCHHQ(ZVL,ZVB-MIN(ZVB/2.,.05),YTEM,XSZTITXL,0.,-1.)
1258 !     CALL PLCHHQ(ZVL,ZVB/2.,YTEM,XSZTITXL,0.,-1.)
1259     ELSE
1260       CALL PLCHHQ(ZVL,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
1261 !     CALL PLCHHQ(ZVL,ZVB/2.,YTEM,.008,0.,-1.)
1262     ENDIF
1263   ENDIF
1264   YTEM(1:LEN(YTEM))=' '
1265   IF(LHEURX)THEN
1266     YTEM='(H)'
1267   ELSE
1268     YTEM='(sec)'
1269   ENDIF
1270   CALL RESOLV_TIT('CTITXM',YTEM)
1271   IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1272     CALL RESOLV_TIT('CTITXM',YTEM)
1273     IF(XSZTITXM /= 0.)THEN
1274       CALL PLCHHQ((ZVL+ZVR)/2.,ZVB-MIN(ZVB/2.,.05),YTEM(1:LEN_TRIM(YTEM)),XSZTITXM,0.,0.)
1275 !     CALL PLCHHQ((ZVL+ZVR)/2.,ZVB/2.,YTEM(1:LEN_TRIM(YTEM)),XSZTITXM,0.,0.)
1276 !     CALL PLCHHQ((ZVL+ZVR)/2.-ZVB/2.,ZVB/2.,YTEM,XSZTITXM,0.,-1.)
1277     ELSE
1278       CALL PLCHHQ((ZVL+ZVR)/2.,ZVB-MIN(ZVB/2.,.05),YTEM(1:LEN_TRIM(YTEM)),.008,0.,0.)
1279 !     CALL PLCHHQ((ZVL+ZVR)/2.,ZVB/2.,YTEM(1:LEN_TRIM(YTEM)),.008,0.,0.)
1280 !     CALL PLCHHQ((ZVL+ZVR)/2.-ZVB/2.,ZVB/2.,YTEM,.008,0.,-1.)
1281     ENDIF
1282   ENDIF
1283   YTEM(1:LEN(YTEM))=' '
1284   CALL RESOLV_TIT('CTITXR',YTEM)
1285   IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1286     CALL RESOLV_TIT('CTITXR',YTEM)
1287     IF(XSZTITXR /= 0.)THEN
1288       CALL PLCHHQ(ZVR-ZVB/2.,ZVB-MIN(ZVB/2.,.05),YTEM,XSZTITXR,0.,-1.)
1289 !     CALL PLCHHQ(ZVR-ZVB/2.,ZVB/2.,YTEM,XSZTITXR,0.,-1.)
1290     ELSE
1291       CALL PLCHHQ(ZVR-ZVB/2.,ZVB-MIN(ZVB/2.,.05),YTEM,.008,0.,-1.)
1292 !     CALL PLCHHQ(ZVR-ZVB/2.,ZVB/2.,YTEM,.008,0.,-1.)
1293     ENDIF
1294   ENDIF
1295 !
1296 ! Titres en Y
1297 !
1298 !-------------------------------------------------------------------
1299   YTEM(1:LEN(YTEM))=' '
1300   YTEM='Altitude;(ms)'
1301   CALL RESOLV_TITY('CTITYM',ZVL,ZVR,ZVB,ZVT,YTEM)
1302   YTEM(1:LEN(YTEM))=' '
1303   CALL RESOLV_TITY('CTITYT',ZVL,ZVR,ZVB,ZVT,YTEM)
1304   YTEM(1:LEN(YTEM))=' '
1305   CALL RESOLV_TITY('CTITYB',ZVL,ZVR,ZVB,ZVT,YTEM)
1306
1307 ! Titres Bottom
1308 !-------------------------------------------------------------------
1309 CALL RESOLV_TIT('CTITB1',HLEGEND)
1310 ZXPOSTITB1=.002
1311 ZXYPOSTITB1=.005
1312 IF(XPOSTITB1 /= 0.)THEN
1313   ZXPOSTITB1=XPOSTITB1
1314 ENDIF
1315 IF(XYPOSTITB1 /= 0.)THEN
1316   ZXYPOSTITB1=XYPOSTITB1
1317 ENDIF
1318
1319 IF(HLEGEND /= ' ')THEN
1320   IF(XSZTITB1 /= 0.)THEN
1321     CALL PLCHHQ(ZXPOSTITB1,ZXYPOSTITB1,HLEGEND,XSZTITB1,0.,-1.)
1322 !   CALL PLCHHQ(0.002,0.005,HLEGEND,XSZTITB1,0.,-1.)
1323   ELSE
1324     CALL PLCHHQ(ZXPOSTITB1,ZXYPOSTITB1,HLEGEND,.007,0.,-1.)
1325 !   CALL PLCHHQ(0.002,0.005,HLEGEND,.007,0.,-1.)
1326   ENDIF
1327 ENDIF
1328 CALL RESOLV_TIT('CTITB2',CLEGEND2)
1329 ZXPOSTITB2=.002
1330 ZXYPOSTITB2=.025
1331 IF(XPOSTITB2 /= 0.)THEN
1332   ZXPOSTITB2=XPOSTITB2
1333 ENDIF
1334 IF(XYPOSTITB2 /= 0.)THEN
1335   ZXYPOSTITB2=XYPOSTITB2
1336 ENDIF
1337 IF(CLEGEND2 /= ' ')THEN
1338   IF(XSZTITB2 /= 0.)THEN
1339     CALL PLCHHQ(0.002,0.025,CLEGEND2,XSZTITB2,0.,-1.)
1340   ELSE
1341     CALL PLCHHQ(0.002,0.025,CLEGEND2,.007,0.,-1.)
1342   ENDIF
1343 ENDIF
1344 YTEM(1:LEN(YTEM))=' '
1345 ! Octobre 2001
1346 YTEM=CTIMEC
1347 YTEM=ADJUSTL(CTIMEC)
1348 ! Octobre 2001
1349 CALL RESOLV_TIT('CTITB3',YTEM)
1350 ZXPOSTITB3=.002
1351 ZXYPOSTITB3=.050
1352 IF(XPOSTITB3 /= 0.)THEN
1353   ZXPOSTITB3=XPOSTITB3
1354 ENDIF
1355 IF(XYPOSTITB3 /= 0.)THEN
1356   ZXYPOSTITB3=XYPOSTITB3
1357 ENDIF
1358 IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1359   IF(XSZTITB3 /= 0.)THEN
1360     CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,XSZTITB3,0.,-1.)
1361 !   CALL PLCHHQ(0.002,0.050,YTEM,XSZTITB3,0.,-1.)
1362   ELSE
1363     CALL PLCHHQ(ZXPOSTITB3,ZXYPOSTITB3,YTEM,.009,0.,-1.)
1364 !   CALL PLCHHQ(0.002,0.050,YTEM,.009,0.,-1.)
1365   ENDIF
1366 ENDIF
1367 ! Titres Top
1368 !-------------------------------------------------------------------
1369 ! Janv 2001
1370    IF(.NOT.LUMVMPV)THEN
1371    IF(XIDEBCOU.NE.-999.)THEN
1372      IF(LDEFCV2CC)THEN
1373        IF(LDEFCV2IND)THEN
1374          WRITE(YCARCOU,1018)NIDEBCV,NJDEBCV,NIFINCV,NJFINCV
1375        ELSE IF(LDEFCV2LL)THEN
1376          WRITE(YCARCOU,1019)XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL
1377        ELSE
1378          WRITE(YCARCOU,1020)XIDEBCV,XJDEBCV,XIFINCV,XJFINCV
1379        ENDIF
1380      ELSE
1381      IF(XIDEBCOU < 99999.)THEN
1382        IF(XJDEBCOU < 99999.)THEN
1383          WRITE(YCARCOU,1001)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
1384        ELSE
1385          WRITE(YCARCOU,1002)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
1386        END IF
1387      ELSE
1388        IF(XJDEBCOU < 99999.)THEN
1389          WRITE(YCARCOU,1003)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
1390        ELSE
1391          WRITE(YCARCOU,1004)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
1392        END IF
1393      END IF
1394      END IF
1395    ELSE
1396      WRITE(YCARCOU,1000)NIDEBCOU,NJDEBCOU,NLANGLE,NLMAX
1397    END IF
1398
1399    ELSE
1400      WRITE(YCARCOU,1021)NIl,NJL
1401    ENDIF
1402
1403 ! Janvier 2001
1404 ! Conversion METERS/SECONDE en M/S
1405 IIBID=INDEX(HTEXT,'METERS/SECONDE')
1406 ILENHT=LEN_TRIM(HTEXT)
1407 IF(IIBID /= 0)THEN
1408 IF(HTEXT(IIBID:ILENHT) == 'METERS/SECONDE')THEN
1409   HTEXT(IIBID:ILENHT)=' '
1410   HTEXT(IIBID:IIBID+2)='M/S '
1411 ENDIF
1412 ENDIF
1413
1414 IF(LUMVMPV)THEN
1415 ! Janvier 2001
1416 IF(HTEXT/= ' ')THEN
1417 ! print *,' ** imcoupv CUNITGAL ',CUNITGAL
1418   ILENYC=LEN_TRIM(YCARCOU)
1419   ILENHT=LEN_TRIM(HTEXT)
1420   YCARCOU(ILENYC+1:ILENYC+3)=' '
1421   YCARCOU(ILENYC+4:ILENYC+ILENHT+4-1)=HTEXT(1:ILENHT)
1422 ! ILENYC=LEN_TRIM(YCARCOU)
1423 ! ILENHT=LEN_TRIM(CUNITGAL)
1424 ! YCARCOU(ILENYC+1:ILENYC+1)=' '
1425 ENDIF
1426 ! Janvier 2001
1427 ENDIF
1428 ! Janvier 2001
1429
1430 CALL RESOLV_TIT('CTITT1',YCARCOU)
1431 ZXPOSTITT1=.002
1432 ZXYPOSTITT1=.98 
1433 IF(XPOSTITT1 /= 0.)THEN
1434   ZXPOSTITT1=XPOSTITT1
1435 ENDIF
1436 IF(XYPOSTITT1 /= 0.)THEN
1437   ZXYPOSTITT1=XYPOSTITT1
1438 ENDIF
1439 IF(YCARCOU /= ' ')THEN
1440   IF(XSZTITT1 /= 0.)THEN
1441     CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YCARCOU,XSZTITT1,0.,-1.)
1442 !   CALL PLCHHQ(0.002,0.98,YCARCOU,XSZTITT1,0.,-1.)
1443   ELSE
1444     CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YCARCOU,.012,0.,-1.)
1445 !   CALL PLCHHQ(0.002,0.98,YCARCOU,.012,0.,-1.)
1446   ENDIF
1447 ENDIF
1448 YTEM(1:LEN(YTEM))=' '
1449 CALL RESOLV_TIT('CTITT2',YTEM)
1450 ZXPOSTITT2=.002
1451 ZXYPOSTITT2=.95
1452 IF(XPOSTITT2 /= 0.)THEN
1453   ZXPOSTITT2=XPOSTITT2
1454 ENDIF
1455 IF(XYPOSTITT2 /= 0.)THEN
1456   ZXYPOSTITT2=XYPOSTITT2
1457 ENDIF
1458 IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1459   IF(XSZTITT2 /= 0.)THEN
1460     CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM,XSZTITT2,0.,-1.)
1461 !   CALL PLCHHQ(0.002,0.95,YTEM,XSZTITT2,0.,-1.)
1462   ELSE
1463     CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM,.008,0.,-1.)
1464 !   CALL PLCHHQ(0.002,0.95,YTEM,.008,0.,-1.)
1465   ENDIF
1466 ! Janvier 2001
1467 ELSE
1468   IF(.NOT.LUMVMPV)THEN
1469     YCAR(1:LEN(YCAR))=' '
1470     WRITE(YCAR,1006)NPROFILE
1471     CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YCAR,.008,0.,-1.)
1472   ENDIF
1473 ! Janvier 2001
1474 ENDIF
1475 YTEM(1:LEN(YTEM))=' '
1476 CALL RESOLV_TIT('CTITT3',YTEM)
1477 ZXPOSTITT3=.002
1478 ZXYPOSTITT3=.93
1479 IF(XPOSTITT3 /= 0.)THEN
1480   ZXPOSTITT3=XPOSTITT3
1481 ENDIF
1482 IF(XYPOSTITT3 /= 0.)THEN
1483   ZXYPOSTITT3=XYPOSTITT3
1484 ENDIF
1485 IF(YTEM /= ' ' .AND. YTEM /= 'DEFAULT')THEN
1486   IF(XSZTITT3 /= 0.)THEN
1487     CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM,XSZTITT3,0.,-1.)
1488 !   CALL PLCHHQ(0.002,0.93,YTEM,XSZTITT3,0.,-1.)
1489   ELSE
1490     CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM,.008,0.,-1.)
1491 !   CALL PLCHHQ(0.002,0.93,YTEM,.008,0.,-1.)
1492   ENDIF
1493 ENDIF
1494 !-------------------------------------------------------------------
1495 IF(LDATFILE)CALL DATFILE_FORDIACHRO
1496 ENDIF
1497
1498 !-------------------------------------------------------------------
1499   IF(NSUPERDIA == 1)THEN
1500     CALL RESOLV_TIT('CTITVAR1',HTEXT)
1501   ELSE IF(NSUPERDIA == 2)THEN
1502     CALL RESOLV_TIT('CTITVAR2',HTEXT)
1503   ELSE IF(NSUPERDIA == 3)THEN
1504     CALL RESOLV_TIT('CTITVAR3',HTEXT)
1505   ELSE IF(NSUPERDIA == 4)THEN
1506     CALL RESOLV_TIT('CTITVAR4',HTEXT)
1507   ELSE IF(NSUPERDIA == 5)THEN
1508     CALL RESOLV_TIT('CTITVAR5',HTEXT)
1509   ELSE IF(NSUPERDIA == 6)THEN
1510     CALL RESOLV_TIT('CTITVAR6',HTEXT)
1511   ELSE IF(NSUPERDIA == 7)THEN
1512     CALL RESOLV_TIT('CTITVAR7',HTEXT)
1513   ELSE IF(NSUPERDIA == 8)THEN
1514     CALL RESOLV_TIT('CTITVAR8',HTEXT)
1515   ENDIF
1516
1517
1518 ! Janvier 2001
1519  IF(.NOT.LUMVMPV)THEN
1520 ! Janvier 2001
1521  IF(HTEXT /= ' ')THEN
1522  IF(.NOT.LSUPER)THEN
1523   IF(XSZTITVAR1 /= 0.)THEN
1524     CALL PLCHHQ(0.1,ZVT+0.03,HTEXT,XSZTITVAR1,0.,-1.)
1525   ELSE
1526     CALL PLCHHQ(0.1,ZVT+0.03,HTEXT,.011,0.,-1.)
1527   ENDIF
1528  ELSE
1529   IF(XSZTITVAR1 /= 0. .AND. NSUPER == 1)THEN
1530     CALL PLCHHQ(0.1+(NSUPER-1)*.26,ZVT+0.03,HTEXT,XSZTITVAR1,0.,-1.)
1531   ELSE
1532     CALL PLCHHQ(0.1+(NSUPER-1)*.26,ZVT+0.03,HTEXT,.011,0.,-1.)
1533   ENDIF
1534  ENDIF
1535  ENDIF
1536 ! Janvier 2001
1537  ENDIF
1538 ! Janvier 2001
1539 !-------------------------------------------------------------------
1540 IF(LSUPER)THEN
1541   LARROVL=.TRUE.
1542 ELSE
1543   LARROVL=.FALSE.
1544 END IF
1545 !
1546 !!!!!!!!!!!!!!!!!!!!!!
1547 !ENDIF
1548 !!!!!!!!!!!!!!!!!!!!!!
1549 !
1550 !*       2.14      Heading formats
1551 !
1552 1000 FORMAT('Vertical section IDEB=',I4,' JDEB=',I4,' ANG.=',I3,' NBPTS=',I4)
1553 1001 FORMAT('Vertical section XDEB=',F6.0,' YDEB=',F6.0,' ANG.=',I3,' NBPTS=',I4)
1554 1002 FORMAT('Vertical section XDEB=',F6.0,' YDEB=',E7.2,' ANG.=',I3,' NBPTS=',I4)
1555 1003 FORMAT('Vertical section XDEB=',E7.2,' YDEB=',F6.0,' ANG.=',I3,' NBPTS=',I4)
1556 1004 FORMAT('Vertical section XDEB=',E6.2,' YDEB=',E7.2,' ANG.=',I3,' NBPTS=',I4)
1557 1006 FORMAT('Vertical profile IPRO=',I4)
1558 1018 FORMAT('Vertical section IND I,J (BEGIN)-(END)=(',I4,',',I4,')-(',I4,',',I4,')')
1559 1019 FORMAT('Vertical section LAT,LON (BEGIN)-(END)=(',F4.1,',',F5.1,')-(',F4.1,',',F5.1,')')
1560 1020 FORMAT('Vertical section CONF. COORD.(BEGIN)-(END)=(',F8.0,',',F8.0,')-(',F8.0,',',F8.0,')')
1561 1021 FORMAT('Vertical profile I=',I4,' J=',I4)
1562 !
1563 CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
1564 !print *,'imcoupv ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT ',ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT
1565 CALL GSCLIP(1)
1566 !
1567 !-------------------------------------------------------------------------
1568 !
1569 !*    3.    EXIT
1570 !           ----
1571 !
1572 RETURN
1573 END SUBROUTINE  IMCOUPV_FORDIACHRO