Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / tratraj3d.f90
1 !-----------------------------------------------------------------
2 !     ####################
3       SUBROUTINE TRATRAJ3D
4 !     ####################
5 !
6 !!****  *TRATRAJ3D* - (Demande Joel Stein,Nicole Asencio, Francois Gheusi)
7 !!                    (Avril 00)
8 !!
9 !!    PURPOSE
10 !!    -------
11 !       Materialisation du positionnement de particules a divers instants
12 !       issues d'une position initiale connue ,
13 !       par transport de leurs coordonnees initiales dans les tableaux
14 !       scalaires SVx1, SVx2, SVx3
15 !
16 !       Conjointement :
17 !         ecriture a chaque point de la trajectoire d'un champ donne 
18 !
19 !!**  METHOD
20 !!    ------
21 !!
22 !!    EXTERNAL
23 !!    --------
24 !!
25 !!    IMPLICIT ARGUMENTS
26 !!    ------------------
27 !!
28 !!
29 !!    REFERENCE
30 !!    ---------
31 !!
32 !!
33 !!    AUTHOR
34 !!    ------
35 !!      J. Duron  et J. Stein  * Laboratoire d'Aerologie *
36 !!
37 !!    MODIFICATIONS
38 !!    -------------
39 !!      Original       12/04/00
40 !!      21/11/03  J. Stein Modification of the test for the field
41 !!                    computation along the backward trajectories
42 !!      10/03/04  JD  Ajout titres standard et possibilite de modification de
43 !!                    ceux-ci
44 !-------------------------------------------------------------------------------
45 !
46 !*       0.    DECLARATIONS
47 !              ------------
48 !
49 USE MODD_TRAJ3D
50 USE MODD_TITLE
51 USE MODD_TIT
52 USE MODI_INTERPXYZ
53 USE MODD_MASK3D
54 USE MODD_RESOLVCAR
55 USE MODD_CONF
56 USE MODD_COORD
57 USE MODD_GRID1
58 USE MODD_NMGRID
59 USE MODD_DIM1
60 USE MODD_PARAMETERS
61 USE MODD_SEVERAL_RECORDS
62 USE MODD_FILES_DIACHRO
63 USE MODD_ALLOC_FORDIACHRO
64 USE MODI_REALLOC_AND_LOAD
65 USE MODN_NCAR
66 USE MODD_CTL_AXES_AND_STYL
67 USE MODN_PARA
68 USE MODI_TIT_TRA3D
69 USE MODI_WRITEDIR
70 !
71 IMPLICIT NONE
72 !
73 COMMON/COLAREA/ICOL(300)
74 !
75 !*       0.1   Local variables
76 !
77 INTEGER           :: JKLOOP,JILOOP , JJLOOP, J, ID, IGRID, JTLOOP, JI
78 INTEGER           :: IIB, IIE, IJB, IJE, IKB, IKE
79 INTEGER           :: ICL, ICOL, ILOOP, IDEB, IFIN, INUM, IRESP
80 !
81 REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZSVM1, ZSVM2, ZSVM3, ZCHAMP
82 REAL :: ZVL, ZVR, ZVB, ZVT, ZWL, ZWR, ZWB, ZWT
83 REAL :: ZVLL, ZVRL, ZVBL, ZVTL
84 REAL :: ZMINZ, ZMAXZ, ZINTZ, ZISO
85 REAL,DIMENSION(300) :: ZLEV
86 !CHARACTER(LEN=8),DIMENSION(300) :: YLLBS
87 CHARACTER(LEN=16) :: YGROUP
88 CHARACTER(LEN=75) :: YCAR
89 CHARACTER(LEN=12) :: YCHAMP
90 CHARACTER(LEN=100),SAVE  :: YTEM2
91 CHARACTER(LEN=110),SAVE  :: YTEM1
92 INTEGER  :: JPART,ICOLOR
93 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZXPOS,ZYPOS,ZZPOS, ZCHAMP_POS  ! positions aux
94 !   instants correspondants aux differents fichiers
95 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: GPART_IN   ! particule in the
96                                                    ! computational domain?
97 !
98 !-------------------------------------------------------------------------------
99 IGRID=NMGRID
100 NMGRID=1
101
102 !
103 ! boucle generale sur les fichiers
104 !
105 DO JTLOOP=1,NBFILES
106 ! on lit les champs X0,Y0 et Z0 de la trajectoire pour tous les fichiers
107 !
108 ! partie selon X
109   YGROUP='LGXM'
110   CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
111   IF(LPBREAD)THEN
112     YGROUP='LGXT'
113     LPBREAD=.FALSE.
114     CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
115     IF(LPBREAD)THEN
116       YGROUP='SVM001'
117       LPBREAD=.FALSE.
118       CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
119       IF(LPBREAD)THEN
120         YGROUP='SVT001'
121         LPBREAD=.FALSE.
122         CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
123         IF(LPBREAD)THEN
124           YGROUP='SVM1'
125           LPBREAD=.FALSE.
126           CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
127           IF(LPBREAD)THEN
128             YGROUP='SVT1'
129             LPBREAD=.FALSE. 
130             CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
131             !
132             IF(LPBREAD)THEN
133           print *,' Absence de variable LGXM, SVM001, LGXT ou SVT001 .. Operation impossible'
134               RETURN
135             ENDIF
136           ENDIF
137         ENDIF
138       ENDIF
139     ENDIF
140   ENDIF
141   !
142   IF (LGROUP) THEN
143     CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
144     CALL READ_DIACHRO(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
145   ENDIF
146   !
147   IF (.NOT. ALLOCATED(ZSVM1)) THEN
148     ALLOCATE(ZSVM1(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3)))
149     ZSVM1=11111.
150   ENDIF
151   IF(MAXVAL(XXHAT)/MAXVAL(XVAR) > 1.E2)THEN
152     print *,' ** Tratraj3D MAXVAL(XXHAT),MAXVAL(XVAR),*1000(KM->M) ',MAXVAL(XXHAT),MAXVAL(XVAR)
153     WHERE(XVAR(:,:,:,1,1,1) /= XSPVAL)
154       ZSVM1(:,:,:)=XVAR(:,:,:,1,1,1)*1000.
155     ELSEWHERE
156       ZSVM1(:,:,:)=XVAR(:,:,:,1,1,1)
157     ENDWHERE
158   ELSE
159     ZSVM1(:,:,:)=XVAR(:,:,:,1,1,1)
160   ENDIF
161   !
162   ! Chargement clegend clegend2
163   CALL RESOLV_TIMES(1)
164   YTEM2=' '
165   YTEM1=' '
166   YTEM2=CLEGEND2
167   ! Elimination volontaire de 104 a 108 charge ds resolv_times pour RS
168   YTEM1=CLEGEND(1:103)
169   !
170   IF(.NOT.LFIC1)THEN
171     CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
172 !    CALL REALLOC_AND_LOAD(YGROUP)
173     IF(LPBREAD)THEN
174       print *,' REQUETE IMPOSSIBLE .',YGROUP,' N''EXISTE PAS DANS', &
175       ' L''UN DES FICHIERS '
176       IF(ALLOCATED(XVAR))THEN
177         CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
178       ENDIF
179       RETURN
180     ENDIF
181   ENDIF
182 !
183 ! partie selon Y
184   YGROUP='LGYM'
185   CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
186   IF(LPBREAD)THEN
187     YGROUP='LGYT'
188     LPBREAD=.FALSE.
189     CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
190     IF(LPBREAD)THEN
191       YGROUP='SVM002'
192       LPBREAD=.FALSE.
193       CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
194       IF(LPBREAD)THEN
195         YGROUP='SVT002'
196         LPBREAD=.FALSE.
197         CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
198         IF(LPBREAD)THEN
199           YGROUP='SVM2'
200           LPBREAD=.FALSE.
201           CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
202           IF(LPBREAD)THEN
203             YGROUP='SVT2'
204             LPBREAD=.FALSE. 
205             CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
206             !
207             IF(LPBREAD)THEN
208           print *,' Absence de variable LGYM, SVM002, LGYT ou SVT002 .. Operation impossible'
209               RETURN
210             ENDIF
211           ENDIF
212         ENDIF
213       ENDIF
214     ENDIF
215   ENDIF
216   !
217   IF (LGROUP) THEN
218     CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
219     CALL READ_DIACHRO(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
220   ENDIF
221   !
222   IF (.NOT. ALLOCATED(ZSVM2)) THEN
223     ALLOCATE(ZSVM2(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3)))
224     ZSVM2=11111.
225   ENDIF
226   IF(MAXVAL(XYHAT)/MAXVAL(XVAR) > 1.E2)THEN
227     print *,' ** Tratraj3D MAXVAL(XYHAT),MAXVAL(XVAR),*1000(KM->M) ',MAXVAL(XYHAT),MAXVAL(XVAR)
228     WHERE(XVAR(:,:,:,1,1,1) /= XSPVAL)
229       ZSVM2(:,:,:)=XVAR(:,:,:,1,1,1)*1000.
230     ELSEWHERE
231       ZSVM2(:,:,:)=XVAR(:,:,:,1,1,1)
232     ENDWHERE
233   ELSE
234     ZSVM2(:,:,:)=XVAR(:,:,:,1,1,1)
235   ENDIF
236   !
237   IF(.NOT.LFIC1)THEN
238     CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
239     IF(LPBREAD)THEN
240       print *,' REQUETE IMPOSSIBLE .',YGROUP,' N''EXISTE PAS DANS', &
241       ' L''UN DES FICHIERS '
242       IF(ALLOCATED(XVAR))THEN
243         CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
244       ENDIF
245       RETURN
246     ENDIF
247   ENDIF
248 !
249 ! partie selon Z
250   YGROUP='LGZM'
251   CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
252   IF(LPBREAD)THEN
253     YGROUP='LGZT'
254     LPBREAD=.FALSE.
255     CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
256     IF(LPBREAD)THEN
257       YGROUP='SVM003'
258       LPBREAD=.FALSE.
259       CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
260       IF(LPBREAD)THEN
261         YGROUP='SVT003'
262         LPBREAD=.FALSE.
263         CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
264         IF(LPBREAD)THEN
265           YGROUP='SVM3'
266           LPBREAD=.FALSE. 
267           CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
268           IF(LPBREAD)THEN
269             YGROUP='SVT3'
270             LPBREAD=.FALSE. 
271             CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
272             !
273             IF(LPBREAD)THEN
274           print *,' Absence de variable LGZM, SVM003, LGZT ou SVT003 .. Operation impossible'
275               RETURN
276             ENDIF
277           ENDIF
278         ENDIF
279       ENDIF
280     ENDIF
281   ENDIF
282   !
283   IF (LGROUP) THEN
284     CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
285     CALL READ_DIACHRO(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),YGROUP)
286   ENDIF
287   !
288   IF (.NOT. ALLOCATED(ZSVM3)) THEN
289     ALLOCATE(ZSVM3(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3)))
290     ZSVM3=11111.
291   ENDIF
292   IF(MAXVAL(XZHAT)/MAXVAL(XVAR) > 1.E2)THEN
293     print *,' ** Tratraj3D MAXVAL(XZHAT),MAXVAL(XVAR),*1000(KM->M) ',MAXVAL(XZHAT),MAXVAL(XVAR)
294     WHERE(XVAR(:,:,:,1,1,1) /= XSPVAL)
295       ZSVM3(:,:,:)=XVAR(:,:,:,1,1,1)*1000.
296     ELSEWHERE
297       ZSVM3(:,:,:)=XVAR(:,:,:,1,1,1)
298     ENDWHERE
299   ELSE
300     ZSVM3(:,:,:)=XVAR(:,:,:,1,1,1)
301   ENDIF
302   !
303   IF(.NOT.LFIC1)THEN
304     CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
305     IF(LPBREAD)THEN
306       print *,' REQUETE IMPOSSIBLE .',YGROUP,' N''EXISTE PAS DANS', &
307       ' L''UN DES FICHIERS '
308       IF(ALLOCATED(XVAR))THEN
309         CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
310       ENDIF
311       RETURN
312     ENDIF
313   ENDIF
314   IF (JTLOOP==1) THEN
315     ! on calcule ici les grilles verticales a cause du cas du champ ALT
316     ! qui pose un probleme car il est situe sur un niveau de w
317     IIB=1+JPHEXT; IIE=SIZE(ZSVM1,1)-JPHEXT
318     IJB=1+JPHEXT; IJE=SIZE(ZSVM1,2)-JPHEXT
319     IKB=1+JPVEXT; IKE=SIZE(ZSVM1,3)-JPVEXT
320     !
321     ! Calcul des altitudes pour la grille 1 dans XZZ
322     !
323     CALL COMPCOORD_FORDIACHRO(1)
324     !
325   ENDIF
326 !
327 ! on lit un champ supplementaire pour le tracer sur la trajectoire
328 !
329   IF (LTRAJ_GROUP) THEN
330    IF ( CTRAJ_GROUP=='ALT') THEN
331      IF (.NOT. ALLOCATED(ZCHAMP)) THEN
332       ALLOCATE(ZCHAMP(SIZE(ZSVM3,1),SIZE(ZSVM3,2),SIZE(ZSVM3,3)))
333       ZCHAMP=11111.
334      ENDIF
335      IF (JTLOOP==1) ZCHAMP(:,:,:)=XZZ(:,:,:)
336    ELSE
337     CALL VERIF_GROUP(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),CTRAJ_GROUP)
338     IF(LPBREAD)THEN
339       print *,' Absence de variable CTRAJ_GROUP .. Operation impossible'
340       RETURN
341     ENDIF
342     !
343     IF (LGROUP) THEN
344       CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
345       CALL READ_DIACHRO(CFILEDIAS(JTLOOP),CLUOUTDIAS(JTLOOP),CTRAJ_GROUP)
346     ENDIF
347     !
348     IF (.NOT. ALLOCATED(ZCHAMP)) THEN
349       ALLOCATE(ZCHAMP(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3)))
350       ZCHAMP=11111.
351     ENDIF
352     !
353     ZCHAMP(:,:,:)=XVAR(:,:,:,1,1,1)
354     !
355     IF(.NOT.LFIC1)THEN
356       CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
357       IF(LPBREAD)THEN
358         print *,' REQUETE IMPOSSIBLE .',CTRAJ_GROUP,' N''EXISTE PAS DANS', &
359         ' L''UN DES FICHIERS '
360         IF(ALLOCATED(XVAR))THEN
361           CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
362         ENDIF
363         RETURN
364       ENDIF
365     ENDIF
366    END IF
367   ELSE
368     IF (.NOT. ALLOCATED(ZCHAMP)) ALLOCATE(ZCHAMP(0,0,0))
369   ENDIF
370 !
371 ! on recherche la valeur R0 d'origine pour le point courant R
372 !
373   IF (JTLOOP==1) THEN
374    ALLOCATE(ZXPOS(NPART,NBFILES+1))
375    ALLOCATE(ZYPOS(NPART,NBFILES+1))
376    ALLOCATE(ZZPOS(NPART,NBFILES+1))
377    ALLOCATE(GPART_IN(NPART,NBFILES+1))
378    GPART_IN=.TRUE.
379    IF (LTRAJ_GROUP) THEN
380      ALLOCATE(ZCHAMP_POS(NPART,NBFILES+1))
381    ELSE
382 !!!Octobre 2001
383      ALLOCATE(ZCHAMP_POS(NPART,NBFILES+1))
384 !    ALLOCATE(ZCHAMP_POS(1,2))
385 !!!Octobre 2001
386 !    ALLOCATE(ZCHAMP_POS(0,0))
387    END IF
388    !
389    ZXPOS(:,1)=XXPART(1:NPART)
390    ZYPOS(:,1)=XYPART(1:NPART)
391    ZZPOS(:,1)=XZPART(1:NPART)
392    !
393    DO JPART=1,NPART
394      IF (ZXPOS(JPART,1).LT.XXX(IIB,1) .OR. ZXPOS(JPART,1).GT.XXX(IIE,1) .OR.   &
395          ZYPOS(JPART,1).LT.XXY(IJB,1) .OR. ZYPOS(JPART,1).GT.XXY(IJE,1)        &
396         ) THEN
397        ZXPOS(JPART,1)=MIN(XXX(IIE,1),MAX(XXX(IIB,1),ZXPOS(JPART,1)))
398        ZYPOS(JPART,1)=MIN(XXY(IJE,1),MAX(XXY(IJB,1),ZYPOS(JPART,1)))
399        print *,' la particule ',JPART,' est sortie du domaine'
400        print *,'nouvelles valeurs de XXPART et XYPART:'
401        print *,'XXPART=',ZXPOS(JPART,1),'XYPART=',ZYPOS(JPART,1)
402      END IF
403    END DO
404   ENDIF
405 !
406 !
407   DO JPART=1,NPART
408     !
409     IF(GPART_IN(JPART,JTLOOP)) THEN
410          ! the particule is in the simulation domain
411       CALL INTERPXYZ(ZSVM1(:,:,:),               &
412                      ZSVM2(:,:,:),               &
413                      ZSVM3(:,:,:),               &
414                      ZCHAMP(:,:,:),              &
415                      ZXPOS(JPART,JTLOOP),        &
416                      ZYPOS(JPART,JTLOOP),        &
417                      ZZPOS(JPART,JTLOOP),        &
418                      XXX(2,1),XXY(2,1),          & 
419                      XXDXHAT(3,1),XXDYHAT(3,1),  &
420                      XZZ,LTRAJ_GROUP,            &
421                      ZXPOS(JPART,JTLOOP+1),      &
422                      ZYPOS(JPART,JTLOOP+1),      &
423                      ZZPOS(JPART,JTLOOP+1),      &
424                      ZCHAMP_POS(JPART,JTLOOP)  )
425          !
426       IF (ZXPOS(JPART,JTLOOP+1).LT.XXX(IIB,1) .OR.   &
427           ZXPOS(JPART,JTLOOP+1).GT.XXX(IIE,1) .OR.   &
428           ZYPOS(JPART,JTLOOP+1).LT.XXY(IJB,1) .OR.   &
429           ZYPOS(JPART,JTLOOP+1).GT.XXY(IJE,1)        &
430          )  THEN
431          ! it is the first time the particule has been gone out
432         GPART_IN(JPART,JTLOOP+1)=.FALSE.
433         ZXPOS(JPART,JTLOOP+1)=ZXPOS(JPART,JTLOOP)
434         ZYPOS(JPART,JTLOOP+1)=ZYPOS(JPART,JTLOOP)
435         ZZPOS(JPART,JTLOOP+1)=ZZPOS(JPART,JTLOOP)
436         print *,'la particule ',JPART,' est sortie du domaine apres ',JTLOOP+1,' avances' 
437       ENDIF
438     ELSE
439          ! the particule is out of the simulation domain
440         GPART_IN(JPART,JTLOOP+1)=.FALSE.
441         ZXPOS(JPART,JTLOOP+1)=ZXPOS(JPART,JTLOOP)
442         ZYPOS(JPART,JTLOOP+1)=ZYPOS(JPART,JTLOOP)
443         ZZPOS(JPART,JTLOOP+1)=ZZPOS(JPART,JTLOOP)
444         ZCHAMP_POS(JPART,JTLOOP)=ZCHAMP_POS(JPART,JTLOOP-1)         
445     END IF
446     ! fin de la boucle sur les particules
447   ENDDO
448 !
449 ! fin de la boucle sur les instants de la trajectoire
450 !
451 ENDDO
452 !
453 DEALLOCATE(ZSVM1,ZSVM2,ZSVM3,ZCHAMP,GPART_IN)   ! dealloc des champs
454 !
455 ! sortie des trajectoires
456 IF(LPRINT)THEN
457   CALL FMLOOK('FICVAL','FICVAL',INUM,IRESP)
458   IF(IRESP /= 0)THEN
459     CALL FMATTR('FICVAL','FICVAL',INUM,IRESP)
460     OPEN(UNIT=INUM,FILE='FICVAL',FORM='FORMATTED')
461     PRINT '('' LPRINT=T --> Les valeurs seront mises dans le fichier FICVAL '')'
462   ENDIF
463   ILOOP=NPART/5
464   IF(ILOOP * 5 < NPART)ILOOP=ILOOP+1
465 ENDIF
466 DO JTLOOP=1,NBFILES+1
467   print*,'*****************'
468   print*,'JTLOOP= ', JTLOOP
469   print*,'*****************'
470   print*,'XPOS= ',ZXPOS(1:NPART,JTLOOP)
471   print*,'YPOS= ',ZYPOS(1:NPART,JTLOOP)
472   print*,'ZPOS= ',ZZPOS(1:NPART,JTLOOP)
473   IF (LTRAJ_GROUP) print*,'CHAMPPOS= ',ZCHAMP_POS(1:NPART,JTLOOP)
474   IF(LPRINT)THEN
475     WRITE(INUM,'(A,I3)') 'LOOP= ',JTLOOP
476     DO JI=1,ILOOP
477       IF (JI==1) THEN
478         IDEB=1 ; IFIN=4
479       ELSE  
480         IDEB=IFIN+1 ; IFIN=IFIN+5
481       ENDIF
482       IF (JI==ILOOP) THEN
483         IFIN=NPART
484       ENDIF
485       IF (JI==1) THEN
486         WRITE(INUM,'(A12,4(3X,E12.6))')' XPOS=',ZXPOS(IDEB:IFIN,JTLOOP)
487       ELSE
488         WRITE(INUM,'(4(E12.6,3X),E12.6)') ZXPOS(IDEB:IFIN,JTLOOP)
489       ENDIF
490     END DO
491     DO JI=1,ILOOP
492       IF (JI==1) THEN
493         IDEB=1 ; IFIN=4
494       ELSE  
495         IDEB=IFIN+1 ; IFIN=IFIN+5
496       ENDIF
497       IF (JI==1) THEN
498         WRITE(INUM,'(A12,4(3X,E12.6))')' YPOS=',ZYPOS(IDEB:IFIN,JTLOOP)
499       ELSE
500         WRITE(INUM,'(4(E12.6,3X),E12.6)') ZYPOS(IDEB:IFIN,JTLOOP)
501       ENDIF
502     END DO
503     DO JI=1,ILOOP
504       IF (JI==1) THEN
505         IDEB=1 ; IFIN=4
506       ELSE  
507         IDEB=IFIN+1 ; IFIN=IFIN+5
508       ENDIF
509       IF (JI==1) THEN
510         WRITE(INUM,'(A12,4(3X,E12.6))')' ZPOS=',ZZPOS(IDEB:IFIN,JTLOOP)
511       ELSE
512         WRITE(INUM,'(4(E12.6,3X),E12.6)') ZZPOS(IDEB:IFIN,JTLOOP)
513       ENDIF
514       IF (JI==ILOOP) WRITE(INUM,*)
515     END DO
516   ENDIF
517 END DO
518 !
519 !-------------------------------------------------------------------------------
520 !
521 !!!!!!!!!!!!JOEL!!!!!!!!!!
522 !!!!!!!!!!!!JOEL!!!!!!!!!!
523 ! Visualisation des trajectoires sur XY, XZ, YZ
524 !!!!!!!!!!!!JOEL!!!!!!!!!!
525 !!!!!!!!!!!!JOEL!!!!!!!!!!
526 !
527 ! Recuperation de la fenetre d'affichage courante pour restauration en fin de
528 ! routine
529 CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
530
531 ! Determination de NIINF NJINF NISUP NJSUP si non initialises par l'utilisateur
532 IF(NIINF == 0 .AND. NISUP == 0 .AND. NJINF == 0 .AND. NJSUP == 0)THEN
533   CALL RESOLV_NIJINF_NIJSUP
534 ENDIF
535
536 !
537 !!!!!! XY 
538 !
539 YCAR(1:LEN_TRIM(YCAR))=' '
540 WRITE(YCAR,'(''TRAJ **XY** '')')
541 IF( LTRAJ_GROUP) THEN
542   ! car TIT_TRA3D ne trace rien sur la 1e image dans le cas LTRAJ_GROUP ...!
543   CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
544   CALL PCSETC('FC','/')
545   CALL PLCHHQ(.002,.98,YCAR(1:LEN_TRIM(YCAR)),.012,0.,-1.)
546   CALL PCSETC('FC',':')
547 ELSE
548   CALL TIT_TRA3D(YCAR,YTEM1,YTEM2,ZVR)
549 ENDIF
550
551 IF(LDATFILE)CALL DATFILE_FORDIACHRO
552
553 IF(LCARTESIAN)THEN
554   CALL DEFENETRE
555 ELSE
556   ! trace de la grille lat-lon
557   CALL GSLWSC(1.)
558   CALL GSTXCI(1)
559   CALL GSPLCI(1)
560   CALL BCGRD_FORDIACHRO(2)
561   !CALL BCGRD_FORDIACHRO(1)
562 ENDIF
563 !
564 ! couleur en fct de l alt ZZPOS (15 intervalles)
565 ICL=15
566 CALL COLOR_FORDIACHRO(ICL+2,1)
567 CALL TABCOL_FORDIACHRO
568 ZMAXZ=MAXVAL(ZZPOS) ; ZMINZ=MINVAL(ZZPOS)
569 ZINTZ=NINT(ZMAXZ-ZMINZ)/15
570 IF(ZMINZ + ICL*ZINTZ <= ZMAXZ)ICL=ICL+1
571 CALL CPSETI('NCL',ICL)
572 CALL CPSETI('CLS',0)
573 ZISO=ZMINZ-ZINTZ
574 DO JI=1,ICL
575   CALL CPSETI('PAI',JI)
576   CALL CPSETI('AIA',JI+1)
577   CALL CPSETI('AIB',JI)
578   ZISO=ZISO+ZINTZ
579   IF(ABS(ZISO)<1.E-20)ZISO=0.
580   CALL CPSETR('CLV',ZISO)
581   CALL CPSETR('CLU',1.)
582   ZLEV(JI)=ZISO
583   !CALL GENFORMAT_FORDIACHRO(ZISO,YLLBS(JI))
584   ICOL(JI)=JI
585 END DO
586 !
587 IF (.NOT.LCOLINE) THEN
588   print *,' LCOLINE=F: Retro-trajectoires et marqueurs noirs dans le plan XY'
589 ENDIF
590 !
591 CALL GSLWSC(3.)
592 DO JPART=1,NPART
593   CALL GSMK(4)  
594   IF (.NOT.LCOLINE) THEN
595     ICOLOR=1
596     CALL GSPMCI(1)
597   ELSE  
598     ICOLOR= 1+ MOD((JPART-1),16)   ! boucle sur les 16 premieres couleurs 
599     ! couleur du marker en fct de l alt ZZPOS
600     IF(ZZPOS(JPART,1) <ZLEV(1))THEN
601       CALL GSPMCI(1)
602     ELSEIF(ZZPOS(JPART,1) >=ZLEV(ICL))THEN
603       CALL GSPMCI(ICL+1)
604     ELSE
605       DO JI=1,ICL-1
606         IF(ZZPOS(JPART,1) >= ZLEV(JI) .AND. &
607           ZZPOS(JPART,1) < ZLEV(JI+1))THEN
608           CALL GSPMCI(JI+1)
609           EXIT
610         ENDIF
611       ENDDO
612     ENDIF
613   ENDIF
614   CALL GSTXCI(ICOLOR)
615   CALL GSPLCI(ICOLOR)
616   CALL GPM(1,ZXPOS(JPART,1),ZYPOS(JPART,1))
617   CALL FRSTD(ZXPOS(JPART,1),ZYPOS(JPART,1))  
618   CALL GSMK(3)  
619   DO JTLOOP=2,NBFILES+1
620     IF (LCOLINE) THEN ! couleur du marker en fct de l alt ZZPOS
621       IF(ZZPOS(JPART,JTLOOP) <ZLEV(1))THEN
622         CALL GSPMCI(1)
623       ELSEIF(ZZPOS(JPART,JTLOOP) >=ZLEV(ICL))THEN
624         CALL GSPMCI(ICL+1)
625       ELSE
626         DO JI=1,ICL-1
627           IF(ZZPOS(JPART,JTLOOP) >= ZLEV(JI) .AND. &
628              ZZPOS(JPART,JTLOOP) < ZLEV(JI+1))THEN
629             CALL GSPMCI(JI+1)
630             EXIT
631           ENDIF
632         ENDDO
633       ENDIF
634     ENDIF
635     CALL VECTD(ZXPOS(JPART,JTLOOP),ZYPOS(JPART,JTLOOP))
636     CALL GPM(1,ZXPOS(JPART,JTLOOP),ZYPOS(JPART,JTLOOP))
637   ENDDO
638   CALL LASTD
639 ENDDO
640 ! Trace des valeurs de ZZPOS en legende: A revoir...
641 !CALL GETSET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)
642 !CALL GSFAIS(1)
643 !CALL LBSETI('CBL',0)
644 !DO JI=1,ICL
645 !  YLLBS(JI)=ADJUSTL(YLLBS(JI))
646 !ENDDO
647 !IF(ZVR < .9)THEN
648 !  CALL LBLBAR_FORDIACHRO(1,ZVR+(MIN(ZVR+.2,1.)-ZVR)/10.,MIN(ZVR+.2,1.),ZVB,ZVT,ICL+1,.15,1.,ICOL,1,YLLBS,ICL,1)
649 !ELSE
650 !  CALL LBLBAR_FORDIACHRO(1,ZVR+(1.-ZVR)/10.,1.,ZVB,ZVT,ICL+1,.15,1.,ICOL,1,YLLBS,ICL,1)
651 !ENDIF
652 !
653 CALL FRAME
654 !
655 !
656 IF( LTRAJ_GROUP) THEN
657   CALL GSLWSC(1.)
658   CALL GSTXCI(1)
659   CALL GSPLCI(1)
660   CALL GSTXCI(1)
661   YCAR(1:LEN_TRIM(YCAR))=' '
662   WRITE(YCAR,'(''TRAJ **XY**   '',A16)') CTRAJ_GROUP
663   CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
664   !CALL PCSETC('FC','/')
665   !CALL PLCHHQ(.002,.98,YCAR(1:LEN_TRIM(YCAR)),.012,0.,-1.)
666   !CALL PCSETC('FC',':')
667   CALL TIT_TRA3D(YCAR,YTEM1,YTEM2,ZVR)
668
669   IF(LDATFILE)CALL DATFILE_FORDIACHRO
670
671   IF(LCARTESIAN)THEN
672     CALL DEFENETRE
673   ELSE
674     CALL BCGRD_FORDIACHRO(1)
675   ENDIF
676
677   CALL GSLWSC(3.)
678   DO JPART=1,NPART
679     CALL GSMK(4)  
680     ICOLOR= 1+ MOD((JPART-1),16)   ! boucle sur les 16 premieres couleurs 
681     CALL GSTXCI(ICOLOR)
682     CALL GSPLCI(ICOLOR)
683     CALL GSPMCI(ICOLOR)
684     CALL GPM(1,ZXPOS(JPART,1),ZYPOS(JPART,1))
685 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
686 !! 19/12/2008 : modification pour controler la taille et le format des labels !!
687 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
688   !   WRITE(YCHAMP,'(E10.5)') ZCHAMP_POS(JPART,1)
689   ! CALL PLCHHQ(ZXPOS(JPART,1),ZYPOS(JPART,1),YCHAMP,10.,0.,-1.)
690   
691    WRITE(YCHAMP,CFMTRTRAJ) ZCHAMP_POS(JPART,1)
692    CALL PLCHHQ(ZXPOS(JPART,1),ZYPOS(JPART,1),YCHAMP,NSZRTRAJ,0.,-1.)
693 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
694
695   CALL FRSTD(ZXPOS(JPART,1),ZYPOS(JPART,1))  
696     CALL GSMK(3)  
697     DO JTLOOP=2,NBFILES+1
698       CALL VECTD(ZXPOS(JPART,JTLOOP),ZYPOS(JPART,JTLOOP))
699       CALL GPM(1,ZXPOS(JPART,JTLOOP),ZYPOS(JPART,JTLOOP))
700       IF (JTLOOP<NBFILES+1) THEN
701       ! le dernier point pour CHAMP se rapporte a l'echeance precedente
702       ! donc il ne peut pas etre calcule et trace
703
704 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
705 !! 19/12/2008 : modification pour controler la taille et le format des labels !!
706 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
707    !     WRITE(YCHAMP,'(E10.5)') ZCHAMP_POS(JPART,JTLOOP)
708    !     CALL PLCHHQ(ZXPOS(JPART,JTLOOP),ZYPOS(JPART,JTLOOP),YCHAMP,10.,0.,-1.)
709
710          WRITE(YCHAMP,CFMTRTRAJ) ZCHAMP_POS(JPART,JTLOOP)
711          CALL PLCHHQ(ZXPOS(JPART,JTLOOP),ZYPOS(JPART,JTLOOP),YCHAMP,NSZRTRAJ,0.,-1.)
712 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
713       ENDIF
714     ENDDO
715     CALL LASTD
716   ENDDO
717   !
718   ! trace de la grille lat-lon
719   CALL GSLWSC(1.)
720   CALL GSTXCI(1)
721   CALL GSPLCI(1)
722   CALL BCGRD_FORDIACHRO(2)
723   CALL FRAME
724 ENDIF
725 !
726 !!!!!! XZ 
727 !
728 CALL GSLWSC(1.)
729 CALL GSTXCI(1)
730 CALL GSPLCI(1)
731 CALL GSTXCI(1)
732 WRITE(YCAR,'(''TRAJ **XZ** '')')
733 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
734 !CALL PCSETC('FC','/')
735 !CALL PLCHHQ(.002,.98,YCAR(1:LEN_TRIM(YCAR)),.012,0.,-1.)
736 !CALL PCSETC('FC',':')
737 CALL TIT_TRA3D(YCAR,YTEM1,YTEM2,ZVR)
738
739 IF(LDATFILE)CALL DATFILE_FORDIACHRO
740
741 CALL SET(.1,.9,.1,.9,XXX(NIINF,1),XXX(NISUP,1), &
742 XHMIN,XHMAX,1)
743 CALL LABMOD('(F8.0)','(F6.0)',9,6,10,10,0,0,0)
744 CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NINT((XHMAX-XHMIN)/1000.),1,1,1,5,0.,0.)
745 !
746 CALL GSLWSC(3.)
747 DO JPART=1,NPART
748   CALL GSMK(4)  
749   ICOLOR= 1+ MOD((JPART-1),16)   ! boucle sur les 16 premieres couleurs 
750   CALL GSPLCI(ICOLOR)
751   CALL GSTXCI(ICOLOR)
752   CALL GSPMCI(ICOLOR)
753   CALL GPM(1,ZXPOS(JPART,1),ZZPOS(JPART,1))
754   CALL FRSTD(ZXPOS(JPART,1),ZZPOS(JPART,1))  
755   CALL GSMK(3)  
756   DO JTLOOP=2,NBFILES+1
757     CALL VECTD(ZXPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
758     CALL GPM(1,ZXPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
759   ENDDO
760   CALL LASTD
761 ENDDO
762 !
763 CALL FRAME
764 !
765 !
766 IF (LTRAJ_GROUP) THEN
767   CALL GSLWSC(1.)
768   CALL GSTXCI(1)
769   CALL GSPLCI(1)
770   CALL GSTXCI(1)
771   WRITE(YCAR,'(''TRAJ **XZ**     '',A16)') CTRAJ_GROUP
772   CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
773 !  CALL PCSETC('FC','/')
774 !  CALL PLCHHQ(.002,.98,YCAR(1:LEN_TRIM(YCAR)),.012,0.,-1.)
775 !  CALL PCSETC('FC',':')
776   CALL TIT_TRA3D(YCAR,YTEM1,YTEM2,ZVR)
777
778   IF(LDATFILE)CALL DATFILE_FORDIACHRO
779
780   CALL SET(.1,.9,.1,.9,XXX(NIINF,1),XXX(NISUP,1), &
781   XHMIN,XHMAX,1)
782   CALL LABMOD('(F8.0)','(F6.0)',9,6,10,10,0,0,0)
783   CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NINT((XHMAX-XHMIN)/1000.),1,1,1,5,0.,0.)
784   !
785   CALL GSLWSC(3.)
786   DO JPART=1,NPART
787     CALL GSMK(4)  
788     ICOLOR= 1+ MOD((JPART-1),16)   ! boucle sur les 16 premieres couleurs 
789     CALL GSPLCI(ICOLOR)
790     CALL GSTXCI(ICOLOR)
791     CALL GSPMCI(ICOLOR)
792     CALL GPM(1,ZXPOS(JPART,1),ZZPOS(JPART,1))
793 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
794 !! 19/12/2008 : modification pour controler la taille et le format des labels !!
795 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
796   !  WRITE(YCHAMP,'(E10.5)') ZCHAMP_POS(JPART,1)
797   !  CALL PLCHHQ(ZXPOS(JPART,1),ZZPOS(JPART,1),YCHAMP,10.,0.,-1.)
798   
799    WRITE(YCHAMP,CFMTRTRAJ) ZCHAMP_POS(JPART,1)
800    CALL PLCHHQ(ZXPOS(JPART,1),ZZPOS(JPART,1),YCHAMP,NSZRTRAJ,0.,-1.)
801 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
802        CALL FRSTD(ZXPOS(JPART,1),ZZPOS(JPART,1))  
803     CALL GSMK(3)  
804     DO JTLOOP=2,NBFILES+1
805       CALL VECTD(ZXPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
806       CALL GPM(1,ZXPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
807       IF (JTLOOP<NBFILES+1) THEN
808           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
809 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
810 !! 19/12/2008 : modification pour controler la taille et le format des labels !!
811 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
812   !    WRITE(YCHAMP,'(E10.5)') ZCHAMP_POS(JPART,JTLOOP)
813   !    CALL PLCHHQ(ZXPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP),YCHAMP,10.,0.,-1.)
814   
815    WRITE(YCHAMP,CFMTRTRAJ) ZCHAMP_POS(JPART,JTLOOP)
816    CALL PLCHHQ(ZXPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP),YCHAMP,NSZRTRAJ,0.,-1.)
817 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
818       ENDIF
819     ENDDO
820     CALL LASTD
821   ENDDO
822   !
823   CALL FRAME
824 END IF
825 !
826 !!!!!! YZ 
827 !
828 CALL GSLWSC(1.)
829 CALL GSPLCI(1)
830 CALL GSTXCI(1)
831 WRITE(YCAR,'(''TRAJ **YZ** '')')
832 CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
833 !CALL PCSETC('FC','/')
834 !CALL PLCHHQ(.002,.98,YCAR(1:LEN_TRIM(YCAR)),.012,0.,-1.)
835 !CALL PCSETC('FC',':')
836 CALL TIT_TRA3D(YCAR,YTEM1,YTEM2,ZVR)
837   
838 IF(LDATFILE)CALL DATFILE_FORDIACHRO
839
840 CALL SET(.1,.9,.1,.9,XXY(NJINF,1),XXY(NJSUP,1), &
841 XHMIN,XHMAX,1)
842 CALL LABMOD('(F8.0)','(F6.0)',9,6,10,10,0,0,0)
843 CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NINT((XHMAX-XHMIN)/1000.),1,1,1,5,0.,0.)
844 !
845 CALL GSLWSC(3.)
846 DO JPART=1,NPART
847   CALL GSMK(4)  
848   ICOLOR= 1+ MOD((JPART-1),16)   ! boucle sur les 16 premieres couleurs 
849   CALL GSPLCI(ICOLOR)
850   CALL GSTXCI(ICOLOR)
851   CALL GSPMCI(ICOLOR)
852   CALL GPM(1,ZYPOS(JPART,1),ZZPOS(JPART,1))
853   CALL FRSTD(ZYPOS(JPART,1),ZZPOS(JPART,1))  
854   CALL GSMK(3)  
855   DO JTLOOP=2,NBFILES+1
856     CALL VECTD(ZYPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
857     CALL GPM(1,ZYPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
858   ENDDO
859   CALL LASTD
860 ENDDO
861 !
862 CALL FRAME
863 !
864 IF (LTRAJ_GROUP) THEN
865   CALL GSLWSC(1.)
866   CALL GSPLCI(1)
867   CALL GSTXCI(1)
868     WRITE(YCAR,'(''TRAJ **YZ**     '',A16)') CTRAJ_GROUP
869   CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
870 !  CALL PCSETC('FC','/')
871 !  CALL PLCHHQ(.002,.98,YCAR(1:LEN_TRIM(YCAR)),.012,0.,-1.)
872 !  CALL PCSETC('FC',':')
873   CALL TIT_TRA3D(YCAR,YTEM1,YTEM2,ZVR)
874
875   IF(LDATFILE)CALL DATFILE_FORDIACHRO
876
877   CALL SET(.1,.9,.1,.9,XXY(NJINF,1),XXY(NJSUP,1), &
878   XHMIN,XHMAX,1)
879   CALL LABMOD('(F8.0)','(F6.0)',9,6,10,10,0,0,0)
880   CALL GRIDAL(NCVITVXMJ,NCVITVXMN,NINT((XHMAX-XHMIN)/1000.),1,1,1,5,0.,0.)
881   !
882   CALL GSLWSC(3.)
883   DO JPART=1,NPART
884     CALL GSMK(4)  
885     ICOLOR= 1+ MOD((JPART-1),16)   ! boucle sur les 16 premieres couleurs 
886     CALL GSPLCI(ICOLOR)
887     CALL GSTXCI(ICOLOR)
888     CALL GSPMCI(ICOLOR)
889     CALL GPM(1,ZYPOS(JPART,1),ZZPOS(JPART,1))
890
891 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
892 !! 19/12/2008 : modification pour controler la taille et le format des labels !!
893 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
894   !  WRITE(YCHAMP,'(E10.5)') ZCHAMP_POS(JPART,1)
895   !CALL PLCHHQ(ZYPOS(JPART,1),ZZPOS(JPART,1),YCHAMP,10.,0.,-1.)
896
897    WRITE(YCHAMP,CFMTRTRAJ) ZCHAMP_POS(JPART,1)
898    CALL PLCHHQ(ZYPOS(JPART,1),ZZPOS(JPART,1),YCHAMP,NSZRTRAJ,0.,-1.)
899 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
900
901     CALL FRSTD(ZYPOS(JPART,1),ZZPOS(JPART,1))  
902     CALL GSMK(3)  
903     DO JTLOOP=2,NBFILES+1
904       CALL VECTD(ZYPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
905       CALL GPM(1,ZYPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP))
906       IF (JTLOOP<NBFILES+1) THEN
907              
908 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
909 !! 19/12/2008 : modification pour controler la taille et le format des labels !!
910 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
911    ! WRITE(YCHAMP,'(E10.5)') ZCHAMP_POS(JPART,JTLOOP)
912    ! CALL PLCHHQ(ZYPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP),YCHAMP,10.,0.,-1.)
913    
914    WRITE(YCHAMP,CFMTRTRAJ) ZCHAMP_POS(JPART,JTLOOP)
915    CALL PLCHHQ(ZYPOS(JPART,JTLOOP),ZZPOS(JPART,JTLOOP),YCHAMP,NSZRTRAJ,0.,-1.)
916 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
917       ENDIF
918     ENDDO
919     CALL LASTD
920   ENDDO
921   !
922   CALL FRAME
923 END IF
924 !
925 !
926 CALL SET(ZVL,ZVR,ZVB,ZVT,ZWL,ZWR,ZWB,ZWT,ID)  
927 !
928 !
929 CALL GSTXCI(1)
930 CALL GSPLCI(1)
931 CALL GSLWSC(1.)
932 CALL GSLN(1)
933 DEALLOCATE(ZXPOS,ZYPOS,ZZPOS,ZCHAMP_POS)   ! dealloc des champs
934 NMGRID=IGRID
935 !------------------------------------------------------------------------------
936 !
937 !*      2.    EXIT
938 !             ----
939 !
940 RETURN
941 !
942 END SUBROUTINE TRATRAJ3D