COSMOS v7.655  COSMOSv7655
(AirShowerMC)
mngrad.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine mngrad (FCN, FUTIL)
 

Function/Subroutine Documentation

◆ mngrad()

subroutine mngrad ( external  FCN,
external  FUTIL 
)

Definition at line 10 of file mngrad.f.

References a, b, c, d, e, f, false, g, h, softenpik::half, i, j, m, maxp, minuit(), mnderi(), mnhes1(), mninex(), n, o, p, parameter(), true, up(), x, xs, and z.

Referenced by mnset().

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 MNSET
25 CC Interprets the SET GRAD command, which informs MINUIT whether
26 CC the first derivatives of FCN will be calculated by the user
27 CC inside FCN. It can check the user's derivative calculation
28 CC by comparing it with a finite difference approximation.
29 CC
30 *
31 * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
32 *
33 * $Log: d506cm.inc,v $
34 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
35 * Minuit
36 *
37 *
38 *
39 *
40 * d506cm.inc
41 *
42  parameter(mne=100 , mni=50)
43  parameter(mnihl=mni*(mni+1)/2)
44  CHARACTER*10 cpnam
45  COMMON
46  1/mn7nam/ cpnam(mne)
47  2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
48  3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
49  4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
50  5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
51  6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
52  7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
53  8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
54  9/mn7fx1/ ipfix(mni) ,npfix
55  a/mn7var/ vhmat(mnihl)
56  b/mn7vat/ vthmat(mnihl)
57  c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
58 C
59  parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
60  parameter(zero=0.0, one=1.0, half=0.5)
61  COMMON
62  d/mn7npr/ maxint ,npar ,maxext ,nu
63  e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
64  e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
65  f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
66  g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
67  h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
68  i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
69  j/mn7arg/ word7(maxp)
70  k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
71  l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
72  m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
73  n/mn7cpt/ chpt(maxcpt)
74  o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
75  CHARACTER ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
76  + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
77  LOGICAL lwarn, lrepor, limset, lnolim, lnewmn, lphead
78 C
79  EXTERNAL fcn,futil
80  CHARACTER*4 cgood,cbad,cnone,cwd
81  LOGICAL lnone
82  dimension gf(mni)
83  parameter(cgood='GOOD',cbad=' BAD',cnone='NONE')
84 C
85  isw(3) = 1
86  nparx = npar
87  IF (word7(1) .GT. zero) GO TO 2000
88 C get user-calculated first derivatives from FCN
89  DO 30 i= 1, nu
90  30 gin(i) = undefi
91  CALL mninex(x)
92  CALL fcn(nparx,gin,fzero,u,2,futil)
93  nfcn = nfcn + 1
94  CALL mnderi(fcn,futil)
95  DO 40 i= 1, npar
96  40 gf(i) = grd(i)
97 C get MINUIT-calculated first derivatives
98  isw(3) = 0
99  istsav = istrat
100  istrat = 2
101  CALL mnhes1(fcn,futil)
102  istrat = istsav
103  WRITE (isyswr,51)
104  51 FORMAT(/' CHECK OF GRADIENT CALCULATION IN FCN'/12x,'PARAMETER',
105  + 6x,9hg(in fcn) ,3x,9hg(minuit) ,2x,'DG(MINUIT)',3x,9hagreement)
106  isw(3) = 1
107  lnone = .false.
108  DO 100 lc = 1, npar
109  i = nexofi(lc)
110  cwd = cgood
111  err = dgrd(lc)
112  IF (abs(gf(lc)-grd(lc)) .GT. err) cwd = cbad
113  IF (gin(i) .EQ. undefi) THEN
114  cwd = cnone
115  lnone = .true.
116  gf(lc) = 0.
117  ENDIF
118  IF (cwd .NE. cgood) isw(3) = 0
119  WRITE (isyswr,99) i,cpnam(i),gf(lc),grd(lc),err,cwd
120  99 FORMAT (7x,i5,2x ,a10,3e12.4,4x ,a4)
121  100 CONTINUE
122  IF (lnone) WRITE (isyswr,'(A)')
123  + ' AGREEMENT=NONE MEANS FCN DID NOT CALCULATE THE DERIVATIVE'
124  IF (isw(3) .EQ. 0) WRITE (isyswr,1003)
125  1003 FORMAT(/' MINUIT DOES NOT ACCEPT DERIVATIVE CALCULATIONS BY FCN'/
126  + ' TO FORCE ACCEPTANCE, ENTER "SET GRAD 1"'/)
127 C
128  2000 CONTINUE
129  RETURN
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
nodes z
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/
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
nodes i
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
subroutine minuit(FCN, FUTIL)
Definition: minuit.f:10
real(4), dimension(:), allocatable, save h
Definition: cNRLAtmos.f:28
! 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
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
struct ob o[NpMax]
Definition: Zprivate.h:34
subroutine mninex(PINT)
Definition: mninex.f:10
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
subroutine mnhes1(FCN, FUTIL)
Definition: mnhes1.f:10
block data include Zlatfit h c fitting region data data data data data d0 data data d0 data data m
Definition: ZlatfitBD.h:35
real(4), save a
Definition: cNRLAtmos.f:20
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
dE dx *! Nuc Int sampling table g
Definition: cblkMuInt.h:130
real(4), save b
Definition: cNRLAtmos.f:21
!onst int maxp
Definition: Zprivate.h:3
subroutine mnderi(FCN, FUTIL)
Definition: mnderi.f:25
integer n
Definition: Zcinippxc.h:1
integer, parameter half
Definition: csoftenPiK.f:108
! 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
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
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: