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