aimpac/hereplot.f at master · ecbrown/aimpac · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
c
c-----------------------------------------------------------------------
c
      subroutine plots (scalex,scaley,file)
        character*(*) file
        call pgbegin(0,file,1,1)
*       call pgscr(0, 1.,1.,1.)
        call pgscr(1, 1.,0.,0.)
        call pgscr(2, 0.,1.,0.)
        call pgscr(3, 0.,0.,1.)
        call pgscr(4, 1.,1.,0.)
        call pgscr(5, 1.,0.,1.)
        call pgscr(6, 0.,1.,1.)
        call pgscr(7, 1.0,0.5,0.5)
        call pgscr(8, 0.5,1.0,0.5)
        call pgscr(9, 0.5,0.5,1.0)
        call pgvport (0.,1.,0.,1.)
*       call pgenv(0,scalex,0,scaley,1,-2)
        call pgenv(0,scalex,0,scaley,1,-1)
      end
c
c-----------------------------------------------------------------------
c
      subroutine plots2 (scalex,scaley,file,line)
        character*(*) file, line
        character*(20) ejex, ejey
        call pgbegin(0,file,1,1)
*mdc*if color
*        call pgscr(0, 1.,1.,1.)
*        call pgscr(1, 1.,0.,0.)
*        call pgscr(2, 0.,1.,0.)
*        call pgscr(3, 0.,0.,1.)
*        call pgscr(4, 1.,1.,0.)
*        call pgscr(5, 1.,0.,1.)
*        call pgscr(6, 0.,1.,1.)
*        call pgscr(7, 1.0,0.5,0.5)
*        call pgscr(8, 0.5,1.0,0.5)
*        call pgscr(9, 0.5,0.5,1.0)
*mdc*else
*mdc*endif
        call pgvport (0.,1.,0.,1.)
*       call pgenv(0,scalex,0,scaley,1,-2)
        call pgenv(0,scalex,0,scaley,1,-1)
        ejex = ' '
        ejey = ' '
        call pglab(ejex,ejey,line(1:leng(line)))
      end
c
c-----------------------------------------------------------------------
c
      subroutine plot(x,y,ipen)
      real xx(1), yy(1)
c
      if (ipen.eq.999) then
c
          call pgend
          return
c
      elseif (ipen.eq.3) then
c
          call pgmove(x,y)
c
      elseif (ipen.eq.2) then
c
          call pgsls(1)
*mdc*if color
*          call pgsci(1)
*mdc*endif
          call pgdraw(x,y)
c
      elseif (ipen.eq.5) then
          call pgsls(2)
*mdc*if color
*          call pgsci(3)
*mdc*endif
*mdc*if trial2
*          call pgmove(x,y)
*          xx(1) = x
*          yy(1) = y
*          call pgpt(1,xx,yy,-1)
*mdc*else
          call pgdraw(x,y)
*mdc*endif
c
      elseif (ipen.gt.3) then
c
          call pgsls(ipen-1)
*mdc*if color
*          call pgsci(ipen-3)
*mdc*endif
          call pgdraw(x,y)
c
      endif
c
      end
c
c-----------------------------------------------------------------------
c
      subroutine plot_line(n,xx,yy,ipen)
      integer n, ipen
      real xx(n), yy(n)
c
      if (ipen.eq.2) then
          call pgsls(1)
*mdc*if color
*          call pgsci(1)
*mdc*endif
c
      elseif (ipen.eq.5) then
c
          call pgsls(4)
*mdc*if color
*          call pgsci(3)
*mdc*endif
c
      elseif (ipen.gt.3) then
c
          call pgsls(ipen-1)
*mdc*if color
*          call pgsci(ipen-3)
*mdc*endif
c
      endif
c
      call pgline(n,xx,yy)
c
      end
c
c-----------------------------------------------------------------------
c
      integer function leng (string)
c
c.....leng - obtains the leng of the string, assuming that the blancs at
c     the end are dummy.
c
      character*(*)     string
      character*(1)     blank
      data blank /' '/
c
      do 10 i = len(string), 1, -1
         if (string(i:i) .ne. blank) then
            leng = i
            return
         endif
 10   continue
      leng = 0
      return
      end