Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / POS / fleche.f90
1 !-----------------------------------------------------------------
2 !--------------- special set of characters for SCCS information
3 !-----------------------------------------------------------------
4 !      @(#) Lib:/opt/local/MESONH/sources/post/s.fleche.f90, Version:1.2, Date:98/10/02, Last modified:98/06/04
5 !-----------------------------------------------------------------
6 !     ######spl
7       SUBROUTINE FLECHE(PX,PY,PU,PV,KLEN,PHA)
8 !     #######################################
9 !
10 !!****  *FLECHE* - Draws a single arrow for emagram wind display
11 !!
12 !!    PURPOSE
13 !!    -------
14 !
15 !    This routine draws an emagram wind vector by invoking the NCAR 
16 !  "DRWVEC" utility (drawing of a single vector). The wind arrow is
17 !  drawn in the appropriate direction and location for the emagram
18 !  environment. KLEN and PHA are input only scaling factors received 
19 !  from the "ECHELLE" routine.
20 !
21 !
22 !!**  METHOD
23 !!    ------
24 !!      A simple call to DRWVEC, which has stand after scaling by
25 !!  "ECHELLE" to set KLEN and PHA.
26 !!
27 !!   NOTICE:  The DRWVEC and the NCAR graphical utilities are NOT written
28 !!   ------   in Fortran 90, but in Fortran 77.. This sub-section of TRACE
29 !!            does not follow the Meso-NH usual rules: communication has
30 !!            to be made using the /VEC1/ COMMON stack with  static memory
31 !!            allocation. See the ECHELLE routine for details.
32 !!
33 !!    EXTERNAL
34 !!    --------
35 !!      FL2INT : Given a coordinate pair in the NCAR user system, returns the
36 !!               corresponding coordinate pair in the metacode system;
37 !!      VVSETI : Sets an integer NCAR parameter to select an option in the
38 !!               NCAR vector environment
39 !!      DRWVEC : Draws a single vector given by two pairs of metacode
40 !!               coordinates, CALL  DRWVEC (M1,M2,M3,M4,LABEL,NC), where
41 !!               (M1,M2) coordinate of arrow base on a 2**15x2**15 grid,
42 !!               (M3,M4) coordinate of arrow head on a 2**15x2**15 grid,
43 !!               LABEL   character label to be put above arrow, and
44 !!               NC      number of character in label. This routine is
45 !!               given and documented in the VELVECT NCAR sources, but
46 !!               not really documented elsewhere... Sorry for this!
47 !!
48 !!
49 !!    IMPLICIT ARGUMENTS
50 !!    ------------------
51 !!      None
52 !!
53 !!    REFERENCE
54 !!    ---------
55 !!
56 !!     MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
57 !!       + Book1: Concepts and Fundamentals, to appear in 1994;
58 !!       + Book2: Technical Reference and Flowcharts, to appear in 1994;
59 !!       + Book3: Tutorial, November 1994.
60 !!
61 !!     NCAR Graphics Technical documentation, UNIX version 3.2,
62 !!     Scientific computing division, NCAR/UCAR, Boulder, USA.
63 !!      Volume 1: Fundamentals, Vers. 1, May 1993
64 !!      Volume 2: Contouring and mapping tutorial, Vers. 2, May 1993
65 !!
66 !!     For the vector utilities not documented in the NCAR package
67 !!     Version 3 idocumentation, a better reference is:
68 !!      The NCAR GKS-Compatible Graphics System Version 2,
69 !!      SPPS an NCAR System Plot Package Simulator.
70 !!      NCAR Technical note 267+1A, April 1986, NCAR/UCAR, Boulder, USA.
71 !!
72 !!    AUTHOR
73 !!    ------
74 !!      J. Duron    * Laboratoire d'Aerologie *
75 !!
76 !!    MODIFICATIONS
77 !!    -------------
78 !!      Original       06/06/94
79 !!      Updated   PM   10/01/95
80 !-------------------------------------------------------------------------------
81 !
82 !*       0.    DECLARATIONS
83 !              ------------
84 !
85 IMPLICIT NONE
86 !
87 !*       0.1   Dummy arguments and results
88 !
89 INTEGER           :: KLEN            ! Maximum arrow size which can be 
90                                      ! plotted (given in metacode units)
91 REAL              :: PX, PY          ! Arrow tail location, given in NCAR 
92                                      ! user coordinate system.
93 REAL              :: PU, PV          ! Wind components U and V to be plotted,
94                                      ! given in m/s.
95 REAL              :: PHA             ! Maximum wind modulus which can be 
96                                      ! plotted (given in m/s). Values of KLEN 
97                                      ! and PHA have to be mutually consistent.
98 !
99 !*       0.2   Local variables  
100 !
101 INTEGER           :: IM1, IM2, IM3, IM4 ! Tail and head locations of the
102                                         ! arrow, given in metacode coordinates
103 CHARACTER(LEN=10) :: YLABEL='AAAAAAAAAA'             ! Arrow label (i.e.: its scale)
104 !
105 INTERFACE
106   SUBROUTINE DRWVEC (M1,M2,M3,M4,LABEL,NC)
107    CHARACTER*10 LABEL
108    INTEGER :: M1,M2,M3,M4,NC
109   END SUBROUTINE DRWVEC
110 END INTERFACE
111 !-------------------------------------------------------------------------------
112 !
113 !*       1.    ARROW DRAWING
114 !              -------------
115
116 !*       1.1   Converts tail location from user to metacode coordinates
117 !*                     (also called fractional) coordinates
118 !
119 CALL FL2INT(PX,PY,IM1,IM2)
120 !
121 !*       1.2   Computes the head location in metacode coordinates
122 !
123 IM3=IM1+INT(PU*FLOAT(KLEN)/PHA)
124 IM4=IM2+INT(PV*FLOAT(KLEN)/PHA)
125 !
126 !*       1.3   Draws the arrow
127 !
128 ! Setting VPO >0, the tail of the vector arrow is 
129 ! placed at the grid point location
130 !
131 CALL VVSETI('VPO',1)
132 !
133 ! As the last argument for DRWVEC 
134 ! is 0, no label is actually written
135 !
136 CALL DRWVEC(IM1,IM2,IM3,IM4,YLABEL,0)
137 !      CALL PWRITX(PU,PV,6H'KGU'-,6,10,0,0)
138 !
139 !------------------------------------------------------------------------------
140 !
141 !*       2.    EXIT
142 !              ----
143 !
144 RETURN
145 !
146 END SUBROUTINE FLECHE