| 1 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
|---|
| 2 | c graphic part not use in Orsay * |
|---|
| 3 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
|---|
| 4 | subroutine ggplot (i,option,core,m,ngood,ns) |
|---|
| 5 | c----------------------------------------------------------------------- |
|---|
| 6 | c |
|---|
| 7 | include 'param_sz.h' |
|---|
| 8 | include 'ucom.h' |
|---|
| 9 | c |
|---|
| 10 | common/com1/scale(10),ws,ps,zs,bgs,wts,ntape |
|---|
| 11 | common/outbuf/tcor(8,imaa*imb) |
|---|
| 12 | character*10 label(6) |
|---|
| 13 | real x(2,imaa),y(2,imaa) |
|---|
| 14 | dimension core(m,imaa), scl(4), it(2) |
|---|
| 15 | dimension xb(2),yb(2),xsq(2),ysq(2),xy(2),a(2),b(2),e(2) |
|---|
| 16 | equivalence (tcor(1,(imb-1)*imaa+1),x(1,1)) |
|---|
| 17 | equivalence (tcor(1,(imb-1)*imaa+imaa/2),y(1,1)) |
|---|
| 18 | c-------------------------------------------------------------------------- |
|---|
| 19 | c* |
|---|
| 20 | data label /'x-xprime ','y-yprime ','phi-w ','z-zprime ' |
|---|
| 21 | 1 ,'x-y ','no plot '/ |
|---|
| 22 | do 2 n=1,2 |
|---|
| 23 | xb(n)=0. |
|---|
| 24 | yb(n)=0. |
|---|
| 25 | xy(n)=0. |
|---|
| 26 | xsq(n)=0. |
|---|
| 27 | ysq(n)=0. |
|---|
| 28 | a(n)=0. |
|---|
| 29 | b(n)=0. |
|---|
| 30 | 2 e(n)=0. |
|---|
| 31 | nc=i |
|---|
| 32 | k=ns-1 |
|---|
| 33 | do 5 n=1,4 |
|---|
| 34 | k=k+1 |
|---|
| 35 | 5 scl(n)=scale(k) |
|---|
| 36 | if (nc.eq.0) nc=amod(wts,360.) |
|---|
| 37 | it(1)=option/10.0 |
|---|
| 38 | if (it(1).eq.0) it(1)=6 |
|---|
| 39 | it(2)=option-it(1)*10 |
|---|
| 40 | if (it(2).eq.0) it(2)=6 |
|---|
| 41 | do 130 n=1,2 |
|---|
| 42 | itype=it(n) |
|---|
| 43 | if (itype.le.0) go to 110 |
|---|
| 44 | go to (10,30,50,50,90), itype |
|---|
| 45 | c x-xp space |
|---|
| 46 | 10 do 20 np=1,ngood |
|---|
| 47 | x(n,np)=core(1,np) |
|---|
| 48 | y(n,np)=core(2,np) |
|---|
| 49 | if (i.eq.0) y(n,np)=y(n,np)/core(6,np) |
|---|
| 50 | 20 continue |
|---|
| 51 | go to 130 |
|---|
| 52 | c y-yp space |
|---|
| 53 | 30 do 40 np=1,ngood |
|---|
| 54 | x(n,np)=core(3,np) |
|---|
| 55 | y(n,np)=core(4,np) |
|---|
| 56 | if (i.eq.0) y(n,np)=y(n,np)/core(6,np) |
|---|
| 57 | 40 continue |
|---|
| 58 | go to 130 |
|---|
| 59 | 50 if (i.eq.0) go to 70 |
|---|
| 60 | c phi-w space |
|---|
| 61 | do 60 np=1,ngood |
|---|
| 62 | x(n,np)=core(5,np)-ps |
|---|
| 63 | 60 y(n,np)=core(6,np)-ws |
|---|
| 64 | it(n)=3 |
|---|
| 65 | go to 130 |
|---|
| 66 | c z-zp space |
|---|
| 67 | 70 do 80 np=1,ngood |
|---|
| 68 | x(n,np)=core(5,np)-zs |
|---|
| 69 | 80 y(n,np)=core(6,np)/bgs - 1. |
|---|
| 70 | it(n)=4 |
|---|
| 71 | go to 130 |
|---|
| 72 | c x-y space |
|---|
| 73 | 90 do 100 np=1,ngood |
|---|
| 74 | x(n,np)=core(1,np) |
|---|
| 75 | 100 y(n,np)=core(3,np) |
|---|
| 76 | go to 130 |
|---|
| 77 | c no graph |
|---|
| 78 | 110 do 120 np=1,ngood |
|---|
| 79 | x(n,np)=0.0 |
|---|
| 80 | 120 y(n,np)=0.0 |
|---|
| 81 | 130 continue |
|---|
| 82 | fng=ngood |
|---|
| 83 | do 135 n=1,2 |
|---|
| 84 | do 133 np=1,ngood |
|---|
| 85 | xb(n)=xb(n)+x(n,np) |
|---|
| 86 | yb(n)=yb(n)+y(n,np) |
|---|
| 87 | xy(n)=xy(n)+x(n,np)*y(n,np) |
|---|
| 88 | xsq(n)=xsq(n)+x(n,np)**2 |
|---|
| 89 | 133 ysq(n)=ysq(n)+y(n,np)**2 |
|---|
| 90 | xb(n)=xb(n)/fng |
|---|
| 91 | yb(n)=yb(n)/fng |
|---|
| 92 | xy(n)=xy(n)/fng - xb(n)*yb(n) |
|---|
| 93 | xsq(n)=xsq(n)/fng-xb(n)**2 |
|---|
| 94 | ysq(n)=ysq(n)/fng-yb(n)**2 |
|---|
| 95 | if(xsq(n)*ysq(n).le.0.)go to 135 |
|---|
| 96 | e(n)=sqrt(xsq(n)*ysq(n)-xy(n)**2) |
|---|
| 97 | a(n)=-xy(n)/e(n) |
|---|
| 98 | if(it(n).le.3)e(n)=1000.*e(n) |
|---|
| 99 | b(n)=xsq(n)/e(n) |
|---|
| 100 | if(it(n).le.2)e(n)=e(n)*bgs |
|---|
| 101 | 135 continue |
|---|
| 102 | it1=it(1) |
|---|
| 103 | it2=it(2) |
|---|
| 104 | write(ntape,140)label(it1),scl(1),scl(2),zs,ngood,label(it2), |
|---|
| 105 | 1 scl(3),scl(4) |
|---|
| 106 | call ttyplot (x,y,ngood,scl,ntape) |
|---|
| 107 | write(ntape,150) a(1),b(1),e(1),a(2),b(2),e(2) |
|---|
| 108 | return |
|---|
| 109 | c |
|---|
| 110 | 140 format (/,1x,a10,f7.3,' x',f6.3,' zr=',f7.1,' ngood=',i4, |
|---|
| 111 | * 1x,a10,f7.3,' x',f6.3) |
|---|
| 112 | 150 format (10x,'alpha',6x,'beta',6x,'erms',15x,'alpha',6x,'beta', |
|---|
| 113 | 1 6x,'erms'/5x,3f10.3,10x,3f10.3) |
|---|
| 114 | end |
|---|
| 115 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
|---|
| 116 | subroutine ttyplot (x,y,np,scale,ntape) |
|---|
| 117 | c generate 2 plots on tape ntape |
|---|
| 118 | include 'param_sz.h' |
|---|
| 119 | include 'ucom.h' |
|---|
| 120 | c |
|---|
| 121 | character*1 aline |
|---|
| 122 | dimension x(2,imaa), y(2,imaa), scale(4), iword(39,2,25), |
|---|
| 123 | 1 aline(80) |
|---|
| 124 | c-------------------------------------------------------------------------- |
|---|
| 125 | c* |
|---|
| 126 | do 10 n=1,25 |
|---|
| 127 | do 10 j=1,39 |
|---|
| 128 | iword(j,1,n)=0 |
|---|
| 129 | iword(j,2,n)=0 |
|---|
| 130 | 10 continue |
|---|
| 131 | c load first plot |
|---|
| 132 | dx=scale(1)/18.0 |
|---|
| 133 | dy=scale(2)/12.0 |
|---|
| 134 | do 20 n=1,np |
|---|
| 135 | nv=13.5-y(1,n)/dy |
|---|
| 136 | if (nv.le.0) go to 20 |
|---|
| 137 | if (nv.gt.25) go to 20 |
|---|
| 138 | nh=20.5+x(1,n)/dx |
|---|
| 139 | if (nh.gt.39) go to 20 |
|---|
| 140 | if (nh.le.0) go to 20 |
|---|
| 141 | iword(nh,1,nv)=1 |
|---|
| 142 | 20 continue |
|---|
| 143 | c load second plot |
|---|
| 144 | dx=scale(3)/18.0 |
|---|
| 145 | dy=scale(4)/12.0 |
|---|
| 146 | do 30 n=1,np |
|---|
| 147 | nv=13.5-y(2,n)/dy |
|---|
| 148 | if (nv.le.0) go to 30 |
|---|
| 149 | if (nv.gt.25) go to 30 |
|---|
| 150 | nh=20.5+x(2,n)/dx |
|---|
| 151 | if (nh.le.0) go to 30 |
|---|
| 152 | if (nh.gt.39) go to 30 |
|---|
| 153 | iword(nh,2,nv)=1 |
|---|
| 154 | 30 continue |
|---|
| 155 | do 40 n=1,25 |
|---|
| 156 | m=0 |
|---|
| 157 | if (n.eq.1) m=1 |
|---|
| 158 | if (n.eq.13) m=1 |
|---|
| 159 | if (n.eq.25) m=1 |
|---|
| 160 | call ttyline (iword(1,1,n),m,aline,0) |
|---|
| 161 | write(ntape,50) aline |
|---|
| 162 | 40 continue |
|---|
| 163 | return |
|---|
| 164 | c |
|---|
| 165 | 50 format (80a1) |
|---|
| 166 | end |
|---|
| 167 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
|---|
| 168 | subroutine pplot (i,option,core,m,ngood) |
|---|
| 169 | c |
|---|
| 170 | include 'param_sz.h' |
|---|
| 171 | include 'ucom.h' |
|---|
| 172 | c |
|---|
| 173 | c generate 2 profile or distribution function plots on the tty |
|---|
| 174 | c common/blcom1/x,y |
|---|
| 175 | common/com1/scale(10),ws,ps,zs,bgs,wts,ntape |
|---|
| 176 | common/outbuf/tcor(8,imaa*imb) |
|---|
| 177 | character*10 label(11) |
|---|
| 178 | real x(2,imaa),y(2,imaa) |
|---|
| 179 | dimension core(m,imaa), scl(4),it(2) |
|---|
| 180 | equivalence (tcor(1,(imb-1)*imaa+1),x(1,1)) |
|---|
| 181 | equivalence (tcor(1,(imb-1)*imaa+imaa/2),y(1,1)) |
|---|
| 182 | c-------------------------------------------------------------------------- |
|---|
| 183 | c* |
|---|
| 184 | data label /'x profile ','xp profile','y profile ', |
|---|
| 185 | 1'yp profile','p profile ','w profile ','r profile ', |
|---|
| 186 | 2'rp profile','no profile','z profile ','zp profile'/ |
|---|
| 187 | opt=abs(option) |
|---|
| 188 | itype=opt/10.0 |
|---|
| 189 | nc=i |
|---|
| 190 | scl(1)=scale(5) |
|---|
| 191 | scl(3)=scale(6) |
|---|
| 192 | if(nc.eq.0)nc=amod(wts,360.) |
|---|
| 193 | do 110 n=1,2 |
|---|
| 194 | nn=2*n-1 |
|---|
| 195 | it(n)=itype |
|---|
| 196 | if (itype.le.0) go to 90 |
|---|
| 197 | go to (10,25,10,25,30,50,70,70,90), itype |
|---|
| 198 | c x or y |
|---|
| 199 | 10 do 20 np=1,ngood |
|---|
| 200 | 20 x(n,np)=core(itype,np) |
|---|
| 201 | go to 110 |
|---|
| 202 | c xp or yp |
|---|
| 203 | 25 if (i.ne.0)go to 10 |
|---|
| 204 | do 26 np=1,ngood |
|---|
| 205 | 26 x(n,np)=core(itype,np)/core(6,np) |
|---|
| 206 | go to 110 |
|---|
| 207 | 30 if (i.eq.0) go to 45 |
|---|
| 208 | c p-ps |
|---|
| 209 | do 40 np=1,ngood |
|---|
| 210 | 40 x(n,np)=core(5,np)-ps |
|---|
| 211 | go to 110 |
|---|
| 212 | c z-zs |
|---|
| 213 | 45 do 46 np=1,ngood |
|---|
| 214 | 46 x(n,np)=core(5,np)-zs |
|---|
| 215 | it(n)=10 |
|---|
| 216 | go to 110 |
|---|
| 217 | 50 if (i.eq.0) go to 65 |
|---|
| 218 | c w-ws |
|---|
| 219 | do 60 np=1,ngood |
|---|
| 220 | 60 x(n,np)=core(6,np)-ws |
|---|
| 221 | go to 110 |
|---|
| 222 | c zp |
|---|
| 223 | 65 do 66 np=1,ngood |
|---|
| 224 | 66 x(n,np)=core(6,np)/bgs-1. |
|---|
| 225 | it(n)=11 |
|---|
| 226 | go to 110 |
|---|
| 227 | c r or rp |
|---|
| 228 | 70 do 80 np=1,ngood |
|---|
| 229 | x(n,np)=sqrt(core(1,np)**2+core(3,np)**2) |
|---|
| 230 | if (itype.ne.8) go to 80 |
|---|
| 231 | if (x(n,np).ne.0.0) x(n,np)=(core(1,np)*core(2,np)+core(3,np)*core |
|---|
| 232 | 1 (4,np))/x(n,np) |
|---|
| 233 | if (x(n,np).eq.0.0) x(n,np)=sqrt(core(2,np)**2+core(4,np)**2) |
|---|
| 234 | 80 continue |
|---|
| 235 | go to 110 |
|---|
| 236 | c no graph |
|---|
| 237 | 90 do 100 np=1,ngood |
|---|
| 238 | 100 x(n,np)=0.0 |
|---|
| 239 | 110 itype=opt-itype*10 |
|---|
| 240 | if(option.lt.0.)go to 170 |
|---|
| 241 | do 130 n=1,2 |
|---|
| 242 | nn=2*n-1 |
|---|
| 243 | dx=scl(nn)/18. |
|---|
| 244 | xmax=19.*dx |
|---|
| 245 | call pdist(ngood,x(n,1),xmax,39,y(n,1)) |
|---|
| 246 | ymax=0. |
|---|
| 247 | do 120 j=1,38 |
|---|
| 248 | y(n,j)=y(n,j+1)-y(n,j) |
|---|
| 249 | if(y(n,j).gt.ymax)ymax=y(n,j) |
|---|
| 250 | 120 continue |
|---|
| 251 | scl(nn+1)=.005 |
|---|
| 252 | if(ymax.gt.0.01)scl(nn+1)=.02 |
|---|
| 253 | if(ymax.gt.0.02)scl(nn+1)=.04 |
|---|
| 254 | if(ymax.gt.0.04)scl(nn+1)=.10 |
|---|
| 255 | if(ymax.gt.0.10)scl(nn+1)=.20 |
|---|
| 256 | if(ymax.gt.0.20)scl(nn+1)=.40 |
|---|
| 257 | if(ymax.gt.0.40)scl(nn+1)=1.0 |
|---|
| 258 | do 125 j=1,37 |
|---|
| 259 | x(n,j)=(j-1)*dx-scl(nn) |
|---|
| 260 | 125 y(n,j)=y(n,j)-.5*scl(nn+1) |
|---|
| 261 | 130 continue |
|---|
| 262 | it1=it(1) |
|---|
| 263 | it2=it(2) |
|---|
| 264 | write(ntape,140) label(it1),scl(1),scl(2),zs,ngood, |
|---|
| 265 | * label(it2),scl(3),scl(4) |
|---|
| 266 | scl(2)=.5*scl(2) |
|---|
| 267 | scl(4)=.5*scl(4) |
|---|
| 268 | 140 format(1x,a10,f8.3,' x ',f4.2,' zs=',f7.1,' ngood=',i4,1x,a10, |
|---|
| 269 | * f8.3,' x ',f4.2) |
|---|
| 270 | call ttyplot(x,y,37,scl,ntape) |
|---|
| 271 | return |
|---|
| 272 | c plot distribution functions |
|---|
| 273 | 170 do 190 n=1,2 |
|---|
| 274 | nn=2*n-1 |
|---|
| 275 | scl(nn+1)=.5 |
|---|
| 276 | call pdist(ngood,x(n,1),scl(nn),37,y(n,1)) |
|---|
| 277 | dx=scl(nn)/18. |
|---|
| 278 | do 180 j=1,37 |
|---|
| 279 | x(n,j)=(j-1)*dx-scl(nn) |
|---|
| 280 | 180 y(n,j)=y(n,j)-.5 |
|---|
| 281 | 190 continue |
|---|
| 282 | it1=it(1) |
|---|
| 283 | it2=it(2) |
|---|
| 284 | write(ntape,160) label(it1),scl(1),zs,ngood,label(it2),scl(3) |
|---|
| 285 | call ttyplot(x,y,37,scl,ntape) |
|---|
| 286 | return |
|---|
| 287 | c |
|---|
| 288 | 150 format (8a10) |
|---|
| 289 | 160 format (5x,a10,4x,f8.3,' zs=',f7.1,' ngood=',i4, 2x,a10,4x,f8.3) |
|---|
| 290 | end |
|---|
| 291 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
|---|
| 292 | subroutine ttyline (ib,m,line,nc) |
|---|
| 293 | c produce an 80-character line for plotting on tty |
|---|
| 294 | c if m.ne.0, fill line with minus signs for horizontal border |
|---|
| 295 | c |
|---|
| 296 | c include 'param_sz.h' |
|---|
| 297 | c include 'ucom.h' |
|---|
| 298 | c |
|---|
| 299 | character*1 line(80) |
|---|
| 300 | character*1 minus ,iast ,iblnk ,ii,ichar |
|---|
| 301 | include 'param_sz.h' |
|---|
| 302 | include 'ucom.h' |
|---|
| 303 | dimension ib(39,2) |
|---|
| 304 | c----------------------------------------------------------------------- |
|---|
| 305 | c* |
|---|
| 306 | data minus /'-'/, iast /'*'/ |
|---|
| 307 | data iblnk /' '/, ii /'i'/ |
|---|
| 308 | c set leading blanks |
|---|
| 309 | line(1)=iblnk |
|---|
| 310 | line(41)=iblnk |
|---|
| 311 | do 50 j=1,2 |
|---|
| 312 | do 40 k=2,40 |
|---|
| 313 | ij=k+40*(j-1) |
|---|
| 314 | c make ichar blank, minus, or i |
|---|
| 315 | ichar=iblnk |
|---|
| 316 | if (m.eq.0) go to 20 |
|---|
| 317 | if (k.ne.2.and.k.ne.40) ichar=minus |
|---|
| 318 | 20 continue |
|---|
| 319 | if (k.eq.3 .or. k.eq.21 .or. k.eq.39) ichar=ii |
|---|
| 320 | c if sign bit of mask is set, plot an asterisk |
|---|
| 321 | if (ib(k-1,j).ne.0) ichar=iast |
|---|
| 322 | line(ij)=ichar |
|---|
| 323 | 40 continue |
|---|
| 324 | 50 continue |
|---|
| 325 | if (nc.eq.0) return |
|---|
| 326 | ihun=nc/100 |
|---|
| 327 | ibal=nc-(ihun*100) |
|---|
| 328 | iten=ibal/10 |
|---|
| 329 | ibal=ibal-(10*iten) |
|---|
| 330 | c encode (2,60,line(41)) iten |
|---|
| 331 | write(line(41),60)iten |
|---|
| 332 | c encode (2,60,line(42)) ibal |
|---|
| 333 | write(line(42),60)ibal |
|---|
| 334 | if (ihun.eq.0) return |
|---|
| 335 | c encode (1,60,line(40)) ihun |
|---|
| 336 | write(line(40),60)ihun |
|---|
| 337 | return |
|---|
| 338 | c |
|---|
| 339 | 60 format (i1) |
|---|
| 340 | end |
|---|
![(please configure the [header_logo] section in trac.ini)](/PSPA/chrome/site/pspa.gif)
