Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / kztnp.f90
1 !     ######spl
2       SUBROUTINE KZTNP(K)
3 !     ###################
4 !
5 !!****  *KZTNP* - 
6 !!
7 !!    PURPOSE
8 !!    -------
9 !      
10 !
11 !!**  METHOD
12 !!    ------
13 !!     
14 !!     N.A.
15 !!
16 !!    EXTERNAL
17 !!    --------
18 !!      None
19 !!
20 !!    IMPLICIT ARGUMENTS
21 !!    ------------------
22 !!
23 !!      Module MODN_NCAR : defines NAM_DIRTRA_POS namelist 
24 !!                         (former NCAR common)
25 !!
26 !!       NIOFFD     : Label normalisation (=0 none, =/=0 active)
27 !!       NULBLL     : Nb of contours between 2 labelled contours
28 !!       NIOFFM     : =0    --> message at picture bottom
29 !!                    =/= 0 --> no message
30 !!       NIOFFP     : Special point value detection
31 !!                    (=0 none, =/=0 active)
32 !!       NHI        : Extrema detection
33 !!                    (=0 --> H+L, <0 nothing)
34 !!       NINITA     : For streamlimes
35 !!       NINITB     : Not yet implemented
36 !!       NIGRNC     : Not yet implemented
37 !!       NDOT       : Line style
38 !!                    (=0|1|1023|65535 --> solid lines;
39 !!                    <0 --> solid lines for positive values and
40 !!                    dotted lines(ABS(NDOT))for negative values;
41 !!                    >0 --> dotted lines(ABS(NDOT)) )
42 !!       NIFDC      : Coastline data style (0 none, 1 NCAR, 2 IGN)
43 !!       NLPCAR     : Number of land-mark points to be plotted
44 !!       NIMNMX     : Contour selection option
45 !!                    (=-1 Min, max and inc. automatically set;
46 !!                    =0 Min, max automatically set; inc. given;
47 !!                    >0 Min, max, inc. given by user)
48 !!       NISKIP     : Rate for drawing velocity vectors
49 !!       CTYPHOR    : Horizontal cross-section type
50 !!                    (='K' --> model level section;
51 !!                     ='Z' --> constant-altitude section;
52 !!                     ='P' --> isobar section (planned)
53 !!                     ='T' --> isentrope section (planned)
54 !!       XSPVAL     : Special value
55 !!       XSIZEL     : Label size
56 !!       XLATCAR, XLONCAR :  Lat. and Long. of land-mark points
57 !!       LXY        : If =.TRUE., plots  a grid-mesh stencil background
58 !!       LXZ        : If =.TRUE., plots  a model-level stencil background 
59 !!
60 !!      Module MODN_PARA  : Defines NAM_DOMAIN_POS namelist 
61 !!                          (former PARA common)
62 !!
63 !!       XIDEBCOU, XJDEBCOU : Origin of a vertical cross-section
64 !!                            in cartesian (or conformal) real values
65 !!       XHMIN      : Altitude of the vert. cross-section
66 !!                    bottom (in meters above sea-level)
67 !!       XHMAX      : Altitude of the vert. cross-section
68 !!                    top (in meters above sea-level)
69 !!
70 !!
71 !!
72 !!    REFERENCE
73 !!    ---------
74 !!
75 !!
76 !!    AUTHOR
77 !!    ------
78 !!      J. Duron    * Laboratoire d'Aerologie *
79 !!
80 !!
81 !!    MODIFICATIONS
82 !!    -------------
83 !!      Original       06/06/94
84 !!      Updated   PM   02/12/94
85 !-------------------------------------------------------------------------------
86 !
87 !*       0.    DECLARATIONS
88 !              ------------
89 !
90 USE MODD_RESOLVCAR
91 USE MODD_MASK3D
92 USE MODD_ALLOC_FORDIACHRO
93 USE MODD_TYPE_AND_LH
94 USE MODN_NCAR    
95 USE MODN_PARA    
96
97 IMPLICIT NONE
98 !
99 !*       0.1   Dummy arguments
100 !              ---------------
101 INTEGER  :: K
102 !
103 !*       0.1   Local variables
104 !              ---------------
105
106 !
107 INTEGER   ::   J, JJ, JE
108 INTEGER   ::   IP1, IP2, IP3, IT
109 INTEGER   ::   JLOOPN, INDN, JF, JLOOPNF
110 INTEGER   ::   ILEN, INBGRA
111
112 REAL      ::   ZDIF
113 CHARACTER(LEN=8) :: YREP
114 !------------------------------------------------------------------------------
115 !
116 ! Traitement des processus
117 !
118 IF(LPROCDIALL(K))THEN
119
120   NBPROCDIA(K)=SIZE(XVAR,6)
121   DO J=1,NBPROCDIA(K)
122     NPROCDIA(J,K)=J
123   ENDDO
124
125 ELSE
126
127   IF(LPINCRDIA(K))THEN
128     
129     NPROCDIA(2,K)=MIN(NPROCDIA(2,K),SIZE(XVAR,6))
130
131     IF(NBPROCDIA(K) == 2)THEN
132
133       IP1=NPROCDIA(1,K)
134       IP2=NPROCDIA(2,K)
135       NBPROCDIA(K)=IP2-IP1+1
136       JJ=0
137       DO J=IP1,IP2
138         JJ=JJ+1
139         NPROCDIA(JJ,K)=J
140       ENDDO
141
142     ELSE IF(NBPROCDIA(K) == 3)THEN
143
144       IP1=NPROCDIA(1,K)
145       IP2=NPROCDIA(2,K)
146       IP3=NPROCDIA(3,K)
147       NBPROCDIA(K)=1
148       DO J=2,100
149         IP1=IP1+IP3
150         IF(IP1 > IP2)EXIT
151         NBPROCDIA(K)=NBPROCDIA(K)+1
152         NPROCDIA(J,K)=IP1
153       ENDDO
154
155     ENDIF
156
157   ENDIF
158
159 ENDIF
160
161 LPINCRDIA(K)=.FALSE.
162
163 IF(NBPROCDIA(K) == 0)THEN
164   NPROCDIA(:,K)=0
165 ENDIF
166
167 !
168 ! Traitement des numeros de masques et trajectoires 
169 !
170 IF(LNDIALL(K))THEN
171   
172   NBNDIA(K)=SIZE(XVAR,5)
173   DO J=1,NBNDIA(K)
174     NNDIA(J,K)=J
175   ENDDO
176
177 ELSE
178
179   IF(LNINCRDIA(K))THEN
180    
181     NNDIA(2,K)=MIN(NNDIA(2,K),SIZE(XVAR,5))
182
183     IF(NBNDIA(K) == 2)THEN
184
185       IP1=NNDIA(1,K)
186       IP2=NNDIA(2,K)
187       NBNDIA(K)=IP2-IP1+1
188       JJ=0
189       DO J=IP1,IP2
190         JJ=JJ+1
191         NNDIA(JJ,K)=J
192       ENDDO
193
194     ELSE IF(NBNDIA(K) == 3)THEN
195
196       IP1=NNDIA(1,K)
197       IP2=NNDIA(2,K)
198       IP3=NNDIA(3,K)
199       NBNDIA(K)=1
200       DO J=2,100
201         IP1=IP1+IP3
202         IF(IP1 > IP2)EXIT
203         NBNDIA(K)=NBNDIA(K)+1
204         NNDIA(J,K)=IP1
205       ENDDO
206
207     ENDIF
208
209   ENDIF
210
211 ENDIF
212
213 LNINCRDIA(K)=.FALSE.
214
215 IF(NBNDIA(K) == 0)THEN
216   NNDIA(:,K)=0
217 ENDIF
218 !
219 ! Traitement des temps
220 !
221 SELECT CASE(CTYPE)
222   CASE('MASK','SSOL','SPXY')
223     JLOOPNF=1
224   CASE DEFAULT
225     JLOOPNF=NBNDIA(K)
226 END SELECT
227
228 DO JLOOPN=1,JLOOPNF  ! Boucle sur les Num traj ou stations
229
230 SELECT CASE(CTYPE)
231   CASE('MASK','SSOL','SPXY')
232     INDN=1
233   CASE DEFAULT
234     INDN=NNDIA(JLOOPN,K)
235 END SELECT
236
237 SELECT CASE(CTYPE)
238   CASE('CART','MASK','SPXY','SSOL')
239     JF=SIZE(XVAR,4)
240   CASE DEFAULT
241     DO JE=SIZE(XTRAJT,1),1,-1
242       IF(XTRAJT(JE,INDN) /= -1.E-15)THEN
243         JF=JE
244         EXIT
245       ENDIF
246     ENDDO
247 END SELECT
248
249 IF(LTIMEDIALL(K,INDN))THEN
250
251   LTINCRDIA(K,INDN)=.TRUE.
252   NBTIMEDIA(K,INDN)=3
253   NTIMEDIA(1,K,INDN)=1
254   NTIMEDIA(2,K,INDN)=JF
255   NTIMEDIA(3,K,INDN)=1
256
257   XTIMEDIA(1,K,INDN)=XTRAJT(NTIMEDIA(1,K,INDN),INDN)
258   XTIMEDIA(2,K,INDN)=XTRAJT(NTIMEDIA(2,K,INDN),INDN)
259
260 ELSE
261
262   IF(LTINCRDIA(K,INDN))THEN
263 ! Incremental
264
265     IF(NTIMEDIA(2,K,INDN) /=  0)THEN
266       NTIMEDIA(2,K,INDN)=MIN(NTIMEDIA(2,K,INDN),JF)
267     ENDIF
268
269     IF(NBTIMEDIA(K,INDN) == 2)THEN
270
271       IP1=NTIMEDIA(1,K,INDN)
272       IP2=NTIMEDIA(2,K,INDN)
273       IF(IP1 /=0 .AND. IP2 /=0)THEN
274         NBTIMEDIA(K,INDN)=3
275         NTIMEDIA(3,K,INDN)=1
276         XTIMEDIA(1,K,INDN)=XTRAJT(NTIMEDIA(1,K,INDN),INDN)
277         XTIMEDIA(2,K,INDN)=XTRAJT(NTIMEDIA(2,K,INDN),INDN)
278 ! CONTROLER LA VALIDITE DES VALEURS
279
280       ELSE
281
282         DO J=1,JF
283           IF(XTIMEDIA(1,K,INDN) <= XTRAJT(J,INDN))EXIT
284         ENDDO
285         NTIMEDIA(1,K,INDN)=J
286         DO J=1,JF
287           IF(XTIMEDIA(2,K,INDN) <= XTRAJT(J,INDN))EXIT
288         ENDDO
289         NTIMEDIA(2,K,INDN)=J
290         NTIMEDIA(2,K,INDN)=MIN(NTIMEDIA(2,K,INDN),JF)
291         NBTIMEDIA(K,INDN)=3
292         NTIMEDIA(3,K,INDN)=1
293       ENDIF
294
295     ELSE IF(NBTIMEDIA(K,INDN) == 3)THEN
296
297       IP1=NTIMEDIA(1,K,INDN)
298       IP2=NTIMEDIA(2,K,INDN)
299       IP3=NTIMEDIA(3,K,INDN)
300       IF(IP1 /=0 .AND. IP2 /=0 .AND. IP3 /=0)THEN
301         XTIMEDIA(1,K,INDN)=XTRAJT(NTIMEDIA(1,K,INDN),INDN)
302         XTIMEDIA(2,K,INDN)=XTRAJT(NTIMEDIA(2,K,INDN),INDN)
303
304       ELSE
305
306         
307         DO J=1,JF
308           IF(XTIMEDIA(1,K,INDN) <= XTRAJT(J,INDN))EXIT
309         ENDDO
310         NTIMEDIA(1,K,INDN)=J
311         DO J=1,JF
312           IF(XTIMEDIA(2,K,INDN) <= XTRAJT(J,INDN))EXIT
313         ENDDO
314         NTIMEDIA(2,K,INDN)=J
315         NTIMEDIA(2,K,INDN)=MIN(NTIMEDIA(2,K,INDN),JF)
316         ZDIF=ABS(XTRAJT(2,INDN)-XTRAJT(3,INDN))
317         IT=ANINT(XTIMEDIA(3,K,INDN)/ZDIF)
318         NTIMEDIA(3,K,INDN)=IT
319       ENDIF
320
321     ENDIF
322
323 ! Non incremental
324   ELSE
325     DO J=1,NBTIMEDIA(K,INDN)
326       IF(NTIMEDIA(J,K,INDN) /= 0)THEN
327         NTIMEDIA(J,K,INDN)=MIN(NTIMEDIA(J,K,INDN),JF)
328         XTIMEDIA(J,K,INDN)=XTRAJT(NTIMEDIA(J,K,INDN),INDN)
329
330       ELSE
331
332         DO JJ=1,JF
333           IF(XTIMEDIA(J,K,INDN) <= XTRAJT(JJ,INDN))EXIT
334         ENDDO
335         NTIMEDIA(J,K,INDN)=JJ
336         NTIMEDIA(J,K,INDN)=MIN(NTIMEDIA(J,K,INDN),JF)
337
338       ENDIF
339     ENDDO
340
341   ENDIF
342
343 ENDIF
344 ENDDO      ! Fin boucle Num traj ou stations
345 !
346 ! Traitement des niveaux de modele K
347 !
348 SELECT CASE(CTYPE)
349   CASE('MASK')
350 ! CASE('MASK','SSOL')
351     JLOOPNF=1
352   CASE DEFAULT
353     JLOOPNF=NBNDIA(K)
354 END SELECT
355
356 DO JLOOPN=1,JLOOPNF  ! Boucle sur les Num traj ou stations
357
358 SELECT CASE(CTYPE)
359   CASE('MASK')
360 ! CASE('MASK','SSOL')
361     INDN=1
362   CASE DEFAULT
363     INDN=NNDIA(JLOOPN,K)
364 END SELECT
365
366 SELECT CASE(CTYPE)
367   CASE('CART','MASK','SPXY')
368     JF=SIZE(XVAR,3)
369   CASE('SSOL','DRST','RSPL','RAPL')
370     DO JE=SIZE(XTRAJZ,1),1,-1
371 ! Le 2eme indice (temps) est mis arbitrairement a 1 parce que la
372 ! dimension en K pour le temps indice 1 est la meme que pour le
373 ! temps indice n.
374       IF(XTRAJZ(JE,1,INDN) /= -1.E-15)THEN
375         JF=JE
376         NKL=1
377         NKH=JF
378         EXIT
379       ENDIF
380     ENDDO
381 END SELECT
382
383 IF(LVLKDIALL(K,INDN))THEN
384
385   NBLVLKDIA(K,INDN)=JF
386   DO J=1,NBLVLKDIA(K,INDN)
387     NLVLKDIA(J,K,INDN)=J+NKL-1
388   ENDDO
389
390 ELSE
391
392   IF(LKINCRDIA(K,INDN))THEN
393
394     IF(NBLVLKDIA(K,INDN) == 2)THEN
395
396       IP1=MAX(NLVLKDIA(1,K,INDN),NKL)
397       IP2=MIN(NLVLKDIA(2,K,INDN),NKH)
398       NBLVLKDIA(K,INDN)=IP2-IP1+1
399       JJ=0
400       DO J=IP1,IP2
401         JJ=JJ+1
402         NLVLKDIA(JJ,K,INDN)=J
403       ENDDO
404
405     ELSE IF(NBLVLKDIA(K,INDN) == 3)THEN
406
407       IP1=MAX(NLVLKDIA(1,K,INDN),NKL)
408       IP2=MIN(NLVLKDIA(2,K,INDN),NKH)
409       IP3=NLVLKDIA(3,K,INDN)
410       NLVLKDIA(1,K,INDN)=IP1
411       NLVLKDIA(2,K,INDN)=IP2
412       NBLVLKDIA(K,INDN)=1
413       DO J=2,1000
414         IP1=IP1+IP3
415         IF(IP1 > IP2)EXIT
416         NBLVLKDIA(K,INDN)=NBLVLKDIA(K,INDN)+1
417         NLVLKDIA(J,K,INDN)=IP1
418       ENDDO
419
420     ENDIF
421
422   ENDIF
423
424 ENDIF
425
426 LKINCRDIA(K,INDN)=.FALSE.
427
428 IF(NBLVLKDIA(K,INDN) == 0)THEN
429   NLVLKDIA(:,K,INDN)=0
430 ENDIF
431 ENDDO      ! Fin boucle Num traj ou stations
432 !
433 ! Traitement des altitudes Z
434 !
435 ! On a directement  les altitudes en numerique en incremental ou non.
436 ! Si (LZINCRDIA(K))  -->   NBLVLZDIA(K)=3
437 !                          XLVLZDIA(1:3,K)= extremes + increment
438 ! Si (.NOT.LZINCRDIA(K))  -->    NBLVLZDIA(K)=N
439 !                                XLVLZDIA(1:N,K)=altitudes
440 !
441 !
442 ! Positionnement de CTYPHOR
443 !
444 SELECT CASE(CTYPE)
445   CASE('CART','MASK','SPXY')
446     CTYPHOR(1:LEN(CTYPHOR))=' '
447     IF(NBLVLKDIA(K,1) == 0 .AND. NBLVLZDIA(K) /=0 )THEN
448       IF(LPR)THEN
449         CTYPHOR='P'
450       ELSE IF(LTK)THEN
451         CTYPHOR='T'
452       ELSE IF(LEV)THEN
453         CTYPHOR='E'
454       ELSE IF(LSV3)THEN
455         CTYPHOR='V'
456       ELSE
457         CTYPHOR='Z'
458       ENDIF
459       LHORIZ=.TRUE.; LVERTI=.FALSE.
460     ELSE IF(NBLVLKDIA(K,1) /= 0 .AND. NBLVLZDIA(K) ==0 )THEN
461       CTYPHOR='K'
462       LHORIZ=.TRUE.; LVERTI=.FALSE.
463
464       IF(LTINCRDIA(K,1))THEN
465         ILEN=(NTIMEDIA(2,K,1)-NTIMEDIA(1,K,1))/NTIMEDIA(3,K,1)+1
466       ELSE
467         ILEN=NBTIMEDIA(K,1)
468       ENDIF
469
470       INBGRA=NBPROCDIA(K)*NBLVLKDIA(K,1)*ILEN
471
472       IF(INBGRA > 35 .AND. LCH .AND. CTYPE /= 'SPXY')THEN
473         print *,'VOUS AVEZ DEMANDE: ',NBLVLKDIA(K,1),' NIVEAUX * ',  &
474 &       ILEN,' TEMPS * ',NBPROCDIA(K),' PROCESSUS = '
475         print *,INBGRA,' GRAPHIQUES '
476         print *,' EN ETES VOUS SUR ???? (y/n) '
477         YREP(1:LEN(YREP))=' '
478         READ(5,*)YREP
479         SELECT CASE(YREP)
480           CASE('y','Y','o','O','yes','YES','oui','OUI')
481           CASE DEFAULT
482             LPBREAD=.TRUE.
483             print *,' VERIFIEZ LA SYNTAXE DE VOTRE DIRECTIVE ET RENTREZ LA A ',&
484 &           'NOUVEAU'
485         END SELECT
486       ENDIF
487
488     ENDIF
489   CASE DEFAULT
490 END SELECT
491
492
493
494 !
495 !-----------------------------------------------------------------------------
496 !
497 !*       2.       EXITS
498 !                 -----
499
500 RETURN
501 END SUBROUTINE KZTNP