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

Go to the source code of this file.

Functions/Subroutines

subroutine mnscan (FCN, FUTIL)
 

Function/Subroutine Documentation

◆ mnscan()

subroutine mnscan ( external  FCN,
external  FUTIL 
)

Definition at line 25 of file mnscan.f.

References a, b, c, d, e, f, g, h, softenpik::half, i, j, m, maxp, mnamin(), mnbins(), mnexin(), mnplot(), mnprin(), n, o, p, parameter(), up(), x, xs, and z.

Referenced by mnexcm().

25 *
26 * $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
27 *
28 * $Log: d506dp.inc,v $
29 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
30 * Minuit
31 *
32 *
33 *
34 *
35 * d506dp.inc
36 *
37 C ************ DOUBLE PRECISION VERSION *************
38  IMPLICIT DOUBLE PRECISION (a-h,o-z)
39 CC Scans the values of FCN as a function of one parameter
40 CC and plots the resulting values as a curve using MNPLOT.
41 CC It may be called to scan one parameter or all parameters.
42 CC retains the best function and parameter values found.
43 *
44 * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
45 *
46 * $Log: d506cm.inc,v $
47 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
48 * Minuit
49 *
50 *
51 *
52 *
53 * d506cm.inc
54 *
55  parameter(mne=100 , mni=50)
56  parameter(mnihl=mni*(mni+1)/2)
57  CHARACTER*10 cpnam
58  COMMON
59  1/mn7nam/ cpnam(mne)
60  2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
61  3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
62  4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
63  5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
64  6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
65  7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
66  8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
67  9/mn7fx1/ ipfix(mni) ,npfix
68  a/mn7var/ vhmat(mnihl)
69  b/mn7vat/ vthmat(mnihl)
70  c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
71 C
72  parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
73  parameter(zero=0.0, one=1.0, half=0.5)
74  COMMON
75  d/mn7npr/ maxint ,npar ,maxext ,nu
76  e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
77  e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
78  f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
79  g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
80  h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
81  i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
82  j/mn7arg/ word7(maxp)
83  k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
84  l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
85  m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
86  n/mn7cpt/ chpt(maxcpt)
87  o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
88  CHARACTER ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
89  + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
90  LOGICAL lwarn, lrepor, limset, lnolim, lnewmn, lphead
91  EXTERNAL fcn,futil
92  xlreq = min(word7(3),word7(4))
93  xhreq = max(word7(3),word7(4))
94  ncall = word7(2) + 0.01
95  IF (ncall .LE. 1) ncall = 41
96  IF (ncall .GT. maxcpt) ncall = maxcpt
97  nccall = ncall
98  IF (amin .EQ. undefi) CALL mnamin(fcn,futil)
99  iparwd = word7(1) + 0.1
100  ipar = max(iparwd, 0)
101  iint = niofex(ipar)
102  cstatu = 'NO CHANGE'
103  IF (iparwd .GT. 0) GO TO 200
104 C
105 C equivalent to a loop over parameters requested
106  100 ipar = ipar + 1
107  IF (ipar .GT. nu) GO TO 900
108  iint = niofex(ipar)
109  IF (iint .LE. 0) GO TO 100
110 C set up range for parameter IPAR
111  200 CONTINUE
112  ubest = u(ipar)
113  xpt(1) = ubest
114  ypt(1) = amin
115  chpt(1)= ' '
116  xpt(2) = ubest
117  ypt(2) = amin
118  chpt(2)= 'X'
119  nxypt = 2
120  IF (nvarl(ipar) .GT. 1) GO TO 300
121 C no limits on parameter
122  IF (xlreq .EQ. xhreq) GO TO 250
123  unext = xlreq
124  step = (xhreq-xlreq)/float(ncall-1)
125  GO TO 500
126  250 CONTINUE
127  xl = ubest - werr(iint)
128  xh = ubest+ werr(iint)
129  CALL mnbins(xl,xh,ncall, unext,uhigh,nbins,step)
130  nccall = nbins + 1
131  GO TO 500
132 C limits on parameter
133  300 CONTINUE
134  IF (xlreq .EQ. xhreq) GO TO 350
135  xl = max(xlreq,alim(ipar))
136  xh = min(xhreq,blim(ipar))
137  IF (xl .GE. xh) GO TO 700
138  unext = xl
139  step = (xh-xl)/float(ncall-1)
140  GO TO 500
141  350 CONTINUE
142  unext = alim(ipar)
143  step = (blim(ipar)-alim(ipar))/float(ncall-1)
144 C main scanning loop over parameter IPAR
145  500 CONTINUE
146  DO 600 icall = 1, nccall
147  u(ipar) = unext
148  nparx = npar
149  CALL fcn(nparx,gin,fnext,u,4,futil)
150  nfcn = nfcn + 1
151  nxypt = nxypt + 1
152  xpt(nxypt) = unext
153  ypt(nxypt) = fnext
154  chpt(nxypt) = '*'
155  IF (fnext .LT. amin) THEN
156  amin = fnext
157  ubest = unext
158  cstatu= 'IMPROVED '
159  ENDIF
160  530 CONTINUE
161  unext = unext + step
162  600 CONTINUE
163 C finished with scan of parameter IPAR
164  u(ipar) = ubest
165  CALL mnexin(x)
166  IF (isw(5) .GE. 1) THEN
167  WRITE (isyswr,1001) newpag,ipar,cpnam(ipar)
168  nunit = isyswr
169  CALL mnplot(xpt,ypt,chpt,nxypt,nunit,npagwd,npagln)
170  ENDIF
171  GO TO 800
172  700 CONTINUE
173  WRITE (isyswr,1000) ipar
174  800 CONTINUE
175  IF (iparwd .LE. 0) GO TO 100
176 C finished with all parameters
177  900 CONTINUE
178  IF (isw(5) .GE. 0) CALL mnprin(5,amin)
179  RETURN
180  1000 FORMAT (46h requested range outside limits for PARAMETER ,i3/)
181  1001 FORMAT (i1,'SCAN OF PARAMETER NO.',i3,3h, ,a10)
parameter
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
z
nodes z
Definition: cstdatmos0.fNew2.h:93
up
block data include Zlatfit h c fitting region data data data data data d0 data data d0 data data h g *is for param c g data up(2, 1)/7.0d0/
e
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
i
nodes i
Definition: cstdatmos0.fNew2.h:93
nrl_atmos::h
real(4), dimension(:), allocatable, save h
Definition: cNRLAtmos.f:28
mnprin
subroutine mnprin(INKODE, FVAL)
Definition: mnprin.f:10
xs
! constants thru Cosmos real ! if multiplied to deg radian Torad ! light velocity m sec ! infinty ! kg m2 *Togpcm2 g cm2 ! g cm2 *Tokgpm2 kg m2 ! cm *Tom m ! m *Tocm cm ! g cm3 *Tokgpm3 kg m3 ! kg m3 *Togpcm3 g cm3 ! sec *Tonsec nsec ! Tesla m ! Avogadro *A2deninv ! mfp *n * xs
Definition: Zglobalc.h:18
mnamin
subroutine mnamin(FCN, FUTIL)
Definition: mnamin.f:10
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
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
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
m
block data include Zlatfit h c fitting region data data data data data d0 data data d0 data data m
Definition: ZlatfitBD.h:35
nrl_atmos::a
real(4), save a
Definition: cNRLAtmos.f:20
g
dE dx *! Nuc Int sampling table g
Definition: cblkMuInt.h:130
mnbins
subroutine mnbins(A1, A2, NAA, BL, BH, NB, BWID)
Definition: mnbins.f:10
nrl_atmos::b
real(4), save b
Definition: cNRLAtmos.f:21
maxp
!onst int maxp
Definition: Zprivate.h:3
mnexin
subroutine mnexin(PINT)
Definition: mnexin.f:10
n
integer n
Definition: Zcinippxc.h:1
softenpik::half
integer, parameter half
Definition: csoftenPiK.f:108
mnplot
subroutine mnplot(XPT, YPT, CHPT, NXYPT, NUNIT, NPAGWD, NPAGLN)
Definition: mnplot.f:10
x
! structure defining a particle at production ! Basic idea of what is to be contained in ! the particle structue is that dynamical ones should be included those derivable from the particle code ! is not included ******************************************************type fmom momentum sequence union map real e endmap map real * x
Definition: Zptcl.h:21
f
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130
Here is the call graph for this function:
Here is the caller graph for this function: