Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / oper_process.f90
1 !     ######spl
2       MODULE MODI_OPER_PROCESS
3 !     #########################
4 !
5 INTERFACE
6 !
7 SUBROUTINE OPER_PROCESS(KLOOP,HTYPE)
8 CHARACTER(LEN=*) :: HTYPE
9 INTEGER          :: KLOOP
10 END SUBROUTINE OPER_PROCESS
11 !
12 END INTERFACE
13 !
14 END MODULE MODI_OPER_PROCESS
15 !     ######spl
16       SUBROUTINE OPER_PROCESS(KLOOP,HTYPE)
17 !     ####################################
18 !
19
20 !!
21 !!    PURPOSE
22 !!    -------
23 !      
24 !
25 !!**  METHOD
26 !!    ------
27 !!     
28 !!     N.A.
29 !!
30 !!    EXTERNAL
31 !!    --------
32 !!      None
33 !!
34 !!    IMPLICIT ARGUMENTS
35 !!    ------------------
36 !!
37 !!      Module MODN_NCAR : defines NAM_DIRTRA_POS namelist 
38 !!                         (former NCAR common)
39 !!
40 !!       NIOFFD     : Label normalisation (=0 none, =/=0 active)
41 !!       NULBLL     : Nb of contours between 2 labelled contours
42 !!       NIOFFM     : =0    --> message at picture bottom
43 !!                    =/= 0 --> no message
44 !!       NIOFFP     : Special point value detection
45 !!                    (=0 none, =/=0 active)
46 !!       NHI        : Extrema detection
47 !!                    (=0 --> H+L, <0 nothing)
48 !!       NINITA     : For streamlimes
49 !!       NINITB     : Not yet implemented
50 !!       NIGRNC     : Not yet implemented
51 !!       NDOT       : Line style
52 !!                    (=0|1|1023|65535 --> solid lines;
53 !!                    <0 --> solid lines for positive values and
54 !!                    dotted lines(ABS(NDOT))for negative values;
55 !!                    >0 --> dotted lines(ABS(NDOT)) )
56 !!       NIFDC      : Coastline data style (0 none, 1 NCAR, 2 IGN)
57 !!       NLPCAR     : Number of land-mark points to be plotted
58 !!       NIMNMX     : Contour selection option
59 !!                    (=-1 Min, max and inc. automatically set;
60 !!                    =0 Min, max automatically set; inc. given;
61 !!                    >0 Min, max, inc. given by user)
62 !!       NISKIP     : Rate for drawing velocity vectors
63 !!       CTYPHOR    : Horizontal cross-section type
64 !!                    (='K' --> model level section;
65 !!                     ='Z' --> constant-altitude section;
66 !!                     ='P' --> isobar section (planned)
67 !!                     ='T' --> isentrope section (planned)
68 !!       XSPVAL     : Special value
69 !!       XSIZEL     : Label size
70 !!       XLATCAR, XLONCAR :  Lat. and Long. of land-mark points
71 !!       LXY        : If =.TRUE., plots  a grid-mesh stencil background
72 !!       LXZ        : If =.TRUE., plots  a model-level stencil background 
73 !!
74 !!      Module MODN_PARA  : Defines NAM_DOMAIN_POS namelist 
75 !!                          (former PARA common)
76 !!
77 !!       XIDEBCOU, XJDEBCOU : Origin of a vertical cross-section
78 !!                            in cartesian (or conformal) real values
79 !!       XHMIN      : Altitude of the vert. cross-section
80 !!                    bottom (in meters above sea-level)
81 !!       XHMAX      : Altitude of the vert. cross-section
82 !!                    top (in meters above sea-level)
83 !!
84 !!
85 !!
86 !!    REFERENCE
87 !!    ---------
88 !!
89 !!
90 !!    AUTHOR
91 !!    ------
92 !!      J. Duron    * Laboratoire d'Aerologie *
93 !!
94 !!
95 !!    MODIFICATIONS
96 !!    -------------
97 !!      Original       06/06/94
98 !!      Updated   PM   02/12/94
99 !-------------------------------------------------------------------------------
100 !
101 !*       0.    DECLARATIONS
102 !              ------------
103 !
104 USE MODD_RESOLVCAR
105 USE MODD_FILES_DIACHRO
106 USE MODD_ALLOC_FORDIACHRO
107 USE MODD_PT_FOR_CH_FORDIACHRO
108 USE MODI_TRACEH_FORDIACHRO
109 USE MODD_TYPE_AND_LH
110 USE MODD_DIM1
111 USE MODD_GRID1
112 USE MODD_GRID, ONLY:XLONORI,XLATORI
113 USE MODD_NMGRID
114 USE MODD_CVERT
115 USE MODD_MASK3D
116 USE MODD_TITLE
117 USE MODD_PARAMETERS
118 USE MODD_EXPERIM
119 USE MODN_NCAR    
120 USE MODN_PARA    
121 USE MODI_PRECOU_FORDIACHRO
122 USE MODI_TRACEV_FORDIACHRO
123 USE MODI_VARFCT
124 USE MODI_PVFCT
125 USE MODI_CLOSF
126 USE MODI_LOADUNITIT
127 USE MODI_TRAMASK
128 USE MODI_CONV2XY
129 USE MODI_TRAPRO_FORDIACHRO
130 USE MODD_COORD
131 USE MODD_CONF
132 USE MODD_SUPER
133 USE MODD_CST
134 USE MODD_PVT
135 USE MODD_DEFCV
136 USE MODD_MEMCV
137 USE MODE_GRIDPROJ
138
139 IMPLICIT NONE
140
141 INTERFACE
142   SUBROUTINE COLVECT(KKU,PTEM2D)
143   REAL, DIMENSION(:,:),  INTENT(IN) :: PTEM2D
144   INTEGER   :: KKU
145   END SUBROUTINE COLVECT
146 END INTERFACE
147 INTERFACE
148               SUBROUTINE IMCOU_FORDIACHRO(PTABV,PINT,HLEGEND,HTEXT)
149               REAL,DIMENSION(:,:) :: PTABV
150               REAL                :: PINT
151               CHARACTER(LEN=*)    :: HTEXT, HLEGEND
152               END SUBROUTINE IMCOU_FORDIACHRO
153 END INTERFACE
154 INTERFACE
155       SUBROUTINE INTERP_FORDIACHRO(KLREF,KD,KF,PTAB,PTABREF)
156       REAL,DIMENSION(:,:,:), INTENT(IN)         :: PTAB 
157       REAL,DIMENSION(SIZE(PTAB,1),SIZE(PTAB,2)) :: PTABREF
158       INTEGER :: KLREF
159       END SUBROUTINE INTERP_FORDIACHRO
160 END INTERFACE
161 INTERFACE
162       SUBROUTINE IMAGE_FORDIACHRO(PTAB,KLREF,PTABINT,KNHI,KNDOT,HTEXTE)
163       CHARACTER(LEN=*)   :: HTEXTE
164       REAL                :: PTABINT
165       REAL,DIMENSION(:,:) :: PTAB
166       INTEGER :: KNHI, KNDOT, KLREF
167       END SUBROUTINE IMAGE_FORDIACHRO
168 END INTERFACE
169 INTERFACE
170       SUBROUTINE TSOUND_FORDIACHRO(PPRES,PPTEMP,PPQV,PPU,PPV,KNN,HEADER,HTEXTE, &
171                         OMXRAT,  &
172                         OMIXRAT,ODOFRAME,OSAMPLEUV)
173       REAL,DIMENSION(:)   ::  PPRES, PPTEMP, PPQV, PPU, PPV
174       CHARACTER(LEN=*)               :: HEADER
175       CHARACTER(LEN=*)               :: HTEXTE
176       LOGICAL                        :: OMXRAT, OMIXRAT, ODOFRAME
177       LOGICAL                        :: OSAMPLEUV
178       END SUBROUTINE TSOUND_FORDIACHRO
179 END INTERFACE
180 INTERFACE
181       SUBROUTINE TRAXY(PTEMX,PTEMY,KLOOP,HTITX,HTITY,PTIMED,PTIMEF)
182       INTEGER    :: KLOOP
183       REAL,DIMENSION(:)  :: PTEMX, PTEMY
184       REAL               :: PTIMED, PTIMEF
185       CHARACTER(LEN=*) :: HTITX, HTITY
186       END SUBROUTINE TRAXY
187 END INTERFACE
188 INTERFACE
189       SUBROUTINE ROTA(PTEM1,PTEMV)
190       REAL, DIMENSION(:,:),  INTENT(INOUT) :: PTEM1
191       REAL, DIMENSION(:,:),  INTENT(INOUT) :: PTEMV
192       END SUBROUTINE ROTA
193 END INTERFACE
194 INTERFACE
195      SUBROUTINE CALUV_FORDIACHRO(KLOOP)
196      INTEGER    :: KLOOP
197      END SUBROUTINE CALUV_FORDIACHRO
198 END INTERFACE
199 COMMON/TEMV/XZWORKZ,XZZDS,NINX,NINY
200 COMMON/LOGI/LVERT,LHOR,LPT,LXABS
201 #include "big.h"
202 REAL,DIMENSION(N2DVERTX,2500) :: XZWORKZ
203 !REAL,DIMENSION(1000,400) :: XZWORKZ
204 !REAL,DIMENSION(200,200) :: XZWORKZ
205 REAL,DIMENSION(N2DVERTX)     :: XZZDS
206 !REAL,DIMENSION(1000)     :: XZZDS
207 !REAL,DIMENSION(200)     :: XZZDS
208 INTEGER                 :: NINX, NINY
209 LOGICAL                 :: LVERT, LHOR, LPT, LXABS
210 !
211 !*       0.1   Dummy arguments
212 !              ---------------
213
214 CHARACTER(LEN=*)  :: HTYPE
215 INTEGER           :: KLOOP
216
217 !
218 !*       0.1   Local variables
219 !              ---------------
220 !
221 INTEGER   ::   J, JJ
222 INTEGER   ::   II, IJ, IK, IKU, IKB, IKE, IIU, IJU
223 INTEGER   ::   JU, ILT
224 INTEGER   ::   JLOOPP, JLOOPN, JLOOPT, JLOOPK, JLOOPZ, JLOOPK1, JLOOPPF
225 INTEGER   ::   IZ, IN, ILOOPP
226 INTEGER   ::   JKLOOP
227 INTEGER   ::   ILENW, IJLT, ILENT, ILENU, ITIMEND
228 INTEGER   ::   ISUP, IJSUP, IINF, IJINF
229 INTEGER   ::   IIB, IIE, IJB, IJE
230 INTEGER   ::   INBK, INUMK, INUMK1
231 INTEGER   ::   INDN
232 INTEGER,SAVE   ::   ISEGM=0, ISEGD=0, ISEGMCOL, ICOLSEGM
233 INTEGER   ::   IJDEBCOU, IIDEBCOU
234 INTEGER   ::   IER, INB, IWK, IX, IY, ICOLI
235 INTEGER   ::   IDEFCV
236 INTEGER   ::   IINFCV, IISUPCV, IJINFCV, IJSUPCV
237 INTEGER,SAVE   ::   IIRS, IJRS
238 INTEGER   ::   IGRID
239
240 REAL      ::   ZLAT, ZLON
241 REAL      ::   ZX, ZY
242 REAL      ::   ZWL, ZWR, ZWB, ZWT
243 REAL      ::   ZTIMED, ZTIMEF
244 REAL      ::   ZZZXD, ZZZXF, ZZZYD, ZZZYF
245 REAL      ::   ZLW
246
247
248 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: ZWORK3D, ZPROVI, ZWORK3V
249 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: ZTEMCV,ZTEM2D, ZWORKRS,ZPROVI2
250 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: ZTEM1, ZTEMV
251 REAL,DIMENSION(:),ALLOCATABLE,SAVE     :: ZWORK1D, ZWORKT, ZTEM1D, ZWORKZ, ZWORKZ2
252 REAL,DIMENSION(:),ALLOCATABLE,SAVE     :: ZTE, ZWO, ZWORKY
253 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: ZTE2, ZSTAB
254
255 CHARACTER(LEN=40)  :: YTEXTE
256 CHARACTER(LEN=LEN(CTITGAL))  :: YTITGAL
257 CHARACTER(LEN=2)   :: YC2
258 CHARACTER(LEN=1)   :: YC1
259 CHARACTER(LEN=16)  :: YTITX, YTITY, YTEM
260 CHARACTER(LEN=16)  :: YBID
261 INTEGER            :: IBID,IRESP
262
263 LOGICAL            :: GINVZ
264 LOGICAL            :: GMXRAT
265 LOGICAL            :: GII1, GIJ1, GCH
266 !------------------------------------------------------------------------------
267 !
268 YTEXTE(1:LEN(YTEXTE)) = ' '
269 YTEXTE=ADJUSTL(CGROUP)
270 CLEGEND(1:LEN(CLEGEND))=' '
271 !CLEGEND2(1:LEN(CLEGEND2))=' '
272 !CLEGEND2(1:7)='TIME = '
273 CTITGAL(1:LEN(CTITGAL))=' '
274 CUNITGAL(1:LEN(CUNITGAL))=' '
275 CTIMEC(1:LEN(CTIMEC))=' '
276 CTIMECS(1:LEN(CTIMECS))=' '
277 CTIMEC(1:7)='TIME = '
278 CTIMECS(1:7)='TIME = '
279 NLOOPT=0
280 LXABS=LXABSC
281 if(nverbia > 0)then
282   print *,' **oper entree LPRESY,XHMIN,XHMAX ',LPRESY,XHMIN,XHMAX
283 endif
284
285 SELECT CASE(HTYPE)
286
287 !*****************************************************************************
288 !*****************************************************************************
289     CASE('CART')
290
291         IF(ALLOCATED(XVAR))THEN
292         II=SIZE(XVAR,1)
293         IJ=SIZE(XVAR,2)
294         IK=SIZE(XVAR,3)  
295   
296         ELSE
297           IF(LRS .OR. LRS1)THEN
298             IF(ALLOCATED(XTH))THEN
299               II=SIZE(XTH,1)
300               IJ=SIZE(XTH,2)
301               IK=SIZE(XTH,3)
302             ENDIF
303           ENDIF
304         ENDIF
305         if(nverbia > 0)then
306           print *,' **oper Entree II,IJ,IK,KLOOP ',II,IJ,IK,KLOOP
307         endif
308
309         IIB=1+JPHEXT; IIE=NIMAX+JPHEXT
310         IJB=1+JPHEXT; IJE=NJMAX+JPHEXT
311         IIU=NIMAX+2*JPHEXT
312         IJU=NJMAX+2*JPHEXT
313         IKU=NKMAX+2*JPVEXT
314         IF(CSTORAGE_TYPE == 'PG' .OR. CSTORAGE_TYPE == 'SU')THEN
315           IKU=1
316         ENDIF
317         IKB=1+JPVEXT; IKE=IKU-JPVEXT
318
319 ! Traitement des RS
320 ! *****************
321         IF(LRS .OR. LRS1)THEN
322 !
323 ! Cas LRS ou LRS1 et KLOOP = 1 --> Allocation de tableaux pour memoriser
324 ! les infos utiles
325 !
326     IF(KLOOP == 1)THEN
327
328       IF(.NOT.LTINCRDIA(KLOOP,1))THEN
329         IF(LRS)THEN
330           ILENW=NBTIMEDIA(KLOOP,1)
331         ELSE
332           ILENW=NSUPERDIA
333         ENDIF
334       ELSE
335         ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/ &
336         NTIMEDIA(3,KLOOP,1)+1
337         if(nverbia >0)then
338         print *,' **oper ilenw ',ILENW
339         endif
340       ENDIF
341       ALLOCATE(XTRS(SIZE(XTH,3),ILENW))
342       ALLOCATE(XPRS(SIZE(XTH,3),ILENW))
343       ALLOCATE(XURS(SIZE(XTH,3),ILENW))
344       ALLOCATE(XVRS(SIZE(XTH,3),ILENW))
345       ALLOCATE(XRVRS(SIZE(XTH,3),ILENW))
346       ALLOCATE(XTIMRS(ILENW))
347       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
348         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
349         ALLOCATE(XPRDAT(16,ILENW))
350       ENDIF
351
352     ENDIF
353 !
354 ! Lecture de U V et RV; chargement dans les tableaux de
355 ! travail puis desallocation des tableaux inutiles.
356 !
357         IF(XIRS /= -999.)THEN
358           IIRS=NIRS
359           IJRS=NJRS
360         ENDIF
361         CALL CALUV_FORDIACHRO(KLOOP)
362         if(nverbia >0)then
363               print *,' **oper NIRS,NJRS ',NIRS,NJRS
364         endif
365
366
367         IF(.NOT.LTINCRDIA(KLOOP,1))THEN
368
369           DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
370             IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
371               NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
372               CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
373             ENDIF
374
375             IF(LRS)THEN
376               XTRS(:,JLOOPT)=XTH(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
377 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
378 ! Correction suggeree par Joel et Isa en Decembre 98
379 !             XTRS(:,JLOOPT)=XTRS(:,JLOOPT)*XEXNREF(NIRS,NJRS,:)
380               XPRS(:,JLOOPT)=(XPRES(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)/ &
381                              XP00)**(XRD/XCPD)
382               XTRS(:,JLOOPT)=XTRS(:,JLOOPT)*XPRS(:,JLOOPT)
383 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
384               XPRS(:,JLOOPT)=XPRES(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
385             ELSE IF(LRS1)THEN
386               XTRS(:,KLOOP)=XTH(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
387 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
388 ! Correction suggeree par Joel et Isa en Decembre 98
389 !             XTRS(:,KLOOP)=XTRS(:,KLOOP)*XEXNREF(NIRS,NJRS,:)
390               XPRS(:,KLOOP)=(XPRES(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)/ &
391                              XP00)**(XRD/XCPD)
392               XTRS(:,KLOOP)=XTRS(:,KLOOP)*XPRS(:,KLOOP)
393 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
394               XPRS(:,KLOOP)=XPRES(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
395             ENDIF
396           ENDDO
397
398         ELSE
399
400           II=0
401           DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),NTIMEDIA(3,KLOOP,1)
402             II=II+1
403         if(nverbia >0)then
404             print *,' **oper JLOOPT II ',JLOOPT,II
405         endif
406             IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
407               CALL LOAD_XPRDAT(II,JLOOPT)
408             ENDIF
409             XTRS(:,II)=XTH(NIRS,NJRS,:,JLOOPT,1,1)
410 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
411 ! Correction suggeree par Joel et Isa en Decembre 98
412 !           XTRS(:,II)=XTRS(:,II)*XEXNREF(NIRS,NJRS,:)
413             XPRS(:,II)=(XPRES(NIRS,NJRS,:,JLOOPT,1,1)/ &
414                              XP00)**(XRD/XCPD)
415             XTRS(:,II)=XTRS(:,II)*XPRS(:,II)
416 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
417             XPRS(:,II)=XPRES(NIRS,NJRS,:,JLOOPT,1,1)
418           ENDDO
419
420         ENDIF
421
422         IF(ALLOCATED(XTH))THEN
423           DEALLOCATE(XTH)
424         ENDIF
425         IF(ALLOCATED(XPRES))THEN
426           DEALLOCATE(XPRES)
427         ENDIF
428
429         IF(.NOT.LTINCRDIA(KLOOP,1))THEN
430
431           DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
432             IF(LRS)THEN
433               XURS(:,JLOOPT)=XU(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
434               XVRS(:,JLOOPT)=XV(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
435               XRVRS(:,JLOOPT)=XRVJD(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
436               XTIMRS(JLOOPT)=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
437             ELSE IF(LRS1)THEN
438               XURS(:,KLOOP)=XU(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
439               XVRS(:,KLOOP)=XV(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
440               XRVRS(:,KLOOP)=XRVJD(NIRS,NJRS,:,NTIMEDIA(JLOOPT,KLOOP,1),1,1)
441               XTIMRS(KLOOP)=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
442             ENDIF
443           ENDDO
444
445         ELSE
446
447           II=0
448           DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),NTIMEDIA(3,KLOOP,1)
449             II=II+1
450             XTIMRS(II)=XTRAJT(JLOOPT,1)
451             XURS(:,II)=XU(NIRS,NJRS,:,JLOOPT,1,1)
452             XVRS(:,II)=XV(NIRS,NJRS,:,JLOOPT,1,1)
453             XRVRS(:,II)=XRVJD(NIRS,NJRS,:,JLOOPT,1,1)
454           ENDDO
455         ENDIF
456
457         IF(ALLOCATED(XU))THEN
458           DEALLOCATE(XU)
459         ENDIF
460         IF(ALLOCATED(XV))THEN
461           DEALLOCATE(XV)
462         ENDIF
463         IF(ALLOCATED(XRVJD))THEN
464           DEALLOCATE(XRVJD)
465         ENDIF
466      
467
468       GMXRAT=.TRUE.
469       IF(XIRS == -999.)THEN
470         IF(NIRS>99) THEN
471           IF(NJRS>99) THEN
472             WRITE(YTEXTE,'(''I='',I4,'' J='',I4)')NIRS,NJRS
473           ELSE
474             WRITE(YTEXTE,'(''I='',I4,'' J='',I2)')NIRS,NJRS
475           ENDIF
476         ELSE
477           IF(NJRS>99) THEN
478             WRITE(YTEXTE,'(''I='',I2,'' J='',I4)')NIRS,NJRS
479           ELSE
480             WRITE(YTEXTE,'(''I='',I2,'' J='',I2)')NIRS,NJRS
481           ENDIF
482         ENDIF
483       ELSE
484       WRITE(YTEXTE,'(''LAT='',F6.2,'' LON='',F6.2)')XIRS,XJRS
485       ENDIF
486       YTEXTE=ADJUSTL(YTEXTE)
487       IF(NMT == 1)THEN
488 !       WRITE(CLEGEND(104:110),'(''UM-VM'')')
489 !       YTEXTE(1:5)='UM-VM'
490         CLEGEND(104:108)='UM-VM'
491       ELSE
492 !       WRITE(CLEGEND(104:110),'(''UT-VT'')')
493 !       YTEXTE(1:5)='UT-VT'
494         CLEGEND(104:108)='UT-VT'
495       ENDIF
496         CALL TABCOL_FORDIACHRO
497         CALL GSTXFP(-13,2)
498
499       IF(KLOOP == 1 .AND. LRS)THEN
500
501       DO JLOOPT=1,ILENW
502         IF(LPRDAT .AND. ILENW > 1)THEN ! Juin 2001 Ajout des dates ds FICVAL 
503 ! Pour distiller les dates une par une
504 ! Si ILENW = 1 on ne fait rien . OK
505           IF(JLOOPT == 1)THEN
506 !!!dec 2001
507            IF(ALLOCATED(XPRDAT))THEN
508 !!!dec 2001
509           IF(ALLOCATED(ZPROVI2))DEALLOCATE(ZPROVI2)
510             ALLOCATE(ZPROVI2(16,SIZE(XPRDAT,2)))
511             ZPROVI2(:,:)=XPRDAT(:,:)
512             DEALLOCATE(XPRDAT)
513             ALLOCATE(XPRDAT(16,1))
514             XPRDAT(:,1)=ZPROVI2(:,JLOOPT)
515 !!!dec 2001
516           ELSE
517             XPRDAT(:,1)=ZPROVI2(:,JLOOPT)
518           ENDIF
519            ELSE
520             print *,' *operA XPRDAT NON ALLOUE'
521            ENDIF
522 !!!dec 2001
523         ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
524
525         IF(.NOT.LTINCRDIA(KLOOP,1))THEN
526           IF(NVERBIA > 0)THEN
527           print *,' KLOOP,LRS,JLOOPT,NTIMEDIA(JLOOPT,KLOOP,1) ', &
528           KLOOP,LRS,JLOOPT,NTIMEDIA(JLOOPT,KLOOP,1)
529           ENDIF
530           CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
531         ELSE
532           II=NTIMEDIA(1,KLOOP,1)+(JLOOPT-1)*NTIMEDIA(3,KLOOP,1)
533         if(nverbia >0)then
534           print *,' **oper II de  RESOLV_TIMES(II) ',II
535         endif
536           CALL RESOLV_TIMES(II)
537         ENDIF
538         CTIMEC(1:LEN(CTIMEC))=' '
539         CTIMEC(1:3)='  ('
540         WRITE(CTIMEC(4:11),'(F8.0)')XTIMRS(JLOOPT)
541         CTIMEC(LEN_TRIM(CTIMEC)+1:LEN_TRIM(CTIMEC)+2)='s)'
542
543         GMXRAT=.TRUE.
544
545         DO J=IKB,IKE
546           IF(XRVRS(J,JLOOPT) <=0.)print *,' No dew point line drawn as nil or' &
547                                 ,' negative water values were found'
548         ENDDO
549         CALL GSCLIP(0)
550         CALL TSOUND_FORDIACHRO(XPRS(IKB:IKE,JLOOPT),XTRS(IKB:IKE,JLOOPT),  &
551                     XRVRS(IKB:IKE,JLOOPT),XURS(IKB:IKE,JLOOPT), &
552                     XVRS(IKB:IKE,JLOOPT),IKE-IKB+1,CLEGEND,&
553                      YTEXTE,GMXRAT,.TRUE.&
554                     ,.FALSE.,.FALSE.)
555         CALL GSCLIP(1)
556 !      CALL NGPICT(1,1)
557 !      CALL GQACWK(1,IER,INB,IWK)
558 !      IF(INB > 1)CALL NGPICT(2,3)
559         CALL FRAME
560       ENDDO
561       IF(.NOT.ALLOCATED(XTRS))print *,' XTRS NON ALLOUE'
562       IF(.NOT.ALLOCATED(XPRS))print *,' XPRS NON ALLOUE'
563       IF(.NOT.ALLOCATED(XURS))print *,' XURS NON ALLOUE'
564       IF(.NOT.ALLOCATED(XVRS))print *,' XVRS NON ALLOUE'
565       IF(.NOT.ALLOCATED(XRVRS))print *,' XRVRS NON ALLOUE'
566       IF(.NOT.ALLOCATED(XTIMRS))print *,' XTIMRS NON ALLOUE'
567       if(nverbia > 0)then
568         print *,' *operA AV DEALLOCATE(XTRS,XPRS,XURS,XVRS,XRVRS,XTIMRS) '
569       endif
570       DEALLOCATE(XTRS,XPRS,XURS,XVRS,XRVRS,XTIMRS)
571       if(nverbia > 0)then
572          print *,' *operA AP DEALLOCATE(XTRS,XPRS,XURS,XVRS,XRVRS,XTIMRS) '
573       endif
574     ELSE IF(LRS1 .AND. KLOOP == NSUPERDIA)THEN
575
576         GMXRAT=.TRUE.
577 ! On met la date courante du 1er temps demande de la 1ere superposition
578         CALL RESOLV_TIMES(NTIMEDIA(1,1,1))
579         CALL GSCLIP(0)
580         CALL TSOUND_FORDIACHRO(XPRS(IKB:IKE,1),XTRS(IKB:IKE,1),  &
581                     XRVRS(IKB:IKE,1),XURS(IKB:IKE,1), &
582                     XVRS(IKB:IKE,1),IKE-IKB+1,CLEGEND,YTEXTE,GMXRAT,.TRUE.&
583                     ,.FALSE.,.FALSE.)
584         CALL GSCLIP(1)
585 !       CALL NGPICT(1,1)
586 !       CALL GQACWK(1,IER,INB,IWK)
587 !       IF(INB > 1)CALL NGPICT(2,3)
588         CALL FRAME
589             print *,' *operB AV DEALLOCATE(XTRS,XPRS,XURS,XVRS,XRVRS,XTIMRS) '
590         DEALLOCATE(XTRS,XPRS,XURS,XVRS,XRVRS,XTIMRS)
591             print *,' *operB AP DEALLOCATE(XTRS,XPRS,XURS,XVRS,XRVRS,XTIMRS) '
592     ENDIF
593     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
594       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
595     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
596
597         IF(XIRS /= -999.)THEN
598           NIRS=IIRS
599           NJRS=IJRS
600         ENDIF
601
602         ELSE
603 !
604 ! Infos autres que RS
605 ! *******************
606
607           IF(II == 1 .AND. IJ == 1 .AND. IK == 1)THEN
608
609 ! Cas compression bilan sur tous les axes ou scalaire unique  f(t)
610 ! ****************************************************************
611
612
613               IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
614                 IF(.NOT.LTINCRDIA(KLOOP,1))THEN
615                   ILENW=NBTIMEDIA(KLOOP,1)
616                 ELSE
617                   ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1)+1
618                 ENDIF
619                 ALLOCATE(XPRDAT(16,ILENW))
620               ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
621
622               IF(.NOT.LTINCRDIA(KLOOP,1))THEN
623                 ALLOCATE(ZWORKT(NBTIMEDIA(KLOOP,1)))
624                 ALLOCATE(ZWORK1D(NBTIMEDIA(KLOOP,1)))
625                 DO JLOOPP=1,NBPROCDIA(KLOOP)
626                   NLOOPP=NPROCDIA(JLOOPP,KLOOP)
627
628                   CALL LOADUNITIT(JLOOPP,KLOOP)
629
630                   DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
631                     NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
632                     IF(JLOOPT == 1)CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
633                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
634                       CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
635                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
636
637                     ZWORKT(JLOOPT)=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
638                     ZWORK1D(JLOOPT)=XVAR(1,1,1,NTIMEDIA(JLOOPT,KLOOP,1),1,NPROCDIA(JLOOPP,KLOOP))
639                   ENDDO
640                   CALL VARFCT(ZWORKT,ZWORK1D,1)
641                   IF(KLOOP == NSUPERDIA)CALL FRAME
642                 ENDDO
643                 DEALLOCATE(ZWORKT,ZWORK1D)
644               ELSE
645                 ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1)+1
646                 ALLOCATE(ZWORKT(ILENW))
647                 ALLOCATE(ZWORK1D(ILENW))
648                 DO JLOOPP=1,NBPROCDIA(KLOOP)
649                   NLOOPP=NPROCDIA(JLOOPP,KLOOP)
650
651                   CALL LOADUNITIT(JLOOPP,KLOOP)
652
653                   IJLT=0
654                   DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),NTIMEDIA(3,KLOOP,1)
655                     NLOOPT=JLOOPT
656                     IF(JLOOPT == NTIMEDIA(1,KLOOP,1))CALL RESOLV_TIMES(JLOOPT)
657                     IJLT=IJLT+1
658                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
659                       CALL LOAD_XPRDAT(IJLT,NLOOPT)
660                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
661                     ZWORKT(IJLT)=XTRAJT(JLOOPT,1)
662                     ZWORK1D(IJLT)=XVAR(1,1,1,JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
663                   ENDDO
664                   CALL VARFCT(ZWORKT,ZWORK1D,1)
665                   IF(KLOOP == NSUPERDIA)CALL FRAME
666                 ENDDO
667                 DEALLOCATE(ZWORKT,ZWORK1D)
668               ENDIF
669               IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
670                 DEALLOCATE(XPRDAT)
671               ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
672
673               IF(.NOT.LICP .AND. .NOT.LJCP .AND. .NOT.LKCP)THEN
674
675 !         Cas scalaire (Impression dim mat. modele et matrice(1,1,1)
676 !         ------------
677
678               ELSE IF(LICP .AND. LJCP .AND. LKCP)THEN
679
680 !         Cas bilan compresse (Impression dim mat. modele et matrice
681 !         -------------------  NIL:NIH,NJL:NJH,NKL:NKH)et
682 !                              matrice (1,1,1)
683
684               ENDIF
685
686           ELSE IF(II == 1 .AND. IJ == 1 .AND. IK /= 1)THEN
687
688 ! Cas compression bilan sur axes X et Y ou PV -->  Profil vertical
689 ! ****************************************************************
690 !
691               IDEFCV=0                      !%%%%%%%%%%%%%%%%%%%%%%%%%%
692               IF(LDEFCV2CC)THEN
693                 LDEFCV2CC=.FALSE.
694                 IDEFCV=1
695               ENDIF                         !%%%%%%%%%%%%%%%%%%%%%%%%%%
696               L1DT=.TRUE.
697               ALLOCATE(ZTEM1D(IKU),ZWORKZ(IKU))
698
699               DO JLOOPP=1,NBPROCDIA(KLOOP)
700                  NLOOPP=NPROCDIA(JLOOPP,KLOOP)
701
702 !!! Octobre 2001
703                 IF(JLOOPP > 1 .AND. LUMVMPV .AND. LPV)EXIT
704 !!! Octobre 2001
705                 IF(LPVKT .AND. NSUPERDIA>1)THEN
706                   IF(NBPROCDIA(KLOOP)>1 .OR. NBLVLKDIA(KLOOP,1)>1)THEN
707                     print *,' _PVKT_  SUPERPOSITIONS : '
708 !fuji    print *,'         On ne peut definir de part de d''autre '&
709 !fuji    &'de _ON_ qu''1 seul processus et 1 seul niveau'
710                     print *,'         On ne peut definir de part de d''autre '
711                     print *,'de _ON_ qu''1 seul processus et 1 seul niveau'
712                     print *,' Nb de niveaux demandes   : ',NBLVLKDIA(KLOOP,1)
713                     print *,' Nb de processus demandes : ',NBPROCDIA(KLOOP)
714                     print *,' *** MODIFIEZ VOTRE DIRECTIVE *** '
715                     EXIT
716                   ENDIF
717                 ENDIF
718
719 ! Modif AOUT 97
720                 ZTEM1D(:)=XSPVAL; ZWORKZ(:)=0.
721 !               ZTEM1D(:)=0.; ZWORKZ(:)=0.
722
723                   CALL LOADUNITIT(JLOOPP,KLOOP)
724 !!!!!Mars 2000
725                   IF(LUMVM)THEN
726                     NMGRID=1
727                   ENDIF
728                   IF(LUMVMPV)THEN
729                     NMGRID=1
730                   ENDIF
731 !!!!!Mars 2000
732
733                   CALL COMPCOORD_FORDIACHRO(NMGRID)
734 ! Expression temps non incrementale
735                 IF(.NOT.LTINCRDIA(KLOOP,1))THEN
736
737                 DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
738                   NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
739
740                   CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
741                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
742 ! Chargement cas PV
743
744                   ZTEM1D(NKL:NKH)=XVAR(1,1,: &
745                   ,NTIMEDIA(JLOOPT,KLOOP,1),1,NPROCDIA(JLOOPP,KLOOP))
746
747                   ZWORKZ(:)=XXZ(:,NMGRID)
748 !                 print * ,'**operoper NMGRID XXZ ',NMGRID
749 !                 print * ,XXZ(:,NMGRID)
750                   IF(NIL /= 1 .OR. NJL /= 1)THEN
751                     IF(LICP .OR. LJCP)THEN
752 !                     print *,'**operoper LICP LJCP ',LICP,LJCP
753                     ELSE
754                     ZWORKZ(:)=XZZ(NIL,NJL,:)
755                     ENDIF
756                     IF(NKL == 1 .AND. NKH == IKU)THEN
757                       ZTEM1D(1)=XSPVAL
758                       ZTEM1D(IKU)=XSPVAL
759                     ENDIF
760                   ENDIF
761                  
762
763                   IF(LPV)THEN
764                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
765                       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
766                       ALLOCATE(XPRDAT(16,1))
767                       CALL LOAD_XPRDAT(1,NLOOPT)
768                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
769
770                     IF(LUMVMPV)THEN
771                       LPV=.FALSE. ; LPVT=.TRUE.
772                       IF(JLOOPP == 1)THEN
773 !!!! Octobre 2001
774                         ILENW=1
775                         ALLOCATE(ZTEM2D(1:IKU,ILENW))
776                         ALLOCATE(ZWORKT(ILENW))
777                         ZWORKT=NLOOPT
778                         IF(ALLOCATED(XTEM2D))THEN
779                           DEALLOCATE(XTEM2D)
780                         ENDIF
781                         ALLOCATE(XTEM2D(1:IKU,ILENW))
782                         XTEM2D=XSPVAL
783                         IF(ALLOCATED(XTEM2D2))THEN
784                           DEALLOCATE(XTEM2D2)
785                         ENDIF
786                         ALLOCATE(XTEM2D2(1:IKU,ILENW))
787                         XTEM2D2=XSPVAL
788                         XTEM2D(:,1)=ZTEM1D
789                         XTEM2D2(NKL:NKH,1)=XVAR(1,1,: &
790                         ,NTIMEDIA(JLOOPT,KLOOP,1),1,NPROCDIA(JLOOPP+1,KLOOP))
791                         IF(NBPROCDIA(KLOOP) == 3)THEN
792                           ZTEM2D=XSPVAL
793                           ZTEM2D(NKL:NKH,1)=XVAR(1,1,: &
794                           ,NTIMEDIA(JLOOPT,KLOOP,1),1,NPROCDIA(JLOOPP+2,KLOOP))
795                           
796                           CALL COLVECT(IKU,ZTEM2D)
797                          ENDIF
798                          CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
799                          IF(LUMVMPV)THEN
800                            LPV=.TRUE. ; LPVT=.FALSE.
801                          ENDIF
802                          DEALLOCATE(ZTEM2D,ZWORKT)
803                          IF(ALLOCATED(XTEM2D))THEN
804                            DEALLOCATE(XTEM2D)
805                          ENDIF
806                          IF(ALLOCATED(XTEM2D2))THEN
807                            DEALLOCATE(XTEM2D2)
808                          ENDIF
809                          LCOLPVT=.FALSE.
810                        ENDIF
811
812                     ELSE
813 !!!! Octobre 2001
814
815                       CALL TRAPRO_FORDIACHRO(ZTEM1D,ZWORKZ,KLOOP)
816
817                     ENDIF
818                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
819                       DEALLOCATE(XPRDAT)
820                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
821                     IF(KLOOP == NSUPERDIA)CALL FRAME
822                   ELSE IF(LPVT .OR. LPVKT)THEN
823                     IF(JLOOPT == 1)THEN
824                       ILENW=NBTIMEDIA(KLOOP,1)
825                       ALLOCATE(ZTEM2D(1:IKU,ILENW))
826                       ZTEM2D=XSPVAL
827                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
828                       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
829                       ALLOCATE(XPRDAT(16,ILENW))
830                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
831 !!!!!Mars 2000
832                       IF(LUMVM)THEN
833                         IF(ALLOCATED(XTEM2D))THEN
834                           DEALLOCATE(XTEM2D)
835                         ENDIF
836                         ALLOCATE(XTEM2D(1:IKU,ILENW))
837                         XTEM2D=XSPVAL
838                       ENDIF
839
840                       IF(LUMVMPV .AND. JLOOPP == 1)THEN
841                         IF(ALLOCATED(XTEM2D))THEN
842                           DEALLOCATE(XTEM2D)
843                         ENDIF
844                         ALLOCATE(XTEM2D(1:IKU,ILENW))
845                         XTEM2D=XSPVAL
846                         IF(ALLOCATED(XTEM2D2))THEN
847                           DEALLOCATE(XTEM2D2)
848                         ENDIF
849                         ALLOCATE(XTEM2D2(1:IKU,ILENW))
850                         XTEM2D2=XSPVAL
851                       ENDIF
852 !!!!!Mars 2000
853                       ALLOCATE(ZWORKT(ILENW))
854                     ENDIF
855                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
856                       CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
857                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
858                     ZWORKT(JLOOPT)=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
859                     ZTEM2D(NKL:NKH,JLOOPT)=  XVAR(1,1,:,  &
860                       NTIMEDIA(JLOOPT,KLOOP,1),1,NPROCDIA(JLOOPP,KLOOP))
861 !!!!!Mars 2000
862                     IF(LUMVM)THEN
863                       XTEM2D(NKL:NKH,JLOOPT)= XU(1,1,:,  &
864                         NTIMEDIA(JLOOPT,KLOOP,1),1,NPROCDIA(JLOOPP,KLOOP))
865                     ENDIF
866 !!!!!Mars 2000
867                     IF(JLOOPT == NBTIMEDIA(KLOOP,1))THEN
868                       XPVMIN=MINVAL(ZTEM2D(MAX(IKB,NKL):MIN(IKE,NKH),:))
869                       XPVMAX=MAXVAL(ZTEM2D(MAX(IKB,NKL):MIN(IKE,NKH),:))
870                       CALL VALMNMX(XPVMIN,XPVMAX)
871                       IF(ABS(XPVMAX-XPVMIN) < 1.E-4)THEN
872                         XPVMIN=XPVMIN-1.
873                         XPVMAX=XPVMAX+1.
874                       ENDIF
875                       IF(NKL == 1 .AND. NKH == IKU)THEN
876                         ZTEM2D(1,:)=XSPVAL
877                         ZTEM2D(IKU,:)=XSPVAL
878                       ENDIF
879
880                       IF(LUMVMPV)THEN
881                         IF(JLOOPP == 1)THEN
882 ! Memorisation de U
883                           XTEM2D=ZTEM2D
884                           CYCLE
885                         ELSEIF(JLOOPP == 2)THEN
886                           IF(JLOOPP == NBPROCDIA(KLOOP))THEN
887                             XTEM2D2=ZTEM2D
888                           ELSE
889                             XTEM2D2=ZTEM2D
890                             CYCLE
891                           ENDIF
892                         ELSEIF(JLOOPP == 3)THEN 
893                           CALL COLVECT(IKU,ZTEM2D)
894                         ENDIF
895                       ENDIF
896
897                       CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
898                       IF(LPRDAT) DEALLOCATE(XPRDAT) ! Juin 2001 Ajout des dates ds FICVAL 
899                       DEALLOCATE(ZTEM2D,ZWORKT)
900                       IF(ALLOCATED(XTEM2D))THEN
901                         DEALLOCATE(XTEM2D)
902                       ENDIF
903                       IF(ALLOCATED(XTEM2D2))THEN
904                         DEALLOCATE(XTEM2D2)
905                       ENDIF
906                       LCOLPVT=.FALSE.
907                       IF(.NOT.LPBREAD)THEN
908                         IF(KLOOP == NSUPERDIA)CALL FRAME
909                       ENDIF
910                     ENDIF
911                   ENDIF
912                 ENDDO
913                 ELSE
914 ! Expression temps incrementale !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
915                 DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),NTIMEDIA(3,KLOOP,1)
916                   NLOOPT=JLOOPT
917                   CALL RESOLV_TIMES(JLOOPT)
918                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(JLOOPT,1)
919
920                   ZTEM1D(NKL:NKH)=XVAR(1,1,: &
921                   ,JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
922
923                   ZWORKZ(:)=XXZ(:,NMGRID)
924 !                 print * ,'**operoper NMGRID XXZ ',NMGRID
925 !                 print * ,XXZ(:,NMGRID)
926                   IF(NIL /= 1 .OR. NJL /= 1)THEN
927                     IF(LICP .OR. LJCP)THEN
928 !                     print * ,'**operoper LICP, LJCP ',LICP, LJCP
929                     ELSE
930                     ZWORKZ(:)=XZZ(NIL,NJL,:)
931                     ENDIF
932                     IF(NKL == 1 .AND. NKH == IKU)THEN
933                       ZTEM1D(1)=XSPVAL
934                       ZTEM1D(IKU)=XSPVAL
935                     ENDIF
936                   ENDIF
937
938                   IF(LPV)THEN
939                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
940                       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
941                       ALLOCATE(XPRDAT(16,1))
942                       CALL LOAD_XPRDAT(1,NLOOPT)
943                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
944
945                     IF(LUMVMPV)THEN
946                       LPV=.FALSE. ; LPVT=.TRUE.
947 !!!Octobre 2001
948                       IF(JLOOPP == 1)THEN
949                         ILENW=1
950                         ALLOCATE(ZTEM2D(1:IKU,ILENW))
951                         ALLOCATE(ZWORKT(ILENW))
952                         ZWORKT=NLOOPT
953                         IF(ALLOCATED(XTEM2D))THEN
954                           DEALLOCATE(XTEM2D)
955                         ENDIF
956                         ALLOCATE(XTEM2D(1:IKU,ILENW))
957                         XTEM2D=XSPVAL
958                         IF(ALLOCATED(XTEM2D2))THEN
959                           DEALLOCATE(XTEM2D2)
960                         ENDIF
961                         ALLOCATE(XTEM2D2(1:IKU,ILENW))
962                         XTEM2D2=XSPVAL
963                         XTEM2D(:,1)=ZTEM1D
964                         XTEM2D2(NKL:NKH,1)=XVAR(1,1,: &
965                         ,JLOOPT,1,NPROCDIA(JLOOPP+1,KLOOP))
966                         IF(NBPROCDIA(KLOOP) == 3)THEN
967                           ZTEM2D=XSPVAL
968                           ZTEM2D(NKL:NKH,1)=XVAR(1,1,: &
969                           ,JLOOPT,1,NPROCDIA(JLOOPP+2,KLOOP))
970
971                           CALL COLVECT(IKU,ZTEM2D)
972                         ENDIF
973                         CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
974                          IF(LUMVMPV)THEN
975                            LPV=.TRUE. ; LPVT=.FALSE.
976                          ENDIF
977                         DEALLOCATE(ZTEM2D,ZWORKT)
978                         IF(ALLOCATED(XTEM2D))THEN
979                           DEALLOCATE(XTEM2D)
980                         ENDIF
981                         IF(ALLOCATED(XTEM2D2))THEN
982                           DEALLOCATE(XTEM2D2)
983                         ENDIF
984                         LCOLPVT=.FALSE.
985                       ENDIF
986
987                     ELSE
988 !!!Octobre 2001
989                       CALL TRAPRO_FORDIACHRO(ZTEM1D,ZWORKZ,KLOOP)
990 !!!Octobre 2001
991                     ENDIF
992 !!!Octobre 2001
993                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
994                       DEALLOCATE(XPRDAT)
995                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
996                     IF(KLOOP == NSUPERDIA)CALL FRAME
997
998                   ELSE IF(LPVT .OR. LPVKT)THEN
999
1000                     IF(JLOOPT == NTIMEDIA(1,KLOOP,1))THEN
1001                       ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1) +1
1002                       IF(NVERBIA > 0)THEN
1003                       print *,' OPER  NTIMEDIA(2,KLOOP,1) NTIMEDIA(1,KLOOP,1) NTIMEDIA(3,KLOOP,1) ILENW ', &
1004                       NTIMEDIA(2,KLOOP,1),NTIMEDIA(1,KLOOP,1),NTIMEDIA(3,KLOOP,1), &
1005                       ILENW, &
1006                       XTIMEDIA(2,KLOOP,1),XTIMEDIA(1,KLOOP,1),XTIMEDIA(3,KLOOP,1)
1007                       ENDIF
1008
1009                       ITIMEND=NTIMEDIA(1,KLOOP,1) + &
1010                       (((NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/  &
1011                       NTIMEDIA(3,KLOOP,1))*NTIMEDIA(3,KLOOP,1))
1012
1013                       IF(NVERBIA > 0)THEN
1014                       print *,' ITIMEND  A',ITIMEND
1015                       ENDIF
1016
1017                       IF(ALLOCATED(ZTEM2D))THEN
1018                         DEALLOCATE(ZTEM2D)
1019                       ENDIF
1020                       IF(ALLOCATED(ZWORKT))THEN
1021                         DEALLOCATE(ZWORKT)
1022                       ENDIF
1023                       ALLOCATE(ZTEM2D(1:IKU,ILENW))
1024                       ZTEM2D=XSPVAL
1025 !!!!!Mars 2000
1026                       IF(LUMVM)THEN
1027                         IF(ALLOCATED(XTEM2D))THEN
1028                           DEALLOCATE(XTEM2D)
1029                         ENDIF
1030                         ALLOCATE(XTEM2D(1:IKU,ILENW))
1031                         XTEM2D=XSPVAL
1032                       ENDIF
1033
1034                       IF(LUMVMPV .AND. JLOOPP == 1)THEN
1035                         IF(ALLOCATED(XTEM2D))THEN
1036                           DEALLOCATE(XTEM2D)
1037                         ENDIF
1038                         ALLOCATE(XTEM2D(1:IKU,ILENW))
1039                         XTEM2D=XSPVAL
1040                         IF(ALLOCATED(XTEM2D2))THEN
1041                           DEALLOCATE(XTEM2D2)
1042                         ENDIF
1043                         ALLOCATE(XTEM2D2(1:IKU,ILENW))
1044                         XTEM2D2=XSPVAL
1045                       ENDIF
1046 !!!!!Mars 2000
1047                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1048                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1049                         ALLOCATE(XPRDAT(16,ILENW))
1050                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1051                       ALLOCATE(ZWORKT(ILENW))
1052                       IJLT=0
1053                     ENDIF
1054
1055                     IJLT=IJLT+1
1056                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1057                         CALL LOAD_XPRDAT(IJLT,NLOOPT)
1058                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1059                     ZWORKT(IJLT)=XTRAJT(JLOOPT,1)
1060                       if(nverbia >0)then
1061 !                      print *,' **oper AV ZTEM2D(NKL:NKH,IJLT)= '
1062                     endif
1063                     ZTEM2D(NKL:NKH,IJLT)= &
1064                     XVAR(1,1,:,  &
1065                     JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
1066                       if(nverbia >0)then
1067 !                       print *,' **oper AP ZTEM2D(NKL:NKH,IJLT)= '
1068                       endif
1069 !!!!!Mars 2000
1070                       IF(LUMVM)THEN
1071                         XTEM2D(NKL:NKH,IJLT)= &
1072                         XU(1,1,:,  &
1073                         JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
1074                       ENDIF
1075 !!!!!Mars 2000
1076
1077 !                   IF(JLOOPT == NTIMEDIA(2,KLOOP,1))THEN
1078                     IF(JLOOPT == ITIMEND)THEN
1079                       XPVMIN=MINVAL(ZTEM2D(MAX(IKB,NKL):MIN(IKE,NKH),:))
1080                       XPVMAX=MAXVAL(ZTEM2D(MAX(IKB,NKL):MIN(IKE,NKH),:))
1081                       CALL VALMNMX(XPVMIN,XPVMAX)
1082                       if(nverbia >0)then
1083                         print *,' **oper AP CALL VALMNMX(XPVMIN,XPVMAX)'
1084                       endif
1085                       IF(ABS(XPVMAX-XPVMIN) < 1.E-4)THEN
1086                         XPVMIN=XPVMIN-1.
1087                         XPVMAX=XPVMAX+1.
1088                       ENDIF
1089                       IF(NKL == 1 .AND. NKH == IKU)THEN
1090                         ZTEM2D(1,:)=XSPVAL
1091                         ZTEM2D(IKU,:)=XSPVAL
1092                       ENDIF
1093
1094                       IF(LUMVMPV)THEN        !llllllllllllllllllll
1095
1096                         IF(JLOOPP == 1)THEN  !kkkkkkkkkkkkkkkkkkkkkkk
1097 ! Memorisation de U
1098                           XTEM2D=ZTEM2D
1099                           CYCLE
1100                         ELSEIF(JLOOPP == 2)THEN !kkkkkkkkkkkkkkkkkkkkk
1101                           IF(JLOOPP == NBPROCDIA(KLOOP))THEN
1102                             XTEM2D2=ZTEM2D
1103                           ELSE
1104                             XTEM2D2=ZTEM2D
1105                             CYCLE
1106                           ENDIF
1107                         ELSEIF(JLOOPP == 3)THEN !kkkkkkkkkkkkkkkkkkkkk
1108                           CALL COLVECT(IKU,ZTEM2D)
1109                         ENDIF         !kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
1110                       ENDIF           !llllllllllllllllllllllllllllllllll
1111
1112                       if(nverbia >0)then
1113                         print *,' ** oper AV CALL PVFCT xx'
1114                       endif
1115                       CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
1116                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1117                       DEALLOCATE(XPRDAT)
1118                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1119                       DEALLOCATE(ZWORKT,ZTEM2D)
1120                       if(nverbia >0)then
1121                         print *,' ** oper AP CALL PVFCT xx'
1122                       endif
1123                       IF(ALLOCATED(XTEM2D))THEN
1124                         DEALLOCATE(XTEM2D)
1125                       ENDIF
1126                       IF(ALLOCATED(XTEM2D2))THEN
1127                         DEALLOCATE(XTEM2D2)
1128                       ENDIF
1129                         LCOLPVT=.FALSE.
1130                       IF(.NOT.LPBREAD)THEN
1131                         IF(KLOOP == NSUPERDIA)CALL FRAME
1132                       if(nverbia >0)then
1133                         print *,' ** oper AP CALL FRAME xx'
1134                       endif
1135                       ENDIF
1136
1137                     ENDIF         ! Fin if=ITIMEND
1138                   ENDIF
1139                 ENDDO    ! fin boucle temporelle
1140                 ENDIF    ! Tps increm ou non
1141
1142               ENDDO     !    Processus
1143               DEALLOCATE(ZTEM1D,ZWORKZ)
1144             IF(.NOT.LICP .AND. .NOT.LJCP .AND. .NOT.LKCP)THEN
1145 !
1146 !  Cas PV enregistre comme tel 
1147 !
1148             ELSE IF(LICP .AND. LJCP .AND. .NOT.LKCP)THEN
1149 ! (Impression dim mat. modele et matrice(NIL:NIH,NJL:NJH,
1150 !  NKL:NKH) et matrice(1,1,NKL:NKH)
1151             ENDIF
1152
1153             IF(IDEFCV==1)THEN                !%%%%%%%%%%%%%%%%%%%%%%%%%%
1154               LDEFCV2CC=.TRUE.
1155               IDEFCV=0
1156             ENDIF                           !%%%%%%%%%%%%%%%%%%%%%%%%%%
1157
1158
1159           ELSE IF(II == 1 .AND. IJ /= 1 .AND. IK /= 1 .AND. LICP)THEN
1160
1161 ! Cas compression bilan sur axe X -->  Plan vertical // Y
1162 ! *******************************************************
1163 ! (Impression dim mat. modele et matrice(NIL:NIH,NJL:NJH,
1164 !  NKL:NKH) et matrice(1,NJL:NJH,NKL:NKH)
1165             LCVYZ=.TRUE.
1166             IDEFCV=0                         !%%%%%%%%%%%%%%%%%%%%%%%%%%
1167             IF(LDEFCV2CC)THEN
1168               LDEFCV2CC=.FALSE.
1169               IDEFCV=1
1170             ENDIF                            !%%%%%%%%%%%%%%%%%%%%%%%%%%
1171             IF(.NOT.L2DBY)THEN
1172               IJINF=MAX(IJB,NJL)
1173               IJSUP=MIN(IJE,NJH)
1174               print *,' 2D Vertical // Y '
1175               print *,' Limites J par defaut (L2DBY=.FALSE.)(par / au domaine integral de simulation, points de garde compris) :',&
1176 &             ' MAX(IJB,NJL) - MIN(IJE,NJH) ',IJINF,' - ',IJSUP
1177               print *,' Si vous voulez selectionner les limites en J, mettez : ',&
1178 &             'L2DBY=.TRUE.' 
1179               print *,' et definissez : NJDEBCOU=    NLMAX= '
1180             ELSE
1181               IJINF=NJDEBCOU     
1182               IJSUP=NJDEBCOU+NLMAX-1
1183               IJSUP=MIN(IJSUP,NJH)
1184             ENDIF
1185             ALLOCATE(ZTEM2D(1:IJSUP-IJINF+1,1:IKU))
1186             NINX=IJSUP-IJINF+1
1187             NINY=IKU
1188             NLMAX=NINX
1189             NLANGLE=90
1190             NJDEBCOU=IJINF
1191             IIDEBCOU=-999
1192             IF(NIDEBCOU /= NIL)THEN
1193               IIDEBCOU=NIDEBCOU
1194               NIDEBCOU=NIL
1195 !             print *,' NIDEBCOU force a la valeur de NIL ',NIL,' pour ', &
1196 !&            'obtention altitudes correctes '
1197 !             print *,' AP utilisation, sera remis a la valeur precedente : ', &
1198 !             IIDEBCOU
1199             ENDIF
1200             LVERT=.TRUE.
1201             LHOR=.FALSE.
1202             LPT=LPXT
1203             IF(NSUPERDIA > 1)THEN
1204                     IF(LMINUS .OR. LPLUS)THEN
1205                       IF(NBPM > 1)THEN
1206                         DO JU=1,NBPM
1207                           IF(NUMPM(JU) == 3)THEN
1208                             LSUPER=.TRUE.
1209                             EXIT
1210                           ELSE
1211                             LSUPER=.FALSE.
1212                           ENDIF
1213                         ENDDO
1214                       ELSE
1215                         LSUPER=.FALSE.
1216                       ENDIF
1217                     ELSE
1218                       LSUPER=.TRUE.
1219                     ENDIF
1220             ELSE
1221               LSUPER=.FALSE.
1222             ENDIF
1223             IF(KLOOP == 1)NSUPER=0
1224             DO JLOOPP=1,NBPROCDIA(KLOOP)      !--- LCVYZ-------------
1225                NLOOPP=NPROCDIA(JLOOPP,KLOOP)
1226                NMGRID=NGRIDIA(NLOOPP)
1227               IF(JLOOPP == 1)NSUPER=0
1228
1229                   CALL LOADUNITIT(JLOOPP,KLOOP)
1230
1231               ILENT=LEN_TRIM(CTITGAL)
1232               ILENU=LEN_TRIM(CUNITGAL)
1233               YTEXTE(1:ILENT)=CTITGAL(1:ILENT)
1234               YTEXTE(ILENT+1:ILENT+1)=' '
1235               YTEXTE(ILENT+2:ILENT+2+ILENU-1)=CUNITGAL(1:ILENU)
1236               IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1237                 IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1238                 ALLOCATE(XPRDAT(16,1))
1239               ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1240
1241               IF(.NOT.LTINCRDIA(KLOOP,1))THEN
1242
1243                 DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
1244
1245                   NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
1246                   IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1247                     CALL LOAD_XPRDAT(1,NLOOPT)
1248                   ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1249                   CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
1250                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
1251                   IF(.NOT. LSUPER .OR. (LSUPER .AND. NSUPER == 0))THEN
1252                     DO J=1,NINX
1253                       XZWORKZ(J,1:IKU)=XXZ(:,NMGRID)
1254                     ENDDO
1255                     XZZDS(1:NINX)=XXY(IJINF:IJSUP,NMGRID)
1256                     ZWL=XZZDS(1); ZWR=XZZDS(NINX)
1257                     IF((XHMIN == 0. .AND. XHMAX == 0.) .OR. (XHMAX<=XHMIN))THEN
1258                       XHMIN=0.
1259                       XHMAX=XZWORKZ(1,IKE)
1260                     ENDIF
1261                     ZWB=XHMIN; ZWT=XHMAX
1262                     CALL SET(.1,.9,.1,.9,ZWL,ZWR,ZWB,ZWT,1)
1263                     CALL GSCLIP(1)
1264                     CALL CPSETI('SET',0)
1265                     CALL CPSETI('MAP',4)
1266                   ENDIF
1267                   ZTEM2D=XSPVAL
1268                   ZTEM2D(1:IJSUP-IJINF+1,NKL:NKH)=XVAR(1, &
1269                   IJINF-NJL+1:IJSUP-NJL+1,:,NTIMEDIA(JLOOPT,KLOOP,1),&
1270                   1,NPROCDIA(JLOOPP,KLOOP))
1271                   IF(NKL < IKB)THEN
1272                     ZTEM2D(:,1:IKB-1)=XSPVAL
1273                   ENDIF
1274                   IF(NKH > IKE)THEN
1275                     ZTEM2D(:,IKE+1:IKU)=XSPVAL
1276                   ENDIF
1277                   if(nverbia >0)THEN
1278                     print *,' ** oper appel imcou  Ytexte ',YTEXTE(1:LEN_TRIM(YTEXTE))
1279                   endif
1280                   IF(KLOOP == 1)NSUPER=0
1281                   CALL IMCOU_FORDIACHRO(ZTEM2D,XDIAINT,CLEGEND,YTEXTE(1:LEN_TRIM&
1282                   (YTEXTE)))
1283 !                 IF(KLOOP == NSUPERDIA)CALL FRAME
1284                   IF(KLOOP == NSUPERDIA)THEN
1285                     CALL NGPICT(1,1)
1286                     CALL GQACWK(1,IER,INB,IWK)
1287                     IF(INB > 1)CALL NGPICT(2,3)
1288                   ENDIF
1289                 ENDDO
1290               ELSE
1291                 DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),  &
1292                           NTIMEDIA(3,KLOOP,1)
1293                   NLOOPT=JLOOPT
1294                   IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1295                     CALL LOAD_XPRDAT(1,NLOOPT)
1296                   ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1297                   CALL RESOLV_TIMES(JLOOPT)
1298                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(JLOOPT,1)
1299                   IF(.NOT. LSUPER .OR. (LSUPER .AND. NSUPER == 0))THEN
1300                     DO J=1,NINX
1301                       XZWORKZ(J,1:IKU)=XXZ(:,NMGRID)
1302                     ENDDO
1303                     XZZDS(1:NINX)=XXY(IJINF:IJSUP,NMGRID)
1304                     ZWL=XZZDS(1); ZWR=XZZDS(NINX)
1305                     IF((XHMIN == 0. .AND. XHMAX == 0.) .OR. (XHMAX<=XHMIN))THEN
1306                       XHMIN=0.
1307                       XHMAX=XZWORKZ(1,IKE)
1308                     ENDIF
1309                     ZWB=XHMIN; ZWT=XHMAX
1310                     CALL SET(.1,.9,.1,.9,ZWL,ZWR,ZWB,ZWT,1)
1311                     CALL GSCLIP(1)
1312                     CALL CPSETI('SET',0)
1313                     CALL CPSETI('MAP',4)
1314                   ENDIF
1315                   ZTEM2D=XSPVAL
1316                   ZTEM2D(1:IJSUP-IJINF+1,NKL:NKH)=XVAR(1, &
1317                   IJINF-NJL+1:IJSUP-NJL+1,:,JLOOPT,1, &
1318                   NPROCDIA(JLOOPP,KLOOP))
1319                   IF(NKL < IKB)THEN
1320                     ZTEM2D(:,1:IKB-1)=XSPVAL
1321                   ENDIF
1322                   IF(NKH > IKE)THEN
1323                     ZTEM2D(:,IKE+1:IKU)=XSPVAL
1324                   ENDIF
1325                   if(nverbia >0)THEN
1326                     print *,' ** oper appel imcou  Ytexte ',YTEXTE(1:LEN_TRIM(YTEXTE))
1327                   endif
1328                   IF(KLOOP ==1)NSUPER=0
1329                   CALL IMCOU_FORDIACHRO(ZTEM2D,XDIAINT,CLEGEND,YTEXTE(1:LEN_TRIM&
1330                   (YTEXTE)))
1331 !                 IF(KLOOP == NSUPERDIA)CALL FRAME
1332                   IF(KLOOP == NSUPERDIA)THEN
1333                     CALL NGPICT(1,1)
1334                     CALL GQACWK(1,IER,INB,IWK)
1335                     IF(INB > 1)CALL NGPICT(2,3)
1336                   ENDIF
1337                 ENDDO
1338               ENDIF
1339             ENDDO                             !--- LCVYZ-------------
1340             IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1341               DEALLOCATE(XPRDAT)
1342             ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1343             DEALLOCATE(ZTEM2D)
1344             IF(IIDEBCOU /= -999)THEN
1345               NIDEBCOU=IIDEBCOU
1346             ENDIF
1347
1348             IF(IDEFCV==1)THEN                 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1349               LDEFCV2CC=.TRUE.
1350               IDEFCV=0
1351             ENDIF                            !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1352
1353           ELSE IF((II == 1 .OR. IIE-IIB == 0) .AND. IJ /= 1 .AND. IK == 1)THEN
1354
1355 ! Cas compression bilan sur axes X et Z -->  Profil horizontal // Y
1356 ! mais a representer comme f(t)
1357 ! ********************************************************************
1358 ! (Impression dim mat. modele et matrice(NIL:NIH,NJL:NJH,
1359 !  NKL:NKH) et matrice(1,NJL:NJH,1)
1360             print *,' Profil horizontal // Y'
1361             IINF=NIINF;ISUP=NISUP;IJINF=NJINF;IJSUP=NJSUP
1362             if(nverbia > 0)then
1363             print *,'IINF,ISUP,IJINF,IJSUP ',IINF,ISUP,IJINF,IJSUP
1364             endif
1365             IF(II == 1)THEN
1366               GII1=.TRUE.
1367             ELSE
1368               GII1=.FALSE.
1369               LCH=.FALSE.
1370             ENDIF
1371
1372             IF(GII1)THEN
1373               IF(.NOT.L2DBY)THEN
1374                 NIINF=1; NISUP=1
1375                 NJINF=MAX(IJB,NJL); NJSUP=MIN(IJE,NJH)
1376                 print *,' Profil horizontal // Y '
1377                 print *,' Limites J par defaut (L2DBY=.FALSE.) :',&
1378 &               ' MAX(IJB,NJL) - MIN(IJE,NJH) ',NJINF,' - ',NJSUP
1379                 print *,' Si vous voulez selectionner les limites en J, mettez : ',&
1380 &               'L2DBY=.TRUE.' 
1381                 print *,' et definissez : NJDEBCOU=    NLMAX= '
1382               ELSE
1383                 NIINF=1; NISUP=1
1384                 NJINF=NJDEBCOU; NJSUP=NJDEBCOU+NLMAX-1
1385                 NJINF=MAX(NJINF,NJL);NJSUP=MIN(NJSUP,NJH)
1386               ENDIF
1387             ELSE
1388               IF(.NOT.L2DBY)THEN
1389                 NIINF=IIB; NISUP=NIINF
1390                 NJINF=MAX(IJB,NJL); NJSUP=MIN(IJE,NJH)
1391                 print *,' Profil horizontal // Y '
1392                 print *,' Limites J par defaut (L2DBY=.FALSE.) :',&
1393 &               ' MAX(IJB,NJL) - MIN(IJE,NJH) ',NJINF,' - ',NJSUP
1394                 print *,' Si vous voulez selectionner les limites en J, mettez : ',&
1395 &               'L2DBY=.TRUE.' 
1396                 print *,' et definissez : NJDEBCOU=    NLMAX= '
1397               ELSE
1398                 NIINF=IIB; NISUP=NIINF
1399                 NJINF=NJDEBCOU; NJSUP=NJDEBCOU+NLMAX-1
1400                 NJINF=MAX(NJINF,NJL);NJSUP=MIN(NJSUP,NJH)
1401               ENDIF
1402             ENDIF
1403             ILENW=NJSUP-NJINF+1
1404
1405             ALLOCATE(ZWORK1D(ILENW),ZWORKY(ILENW))
1406
1407             DO JLOOPP=1,NBPROCDIA(KLOOP)
1408               NLOOPP=NPROCDIA(JLOOPP,KLOOP)
1409
1410               YTITX(1:LEN(YTITX))=' '
1411               YTITY(1:LEN(YTITY))=' '
1412
1413                   CALL LOADUNITIT(JLOOPP,KLOOP)
1414
1415               YTITX='Y(M)'
1416               YTITY=CUNITGAL(1:LEN_TRIM(CUNITGAL))
1417
1418               ZWORK1D(:)=0.; ZWORKY(:)=0.
1419               IF(.NOT.LTINCRDIA(KLOOP,1))THEN
1420                 
1421                 DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
1422
1423                   NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
1424
1425                   IF(LPYT)THEN
1426                     IF(JLOOPT == 1)THEN
1427                       ILENW=NBTIMEDIA(KLOOP,1)
1428                       IX=NJSUP-NJINF+1
1429                       ALLOCATE(ZTEM2D(IX,ILENW))
1430                       ALLOCATE(ZWORKT(ILENW))
1431                       ZTEM2D=XSPVAL
1432                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1433                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1434                         ALLOCATE(XPRDAT(16,ILENW))
1435                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1436                     ENDIF
1437
1438                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1439                       CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
1440                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1441                     ZWORKT(JLOOPT)=XTRAJT(NLOOPT,1)
1442                     ZTEM2D(:,JLOOPT)=XVAR(NIINF,NJINF-NJL+1:NJSUP-NJL+1,1, &
1443                     NLOOPT,1,NLOOPP)
1444                     IF(JLOOPT == NBTIMEDIA(KLOOP,1))THEN
1445                       CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
1446                     IF(.NOT.LPBREAD)THEN
1447                       IF(KLOOP == NSUPERDIA)THEN
1448                         CALL NGPICT(1,1)
1449                         CALL GQACWK(1,IER,INB,IWK)
1450                         IF(INB > 1)CALL NGPICT(2,3)
1451                       ENDIF
1452                     ENDIF
1453                     DEALLOCATE(ZTEM2D,ZWORKT)
1454                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1455                         DEALLOCATE(XPRDAT)
1456                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1457                     ENDIF
1458
1459                   ELSE
1460
1461                     ZWORK1D=XXY(NJINF:NJSUP,NMGRID)
1462                     ZWORKY=XVAR(NIINF,NJINF-NJL+1:NJSUP-NJL+1,1,NTIMEDIA(JLOOPT,KLOOP,1),1,NLOOPP)
1463                     ZTIMED=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
1464                     ZTIMEF=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
1465                     IF(JLOOPT == 1)THEN
1466                       IF(LDATFILE)CALL DATFILE_FORDIACHRO
1467                       CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
1468                     ENDIF
1469                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1470                       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1471                         ALLOCATE(XPRDAT(16,1))
1472                         CALL LOAD_XPRDAT(1,NLOOPT)
1473                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1474                     CALL TRAXY(ZWORK1D,ZWORKY,KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF)
1475                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1476                         DEALLOCATE(XPRDAT)
1477                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1478 !                   IF(KLOOP == NSUPERDIA)CALL FRAME
1479                     IF(KLOOP == NSUPERDIA)THEN
1480                       CALL NGPICT(1,1)
1481                       CALL GQACWK(1,IER,INB,IWK)
1482                       IF(INB > 1)CALL NGPICT(2,3)
1483                     ENDIF
1484
1485                   ENDIF
1486                 ENDDO
1487
1488               ELSE
1489
1490                 DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),NTIMEDIA(3,KLOOP,1)
1491                   NLOOPT=JLOOPT
1492
1493                   IF(LPYT)THEN
1494                     IF(JLOOPT == NTIMEDIA(1,KLOOP,1))THEN
1495                       ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/ &
1496                       NTIMEDIA(3,KLOOP,1)+1
1497 !                     print *,'oper verif ilenw ',ILENW
1498                       ITIMEND=NTIMEDIA(1,KLOOP,1)+(((NTIMEDIA(2,KLOOP,1)- &
1499                       NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1))*NTIMEDIA(3,KLOOP,1))
1500                       IX=NJSUP-NJINF+1
1501                       ALLOCATE(ZTEM2D(IX,ILENW))
1502                       ALLOCATE(ZWORKT(ILENW))
1503                       ZTEM2D=XSPVAL
1504                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1505                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1506                         ALLOCATE(XPRDAT(16,ILENW))
1507                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1508                       IJLT=0
1509                     ENDIF
1510                     IJLT=IJLT+1
1511                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1512                       CALL LOAD_XPRDAT(IJLT,NLOOPT)
1513                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1514                     ZWORKT(IJLT)=XTRAJT(NLOOPT,1)
1515                     ZTEM2D(:,IJLT)=XVAR(NIINF,NJINF-NJL+1:NJSUP-NJL+1,1, &
1516                     NLOOPT,1,NLOOPP)
1517                     IF(JLOOPT == ITIMEND)THEN
1518                       CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
1519                     IF(.NOT.LPBREAD)THEN
1520                       IF(KLOOP == NSUPERDIA)THEN
1521                         CALL NGPICT(1,1)
1522                         CALL GQACWK(1,IER,INB,IWK)
1523                         IF(INB > 1)CALL NGPICT(2,3)
1524                       ENDIF
1525                     ENDIF
1526                     DEALLOCATE(ZTEM2D,ZWORKT)
1527                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1528                         DEALLOCATE(XPRDAT)
1529                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1530                     ENDIF
1531
1532                   ELSE
1533
1534                     ZWORK1D=XXY(NJINF:NJSUP,NMGRID)
1535                     ZWORKY=XVAR(NIINF,NJINF-NJL+1:NJSUP-NJL+1,1,JLOOPT,1,NLOOPP)
1536                     ZTIMED=XTRAJT(JLOOPT,1)
1537                     ZTIMEF=XTRAJT(JLOOPT,1)
1538                     IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1539                       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1540                         ALLOCATE(XPRDAT(16,1))
1541                         CALL LOAD_XPRDAT(1,NLOOPT)
1542                     ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1543                     IF(JLOOPT == 1)THEN
1544                       IF(LDATFILE)CALL DATFILE_FORDIACHRO
1545                       CALL RESOLV_TIMES(JLOOPT)
1546                     ENDIF
1547                     CALL TRAXY(ZWORK1D,ZWORKY,KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF)
1548 !                   IF(KLOOP == NSUPERDIA)CALL FRAME
1549                     IF(KLOOP == NSUPERDIA)THEN
1550                       CALL NGPICT(1,1)
1551                       CALL GQACWK(1,IER,INB,IWK)
1552                       IF(INB > 1)CALL NGPICT(2,3)
1553                     ENDIF
1554                       IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1555                         DEALLOCATE(XPRDAT)
1556                       ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1557
1558                   ENDIF
1559                 ENDDO
1560               ENDIF
1561             ENDDO
1562
1563             DEALLOCATE(ZWORK1D,ZWORKY)
1564
1565             NIINF=IINF;NISUP=ISUP;NJINF=IJINF;NJSUP=IJSUP
1566
1567           ELSE IF((II /= 1 .AND. IIE /= IIB) .AND. (IJ /= 1 .AND. IJB /= IJE) .AND. IK == 1)THEN
1568
1569 ! Cas compression bilan sur axe Z ou 2D hor.  -->  Plan horizontal
1570 ! ****************************************************************
1571 ! (Impression dim mat. modele et matrice(NIL:NIH,NJL:NJH,
1572 !  NKL:NKH) et matrice(NIL:NIH,NJL:NJH,1)
1573
1574             LCHXY=.TRUE.
1575             CALL RESOLV_NIJINF_NIJSUP
1576
1577 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1578 ! CH  Allocation matrice 2D de reception des valeurs
1579 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1580
1581             ALLOCATE (ZTEM2D(1:NISUP-NIINF+1,1:NJSUP-NJINF+1))
1582
1583 ! Ajout PH Oct 2000 + 1pt FT ou PVKT_k_1
1584             IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT .OR. &
1585 !! Nov 2001
1586                LDIRWM .OR. LDIRWT .OR. LDIRWIND .OR. &
1587 !! Nov 2001
1588                (LCH .AND. LCV) .OR. LFT .OR. LPVKT)THEN
1589               ALLOCATE (ZWORK3D(1:NISUP-NIINF+1,1:NJSUP-NJINF+1,1))
1590               IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT .OR. &
1591 !! Nov 2001
1592                LDIRWM .OR. LDIRWT .OR. LDIRWIND )THEN 
1593 !! Nov 2001
1594                 NMGRID=1
1595               ENDIF
1596             ENDIF
1597
1598             DO JLOOPP=1,NBPROCDIA(KLOOP)      !--- LCHXY-------------
1599               NLOOPP=NPROCDIA(JLOOPP,KLOOP)
1600
1601                   CALL LOADUNITIT(JLOOPP,KLOOP)
1602               YTEXTE(1:LEN(YTEXTE)) = ' '
1603               ILENT=LEN_TRIM(CTITGAL)
1604               ILENU=LEN_TRIM(CUNITGAL)
1605               YTEXTE(1:ILENT)=CTITGAL(1:ILENT)
1606               YTEXTE(ILENT+1:ILENT+1)=' '
1607               YTEXTE(ILENT+2:ILENT+2+ILENU-1)=CUNITGAL(1:ILENU)
1608            if(nverbia >0)then
1609              print *,' OPER TIT=',CTITGAL(1:ILENT),' UNIT=',CUNITGAL(1:ILENU),&
1610                      ' TEXTE=',TRIM(YTEXTE)
1611            endif
1612               IF(.NOT.LTINCRDIA(KLOOP,1))THEN
1613
1614                 DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
1615
1616                   NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
1617
1618                   IF(LANIMT .AND. NISUP-NIINF /= 0 .AND. NJSUP-NJINF /= 0)THEN
1619                     IF(JLOOPT == 1)THEN
1620                       CALL FMFREE(YBID,YBID,IRESP)
1621                       if(nverbia >0)then
1622                       print *,' OPER FMFREE YBID IRESP ',YBID,IRESP
1623                       endif
1624
1625                       CALL FMATTR(YBID,YBID,IBID,IRESP)
1626                       CALL GOPWK(9,IBID,3)
1627 !                     CALL GOPWK(9,20,3)
1628                       ISEGM=ISEGM+1
1629                       ISEGD=ISEGM
1630                       CALL GFLAS1(ISEGM)
1631                     ELSE
1632                       ISEGM=ISEGM+1
1633                       CALL GFLAS1(ISEGM)
1634                     ENDIF
1635                   ENDIF
1636                   IF((.NOT.LFT .AND. .NOT.LPVKT) .OR. (LFT .OR. LPVKT .OR. JLOOPT == 1))THEN
1637                   CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
1638                   ENDIF
1639                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
1640 ! Ajout PH Oct 2000
1641 !! Nov 2001
1642                   IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT .OR. LDIRWM &
1643                     .OR. LDIRWT .OR. LDIRWIND )THEN
1644 !! Nov 2001
1645 !                 IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT )THEN
1646                   ZWORK3D(:,:,1)=XU(NIINF-NIL+1:NISUP-NIL+1, &
1647                                    NJINF-NJL+1:NJSUP-NJL+1, &
1648                                    1,NTIMEDIA(JLOOPT,KLOOP,1),1,  &
1649                                    NPROCDIA(JLOOPP,KLOOP))
1650                   ELSE IF((LCH .AND. LCV) .OR. LFT .OR. LPVKT)THEN
1651                   ZWORK3D(:,:,1)=XVAR(NIINF-NIL+1:NISUP-NIL+1, &
1652                                    NJINF-NJL+1:NJSUP-NJL+1, &
1653                                    1,NTIMEDIA(JLOOPT,KLOOP,1),1,  &
1654                                    NPROCDIA(JLOOPP,KLOOP))
1655                   ELSE
1656                   ZTEM2D(:,:)=XVAR(NIINF-NIL+1:NISUP-NIL+1, &
1657                                    NJINF-NJL+1:NJSUP-NJL+1, &
1658                                    1,NTIMEDIA(JLOOPT,KLOOP,1),1,  &
1659                                    NPROCDIA(JLOOPP,KLOOP))
1660                   ENDIF
1661                   IF(NSUPERDIA > 1)THEN
1662                     IF(LMINUS .OR. LPLUS)THEN
1663                       IF(NBPM > 1)THEN
1664                         DO JU=1,NBPM
1665                           IF(NUMPM(JU) == 3)THEN
1666                             LSUPER=.TRUE.
1667                             EXIT
1668                           ELSE
1669                             LSUPER=.FALSE.
1670                           ENDIF
1671                         ENDDO
1672                       ELSE
1673                         LSUPER=.FALSE.
1674                       ENDIF
1675                     ELSE
1676                       LSUPER=.TRUE.
1677                     ENDIF
1678                     IF(KLOOP == 1)NSUPER=0
1679                   ELSE
1680                     LSUPER=.FALSE.
1681                   ENDIF
1682                   CTYPHOR='K'
1683
1684                   IF(NISUP-NIINF == 0 .OR. NJSUP-NJINF == 0)THEN
1685
1686                     IF(LPXT .OR. LPYT)THEN
1687                       IF(JLOOPT == 1)THEN
1688                         ILENW=NBTIMEDIA(KLOOP,1)
1689                         IF(LPXT)THEN
1690                           IX=NISUP-NIINF+1
1691                         ELSE IF(LPYT)THEN
1692                           IX=NJSUP-NJINF+1
1693                         ENDIF
1694                         ALLOCATE(ZPROVI2(IX,ILENW))
1695                         ALLOCATE(ZWORKT(ILENW))
1696                         ZPROVI2=XSPVAL
1697                         IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1698                           IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1699                           ALLOCATE(XPRDAT(16,ILENW))
1700                         ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1701
1702                       ENDIF
1703                         IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1704                           CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
1705                         ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1706                       ZWORKT(JLOOPT)=XTRAJT(NLOOPT,1)
1707                       IF(LPXT)THEN
1708                         ZPROVI2(:,JLOOPT)=ZTEM2D(:,1)
1709                       ELSE IF(LPYT)THEN
1710                         ZPROVI2(:,JLOOPT)=ZTEM2D(1,:)
1711                       ENDIF
1712                       IF(JLOOPT == NBTIMEDIA(KLOOP,1))THEN
1713                         CALL PVFCT(ZWORKT,ZPROVI2,KLOOP)
1714                         IF(.NOT.LPBREAD)THEN
1715                           IF(KLOOP == NSUPERDIA)THEN
1716                             CALL NGPICT(1,1)
1717                             CALL GQACWK(1,IER,INB,IWK)
1718                             IF(INB > 1)CALL NGPICT(2,3)
1719                           ENDIF
1720                         ENDIF
1721                         DEALLOCATE(ZPROVI2,ZWORKT)
1722                         IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1723                           DEALLOCATE(XPRDAT)
1724                         ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1725                       ENDIF
1726                       
1727                     ELSE
1728                     ALLOCATE(ZPROVI(SIZE(ZTEM2D,1),SIZE(ZTEM2D,2),1))
1729                     ZPROVI(:,:,1)=ZTEM2D(:,:)
1730                         IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1731                           IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1732                           ALLOCATE(XPRDAT(16,1))
1733                           CALL LOAD_XPRDAT(1,NLOOPT)
1734                         ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1735                     CALL TRACEH_FORDIACHRO(1,ZPROVI,KLOOP)
1736                         IF(LPRDAT)THEN ! Juin 2001 Ajout des dates ds FICVAL 
1737                           DEALLOCATE(XPRDAT)
1738                         ENDIF ! Juin 2001 Ajout des dates ds FICVAL 
1739                     DEALLOCATE(ZPROVI)
1740                     ENDIF
1741
1742                   ELSE
1743
1744 ! Ajout PH Oct 2000
1745                     IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT .OR. &
1746 !! Nov 2001
1747                LDIRWM .OR. LDIRWT .OR. LDIRWIND .OR. &
1748 !! Nov 2001
1749                        (LCH .AND. LCV) .OR. LFT .OR. LPVKT)THEN
1750
1751                       IF(LFT .OR. LPVKT)THEN
1752                         ILENW=NBTIMEDIA(KLOOP,1)
1753
1754                         IF(JLOOPT == 1)THEN
1755                           ALLOCATE(ZWORKT(ILENW))
1756                           ALLOCATE(ZWORK1D(ILENW))
1757                           CALL VERIFLEN_FORDIACHRO
1758                           CALL MEMCV
1759                           IF(ALLOCATED(ZTEMCV))THEN
1760                             DEALLOCATE(ZTEMCV)
1761                           ENDIF
1762                           ALLOCATE(ZTEMCV(NLMAX,1))
1763                           IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1764                             IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1765                             ALLOCATE(XPRDAT(16,ILENW))
1766                           ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1767                         ENDIF
1768
1769                         CALL PRECOU_FORDIACHRO(ZWORK3D,ZTEMCV)
1770                         ZWORK1D(JLOOPT)=ZTEMCV(NPROFILE,1)
1771                         ZWORKT(JLOOPT)=XTRAJT(NLOOPT,1)
1772                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1773                           CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
1774                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1775
1776                         IF(JLOOPT == NBTIMEDIA(KLOOP,1))THEN
1777                           IF(LFT)THEN
1778                             CALL VARFCT(ZWORKT,ZWORK1D,1)
1779                           ELSEIF(LPVKT)THEN
1780                             ALLOCATE(ZPROVI2(1,SIZE(ZWORKT,1)))
1781                             ZPROVI2(1,:)=ZWORK1D
1782                             CALL PVFCT(ZWORKT,ZPROVI2,KLOOP)
1783                             DEALLOCATE(ZPROVI2)
1784                           ENDIF
1785                           DEALLOCATE(ZWORKT,ZWORK1D)
1786                           IF(ALLOCATED(ZTEMCV))THEN
1787                             DEALLOCATE(ZTEMCV)
1788                           ENDIF
1789                           IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1790                             DEALLOCATE(XPRDAT)
1791                           ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1792                           IF(KLOOP == NSUPERDIA)THEN
1793                             CALL NGPICT(1,1)
1794                             CALL GQACWK(1,IER,INB,IWK)
1795                             IF(INB > 1)CALL NGPICT(2,3)
1796                           ENDIF
1797                         ENDIF
1798
1799                       ELSE
1800                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1801                           IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1802                           ALLOCATE(XPRDAT(16,1))
1803                           CALL LOAD_XPRDAT(1,NLOOPT)
1804                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1805                         CALL TRACEH_FORDIACHRO(1,ZWORK3D,KLOOP)
1806                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1807                           DEALLOCATE(XPRDAT)
1808                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1809                       ENDIF
1810
1811                     ELSE
1812
1813                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1814                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
1815                         ALLOCATE(XPRDAT(16,1))
1816                         CALL LOAD_XPRDAT(1,NLOOPT)
1817                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1818                       CALL IMAGE_FORDIACHRO(ZTEM2D,1,XDIAINT,NHI,NDOT,YTEXTE(1:&
1819                                                               LEN_TRIM(YTEXTE)))
1820                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
1821                         DEALLOCATE(XPRDAT)
1822                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
1823         if(nverbia > 0)then
1824           print *,' **oper AP IMAGE1 II,IJ,IK,KLOOP ',II,IJ,IK,KLOOP
1825         endif
1826                     ENDIF
1827                   ENDIF
1828                   IF(LANIMT .AND. NISUP-NIINF /= 0 .AND. NJSUP-NJINF /= 0)THEN
1829                     CALL GFLAS2
1830                     IF(JLOOPT == NBTIMEDIA(KLOOP,1))THEN
1831                       DO JJ=ISEGD,ISEGM
1832                         CALL GFLAS3(JJ)
1833                       ENDDO
1834                       CALL GCLWK(9)
1835                       CALL NGPICT(1,1)
1836                       CALL GQACWK(1,IER,INB,IWK)
1837                       IF(INB > 1)CALL NGPICT(2,3)
1838                     ENDIF
1839                   ELSE IF(LPXT.OR.LPYT .OR. LFT .OR. LPVKT)THEN
1840                   ELSE
1841 !                 IF(KLOOP == NSUPERDIA)CALL FRAME
1842                   IF(KLOOP == NSUPERDIA)THEN
1843
1844                     ! Trace du domaine fils eventuellement
1845                     IF(LDOMAIN .AND. .NOT.LCV)THEN
1846                       ZZZXD=XXX(NDOMAINL,NMGRID)
1847                       ZZZXF=XXX(NDOMAINR,NMGRID)
1848                       ZZZYD=XXY(NDOMAINB,NMGRID)
1849                       ZZZYF=XXY(NDOMAINT,NMGRID)
1850                       CALL GSLWSC(XLWDOMAIN)
1851                       CALL FRSTPT(ZZZXD,ZZZYD)
1852                       CALL VECTOR(ZZZXF,ZZZYD)
1853                       CALL VECTOR(ZZZXF,ZZZYF)
1854                       CALL VECTOR(ZZZXD,ZZZYF)
1855                       CALL VECTOR(ZZZXD,ZZZYD)
1856                     ENDIF
1857                     ! Trace de segments eventuellement
1858                     IF(LSEGM .AND. .NOT.LCV)THEN
1859                       CALL GQPLCI(IER,ICOLI)
1860                       DO J=1,NCOLSEGM
1861       !IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE .AND. NCOLSEGMS(J) > 1)THEN
1862       IF(NCOLSEGMS(J) > 1)THEN
1863         CALL TABCOL_FORDIACHRO
1864         print *,' appel a TABCOL_FORDIACHRO pour le trace de polynes'
1865       ENDIF
1866                       EXIT
1867                       ENDDO
1868                       CALL GSLWSC(XLWSEGM)
1869                       ISEGMCOL=0
1870                       if(nverbia > 0)then
1871                         print *,' **oper size((NSEGMS) ',size(NSEGMS)
1872                       endif
1873                       IGRID=NGRIDIA(NPROCDIA(JLOOPP,KLOOP))
1874                       DO J=1,SIZE(NSEGMS,1)
1875                       ! Conversion en coordonnees conformes
1876                         ZLAT=XSEGMS(J,1)
1877                         ZLON=XSEGMS(J,2)
1878                         IF (NSEGMS(J)==1) THEN           ! XSEGMS
1879                           IF (XCONFSEGMS(J,1)==0. .AND. XCONFSEGMS(J,2)==0.) &
1880                             CALL SM_XYHAT_S(XLATORI,XLONORI, &
1881                                             ZLAT,ZLON,                 &
1882                                             XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1883                         ELSE IF (NSEGMS(J)==-1) THEN     ! ISEGMS
1884                           NSEGMS(J)=1
1885                           II=MAX(MIN(INT(ZLAT),NIMAX+2*JPHEXT-1),1)
1886                           IJ=MAX(MIN(INT(ZLON),NJMAX+2*JPHEXT-1),1)
1887                           XCONFSEGMS(J,1)=XXX(II,IGRID) +  &
1888                              (ZLAT-FLOAT(II))*(XXX(II+1,IGRID) - XXX(II,IGRID) )
1889                           XCONFSEGMS(J,2)=XXY(IJ,IGRID) + &
1890                              (ZLON-FLOAT(IJ))*(XXY(IJ+1,IGRID) - XXY(IJ,IGRID) )
1891                         END IF
1892                         IF(J == 1 .AND. NSEGMS(J) == 1) THEN
1893                           ISEGMCOL=ISEGMCOL+1
1894                           ICOLSEGM=NCOLSEGMS(ISEGMCOL)
1895                       IF((LCOLAREA .OR. LCOLINE) .AND. ICOLSEGM > 1)THEN
1896         print *,' Avec LCOLAREA=T ou LCOLINE=T , attention a la superposition des couleurs'
1897         !print *,' valeur trouvee: ',NCOLSEGMS,'FORCEE a 1 '
1898         print *,' pour les segments preferez NCOLSEGMS= 0 ou 1 '
1899                        !ICOLSEGM=1
1900                       ENDIF
1901                           CALL GSPLCI(ICOLSEGM)
1902                           CALL GSTXCI(ICOLSEGM)
1903                           CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1904 !!!!!
1905                         ELSE IF(J > 1 .AND. NSEGMS(J) == 1 )THEN
1906                           IF( NSEGMS(J-1) == 0)THEN
1907                             ISEGMCOL=ISEGMCOL+1
1908                             ICOLSEGM=NCOLSEGMS(ISEGMCOL)
1909                             IF(J > 1)CALL SFLUSH
1910                       IF((LCOLAREA .OR. LCOLINE) .AND. ICOLSEGM > 1)THEN
1911         print *,' Avec LCOLAREA=T ou LCOLINE=T , attention a la superposition des couleurs'
1912         !print *,' valeur trouvee: ',NCOLSEGMS,'FORCEE a 1 '
1913         print *,' pour les segments preferez NCOLSEGMS= 0 ou 1 '
1914                        !ICOLSEGM=1
1915                       ENDIF
1916                             CALL GSPLCI(ICOLSEGM)
1917                             CALL GSTXCI(ICOLSEGM)
1918                             CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1919                           ELSEIF(NSEGMS(J-1)== 1)THEN
1920                             CALL VECTOR(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1921                           ENDIF
1922 !!!!!
1923                         ENDIF
1924                       ENDDO
1925                       CALL SFLUSH
1926                       CALL GSPLCI(ICOLI)
1927                       CALL GSTXCI(1)
1928                     ENDIF
1929                     ! Trace de la CV dans CH suivante(s) eventuellement
1930                     IF(LTRACECV .AND. .NOT.LCV)THEN
1931                       CALL GQLWSC(IER,ZLW)
1932                       CALL GSLWSC(XLWTRACECV)
1933                       CALL GSMKSC(2.)
1934                       if(nverbia > 0)then
1935                         print *,' **oper size((NSEGMS) for tracecv',size(NSEGMS)
1936                       endif
1937                       DO J=1,SIZE(NSEGMS,1)
1938                         ICOLSEGM=1
1939                         IF(J == 1 .AND. NSEGMS(J) == 2) THEN
1940                           CALL GSPLCI(ICOLSEGM)
1941                           CALL GSTXCI(ICOLSEGM)
1942                           CALL GSMK(4)
1943                           CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1944                           CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1945                         ELSE IF(J > 1 .AND. NSEGMS(J) == 2 )THEN
1946                           IF( NSEGMS(J-1) == 0)THEN
1947                             CALL SFLUSH
1948                             CALL GSPLCI(ICOLSEGM)
1949                             CALL GSTXCI(ICOLSEGM)
1950                             CALL GSMK(4)
1951                             CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1952                             CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1953                           ELSEIF(NSEGMS(J-1)== 2)THEN
1954                             CALL GSMK(5)
1955                             CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1956                             CALL VECTOR(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
1957                           ENDIF
1958                         ENDIF
1959                       ENDDO
1960                       CALL SFLUSH
1961                       CALL GSLWSC(ZLW)
1962                       CALL GSTXCI(1)
1963                     ENDIF
1964                     !
1965                     CALL NGPICT(1,1)
1966                     CALL GQACWK(1,IER,INB,IWK)
1967                     IF(INB > 1)CALL NGPICT(2,3)
1968                   ENDIF
1969                   ENDIF
1970                 ENDDO
1971               ELSE
1972                 DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),  &
1973                           NTIMEDIA(3,KLOOP,1)
1974                   NLOOPT=JLOOPT
1975                   IF(LANIMT .AND. NJSUP-NJINF /= 0 .AND. NISUP-NIINF /=0)THEN
1976                     IF(JLOOPT == NTIMEDIA(1,KLOOP,1))THEN
1977                       CALL FMFREE(YBID,YBID,IRESP)
1978                       if(nverbia >0)then
1979                       print *,' OPER FMFREE YBID IRESP ',YBID,IRESP
1980                       endif
1981                       CALL FMATTR(YBID,YBID,IBID,IRESP)
1982                       CALL GOPWK(9,IBID,3)
1983                       ISEGM=ISEGM+1
1984                       ISEGD=ISEGM
1985                       CALL GFLAS1(ISEGM)
1986                       ITIMEND=NTIMEDIA(1,KLOOP,1) + &
1987                       (((NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/  &
1988                       NTIMEDIA(3,KLOOP,1))*NTIMEDIA(3,KLOOP,1))
1989                     ELSE
1990                       ISEGM=ISEGM+1
1991                       CALL GFLAS1(ISEGM)
1992                     ENDIF
1993                   ENDIF
1994                   IF((.NOT.LFT .AND. .NOT.LPVKT) .OR. (LFT .OR. LPVKT .OR. JLOOPT == NTIMEDIA(1,KLOOP,1)))THEN
1995                     CALL RESOLV_TIMES(JLOOPT)
1996                   ENDIF
1997                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(JLOOPT,1)
1998
1999 ! Ajout PH Oct 2000
2000 !! Nov 2001
2001 !                 IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT)THEN
2002                   IF(LDIRWM .OR. LDIRWT .OR. LDIRWIND .OR. &
2003                   LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT)THEN
2004 !! Nov 2001
2005                     ZWORK3D(:,:,1)=XU(NIINF-NIL+1:NISUP-NIL+1, &
2006                                    NJINF-NJL+1:NJSUP-NJL+1, &
2007                                    1,JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
2008                   ELSEIF((LCH .AND. LCV) .OR. LFT .OR.LPVKT)THEN
2009                     ZWORK3D(:,:,1)=XVAR(NIINF-NIL+1:NISUP-NIL+1, &
2010                                    NJINF-NJL+1:NJSUP-NJL+1, &
2011                                    1,JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
2012
2013                   ELSE
2014                     ZTEM2D(:,:)=XVAR(NIINF-NIL+1:NISUP-NIL+1, &
2015                                    NJINF-NJL+1:NJSUP-NJL+1, &
2016                                    1,JLOOPT,1,NPROCDIA(JLOOPP,KLOOP))
2017                   ENDIF
2018                   IF(NSUPERDIA > 1)THEN
2019 !           LSUPER=.TRUE.
2020                     IF(LMINUS .OR. LPLUS)THEN
2021                       IF(NBPM > 1)THEN
2022                         DO JU=1,NBPM
2023                           IF(NUMPM(JU) == 3)THEN
2024                             LSUPER=.TRUE.
2025                             EXIT
2026                           ELSE
2027                             LSUPER=.FALSE.
2028                           ENDIF
2029                         ENDDO
2030                       ELSE
2031                         LSUPER=.FALSE.
2032                       ENDIF
2033                     ELSE
2034                       LSUPER=.TRUE.
2035                     ENDIF
2036                     IF(KLOOP == 1)NSUPER=0
2037                   ELSE
2038                     LSUPER=.FALSE.
2039                   ENDIF
2040                   CTYPHOR='K'
2041                   IF(NISUP-NIINF == 0 .OR. NJSUP-NJINF == 0)THEN
2042                     IF(LPXT .OR. LPYT)THEN
2043                       IF(JLOOPT == NTIMEDIA(1,KLOOP,1))THEN
2044                         ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))&
2045                                /NTIMEDIA(3,KLOOP,1)+1
2046                         IF(NVERBIA > 0)THEN
2047                         print *,'oper verif ilenw ',ILENW
2048                         ENDIF
2049                         ITIMEND=NTIMEDIA(1,KLOOP,1)+(((NTIMEDIA(2,KLOOP,1)- &
2050                         NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1))* &
2051                         NTIMEDIA(3,KLOOP,1))
2052                         IF(LPXT)THEN
2053                           IX=NISUP-NIINF+1
2054                         ELSE IF(LPYT)THEN
2055                           IX=NJSUP-NJINF+1
2056                         ENDIF
2057                         ALLOCATE(ZPROVI2(IX,ILENW))
2058                         ALLOCATE(ZWORKT(ILENW))
2059                         ZPROVI2=XSPVAL
2060                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2061                           IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2062                           ALLOCATE(XPRDAT(16,ILENW))
2063                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2064                         IJLT=0
2065                       ENDIF
2066                       IJLT=IJLT+1
2067                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2068                         CALL LOAD_XPRDAT(IJLT,NLOOPT)
2069                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2070                       ZWORKT(IJLT)=XTRAJT(NLOOPT,1)
2071                       IF(LPXT)THEN
2072                         ZPROVI2(:,IJLT)=ZTEM2D(:,1)
2073                       ELSE IF(LPYT)THEN
2074                         ZPROVI2(:,IJLT)=ZTEM2D(1,:)
2075                       ENDIF
2076                       IF(JLOOPT == ITIMEND)THEN
2077                         CALL PVFCT(ZWORKT,ZPROVI2,KLOOP)
2078                         IF(.NOT.LPBREAD)THEN
2079                           IF(KLOOP == NSUPERDIA)THEN
2080                             CALL NGPICT(1,1)
2081                             CALL GQACWK(1,IER,INB,IWK)
2082                             IF(INB > 1)CALL NGPICT(2,3)
2083                           ENDIF
2084                         ENDIF
2085                         DEALLOCATE(ZPROVI2,ZWORKT)
2086                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2087                           DEALLOCATE(XPRDAT)
2088                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2089                       ENDIF
2090                     ELSE
2091                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2092                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2093                         ALLOCATE(XPRDAT(16,1))
2094                         CALL LOAD_XPRDAT(1,NLOOPT)
2095                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2096                       ALLOCATE(ZPROVI(SIZE(ZTEM2D,1),SIZE(ZTEM2D,2),1))
2097                       ZPROVI(:,:,1)=ZTEM2D(:,:)
2098                       CALL TRACEH_FORDIACHRO(1,ZPROVI,KLOOP)
2099                       DEALLOCATE(ZPROVI)
2100                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2101                         DEALLOCATE(XPRDAT)
2102                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2103                     ENDIF
2104                   ELSE
2105 ! Ajout PH Oct 2000 + Nov FT ou PVKT
2106                     IF(LUMVM .OR. LUTVT .OR. LMUMVM .OR. LMUTVT .OR. &
2107 !! Nov 2001
2108                LDIRWM .OR. LDIRWT .OR. LDIRWIND .OR. &
2109 !! Nov 2001
2110                        (LCH .AND. LCV ) .OR. LFT .OR. LPVKT)THEN
2111
2112                       IF(LFT .OR. LPVKT)THEN
2113                         ILENW=(NTIMEDIA(2,KLOOP,1)- &
2114                         NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1)+1
2115
2116                         IF(JLOOPT == NTIMEDIA(1,KLOOP,1))THEN
2117                           ALLOCATE(ZWORKT(ILENW))
2118                           ALLOCATE(ZWORK1D(ILENW))
2119                           CALL VERIFLEN_FORDIACHRO
2120                           CALL MEMCV
2121                           IF(ALLOCATED(ZTEMCV))THEN
2122                             DEALLOCATE(ZTEMCV)
2123                           ENDIF
2124                           ALLOCATE(ZTEMCV(NLMAX,1))
2125                           IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2126                             IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2127                             ALLOCATE(XPRDAT(16,ILENW))
2128                           ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2129                           ILT=0
2130                         ENDIF
2131
2132                         CALL PRECOU_FORDIACHRO(ZWORK3D,ZTEMCV)
2133                         ILT=ILT+1
2134                         ZWORK1D(ILT)=ZTEMCV(NPROFILE,1)
2135                         ZWORKT(ILT)=XTRAJT(NLOOPT,1)
2136                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2137                           CALL LOAD_XPRDAT(ILT,NLOOPT)
2138                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2139
2140                         IF(JLOOPT == NTIMEDIA(2,KLOOP,1))THEN
2141                           IF(LFT)THEN
2142                           CALL VARFCT(ZWORKT,ZWORK1D,1)
2143                           ELSEIF(LPVKT)THEN
2144                             ALLOCATE(ZPROVI2(1,SIZE(ZWORKT,1)))
2145                             ZPROVI2(1,:)=ZWORK1D
2146                             CALL PVFCT(ZWORKT,ZPROVI2,KLOOP)
2147                             DEALLOCATE(ZPROVI2)
2148                           ENDIF
2149                           DEALLOCATE(ZWORKT,ZWORK1D)
2150                           IF(ALLOCATED(ZTEMCV))THEN
2151                             DEALLOCATE(ZTEMCV)
2152                           ENDIF
2153                           IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2154                             DEALLOCATE(XPRDAT)
2155                           ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2156                           IF(KLOOP == NSUPERDIA)THEN
2157                             CALL NGPICT(1,1)
2158                             CALL GQACWK(1,IER,INB,IWK)
2159                             IF(INB > 1)CALL NGPICT(2,3)
2160                           ENDIF
2161                         ENDIF
2162
2163                       ELSE
2164                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2165                           IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2166                           ALLOCATE(XPRDAT(16,1))
2167                           CALL LOAD_XPRDAT(1,NLOOPT)
2168                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2169                         CALL TRACEH_FORDIACHRO(1,ZWORK3D,KLOOP)
2170                         IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2171                           DEALLOCATE(XPRDAT)
2172                         ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2173                       ENDIF
2174
2175                     ELSE
2176                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2177                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2178                         ALLOCATE(XPRDAT(16,1))
2179                         CALL LOAD_XPRDAT(1,NLOOPT)
2180                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2181                   if(nverbia >0)THEN
2182                     print *,' ** oper appel image  Ytexte ',YTEXTE(1:LEN_TRIM(YTEXTE))
2183                   endif
2184                       CALL IMAGE_FORDIACHRO(ZTEM2D,1,XDIAINT,NHI,NDOT,YTEXTE(1: &
2185                                                               LEN_TRIM(YTEXTE)))
2186                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2187                         DEALLOCATE(XPRDAT)
2188                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2189         if(nverbia > 0)then
2190           print *,' **oper AP IMAGE2 II,IJ,IK,KLOOP ',II,IJ,IK,KLOOP
2191         endif
2192                     ENDIF
2193                   ENDIF
2194                   IF(LANIMT .AND. NISUP-NIINF /= 0 .AND. NJSUP-NJINF /= 0)THEN
2195                     CALL GFLAS2
2196                     IF(JLOOPT == ITIMEND)THEN
2197                       DO JJ=ISEGD,ISEGM
2198                         CALL GFLAS3(JJ)
2199                       ENDDO 
2200                       CALL GCLWK(9)
2201                       CALL NGPICT(1,1)
2202                       CALL GQACWK(1,IER,INB,IWK)
2203                       IF(INB > 1)CALL NGPICT(2,3)
2204                     ENDIF
2205                   ELSE IF(LPXT.OR.LPYT .OR. LFT .OR. LPVKT)THEN
2206                   ELSE
2207 !                 IF(KLOOP == NSUPERDIA)CALL FRAME
2208                   IF(KLOOP == NSUPERDIA)THEN
2209                     ! Trace du domaine fils eventuellement
2210                     IF(LDOMAIN .AND. .NOT.LCV)THEN
2211                       ZZZXD=XXX(NDOMAINL,NMGRID)
2212                       ZZZXF=XXX(NDOMAINR,NMGRID)
2213                       ZZZYD=XXY(NDOMAINB,NMGRID)
2214                       ZZZYF=XXY(NDOMAINT,NMGRID)
2215                       CALL GSLWSC(XLWDOMAIN)
2216                       CALL FRSTPT(ZZZXD,ZZZYD)
2217                       CALL VECTOR(ZZZXF,ZZZYD)
2218                       CALL VECTOR(ZZZXF,ZZZYF)
2219                       CALL VECTOR(ZZZXD,ZZZYF)
2220                       CALL VECTOR(ZZZXD,ZZZYD)
2221                     ENDIF
2222                     ! Trace de segments eventuellement
2223                     IF(LSEGM .AND. .NOT.LCV)THEN
2224                       CALL GQPLCI(IER,ICOLI)
2225                       ICOLSEGM=NCOLSEGMS(1)
2226                       DO J=1,NCOLSEGM
2227       !IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE .AND. NCOLSEGMS(J) > 1)THEN
2228       IF(NCOLSEGMS(J) > 1)THEN
2229         CALL TABCOL_FORDIACHRO
2230         print *,' appel a TABCOL_FORDIACHRO pour le trace de polynes'
2231       ENDIF
2232                       EXIT
2233                       ENDDO
2234                       CALL GSLWSC(XLWSEGM)
2235                       ISEGMCOL=0
2236                       if(nverbia > 0)then
2237                         print *,' **oper size2(NSEGMS) ',size(NSEGMS)
2238                       endif
2239                       IGRID=NGRIDIA(NPROCDIA(JLOOPP,KLOOP))
2240                       DO J=1,SIZE(NSEGMS,1)
2241                       ! Conversion en coordonnees conformes
2242                         ZLAT=XSEGMS(J,1)
2243                         ZLON=XSEGMS(J,2)
2244                         IF (NSEGMS(J)==1) THEN           ! XSEGMS
2245                           IF (XCONFSEGMS(J,1)==0. .AND. XCONFSEGMS(J,2)==0.) &
2246                             CALL SM_XYHAT_S(XLATORI,XLONORI, &
2247                                             ZLAT,ZLON,                 &
2248                                             XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2249                         ELSE IF (NSEGMS(J)==-1) THEN     ! ISEGMS
2250                           NSEGMS(J)=1
2251                           II=MAX(MIN(INT(ZLAT),NIMAX+2*JPHEXT-1),1)
2252                           IJ=MAX(MIN(INT(ZLON),NJMAX+2*JPHEXT-1),1)
2253                           XCONFSEGMS(J,1)=XXX(II,IGRID) +  &
2254                              (ZLAT-FLOAT(II))*(XXX(II+1,IGRID) - XXX(II,IGRID) )
2255                           XCONFSEGMS(J,2)=XXY(IJ,IGRID) + &
2256                              (ZLON-FLOAT(IJ))*(XXY(IJ+1,IGRID) - XXY(IJ,IGRID) )
2257                         END IF
2258                         IF(J == 1 .AND. NSEGMS(J) == 1)THEN
2259                           ISEGMCOL=ISEGMCOL+1
2260                           ICOLSEGM=NCOLSEGMS(ISEGMCOL)
2261                       IF((LCOLAREA .OR. LCOLINE) .AND. ICOLSEGM > 1)THEN
2262         print *,' Avec LCOLAREA=T ou LCOLINE=T ,  attention a la superposition des couleurs'
2263         !print *,' valeur trouvee: ',NCOLSEGMS,'FORCEE a 1 '
2264         print *,' pour les segments preferez NCOLSEGMS= 0 ou 1 '
2265                         !ICOLSEGM=1
2266                       ENDIF
2267                           CALL GSPLCI(ICOLSEGM)
2268                           CALL GSTXCI(ICOLSEGM)
2269                           CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2270                         ELSE IF(J > 1 .AND. NSEGMS(J) == 1 )THEN
2271                           IF(NSEGMS(J-1) == 0)THEN
2272                             ISEGMCOL=ISEGMCOL+1
2273                             ICOLSEGM=NCOLSEGMS(ISEGMCOL)
2274                             IF(J > 1)CALL SFLUSH
2275                       IF((LCOLAREA .OR. LCOLINE) .AND. ICOLSEGM > 1)THEN
2276         print *,' Avec LCOLAREA=T ou LCOLINE=T ,  attention a la superposition des couleurs'
2277         !print *,' valeur trouvee: ',NCOLSEGMS,'FORCEE a 1 '
2278         print *,' pour les segments preferez NCOLSEGMS= 0 ou 1 '
2279                         !ICOLSEGM=1
2280                       ENDIF
2281                             CALL GSPLCI(ICOLSEGM)
2282                             CALL GSTXCI(ICOLSEGM)
2283                             CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2284
2285                           ELSEIF(NSEGMS(J-1)== 1)THEN
2286                             CALL VECTOR(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2287                           ENDIF
2288                         ENDIF
2289                       ENDDO
2290                       CALL SFLUSH
2291                       CALL GSPLCI(ICOLI)
2292                       CALL GSTXCI(1)
2293                     ENDIF
2294                      ! Trace de la CV dans CH suivante(s) eventuellement
2295                     IF(LTRACECV .AND. .NOT.LCV)THEN
2296                       CALL GQLWSC(IER,ZLW)
2297                       CALL GSLWSC(XLWTRACECV)
2298                       CALL GSMKSC(2.)
2299                       if(nverbia > 0)then
2300                         print *,' **oper size((NSEGMS) for tracecv2',size(NSEGMS)
2301                       endif
2302                       DO J=1,SIZE(NSEGMS,1)
2303                         ICOLSEGM=1
2304                         IF(J == 1 .AND. NSEGMS(J) == 2) THEN
2305                           CALL GSPLCI(ICOLSEGM)
2306                           CALL GSTXCI(ICOLSEGM)
2307                           CALL GSMK(4)
2308                           CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2309                           CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2310                         ELSE IF(J > 1 .AND. NSEGMS(J) == 2 )THEN
2311                           IF( NSEGMS(J-1) == 0)THEN
2312                             CALL SFLUSH
2313                             CALL GSPLCI(ICOLSEGM)
2314                             CALL GSTXCI(ICOLSEGM)
2315                             CALL GSMK(4)
2316                             CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2317                             CALL FRSTPT(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2318                           ELSEIF(NSEGMS(J-1)== 2)THEN
2319                             CALL GSMK(5)
2320                             CALL GPM(1,XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2321                             CALL VECTOR(XCONFSEGMS(J,1),XCONFSEGMS(J,2))
2322                           ENDIF
2323                         ENDIF
2324                       ENDDO
2325                       CALL SFLUSH
2326                       CALL GSLWSC(ZLW)
2327                       CALL GSTXCI(1)
2328                     ENDIF
2329                     CALL NGPICT(1,1)
2330                     CALL GQACWK(1,IER,INB,IWK)
2331                     IF(INB > 1)CALL NGPICT(2,3)
2332                   ENDIF
2333                   ENDIF
2334                 ENDDO
2335               ENDIF
2336             ENDDO                             !--- LCHXY-------------
2337             DEALLOCATE(ZTEM2D)
2338             IF(ALLOCATED(ZWORK3D))THEN
2339               DEALLOCATE(ZWORK3D)
2340             ENDIF
2341
2342           ELSE IF(II /= 1 .AND. (IJ == 1 .OR. IJE-IJB == 0) .AND. IK == 1)THEN
2343
2344 ! Cas compression bilan sur axes Y et Z -->  Profil horizontal // X
2345 ! *****************************************************************
2346 ! (Impression dim mat. modele et matrice(NIL:NIH,NJL:NJH,
2347 !  NKL:NKH) et matrice(NIL:NIH,1,1)
2348
2349             print *,'  Profil horizontal // X'
2350             IINF=NIINF;ISUP=NISUP;IJINF=NJINF;IJSUP=NJSUP
2351             print *,'IINF,ISUP,IJINF,IJSUP ',IINF,ISUP,IJINF,IJSUP
2352             IF(IJ == 1)THEN
2353               GIJ1=.TRUE.
2354             ELSE
2355               GIJ1=.FALSE.
2356               LCH=.FALSE.
2357             ENDIF
2358
2359             IF(GIJ1)THEN
2360               IF(.NOT.L2DBX)THEN
2361                 NJINF=1; NJSUP=1
2362                 NIINF=MAX(IIB,NIL); NISUP=MIN(IIE,NIH)
2363                 print *,' Limites I par defaut (L2DBX=.FALSE.) :',&
2364 &             ' MAX(IIB,NIL) - MIN(IIE,NIH) ',NIINF,' - ',NISUP
2365                 print *,' Si vous voulez selectionner les limites en I, mettez :',&
2366 &             ' L2DBX=.TRUE.'
2367                 print *,' et definissez : NIDEBCOU=    NLMAX= '
2368               ELSE
2369                 NJINF=1;NJSUP=1
2370                 NIINF=NIDEBCOU; NISUP=NIDEBCOU+NLMAX-1
2371                 NIINF=MAX(NIINF,NIL);NISUP=MIN(NISUP,NIH)
2372               ENDIF
2373             ELSE
2374               IF(.NOT.L2DBX)THEN
2375                 NJINF=IJB; NJSUP=IJE
2376                 NIINF=MAX(IIB,NIL); NISUP=MIN(IIE,NIH)
2377                 print *,' Limites I par defaut (L2DBX=.FALSE.) :',&
2378 &             ' MAX(IIB,NIL) - MIN(IIE,NIH) ',NIINF,' - ',NISUP
2379                 print *,' Si vous voulez selectionner les limites en I, mettez :',&
2380 &             ' L2DBX=.TRUE.'
2381                 print *,' et definissez : NIDEBCOU=    NLMAX= '
2382               ELSE
2383                 NJINF=IJB; NJSUP=IJE
2384                 NIINF=NIDEBCOU; NISUP=NIDEBCOU+NLMAX-1
2385                 NIINF=MAX(NIINF,NIL);NISUP=MIN(NISUP,NIH)
2386               ENDIF
2387             ENDIF
2388             ILENW=NISUP-NIINF+1
2389
2390             ALLOCATE(ZWORK1D(ILENW),ZWORKY(ILENW))
2391
2392             DO JLOOPP=1,NBPROCDIA(KLOOP)
2393               NLOOPP=NPROCDIA(JLOOPP,KLOOP)
2394
2395               YTITX(1:LEN(YTITX))=' '
2396               YTITY(1:LEN(YTITY))=' '
2397
2398                   CALL LOADUNITIT(JLOOPP,KLOOP)
2399
2400               YTITX='X(M)'
2401               YTITY=CUNITGAL(1:LEN_TRIM(CUNITGAL))
2402
2403               ZWORK1D(:)=0.; ZWORKY(:)=0.
2404               IF(.NOT.LTINCRDIA(KLOOP,1))THEN
2405                 
2406                 DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
2407                   NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
2408
2409                   IF(LPXT)THEN
2410                     IF(JLOOPT == 1)THEN
2411                       ILENW=NBTIMEDIA(KLOOP,1)
2412                       IX=NISUP-NIINF+1
2413                       ALLOCATE(ZTEM2D(IX,ILENW))
2414                       ALLOCATE(ZWORKT(ILENW))
2415                       ZTEM2D=XSPVAL
2416                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2417                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2418                         ALLOCATE(XPRDAT(16,ILENW))
2419                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2420                     ENDIF
2421                     ZWORKT(JLOOPT)=XTRAJT(NLOOPT,1)
2422                     IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2423                       CALL LOAD_XPRDAT(JLOOPT,NLOOPT)
2424                     ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2425
2426                     ZTEM2D(:,JLOOPT)=XVAR(NIINF-NIL+1:NISUP-NIL+1,NJINF,1, &
2427                     NLOOPT,1,NLOOPP)
2428                     IF(JLOOPT == NBTIMEDIA(KLOOP,1))THEN
2429                       CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
2430                       IF(.NOT.LPBREAD)THEN
2431                         IF(KLOOP == NSUPERDIA)THEN
2432                           CALL NGPICT(1,1)
2433                           CALL GQACWK(1,IER,INB,IWK)
2434                           IF(INB > 1)CALL NGPICT(2,3)
2435                         ENDIF
2436                       ENDIF
2437                       DEALLOCATE(ZTEM2D,ZWORKT)
2438                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2439                         DEALLOCATE(XPRDAT)
2440                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2441                     ENDIF
2442
2443                   ELSE
2444
2445                     ZWORK1D=XXX(NIINF:NISUP,NMGRID)
2446                     ZWORKY=XVAR(NIINF-NIL+1:NISUP-NIL+1,NJINF,1,NTIMEDIA(JLOOPT,KLOOP,1),1,NLOOPP)
2447                     ZTIMED=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
2448                     ZTIMEF=XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
2449                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2450                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2451                         ALLOCATE(XPRDAT(16,1))
2452                         CALL LOAD_XPRDAT(1,NLOOPT)
2453                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2454                     IF(JLOOPT == 1)THEN
2455                       IF(LDATFILE)CALL DATFILE_FORDIACHRO
2456                       CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
2457                     ENDIF
2458                     CALL TRAXY(ZWORK1D,ZWORKY,KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF)
2459                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2460                         DEALLOCATE(XPRDAT)
2461                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2462                     IF(KLOOP == NSUPERDIA)THEN
2463                       CALL NGPICT(1,1)
2464                       CALL GQACWK(1,IER,INB,IWK)
2465                       IF(INB > 1)CALL NGPICT(2,3)
2466                     ENDIF
2467                   ENDIF
2468                 ENDDO
2469
2470               ELSE
2471
2472                 DO JLOOPT=NTIMEDIA(1,KLOOP,1),NTIMEDIA(2,KLOOP,1),NTIMEDIA(3,KLOOP,1)
2473                   NLOOPT=JLOOPT
2474                   IF(LPXT)THEN
2475
2476                     IF(JLOOPT == NTIMEDIA(1,KLOOP,1))THEN
2477                       ILENW=(NTIMEDIA(2,KLOOP,1)-NTIMEDIA(1,KLOOP,1))/ &
2478                       NTIMEDIA(3,KLOOP,1)+1
2479                       IF(NVERBIA > 0)THEN
2480                       print *,'oper verif ilenw ',ILENW
2481                       ENDIF
2482                       ITIMEND=NTIMEDIA(1,KLOOP,1)+(((NTIMEDIA(2,KLOOP,1)- &
2483                       NTIMEDIA(1,KLOOP,1))/NTIMEDIA(3,KLOOP,1))*NTIMEDIA(3,KLOOP,1))
2484                       IX=NISUP-NIINF+1
2485                       ALLOCATE(ZTEM2D(IX,ILENW))
2486                       ALLOCATE(ZWORKT(ILENW))
2487                       ZTEM2D=XSPVAL
2488                       IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2489                         IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2490                         ALLOCATE(XPRDAT(16,ILENW))
2491                       ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2492                       IJLT=0
2493                     ENDIF
2494                     IJLT=IJLT+1
2495                     IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2496                       CALL LOAD_XPRDAT(IJLT,NLOOPT)
2497                     ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2498                     ZWORKT(IJLT)=XTRAJT(NLOOPT,1)
2499                     ZTEM2D(:,IJLT)=XVAR(NIINF-NIL+1:NISUP-NIL+1,NJINF,1, &
2500                     NLOOPT,1,NLOOPP)
2501                     IF(JLOOPT == ITIMEND)THEN
2502                       CALL PVFCT(ZWORKT,ZTEM2D,KLOOP)
2503                     IF(.NOT.LPBREAD)THEN
2504                       IF(KLOOP == NSUPERDIA)THEN
2505                         CALL NGPICT(1,1)
2506                         CALL GQACWK(1,IER,INB,IWK)
2507                         IF(INB > 1)CALL NGPICT(2,3)
2508                       ENDIF
2509                     ENDIF
2510                     IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2511                       DEALLOCATE(XPRDAT)
2512                     ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2513                     DEALLOCATE(ZTEM2D,ZWORKT)
2514                     ENDIF
2515
2516                   ELSE
2517
2518                     ZWORK1D=XXX(NIINF:NISUP,NMGRID)
2519                     ZWORKY=XVAR(NIINF-NIL+1:NISUP-NIL+1,NJINF,1,JLOOPT,1,NLOOPP)
2520                     ZTIMED=XTRAJT(JLOOPT,1)
2521                     ZTIMEF=XTRAJT(JLOOPT,1)
2522                     IF(JLOOPT == 1)THEN
2523                       IF(LDATFILE)CALL DATFILE_FORDIACHRO
2524                       CALL RESOLV_TIMES(JLOOPT)
2525                     ENDIF
2526                     IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2527                       IF(ALLOCATED(XPRDAT))DEALLOCATE(XPRDAT)
2528                       ALLOCATE(XPRDAT(16,1))
2529                       CALL LOAD_XPRDAT(1,NLOOPT)
2530                     ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2531                     CALL TRAXY(ZWORK1D,ZWORKY,KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF)
2532                     IF(LPRDAT)THEN !  Juin 2001 Ajout des dates ds FICVAL 
2533                       DEALLOCATE(XPRDAT)
2534                     ENDIF !  Juin 2001 Ajout des dates ds FICVAL 
2535                     IF(KLOOP == NSUPERDIA)THEN
2536                       CALL NGPICT(1,1)
2537                       CALL GQACWK(1,IER,INB,IWK)
2538                       IF(INB > 1)CALL NGPICT(2,3)
2539                     ENDIF
2540
2541                   ENDIF
2542
2543                 ENDDO
2544               ENDIF
2545             ENDDO
2546
2547             DEALLOCATE(ZWORK1D,ZWORKY)
2548
2549             NIINF=IINF;NISUP=ISUP;NJINF=IJINF;NJSUP=IJSUP
2550
2551           ELSE IF(II /= 1 .AND. IJ == 1 .AND. IK /= 1 .AND. LJCP)THEN
2552
2553 ! Cas compression bilan sur axe Y -->  Plan vertical // X
2554 ! *******************************************************
2555 ! (Impression dim mat. modele et matrice(NIL:NIH,NJL:NJH,
2556 !  NKL:NKH) et matrice(NIL:NIH,1,NKL:NKH)
2557               IDEFCV=0                      !%%%%%%%%%%%%%%%%%%%%%%%%%%
2558               IF(LDEFCV2CC)THEN
2559                 LDEFCV2CC=.FALSE.
2560                 IDEFCV=1
2561               ENDIF                         !%%%%%%%%%%%%%%%%%%%%%%%%%%
2562             LCVXZ=.TRUE.
2563             IF(.NOT.L2DBX)THEN
2564               IINF=MAX(IIB,NIL)
2565               ISUP=MIN(IIE,NIH)
2566               print *,' 2D Vertical // X '
2567               print *,' Limites I par defaut (L2DBX=.FALSE.)(par / au domaine integral de simulation,points de garde compris) :',&
2568 &             ' MAX(IIB,NIL) - MIN(IIE,NIH) ',IINF,' - ',ISUP
2569               print *,' Si vous voulez selectionner les limites en I, mettez : ',&
2570 &             'L2DBX=.TRUE.' 
2571               print *,' et definissez : NIDEBCOU=    NLMAX= '
2572             ELSE
2573               IINF=NIDEBCOU     
2574               ISUP=NIDEBCOU+NLMAX-1
2575               ISUP=MIN(ISUP,NIH)
2576             ENDIF
2577             ALLOCATE(ZTEM2D(1:ISUP-IINF+1,1:IKU))
2578             NINX=ISUP-IINF+1
2579             NINY=IKU
2580             NLMAX=NINX
2581             NLANGLE=0
2582             NIDEBCOU=IINF
2583             IJDEBCOU=-999
2584             IF(NJDEBCOU /= NJL)THEN
2585               IJDEBCOU=NJDEBCOU
2586               NJDEBCOU=NJL
2587               print *,' NJDEBCOU force a la valeur de NJL ',NJL,' pour ', &
2588 &            'obtention altitudes correctes '
2589               print *,' AP utilisation, sera remis a la valeur precedente : ', &
2590               IJDEBCOU
2591             ENDIF
2592             LVERT=.TRUE.
2593             LHOR=.FALSE.
2594             LPT=LPXT
2595             IF(NSUPERDIA > 1)THEN
2596 !      LSUPER=.TRUE.
2597                     IF(LMINUS .OR. LPLUS)THEN
2598                       IF(NBPM > 1)THEN
2599                         DO JU=1,NBPM
2600                           IF(NUMPM(JU) == 3)THEN
2601                             LSUPER=.TRUE.
2602                             EXIT
2603                           ELSE
2604                             LSUPER=.FALSE.
2605                           ENDIF
2606                         ENDDO
2607                       ELSE
2608                         LSUPER=.FALSE.
2609                       ENDIF
2610                     ELSE
2611                       LSUPER=.TRUE.
2612                     ENDIF
2613             ELSE
2614               LSUPER=.FALSE.
2615             ENDIF
2616             IF(KLOOP == 1)NSUPER=0
2617             DO JLOOPP=1,NBPROCDIA(KLOOP)      !--- LCVXZ-------------
2618               NLOOPP=NPROCDIA(JLOOPP,KLOOP)
2619
2620                   CALL LOADUNITIT(JLOOPP,KLOOP)
2621
2622               ILENT=LEN_TRIM(CTITGAL)
2623               ILENU=LEN_TRIM(CUNITGAL)
2624               YTEXTE(1:ILENT)=CTITGAL(1:ILENT)
2625               YTEXTE(ILENT+1:ILENT+1)=' '
2626               YTEXTE(ILENT+2:ILENT+2+ILENU-1)=CUNITGAL(1:ILENU)
2627               IF(.NOT.LTINCRDIA(KLOOP,1))THEN
2628                 DO JLOOPT=1,NBTIMEDIA(KLOOP,1)
2629                   NLOOPT=NTIMEDIA(JLOOPT,KLOOP,1)
2630                   CALL RESOLV_TIMES(NTIMEDIA(JLOOPT,KLOOP,1))
2631                   WRITE(CTIMEC(8:15),'(F8.0)')XTRAJT(NTIMEDIA(JLOOPT,KLOOP,1),1)
2632                   IF(.NOT.LSUPER .OR. (LSUPER .AND. NSUPER == 0))THEN
2633 !                   print *,' OPER LJCP .AND. SIZE(XZS,2) ',LJCP,SIZE(XZS,2)
2634                     IF(.NOT.LJCP .AND. SIZE(XZS,2) == 3)THEN
2635                       CALL COMPCOORD_FORDIACHRO(NMGRID)
2636                       IF(ALLOCATED(XWORKZ))THEN
2637                         DEALLOCATE(XWORKZ)
2638                       ENDIF
2639                       IF(ALLOCATED(XDS))THEN
2640                         DEALLOCATE(XDS)
2641                       ENDIF
2642                       IF(ALLOCATED(XWZ))THEN
2643                         DEALLOCATE(XWZ)
2644                       ENDIF
2645                       ALLOCATE(XWORKZ(NLMAX,IKU,7))
2646                       ALLOCATE(XWZ(NLMAX,7))
2647                       ALLOCATE(XDS(NLMAX+100,7))
2648                       XDS(1:NLMAX,NMGRID)=XXX(IINF:ISUP,NMGRID)
2649                       XWORKZ(1:NLMAX,1:IKU,NMGRID)=XZZ(IINF:ISUP,NJDEBCOU,1:IKU)
2650                       XWZ(1:NLMAX,NMGRID)=XXZS(IINF:ISUP,2,NMGRID)
2651                     ENDIF
2652                     IF(.NOT.LJCP .AND. SIZE(XZS,2) == 3)THEN
2653                       DO J=1,NLMAX
2654                       XZWORKZ(J,1:IKU)=XWORKZ(J,1:IKU,NMGRID)
2655                       ENDDO
2656                     ELSE
2657                       DO J=1,NINX
2658                         XZWORKZ(J,1:IKU)=XXZ(:,NMGRID)
2659                       ENDDO
2660                     ENDIF
2661                     XZZDS(1:NINX)=XXX(IINF:ISUP,NMGRID)
2662                     ZWL=XZZDS(1); ZWR=XZZDS(NINX)
2663                     IF((XHMIN == 0. .AND. XHMAX == 0.) .OR. (XHMAX<=XHMIN))THEN
2664                       XHMIN=0.
2665                       XHMAX=XZWORKZ(1,IKE)
2666                     ENDIF
2667 !                   print *,' OPER XHMIN XHMAX ',XHMIN,XHMAX
2668                     ZWB=XHMIN; ZWT=XHMAX
2669                     CALL SET(.1,.9,.1,.9,ZWL,ZWR,ZWB,ZWT,1)
2670                     CALL GSCLIP(1)
2671                     CALL CPSETI('SET',0)
2672                     CALL CPSETI('MAP',4)
2673                   ENDIF
2674                   ZTEM2D=XSPVAL
2675                   ZTEM2D(1:ISUP-IINF+1,NKL:NKH)=XVAR( &
2676                   IINF-NIL+1:ISUP-NIL+1,1,:,NTIMEDIA(JLOOPT,KLOOP,1),&
2677                   1,NPROCDIA(JLOOPP,KLOOP))
2678                   IF(NKL < IKB)THEN
2679                     ZTEM2D(:,1:IKB-1)=XSPVAL
2680                   ENDIF
2681                   IF(NKH > IKE)THEN
2682                     ZTEM2D(:,IKE+1:IKU)=XSPVAL
2683                   ENDIF