da_scl_plotting_routines.inc
References to this file elsewhere.
1 subroutine plot_it(plt,num,k,varname,nx,ny,nt)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent(in) :: num,k,nx,ny,nt
10 real, dimension(nx,ny,nt), intent(inout) :: plt
11 character(len=7), intent(in) :: varname
12
13 real :: radius, value, xpb, xpe, ypb, ype
14
15 integer :: i, j, ib, jb, ie, je, m, n, mm, nn
16
17 real, dimension(nx,ny,nt) :: pltsqr
18
19 character(len=20) :: pltlab
20
21 ib=4
22 jb=6
23
24 ie=nx-4
25 je=ny-6
26
27 write(pltlab(1:20),fmt='(2a,i5)') &
28 varname(1:3), ' FOR MODE : ', k
29
30 write(unit=*, fmt='(a)') pltlab
31
32 call set(xwb,xwe,ywb,ywe,xwb,xwe,ywb,ywe,plot_style)
33
34 call gsplci(red)
35 call gspmci(red)
36 call gstxci(red)
37
38 call pwritx(xlb,ylb,pltlab,20,1,0,0)
39
40 xpb=0.0
41 xpe=sqrt(real((nx-1)*(nx-1)+(ny-1)*(ny-1)))
42
43 if (plot_switch > 0) then
44 call point_plot(plt,num,nx,ny,nt,ib,jb,ie,je, &
45 xpb,xpe,ypb,ype)
46 else
47 call line_plot(plt,num,nx,ny,nt,ib,jb,ie,je, &
48 xpb,xpe,ypb,ype)
49 end if
50
51 call gsplci(red)
52 call gspmci(red)
53 call gstxci(red)
54
55 call line(xpb,0.0,xpe,0.0)
56
57 call frame
58
59 end subroutine plot_it
60
61
62 subroutine point_plot(plt,num,nx,ny,nt,ib,jb,ie,je, &
63 xpb,xpe,ypb,ype)
64
65 implicit none
66
67 integer, intent(in) :: num,nx,ny,nt, &
68 ib,jb,ie,je
69 real, dimension(nx,ny,nt), intent(in) :: plt
70 real, intent(in) :: xpb,xpe
71 real, intent(out) :: ypb,ype
72
73
74 real :: radius, value
75
76 integer :: i, j, m, n, mm, nn
77
78 real, dimension(nx,ny,nt) :: pltsqr
79
80 character(len=1), parameter :: symbol='.'
81
82 do n=1,num
83 do j=1,ny
84 do i=1,nx
85 pltsqr(i,j,n)=plt(i,j,n)*plt(i,j,n)
86 end do
87 end do
88 end do
89
90 ype=maxval(pltsqr(ib:ie, jb:je, 1:num))*1.25
91 ypb=-ype
92
93 if (abs(ype - ypb) < 1.0e-5) then
94 call frame
95 call da_error(__FILE__,__LINE,(/'ype - ypb is too small.'/))
96 end if
97
98 call set(xfb,xfe,yfb,yfe,xpb,xpe,ypb,ype,plot_style)
99
100 call line(xpb,ypb,xpe,ypb)
101
102 call line(xpb,ypb,xpb,ype)
103
104 i=int(xpe) + 1
105 j=2
106
107 m=int(ype-ypb) + 1
108 n=m/10
109
110 ! call perim(i,j,m,m)
111
112 value = ypb+0.02*(ype-ypb)
113
114 do m=2,i,2
115 radius=real(m)
116 call line(radius,ypb,radius,value)
117 end do
118
119 call gsplci(blue)
120 call gspmci(blue)
121 call gstxci(blue)
122
123 do j=jb,je,2
124 do i=ib,ie,2
125 do n=j,je,2
126 do m=i,ie,2
127 radius=sqrt(real((m-i)*(m-i)+(n-j)*(n-j)))
128
129 do nn=1,num
130 value=plt(m,n,nn)*plt(i,j,nn)
131
132 call pwritx(radius,value,symbol,1,1,0,0)
133 end do
134 end do
135 end do
136 end do
137 end do
138
139 end subroutine point_plot
140
141
142 subroutine line_plot(plt,num,nx,ny,nt,ib,jb,ie,je, &
143 xpb,xpe,ypb,ype)
144
145 implicit none
146
147 integer, intent(in) :: num,nx,ny,nt, &
148 ib,jb,ie,je
149 real, dimension(nx,ny,nt), intent(in) :: plt
150 real, intent(in) :: xpb,xpe
151 real, intent(out) :: ypb,ype
152
153 real, dimension(nx+ny) :: avg, sum
154
155 real :: radius, value
156
157 integer :: i, j, m, n, mm, nn
158
159
160 sum = 0.0
161 avg = 0.0
162
163
164 do j=jb,je
165 do i=ib,ie
166 do n=j,je
167 do m=i,ie
168 radius=sqrt(real((m-i)*(m-i)+(n-j)*(n-j)))
169 mm=int(radius+0.5) + 1
170
171 do nn=1,num
172 value=plt(m,n,nn)*plt(i,j,nn)
173
174 avg(mm)=avg(mm)+value
175 sum(mm)=sum(mm)+1.0
176 end do
177 end do
178 end do
179 end do
180 end do
181
182 n = 0
183
184 do i=1,nx+ny
185 if (sum(i) < 0.5) exit
186
187 avg(i)=avg(i)/sum(i)
188 n=i
189 end do
190
191 ypb=minval(avg)*1.25
192 ype=maxval(avg)*1.25
193
194 call set(xfb,xfe,yfb,yfe,xpb,xpe,ypb,ype,plot_style)
195
196 call line(xpb,ypb,xpe,ypb)
197
198 call line(xpb,ypb,xpb,ype)
199
200 i=int(xpe) + 1
201 j=2
202
203 m=int(ype-ypb) + 1
204 n=m/10
205
206 value = ypb+0.02*(ype-ypb)
207
208 do m=2,i,2
209 radius=real(m)
210 call line(radius,ypb,radius,value)
211 end do
212
213 call gsplci(blue)
214 call gspmci(blue)
215 call gstxci(blue)
216
217 do i=2,nx+ny
218 if (sum(i) < 0.5) exit
219
220 call line(real(i-2), avg(i-1), real(i-1), avg(i))
221 end do
222
223 end subroutine line_plot
224
225
226 subroutine plot_sl(yr,r,nm,nn,slnt,cnst,k,varname)
227
228 implicit none
229
230 integer, intent(in) :: nm,nn,k
231 real(kind=8), dimension(0:nn), intent(in) :: yr,r
232 real(kind=8), intent(in) :: slnt,cnst
233 character(len=7), intent(in) :: varname
234
235 real :: x,y,xpb,xpe,ypb,ype
236
237 integer :: i
238
239 character(len=1), parameter :: symbol='.'
240 character(len=9) :: label
241
242 call set(xwb,xwe,ywb,ywe,xwb,xwe,ywb,ywe,plot_style)
243
244 call gsplci(red)
245 call gspmci(red)
246 call gstxci(red)
247
248 write(label(1:9), fmt='(2a, i3)') varname(1:3), ' M=', k
249
250 call pwritx(xlb,ylb,label,9,1,0,0)
251
252 xpb=0.0
253 xpe=r(nm)*1.05
254
255 write(unit=*, fmt='(a, i5, f18.8)') &
256 'nm,r(nm)=', nm,r(nm)
257
258 ype=maxval(yr(0:nm))*1.05
259 ypb=0.0
260
261
262 write(unit=*, fmt='(a, 2f18.8)') &
263 'xpe,ype=',xpe,ype
264
265 call set(xfb,xfe,yfb,yfe,xpb,xpe,ypb,ype,plot_style)
266
267 call line(xpb,ypb,xpe,ypb)
268
269 call line(xpb,ypb,xpb,ype)
270
271 y = ypb+0.02*(ype-ypb)
272
273 do i=2,nm,2
274 x=real(i)
275 call line(x,ypb,x,y)
276 end do
277
278 x = xpb+0.02*(xpe-xpb)
279
280 y=0.0
281
282 do
283 y=y+1.0
284 if (y > ype) exit
285 call line(xpb,y,x,y)
286 end do
287
288 call gsplci(blue)
289 call gspmci(blue)
290 call gstxci(blue)
291
292 do i=1,nm
293 x= r(i)
294 y=yr(i)
295 call pwritx(x,y,symbol,1,1,0,0)
296
297 write(unit=*, fmt='(a,i3,2(f8.4,f18.8))') &
298 'i,x,y,r,yr=',i,x,y,r(i),yr(i)
299 end do
300
301 xpb=0.0
302 ypb=cnst
303
304 do i=1,nm
305 x=real(i)
306 y=slnt*x+cnst
307
308 if (y > ype) exit
309
310 call line(xpb,ypb,x,y)
311
312 xpb=x
313 ypb=y
314 end do
315
316 call frame
317
318 end subroutine plot_sl
319
320