← Back to branch summary

~uhh-ssd/+junk/humidity_readout

« back to all changes in this revision

Viewing changes to plplot/plplot-5.9.9/examples/f95/x11f.f90

  • Committer: Joachim Erfle
  • Date: 2013-07-24 13:53:41 UTC
  • Revision ID: joachim.erfle@desy.de-20130724135341-1qojpp701zsn009p
initial commit

Show diffs side-by-side

added added

removed removed

Lines of Context:
plplot/plplot-5.9.9/examples/f95/x11f.f90
 
1
!      $Id: x11f.f90 11680 2011-03-27 17:57:51Z airwin $
 
2
!      Mesh plot demo
 
3
!
 
4
!      Copyright (C) 2004  Alan W. Irwin
 
5
!
 
6
!      This file is part of PLplot.
 
7
!
 
8
!      PLplot is free software; you can redistribute it and/or modify
 
9
!      it under the terms of the GNU Library General Public License as
 
10
!      published by the Free Software Foundation; either version 2 of the
 
11
!      License, or (at your option) any later version.
 
12
!
 
13
!      PLplot is distributed in the hope that it will be useful,
 
14
!      but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
!      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
!      GNU Library General Public License for more details.
 
17
!
 
18
!      You should have received a copy of the GNU Library General Public
 
19
!      License along with PLplot; if not, write to the Free Software
 
20
!      Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
21
 
 
22
      use plplot, PI => PL_PI
 
23
      implicit none
 
24
      integer i, j, k, ifshade, xpts, ypts
 
25
      parameter (xpts=35, ypts=46)
 
26
 
 
27
      real(kind=plflt) x(xpts), y(ypts), z(xpts,ypts), xx, yy, r
 
28
 
 
29
      character*80 title(2)
 
30
      real(kind=plflt) alt(2),az(2)
 
31
      integer opt(2)
 
32
      data alt /33.0_plflt,17.0_plflt/
 
33
      data az  /24.0_plflt,115.0_plflt/
 
34
!      DRAW_LINEXY
 
35
      data opt /2*3/
 
36
      data title /'#frPLplot Example 11 - Alt=33, Az=24, Opt=3', &
 
37
                  '#frPLplot Example 11 - Alt=17, Az=115, Opt=3'/
 
38
      integer nlevel
 
39
      parameter (nlevel = 10)
 
40
      real(kind=plflt) zmin, zmax, step, clevel(nlevel)
 
41
!      Process command-line arguments
 
42
      call plparseopts(PL_PARSE_FULL)
 
43
 
 
44
 
 
45
      do i = 1,xpts
 
46
        x(i) = 3._plflt*dble(i-1-(xpts/2))/dble (xpts/2)
 
47
      enddo
 
48
      do j = 1,ypts
 
49
        y(j) = 3._plflt*dble(j-1-(ypts/2))/dble (ypts/2)
 
50
      enddo
 
51
 
 
52
      do i=1,xpts
 
53
        xx = x(i)
 
54
        do j=1,ypts
 
55
          yy = y(j)
 
56
          z(i,j) = 3._plflt * (1._plflt-xx)*(1._plflt-xx) * &
 
57
            exp(-(xx*xx) - (yy+1._plflt)*(yy+1._plflt)) - &
 
58
            10._plflt * (xx/5._plflt - xx**3 - yy**5) * exp(-xx*xx-yy*yy) - &
 
59
            1._plflt/3._plflt * exp(-(xx+1._plflt)*(xx+1._plflt) - (yy*yy))
 
60
          if(.false.) then
 
61
!            Jungfraujoch/Interlaken
 
62
            if(z(i,j).lt.-1._plflt) z(i,j) = -1._plflt
 
63
          endif
 
64
        enddo
 
65
      enddo
 
66
      call a2mnmx(z, xpts, ypts, zmin, zmax)
 
67
      step = (zmax-zmin)/(nlevel+1)
 
68
      do i = 1, nlevel
 
69
        clevel(i) = zmin + step*i
 
70
      enddo
 
71
 
 
72
      call plinit()
 
73
      call cmap1_init(0)
 
74
      do k=1,2
 
75
        do ifshade = 0, 3
 
76
          call pladv(0)
 
77
          call plcol0(1)
 
78
          call plvpor(0.0_plflt, 1.0_plflt, 0.0_plflt, 0.9_plflt )
 
79
          call plwind(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.5_plflt )
 
80
          call plw3d(1.0_plflt, 1.0_plflt, 1.2_plflt, -3.0_plflt, &
 
81
            3.0_plflt, -3.0_plflt, 3.0_plflt, zmin, zmax, alt(k),az(k))
 
