Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / trahtraxy.f90
1 !     #################
2       SUBROUTINE TRAHTRAXY(KLOOP,PTEMCV,HTEXTE)
3 !     #################
4 !
5 !!****  *TRAHTRAXY* - 
6 !!                                                            
7 !!
8 !!    PURPOSE
9 !!    -------
10 !        Trace PH (tableaux 1D scalaires  y compris MUMVM et DIRUMVM)
11 !        dans traceh_fordiachro
12 !
13 !!**  METHOD
14 !!    ------
15 !!
16 !!    EXTERNAL
17 !!    --------
18 !!
19 !!    IMPLICIT ARGUMENTS
20 !!    ------------------
21 !!
22 !!    REFERENCE
23 !!    ---------
24 !!
25 !!    AUTHOR
26 !!    ------
27 !!      J. Duron    * Laboratoire d'Aerologie *
28 !!
29 !!    MODIFICATIONS
30 !!    -------------
31 !!      Original       30/11/01
32 !!      Updated   PM  
33 !-------------------------------------------------------------------------------
34 !
35 !*       0.    DECLARATIONS
36 !              ------------
37 !
38
39 USE MODD_NMGRID
40 USE MODD_COORD
41 USE MODD_DEFCV
42 USE MODD_TIT  
43 USE MODD_TYPE_AND_LH
44 USE MODD_PT_FOR_CH_FORDIACHRO
45 USE MODD_RESOLVCAR
46 USE MODD_ALLOC_FORDIACHRO
47 USE MODN_PARA
48 USE MODN_NCAR
49 USE MODI_RESOLV_TIT
50 USE MODI_RESOLV_TITY
51
52 IMPLICIT NONE
53 !
54 INTERFACE
55       SUBROUTINE TRAXY(PTEMX,PTEMY,KLOOP,HTITX,HTITY,PTIMED,PTIMEF)
56       INTEGER    :: KLOOP
57       REAL,DIMENSION(:)  :: PTEMX, PTEMY
58       REAL               :: PTIMED, PTIMEF
59       CHARACTER(LEN=*) :: HTITX, HTITY
60       END SUBROUTINE TRAXY
61 END INTERFACE
62 !
63 !
64 !*       0.1   Dummy arguments
65 !
66 INTEGER           :: KLOOP
67 REAL,DIMENSION(:,:)         :: PTEMCV
68 CHARACTER(LEN=40) :: HTEXTE
69 !
70 !*       0.1   Local variables
71 !
72 !
73 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: ZTEMCV
74 REAL,DIMENSION(:),ALLOCATABLE,SAVE :: ZTEMX, ZTEMY
75 REAL              :: ZTIMED, ZTIMEF
76 REAL              :: ZXPOSTITT1, ZXYPOSTITT1
77 REAL              :: ZXPOSTITT2, ZXYPOSTITT2
78 REAL              :: ZXPOSTITT3, ZXYPOSTITT3
79 REAL              :: ZXPOSTITT4, ZXYPOSTITT4
80 REAL              :: ZXPOSTITB1, ZXYPOSTITB1
81 REAL              :: ZXPOSTITB2, ZXYPOSTITB2
82 REAL              :: ZXPOSTITB3, ZXYPOSTITB3
83 REAL              :: ZXPOSTITB4, ZXYPOSTITB4
84 !
85 CHARACTER(LEN=16) :: YTITX,YTITY
86 CHARACTER(LEN=40) :: YTEXTE,YTEM
87 CHARACTER(LEN=80) :: YCARCOU
88 !
89 !-------------------------------------------------------------------------------
90 !
91 !*      1. 
92 !              ----------------------------
93 !
94 YTEXTE=HTEXTE
95 !!!!!!!!!!!!! Supprime le 30/11/01
96 ! Appel a TRAXY pour le trace du PH
97        IF(ALLOCATED(ZTEMX))THEN
98          DEALLOCATE(ZTEMX)
99        ENDIF
100        IF(ALLOCATED(ZTEMY))THEN
101          DEALLOCATE(ZTEMY)
102        ENDIF
103        IF(ALLOCATED(ZTEMCV))THEN
104          DEALLOCATE(ZTEMCV)
105        ENDIF
106        ALLOCATE(ZTEMCV(SIZE(PTEMCV,1),SIZE(PTEMCV,2)))
107        ZTEMCV(:,:)=PTEMCV(:,:)
108        ALLOCATE(ZTEMX(SIZE(ZTEMCV,1)))
109        ALLOCATE(ZTEMY(SIZE(ZTEMCV,1)))
110        IF(SIZE(ZTEMCV,2) == 1)THEN
111          ZTEMY(:)=ZTEMCV(:,1)
112        ELSE
113          ZTEMY(:)=ZTEMCV(:,MAX(2,NKL))
114        ENDIF
115        ZTEMX(:)=XDS(1:NLMAX,NMGRID)
116         WHERE(ZTEMY == XSPVAL)
117           ZTEMY=1.E36
118         END WHERE
119        YTITX(1:LEN(YTITX))=' '
120        YTITY(1:LEN(YTITX))=' '
121        YTITX='X(M)'
122        YTITY=CUNITGAL(1:LEN(CUNITGAL))
123        ZTIMED=XTRAJT(NLOOPT,1)
124        ZTIMEF=ZTIMED
125        IF(NVERBIA > 0)THEN
126          print *,' TRACEH AV TRAXY KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF',&
127          KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF
128        ENDIF
129        CALL TRAXY(ZTEMX,ZTEMY,KLOOP,YTITX,YTITY,ZTIMED,ZTIMEF)
130
131         IF(KLOOP == 1)THEN
132
133           IF(LDATFILE)CALL DATFILE_FORDIACHRO
134           CALL RESOLV_TIMES(NLOOPT)
135           YTEM(1:LEN(YTEM))=' '
136 ! CTITVAR1
137           CALL RESOLV_TIT('CTITVAR1',YTEM)
138           IF(CTITVAR1 == 'DEFAULT')THEN
139             CALL PLCHHQ(.99,.007,YTEXTE(1:LEN_TRIM(YTEXTE)),.011,0.,+1.)
140           ELSE IF(YTEM /= ' ')THEN
141             CALL PLCHHQ(.99,.007,YTEM(1:LEN_TRIM(YTEM)),.011,0.,+1.)
142           ENDIF
143 ! CTITT1
144           YCARCOU(1:LEN(YCARCOU))=' '
145           YTEM(1:LEN(YTEM))=' '
146           CALL RESOLV_TIT('CTITT1',YTEM)
147           ZXPOSTITT1=.002
148           ZXYPOSTITT1=.98
149           IF(XPOSTITT1 /= 0.)THEN
150             ZXPOSTITT1=XPOSTITT1
151           ENDIF
152           IF(XYPOSTITT1 /= 0.)THEN
153             ZXYPOSTITT1=XYPOSTITT1
154           ENDIF
155
156           IF(XIDEBCOU.NE.-999.)THEN
157             IF(LDEFCV2CC)THEN           !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
158               IF(LDEFCV2IND)THEN
159                 WRITE(YCARCOU,1018)NIDEBCV,NJDEBCV,NIFINCV,NJFINCV
160               ELSE IF(LDEFCV2LL)THEN
161                 WRITE(YCARCOU,1019)XIDEBCVLL,XJDEBCVLL,XIFINCVLL,XJFINCVLL
162               ELSE
163                 WRITE(YCARCOU,1020)XIDEBCV,XJDEBCV,XIFINCV,XJFINCV
164               ENDIF
165             ELSE                        !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
166               IF(XIDEBCOU < 99999.)THEN
167                 IF(XJDEBCOU < 99999.)THEN
168                   WRITE(YCARCOU,1011)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
169                 ELSE
170                   WRITE(YCARCOU,1013)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
171                 END IF
172               ELSE
173                 IF(XJDEBCOU < 99999.)THEN
174                   WRITE(YCARCOU,1014)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
175                 ELSE
176                   WRITE(YCARCOU,1015)XIDEBCOU,XJDEBCOU,NLANGLE,NLMAX
177                 END IF
178               END IF
179             ENDIF                       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
180           ELSE
181             WRITE(YCARCOU,1010)NIDEBCOU,NJDEBCOU,NLANGLE,NLMAX
182           ENDIF
183           IF(CTITT1 == 'DEFAULT')THEN
184             IF(XSZTITT1 /= 0.)THEN
185               CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YCARCOU(1:LEN_TRIM(YCARCOU)),XSZTITT1,0.,-1.)
186 !             CALL PLCHHQ(.002,.98,YCARCOU(1:LEN_TRIM(YCARCOU)),XSZTITT1,0.,-1.)
187             ELSE
188               CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YCARCOU(1:LEN_TRIM(YCARCOU)),.012,0.,-1.)
189 !             CALL PLCHHQ(.002,.98,YCARCOU(1:LEN_TRIM(YCARCOU)),.012,0.,-1.)
190             ENDIF
191           ELSE IF(YTEM /= ' ')THEN
192             IF(XSZTITT1 /= 0.)THEN
193               CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YTEM(1:LEN_TRIM(YTEM)),XSZTITT1,0.,-1.)
194 !             CALL PLCHHQ(.002,.98,YTEM(1:LEN_TRIM(YTEM)),XSZTITT1,0.,-1.)
195             ELSE
196               CALL PLCHHQ(ZXPOSTITT1,ZXYPOSTITT1,YTEM(1:LEN_TRIM(YTEM)),.012,0.,-1.)
197 !             CALL PLCHHQ(.002,.98,YTEM(1:LEN_TRIM(YTEM)),.012,0.,-1.)
198             ENDIF
199           ENDIF
200 ! CTITT2
201           YTEM(1:LEN(YTEM))=' '
202           CALL RESOLV_TIT('CTITT2',YTEM)
203           ZXPOSTITT2=.002
204           ZXYPOSTITT2=.95
205           IF(XPOSTITT2 /= 0.)THEN
206             ZXPOSTITT2=XPOSTITT2
207           ENDIF
208           IF(XYPOSTITT2 /= 0.)THEN
209             ZXYPOSTITT2=XYPOSTITT2
210           ENDIF
211           IF(YTEM /= ' ')THEN
212             IF(XSZTITT2 /= 0.)THEN
213               CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM(1:LEN_TRIM(YTEM)),XSZTITT2,0.,-1.)
214 !             CALL PLCHHQ(.002,.95,YTEM(1:LEN_TRIM(YTEM)),XSZTITT2,0.,-1.)
215             ELSE
216               CALL PLCHHQ(ZXPOSTITT2,ZXYPOSTITT2,YTEM(1:LEN_TRIM(YTEM)),.008,0.,-1.)
217 !             CALL PLCHHQ(.002,.95,YTEM(1:LEN_TRIM(YTEM)),.008,0.,-1.)
218             ENDIF
219           ENDIF
220 ! CTITT3
221           YTEM(1:LEN(YTEM))=' '
222           CALL RESOLV_TIT('CTITT3',YTEM)
223           ZXPOSTITT3=.002
224           ZXYPOSTITT3=.93
225           IF(XPOSTITT3 /= 0.)THEN
226             ZXPOSTITT3=XPOSTITT3
227           ENDIF
228           IF(XYPOSTITT3 /= 0.)THEN
229             ZXYPOSTITT3=XYPOSTITT3
230           ENDIF
231           IF(YTEM /= ' ')THEN
232             IF(XSZTITT3 /= 0.)THEN
233               CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM(1:LEN_TRIM(YTEM)),XSZTITT3,0.,-1.)
234 !             CALL PLCHHQ(.002,.93,YTEM(1:LEN_TRIM(YTEM)),XSZTITT3,0.,-1.)
235             ELSE
236               CALL PLCHHQ(ZXPOSTITT3,ZXYPOSTITT3,YTEM(1:LEN_TRIM(YTEM)),.008,0.,-1.)
237 !             CALL PLCHHQ(.002,.93,YTEM(1:LEN_TRIM(YTEM)),.008,0.,-1.)
238             ENDIF
239           ENDIF
240
241         ENDIF
242 !!!!!!!!!!!!! Supprime le 30/11/01
243 1010 FORMAT('Horiz. profile IDEB=',I3,' JDEB=',I3,' ANG.=',I3,' NBPTS=',I3)
244 1011 FORMAT('Horiz. profile XDEB=',F6.0,' YDEB=',F6.0,' ANG.=',I3,' NBPTS=',I3)
245 1013 FORMAT('Horiz. profile XDEB=',F6.0,' YDEB=',E7.2,' ANG.=',I3,' NBPTS=',I3)
246 1014 FORMAT('Horiz. profile XDEB=',E7.2,' YDEB=',F6.0,' ANG.=',I3,' NBPTS=',I3)
247 1015 FORMAT('Horiz. profile XDEB=',E6.2,' YDEB=',E7.2,' ANG.=',I3,' NBPTS=',I3)
248 1018 FORMAT('Horiz. profile IND I,J (BEGIN)-(END)=(',I3,',',I3,')-(',I3,',',I3,')')
249 1019 FORMAT('Horiz. profile LAT,LON (BEGIN)-(END)=(',F4.1,',',F5.1,')-(',F4.1,',',F5.1,')')
250 1020 FORMAT('Horiz. profile CONF. COORD.(BEGIN)-(END)=(',F8.0,',',F8.0,')-(',F8.0,',',F8.0,')')
251 !
252 !
253 !------------------------------------------------------------------------------
254 !
255 !*      2.    EXIT
256 !             ----
257 !
258 RETURN
259 END SUBROUTINE TRAHTRAXY