1!    Generates polar plot with, 1-1 scaling
2!
3!    Copyright (C) 2004-2016 Alan W. Irwin
4!
5!    This file is part of PLplot.
6!
7!    PLplot is free software; you can redistribute it and/or modify
8!    it under the terms of the GNU Library General Public License as
9!    published by the Free Software Foundation; either version 2 of the
10!    License, or (at your option) any later version.
11!
12!    PLplot is distributed in the hope that it will be useful,
13!    but WITHOUT ANY WARRANTY; without even the implied warranty of
14!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15!    GNU Library General Public License for more details.
16!
17!    You should have received a copy of the GNU Library General Public
18!    License along with PLplot; if not, write to the Free Software
19!    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20
21!     N.B. the pl_test_flt parameter used in this code is only
22!     provided by the plplot module to allow convenient developer
23!     testing of either kind(1.0) or kind(1.0d0) floating-point
24!     precision regardless of the floating-point precision of the
25!     PLplot C libraries.  We do not guarantee the value of this test
26!     parameter so it should not be used by users, and instead user
27!     code should replace the pl_test_flt parameter by whatever
28!     kind(1.0) or kind(1.0d0) precision is most convenient for them.
29!     For further details on floating-point precision issues please
30!     consult README_precision in this directory.
31!
32program x03f
33    use plplot, double_PI => PL_PI
34    use plfortrandemolib
35    implicit none
36
37    real(kind=pl_test_flt), parameter :: PI = double_PI
38    character (len=3) :: text
39    real(kind=pl_test_flt), dimension(0:360) :: x0, y0, x, y
40    real(kind=pl_test_flt) :: dtr, theta, dx, dy, offset
41    integer :: i
42    integer :: plparseopts_rc
43    !    Process command-line arguments
44    plparseopts_rc = plparseopts(PL_PARSE_FULL)
45    if(plparseopts_rc .ne. 0) stop "plparseopts error"
46
47    !   Set orientation to portrait - note not all device drivers
48    !   support this, in particular most interactive drivers do not.
49    call plsori(1)
50
51    dtr = PI/180.0_pl_test_flt
52    x0 = cos(dtr * arange(361))
53    y0 = sin(dtr * arange(361))
54
55    !    Initialize PLplot
56
57    call plinit()
58
59    !    Set up viewport and window, but do not draw box
60
61    call plenv(-1.3_pl_test_flt, 1.3_pl_test_flt, -1.3_pl_test_flt, 1.3_pl_test_flt, 1, -2)
62    !   Draw circles for polar grid
63    do i = 1,10
64        call plarc(0.0_pl_test_flt, 0.0_pl_test_flt, 0.1_pl_test_flt*i, 0.1_pl_test_flt*i, &
65               0.0_pl_test_flt, 360.0_pl_test_flt, 0.0_pl_test_flt, .false.)
66    enddo
67    call plcol0(2)
68    do i = 0,11
69        theta = 30.0_pl_test_flt*i
70        dx = cos(dtr*theta)
71        dy = sin(dtr*theta)
72
73        !      Draw radial spokes for polar grid
74
75        call pljoin(0.0_pl_test_flt, 0.0_pl_test_flt, dx, dy)
76        write (text,'(i3)') nint(theta)
77
78        !      Write labels for angle
79
80        text = adjustl(text)
81
82        if (theta .lt. 9.99) then
83            offset = 0.45
84        elseif (theta .lt. 99.9) then
85            offset = 0.30
86        else
87            offset = 0.15
88        endif
89        !      Slightly off zero to avoid floating point logic flips at
90        !      90 and 270 deg.
91        if (dx >= -0.00001_pl_test_flt) then
92            call plptex(dx, dy, dx, dy, -offset, text)
93        else
94            call plptex(dx, dy, -dx, -dy, 1._pl_test_flt+offset, text)
95        end if
96    enddo
97    !    Draw the graph
98
99    x = x0 * sin(5.0_pl_test_flt * dtr * arange(361))
100    y = y0 * sin(5.0_pl_test_flt * dtr * arange(361))
101
102    call plcol0(3)
103    call plline(x,y)
104
105    call plcol0(4)
106    call plmtex('t', 2.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, &
107           '#frPLplot Example 3 - r(#gh)=sin 5#gh')
108
109    !    Close the plot at end
110
111    call plend
112end program x03f
113