82
          call plbox3('bnstu','x axis', 0.0_plflt, 0, &
 
83
            'bnstu', 'y axis', 0.0_plflt, 0, &
 
84
            'bcdmnstuv','z axis', 0.0_plflt, 0)
 
85
          call plcol0(2)
 
86
          if(ifshade.eq.0) then
 
87
!            wireframe plot
 
88
            call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), &
 
89
              opt(k))
 
90
          elseif(ifshade.eq.1) then
 
91
!            magnitude colored wireframe plot
 
92
            call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), &
 
93
              ior(opt(k), MAG_COLOR))
 
94
          elseif(ifshade.eq.2) then
 
95
!            magnitude colored wireframe plot with sides
 
96
            call plot3d(x(:xpts), y(:ypts), z(:xpts,:ypts), &
 
97
              ior(opt(k), MAG_COLOR), .true.)
 
98
          elseif(ifshade.eq.3) then
 
99
!             magnitude colored wireframe plot with base contour
 
100
            call plmeshc(x(:xpts), y(:ypts), z(:xpts,:ypts), &
 
101
              ior(opt(k), ior(MAG_COLOR, BASE_CONT)), clevel)
 
102
          else
 
103
            stop 'x11f: bad logic'
 
104
          endif
 
105
          call plcol0(3)
 
106
          call plmtex('t', 1.0_plflt, 0.5_plflt, 0.5_plflt, title(k))
 
107
        enddo
 
108
      enddo
 
109
      call plend
 
110
      end
 
111
 
 
112
!----------------------------------------------------------------------------
 
113
      subroutine cmap1_init(gray)
 
114
!      For gray.eq.1, basic grayscale variation from half-dark
 
115
!      to light.  Otherwise, hue variations around the front of the
 
116
!      colour wheel from blue to green to red with constant lightness
 
117
!      and saturation.
 
118
 
 
119
      use plplot
 
120
      implicit none
 
121
      integer gray
 
122
      real(kind=plflt) i(0:1), h(0:1), l(0:1), s(0:1)
 
123
!      left boundary
 
124
      i(0) = 0._plflt
 
125
!      right boundary
 
126
      i(1) = 1._plflt
 
127
      if (gray.eq.1) then
 
128
!        hue -- low: red (arbitrary if s=0)
 
129
        h(0) = 0.0_plflt
 
130
!        hue -- high: red (arbitrary if s=0)
 
131
        h(1) = 0.0_plflt
 
132
!        lightness -- low: half-dark
 
133
        l(0) = 0.5_plflt
 
134
!        lightness -- high: light
 
135
        l(1) = 1.0_plflt
 
136
!        minimum saturation
 
137
        s(0) = 0.0_plflt
 
138
!        minimum saturation
 
139
        s(1) = 0.0_plflt
 
140
      else
 
141
!        This combination of hues ranges from blue to cyan to green to yellow
 
142
!        to red (front of colour wheel) with constant lightness = 0.6
 
143
!        and saturation = 0.8.
 
144
 
 
145
!        hue -- low: blue
 
146
        h(0) = 240._plflt
 
147
!        hue -- high: red
 
148
        h(1) = 0.0_plflt
 
149
!        lightness -- low:
 
150
        l(0) = 0.6_plflt
 
151
!        lightness -- high:
 
152
        l(1) = 0.6_plflt
 
153
!        saturation
 
154
        s(0) = 0.8_plflt
 
155
!        minimum saturation
 
156
        s(1) = 0.8_plflt
 
157
      endif
 
158
      call plscmap1n(256)
 
159
      call plscmap1l(.false., i, h, l, s)
 
160
      end
 
161
 
 
162
!----------------------------------------------------------------------------
 
163
!      Subroutine a2mnmx
 
164
!      Minimum and the maximum elements of a 2-d array.
 
165
 
 
166
      subroutine a2mnmx(f, nx, ny, fmin, fmax)
 
167
      use plplot
 
168
      implicit none
 
169
 
 
170
      integer   i, j, nx, ny
 
171
      real(kind=plflt)    f(nx, ny), fmin, fmax
 
172
 
 
173
      fmax = f(1, 1)
 
174
      fmin = fmax
 
175
      do j = 1, ny
 
176
        do  i = 1, nx
 
177
          fmax = max(fmax, f(i, j))
 
178
          fmin = min(fmin, f(i, j))
 
179
        enddo
 
180
      enddo
 
181
      end