COSMOS v7.655  COSMOSv7655
(AirShowerMC)
Functions/Subroutines
mnplot.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine mnplot (XPT, YPT, CHPT, NXYPT, NUNIT, NPAGWD, NPAGLN)
 

Function/Subroutine Documentation

◆ mnplot()

subroutine mnplot ( dimension(*)  XPT,
dimension(*)  YPT,
character*1, dimension(*)  CHPT,
  NXYPT,
  NUNIT,
  NPAGWD,
  NPAGLN 
)

Definition at line 10 of file mnplot.f.

References a, false, h, i, j, mnbins(), o, parameter(), true, and z.

Referenced by mncont(), mncros(), mnline(), and mnscan().

10 *
11 * $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
12 *
13 * $Log: d506dp.inc,v $
14 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
15 * Minuit
16 *
17 *
18 *
19 *
20 * d506dp.inc
21 *
22 C ************ DOUBLE PRECISION VERSION *************
23  IMPLICIT DOUBLE PRECISION (a-h,o-z)
24 CC plots points in array xypt onto one page with labelled axes
25 CC NXYPT is the number of points to be plotted
26 CC XPT(I) = x-coord. of ith point
27 CC YPT(I) = y-coord. of ith point
28 CC CHPT(I) = character to be plotted at this position
29 CC the input point arrays XPT, YPT, CHPT are destroyed.
30 CC
31  dimension xpt(*), ypt(*)
32  CHARACTER*1 chpt(*) , chsav, chbest, cdot, cslash, cblank
33  parameter(maxwid=100)
34  CHARACTER cline*100, chmess*30
35  dimension xvalus(12)
36  LOGICAL overpr
37  DATA cdot,cslash,cblank/ '.' , '/' , ' '/
38  maxnx = min(npagwd-20,maxwid)
39  IF (maxnx .LT. 10) maxnx = 10
40  maxny = npagln
41  IF (maxny .LT. 10) maxny = 10
42  IF (nxypt .LE. 1) RETURN
43  xbest = xpt(1)
44  ybest = ypt(1)
45  chbest = chpt(1)
46 C order the points by decreasing y
47  km1 = nxypt - 1
48  DO 150 i= 1, km1
49  iquit = 0
50  ni = nxypt - i
51  DO 140 j= 1, ni
52  IF (ypt(j) .GT. ypt(j+1)) GO TO 140
53  savx = xpt(j)
54  xpt(j) = xpt(j+1)
55  xpt(j+1) = savx
56  savy = ypt(j)
57  ypt(j) = ypt(j+1)
58  ypt(j+1) = savy
59  chsav = chpt(j)
60  chpt(j) = chpt(j+1)
61  chpt(j+1) = chsav
62  iquit = 1
63  140 CONTINUE
64  IF (iquit .EQ. 0) GO TO 160
65  150 CONTINUE
66  160 CONTINUE
67 C find extreme values
68  xmax = xpt(1)
69  xmin = xmax
70  DO 200 i= 1, nxypt
71  IF (xpt(i) .GT. xmax) xmax = xpt(i)
72  IF (xpt(i) .LT. xmin) xmin = xpt(i)
73  200 CONTINUE
74  dxx = 0.001*(xmax-xmin)
75  xmax = xmax + dxx
76  xmin = xmin - dxx
77  CALL mnbins(xmin,xmax,maxnx,xmin,xmax,nx,bwidx)
78  ymax = ypt(1)
79  ymin = ypt(nxypt)
80  IF (ymax .EQ. ymin) ymax=ymin+1.0
81  dyy = 0.001*(ymax-ymin)
82  ymax = ymax + dyy
83  ymin = ymin - dyy
84  CALL mnbins(ymin,ymax,maxny,ymin,ymax,ny,bwidy)
85  any = ny
86 C if first point is blank, it is an 'origin'
87  IF (chbest .EQ. cblank) GO TO 50
88  xbest = 0.5 * (xmax+xmin)
89  ybest = 0.5 * (ymax+ymin)
90  50 CONTINUE
91 C find scale constants
92  ax = 1.0/bwidx
93  ay = 1.0/bwidy
94  bx = -ax*xmin + 2.0
95  by = -ay*ymin - 2.0
96 C convert points to grid positions
97  DO 300 i= 1, nxypt
98  xpt(i) = ax*xpt(i) + bx
99  300 ypt(i) = any-ay*ypt(i) - by
100  nxbest = ax*xbest + bx
101  nybest = any - ay*ybest - by
102 C print the points
103  ny = ny + 2
104  nx = nx + 2
105  isp1 = 1
106  linodd = 1
107  overpr=.false.
108  DO 400 i= 1, ny
109  DO 310 ibk= 1, nx
110  310 cline(ibk:ibk) = cblank
111  cline(1:1) = cdot
112  cline(nx:nx) = cdot
113  cline(nxbest:nxbest) = cdot
114  IF (i.NE.1 .AND. i.NE.nybest .AND. i.NE.ny) GO TO 320
115  DO 315 j= 1, nx
116  315 cline(j:j) = cdot
117  320 CONTINUE
118  yprt = ymax - float(i-1)*bwidy
119  IF (isp1 .GT. nxypt) GO TO 350
120 C find the points to be plotted on this line
121  DO 341 k= isp1,nxypt
122  ks = ypt(k)
123  IF (ks .GT. i) GO TO 345
124  ix = xpt(k)
125  IF (cline(ix:ix) .EQ. cdot) GO TO 340
126  IF (cline(ix:ix) .EQ. cblank) GO TO 340
127  IF (cline(ix:ix) .EQ.chpt(k)) GO TO 341
128  overpr = .true.
129 C OVERPR is true if one or more positions contains more than
130 C one point
131  cline(ix:ix) = '&'
132  GO TO 341
133  340 cline(ix:ix) = chpt(k)
134  341 CONTINUE
135  isp1 = nxypt + 1
136  GO TO 350
137  345 isp1 = k
138  350 CONTINUE
139  IF (linodd .EQ. 1 .OR. i .EQ. ny) GO TO 380
140  linodd = 1
141  WRITE (nunit, '(18X,A)') cline(:nx)
142  GO TO 400
143  380 WRITE (nunit,'(1X,G14.7,A,A)') yprt, ' ..', cline(:nx)
144  linodd = 0
145  400 CONTINUE
146 C print labels on x-axis every ten columns
147  DO 410 ibk= 1, nx
148  cline(ibk:ibk) = cblank
149  IF (mod(ibk,10) .EQ. 1) cline(ibk:ibk) = cslash
150  410 CONTINUE
151  WRITE (nunit, '(18X,A)') cline(:nx)
152 C
153  DO 430 ibk= 1, 12
154  430 xvalus(ibk) = xmin + float(ibk-1)*10.*bwidx
155  iten = (nx+9) / 10
156  WRITE (nunit,'(12X,12G10.4)') (xvalus(ibk), ibk=1,iten)
157  chmess = ' '
158  IF (overpr) chmess=' Overprint character is &'
159  WRITE (nunit,'(25X,A,G13.7,A)') 'ONE COLUMN=',bwidx, chmess
160  500 RETURN
parameter
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
z
nodes z
Definition: cstdatmos0.fNew2.h:93
i
nodes i
Definition: cstdatmos0.fNew2.h:93
true
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon true
Definition: cblkElemag.h:7
nrl_atmos::h
real(4), dimension(:), allocatable, save h
Definition: cNRLAtmos.f:28
j
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
o
struct ob o[NpMax]
Definition: Zprivate.h:34
nrl_atmos::a
real(4), save a
Definition: cNRLAtmos.f:20
false
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon ! knockon is considered Obsolete *PhotoProd false
Definition: cblkElemag.h:7
mnbins
subroutine mnbins(A1, A2, NAA, BL, BH, NB, BWID)
Definition: mnbins.f:10
Here is the call graph for this function:
Here is the caller graph for this function: