COSMOS v7.655  COSMOSv7655
(AirShowerMC)
mnhes1.f
Go to the documentation of this file.
1 *
2 * $Id: mnhes1.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
3 *
4 * $Log: mnhes1.F,v $
5 * Revision 1.1.1.1 1996/03/07 14:31:30 mclareni
6 * Minuit
7 *
8 *
9  SUBROUTINE mnhes1(FCN,FUTIL)
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 Called from MNHESS and MNGRAD
25 CC Calculate first derivatives (GRD) and uncertainties (DGRD)
26 CC and appropriate step sizes GSTEP
27 *
28 * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
29 *
30 * $Log: d506cm.inc,v $
31 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
32 * Minuit
33 *
34 *
35 *
36 *
37 * d506cm.inc
38 *
39  parameter(mne=100 , mni=50)
40  parameter(mnihl=mni*(mni+1)/2)
41  CHARACTER*10 CPNAM
42  COMMON
43  1/mn7nam/ cpnam(mne)
44  2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
45  3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
46  4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
47  5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
48  6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
49  7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
50  8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
51  9/mn7fx1/ ipfix(mni) ,npfix
52  a/mn7var/ vhmat(mnihl)
53  b/mn7vat/ vthmat(mnihl)
54  c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
55 C
56  parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
57  parameter(zero=0.0, one=1.0, half=0.5)
58  COMMON
59  d/mn7npr/ maxint ,npar ,maxext ,nu
60  e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
61  e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
62  f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
63  g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
64  h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
65  i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
66  j/mn7arg/ word7(maxp)
67  k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
68  l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
69  m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
70  n/mn7cpt/ chpt(maxcpt)
71  o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
72  CHARACTER CTITL*50, CWORD*(maxcwd), CUNDEF*10, CFROM*8,
73  + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
74  LOGICAL LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD
75  EXTERNAL fcn,futil
76  LOGICAL LDEBUG
77  CHARACTER CBF1*22
78  ldebug = (idbg(5) .GE. 1)
79  IF (istrat .LE. 0) ncyc = 1
80  IF (istrat .EQ. 1) ncyc = 2
81  IF (istrat .GT. 1) ncyc = 6
82  idrv = 1
83  nparx = npar
84  dfmin = 4.*epsma2*(abs(amin)+up)
85 C main loop over parameters
86  DO 100 i= 1, npar
87  xtf = x(i)
88  dmin = 4.*epsma2*abs(xtf)
89  epspri = epsma2 + abs(grd(i)*epsma2)
90  optstp = sqrt(dfmin/(abs(g2(i))+epspri))
91  d = 0.2 * abs(gstep(i))
92  IF (d .GT. optstp) d = optstp
93  IF (d .LT. dmin) d = dmin
94  chgold = 10000.
95 C iterate reducing step size
96  DO 50 icyc= 1, ncyc
97  x(i) = xtf + d
98  CALL mninex(x)
99  CALL fcn(nparx,gin,fs1,u,4,futil)
100  nfcn = nfcn + 1
101  x(i) = xtf - d
102  CALL mninex(x)
103  CALL fcn(nparx,gin,fs2,u,4,futil)
104  nfcn = nfcn + 1
105  x(i) = xtf
106 C check if step sizes appropriate
107  sag = 0.5*(fs1+fs2-2.0*amin)
108  grdold = grd(i)
109  grdnew = (fs1-fs2)/(2.0*d)
110  dgmin = epsmac*(abs(fs1)+abs(fs2))/d
111  IF (ldebug) WRITE (isyswr,11) i,idrv,gstep(i),d,g2(i),grdnew,sag
112  11 FORMAT (i4,i2,6g12.5)
113  IF (grdnew .EQ. zero) GO TO 60
114  change = abs((grdold-grdnew)/grdnew)
115  IF (change.GT.chgold .AND. icyc.GT.1) GO TO 60
116  chgold = change
117  grd(i) = grdnew
118  gstep(i) = sign(d,gstep(i))
119 C decrease step until first derivative changes by <5%
120  IF (change .LT. 0.05) GO TO 60
121  IF (abs(grdold-grdnew) .LT. dgmin) GO TO 60
122  IF (d .LT. dmin) THEN
123  CALL mnwarn('D','MNHES1','Step size too small for 1st drv.')
124  GO TO 60
125  ENDIF
126  d = 0.2*d
127  50 CONTINUE
128 C loop satisfied = too many iter
129  WRITE (cbf1,'(2G11.3)') grdold,grdnew
130  CALL mnwarn('D','MNHES1','Too many iterations on D1.'//cbf1)
131  60 CONTINUE
132  dgrd(i) = max(dgmin,abs(grdold-grdnew))
133  100 CONTINUE
134 C end of first deriv. loop
135  CALL mninex(x)
136  RETURN
137  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
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
o
struct ob o[NpMax]
Definition: Zprivate.h:34
mninex
subroutine mninex(PINT)
Definition: mninex.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
mnhes1
subroutine mnhes1(FCN, FUTIL)
Definition: mnhes1.f:10
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
mnwarn
subroutine mnwarn(COPT, CORG, CMES)
Definition: mnwarn.f:10
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