COSMOS v7.655  COSMOSv7655
(AirShowerMC)
mnlims.f
Go to the documentation of this file.
1 *
2 * $Id: mnlims.F,v 1.2 1996/03/15 18:02:48 james Exp $
3 *
4 * $Log: mnlims.F,v $
5 * Revision 1.2 1996/03/15 18:02:48 james
6 * Modified Files:
7 * mnderi.F eliminate possible division by zero
8 * mnexcm.F suppress print on STOP when print flag=-1
9 * set FVAL3 to flag if FCN already called with IFLAG=3
10 * mninit.F set version 96.03
11 * mnlims.F remove arguments, not needed
12 * mnmigr.F VLEN -> LENV in debug print statement
13 * mnparm.F move call to MNRSET to after NPAR redefined, to zero all
14 * mnpsdf.F eliminate possible division by zero
15 * mnscan.F suppress printout when print flag =-1
16 * mnset.F remove arguments in call to MNLIMS
17 * mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
18 * mnvert.F eliminate possible division by zero
19 *
20 * Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
21 * Minuit
22 *
23 *
24  SUBROUTINE mnlims
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 Called from MNSET
40 CC Interprets the SET LIM command, to reset the parameter limits
41 CC
42 *
43 * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
44 *
45 * $Log: d506cm.inc,v $
46 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
47 * Minuit
48 *
49 *
50 *
51 *
52 * d506cm.inc
53 *
54  parameter(mne=100 , mni=50)
55  parameter(mnihl=mni*(mni+1)/2)
56  CHARACTER*10 CPNAM
57  COMMON
58  1/mn7nam/ cpnam(mne)
59  2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
60  3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
61  4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
62  5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
63  6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
64  7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
65  8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
66  9/mn7fx1/ ipfix(mni) ,npfix
67  a/mn7var/ vhmat(mnihl)
68  b/mn7vat/ vthmat(mnihl)
69  c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
70 C
71  parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
72  parameter(zero=0.0, one=1.0, half=0.5)
73  COMMON
74  d/mn7npr/ maxint ,npar ,maxext ,nu
75  e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
76  e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
77  f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
78  g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
79  h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
80  i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
81  j/mn7arg/ word7(maxp)
82  k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
83  l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
84  m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
85  n/mn7cpt/ chpt(maxcpt)
86  o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
87  CHARACTER CTITL*50, CWORD*(maxcwd), CUNDEF*10, CFROM*8,
88  + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
89  LOGICAL LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD
90 C
91  cfrom = 'SET LIM '
92  nfcnfr = nfcn
93  cstatu= 'NO CHANGE '
94  i2 = word7(1)
95  IF (i2 .GT. maxext .OR. i2 .LT. 0) GO TO 900
96  IF (i2 .GT. 0) GO TO 30
97 C set limits on all parameters
98  newcod = 4
99  IF (word7(2) .EQ. word7(3)) newcod = 1
100  DO 20 inu= 1, nu
101  IF (nvarl(inu) .LE. 0) GO TO 20
102  IF (nvarl(inu).EQ.1 .AND. newcod.EQ.1) GO TO 20
103  kint = niofex(inu)
104 C see if parameter has been fixed
105  IF (kint .LE. 0) THEN
106  IF (isw(5) .GE. 0) WRITE (isyswr,'(11X,A,I3)')
107  + ' LIMITS NOT CHANGED FOR FIXED PARAMETER:',inu
108  GO TO 20
109  ENDIF
110  IF (newcod .EQ. 1) THEN
111 C remove limits from parameter
112  IF (isw(5) .GT. 0) WRITE (isyswr,134) inu
113  cstatu = 'NEW LIMITS'
114  CALL mndxdi(x(kint),kint,dxdi)
115  snew = gstep(kint)*dxdi
116  gstep(kint) = abs(snew)
117  nvarl(inu) = 1
118  ELSE
119 C put limits on parameter
120  alim(inu) = min(word7(2),word7(3))
121  blim(inu) = max(word7(2),word7(3))
122  IF (isw(5) .GT. 0) WRITE (isyswr,237) inu,alim(inu),blim(inu)
123  nvarl(inu) = 4
124  cstatu = 'NEW LIMITS'
125  gstep(kint) = -0.1
126  ENDIF
127  20 CONTINUE
128  GO TO 900
129 C set limits on one parameter
130  30 IF (nvarl(i2) .LE. 0) THEN
131  WRITE (isyswr,'(A,I3,A)') ' PARAMETER ',i2,' IS NOT VARIABLE.'
132  GO TO 900
133  ENDIF
134  kint = niofex(i2)
135 C see if parameter was fixed
136  IF (kint .EQ. 0) THEN
137  WRITE (isyswr,'(A,I3)')
138  + ' REQUEST TO CHANGE LIMITS ON FIXED PARAMETER:',i2
139  DO 82 ifx= 1, npfix
140  IF (i2 .EQ. ipfix(ifx)) GO TO 92
141  82 CONTINUE
142  WRITE (isyswr,'(A)') ' MINUIT BUG IN MNLIMS. SEE F. JAMES'
143  92 CONTINUE
144  ENDIF
145  IF (word7(2) .NE. word7(3)) GO TO 235
146 C remove limits
147  IF (nvarl(i2) .NE. 1) THEN
148  IF (isw(5) .GT. 0) WRITE (isyswr,134) i2
149  134 FORMAT (30h limits removed from PARAMETER ,i4)
150  cstatu = 'NEW LIMITS'
151  IF (kint .LE. 0) THEN
152  gsteps(ifx) = abs(gsteps(ifx))
153  ELSE
154  CALL mndxdi(x(kint),kint,dxdi)
155  IF (abs(dxdi) .LT. 0.01) dxdi=0.01
156  gstep(kint) = abs(gstep(kint)*dxdi)
157  grd(kint) = grd(kint)*dxdi
158  ENDIF
159  nvarl(i2) = 1
160  ELSE
161  WRITE (isyswr,'(A,I3)') ' NO LIMITS SPECIFIED. PARAMETER ',
162  + i2,' IS ALREADY UNLIMITED. NO CHANGE.'
163  ENDIF
164  GO TO 900
165 C put on limits
166  235 alim(i2) = min(word7(2),word7(3))
167  blim(i2) = max(word7(2),word7(3))
168  nvarl(i2) = 4
169  IF (isw(5) .GT. 0) WRITE (isyswr,237) i2,alim(i2),blim(i2)
170  237 FORMAT (10h PARAMETER ,i3, 14h limits set to ,2g15.5)
171  cstatu = 'NEW LIMITS'
172  IF (kint .LE. 0) THEN
173  gsteps(ifx) = -0.1
174  ELSE
175  gstep(kint) = -0.1
176  ENDIF
177 C
178  900 CONTINUE
179  IF (cstatu .NE. 'NO CHANGE ') THEN
180  CALL mnexin(x)
181  CALL mnrset(1)
182  ENDIF
183  RETURN
184  END
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
mnlims
subroutine mnlims
Definition: mnlims.f:25
mnrset
subroutine mnrset(IOPT)
Definition: mnrset.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
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
to
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer to
Definition: Zfit.h:15
o
struct ob o[NpMax]
Definition: Zprivate.h:34
mndxdi
subroutine mndxdi(PINT, IPAR, DXDI)
Definition: mndxdi.f:10
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
a
nodes a
Definition: cstdatmos0.fNew2.h:93
b
dE dx *! Nuc Int sampling table b
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
h
dE dx *! Nuc Int sampling table h
Definition: cblkMuInt.h:130
g
dE dx *! Nuc Int sampling table g
Definition: cblkMuInt.h:130
maxp
!onst int maxp
Definition: Zprivate.h:3
mnexin
subroutine mnexin(PINT)
Definition: mnexin.f:10
from
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer from
Definition: Zfit.h:15
n
integer n
Definition: Zcinippxc.h:1
softenpik::half
integer, parameter half
Definition: csoftenPiK.f:108
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