doxygen/v8.037/mnderi_8f_source.html

 *
 * $Id: mnderi.F,v 1.2 1996/03/15 18:02:43 james Exp $
 *
 * $Log: mnderi.F,v $
 * Revision 1.2  1996/03/15 18:02:43  james
 *     Modified Files:
 * mnderi.F eliminate possible division by zero
 * mnexcm.F suppress print on STOP when print flag=-1
 *          set FVAL3 to flag if FCN already called with IFLAG=3
 * mninit.F set version 96.03
 * mnlims.F remove arguments, not needed
 * mnmigr.F VLEN -> LENV in debug print statement
 * mnparm.F move call to MNRSET to after NPAR redefined, to zero all
 * mnpsdf.F eliminate possible division by zero
 * mnscan.F suppress printout when print flag =-1
 * mnset.F  remove arguments in call to MNLIMS
 * mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
 * mnvert.F eliminate possible division by zero
 *
 * Revision 1.1.1.1  1996/03/07 14:31:29  mclareni
 * Minuit
 *
 *
       SUBROUTINE mnderi(FCN,FUTIL)
 *
 * $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
 *
 * $Log: d506dp.inc,v $
 * Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
 * Minuit
 *
 *
 *
 *
 * d506dp.inc
 *
 C ************ DOUBLE PRECISION VERSION *************
       IMPLICIT DOUBLE PRECISION (a-h,o-z)
 CC        Calculates the first derivatives of FCN (GRD),
 CC        either by finite differences or by transforming the user-
 CC        supplied derivatives to internal coordinates,
 CC        according to whether ISW(3) is zero or one.
 CC
 *
 * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
 *
 * $Log: d506cm.inc,v $
 * Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
 * Minuit
 *
 *
 *
 *
 * d506cm.inc
 *
       parameter(mne=100 , mni=50)
       parameter(mnihl=mni*(mni+1)/2)
       CHARACTER*10 CPNAM
       COMMON
      1/mn7nam/ cpnam(mne)
      2/mn7ext/ u(mne)     ,alim(mne)  ,blim(mne)
      3/mn7err/ erp(mni)   ,ern(mni)   ,werr(mni)  ,globcc(mni)
      4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
      5/mn7int/ x(mni)     ,xt(mni)    ,dirin(mni)
      6/mn7fx2/ xs(mni)    ,xts(mni)   ,dirins(mni)
      7/mn7der/ grd(mni)   ,g2(mni)    ,gstep(mni) ,gin(mne) ,dgrd(mni)
      8/mn7fx3/ grds(mni)  ,g2s(mni)   ,gsteps(mni)
      9/mn7fx1/ ipfix(mni) ,npfix
      a/mn7var/ vhmat(mnihl)
      b/mn7vat/ vthmat(mnihl)
      c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
 C
       parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
       parameter(zero=0.0,  one=1.0,   half=0.5)
       COMMON
      d/mn7npr/ maxint ,npar   ,maxext ,nu
      e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
      e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
      f/mn7tit/ cfrom  ,cstatu ,ctitl  ,cword  ,cundef ,cvrsn ,covmes
      g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
      h/mn7min/ amin   ,up     ,edm    ,fval3  ,epsi   ,apsi  ,dcovar
      i/mn7cnv/ nfcn   ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
      j/mn7arg/ word7(maxp)
      k/mn7log/ lwarn  ,lrepor ,limset ,lnolim ,lnewmn ,lphead
      l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
      m/mn7rpt/ xpt(maxcpt)    ,ypt(maxcpt)
      n/mn7cpt/ chpt(maxcpt)
      o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr  ,ke2cr
       CHARACTER CTITL*50, CWORD*(maxcwd), CUNDEF*10, CFROM*8,
      +          cvrsn*6,  covmes(0:3)*22, cstatu*10, chpt*1
       LOGICAL   LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD
       EXTERNAL fcn,futil
       LOGICAL LDEBUG
       CHARACTER CBF1*22
       nparx = npar
       ldebug = (idbg(2) .GE. 1)
       IF (amin .EQ. undefi)  CALL mnamin(fcn,futil)
       IF (isw(3) .EQ. 1)  GO TO 100
       IF (ldebug) THEN
 C                       make sure starting at the right place
         CALL mninex(x)
         nparx = npar
         CALL fcn(nparx,gin,fs1,u,4,futil)
         nfcn = nfcn + 1
         IF (fs1 .NE. amin) THEN
            df = amin - fs1
            WRITE (cbf1(1:12),'(G12.3)') df
            CALL mnwarn('D','MNDERI',
      +         'function value differs from AMIN by '//cbf1(1:12) )
            amin = fs1
         ENDIF
           WRITE
      +   (isyswr,'(/''  FIRST DERIVATIVE DEBUG PRINTOUT.  MNDERI''/
      +   '' PAR    DERIV     STEP      MINSTEP   OPTSTEP '',
      +   '' D1-D2    2ND DRV'')')
       ENDIF
       dfmin = 8. * epsma2*(abs(amin)+up)
       vrysml = 8.* epsmac**2
       IF (istrat .LE. 0) THEN
          ncyc = 2
          tlrstp = 0.5
          tlrgrd = 0.1
       ELSE IF (istrat .EQ. 1) THEN
          ncyc = 3
          tlrstp = 0.3
          tlrgrd = 0.05
       ELSE
          ncyc = 5
          tlrstp = 0.1
          tlrgrd = 0.02
       ENDIF
 C                                loop over variable parameters
       DO 60  i=1,npar
       epspri = epsma2 + abs(grd(i)*epsma2)
 C         two-point derivatives always assumed necessary
 C         maximum number of cycles over step size depends on strategy
       xtf = x(i)
       stepb4 = 0.
 C                               loop as little as possible here!
       DO 45 icyc= 1, ncyc
 C                 ........ theoretically best step
       optstp = sqrt(dfmin/(abs(g2(i))+epspri))
 C                     step cannot decrease by more than a factor of ten
       step = max(optstp, abs(0.1*gstep(i)))
 C                 but if parameter has limits, max step size = 0.5
       IF (gstep(i).LT.zero .AND. step.GT.0.5)  step=0.5
 C                 and not more than ten times the previous step
       stpmax = 10.*abs(gstep(i))
       IF (step .GT. stpmax)  step = stpmax
 C                 minimum step size allowed by machine precision
       stpmin = max(vrysml, 8.*abs(epsma2*x(i)))
       IF (step .LT. stpmin)  step = stpmin
 C                 end of iterations if step change less than factor 2
       IF (abs((step-stepb4)/step) .LT. tlrstp)  GO TO 50
 C         take step positive
       gstep(i) = sign(step, gstep(i))
       stepb4 = step
       x(i) = xtf + step
       CALL mninex(x)
       CALL fcn(nparx,gin,fs1,u,4,futil)
       nfcn=nfcn+1
 C         take step negative
       x(i) = xtf - step
       CALL mninex(x)
       CALL fcn(nparx,gin,fs2,u,4,futil)
       nfcn=nfcn+1
       grbfor = grd(i)
       grd(i) = (fs1-fs2)/(2.0*step)
       g2(i) = (fs1+fs2-2.0*amin)/(step**2)
       x(i) = xtf
       IF (ldebug) THEN
          d1d2 = (fs1+fs2-2.0*amin)/step
          WRITE (isyswr,41) i,grd(i),step,stpmin,optstp,d1d2,g2(i)
    41    FORMAT (i4,2g11.3,5g10.2)
       ENDIF
 C         see if another iteration is necessary
       IF (abs(grbfor-grd(i))/(abs(grd(i))+dfmin/step) .LT. tlrgrd)
      +        GO TO 50
    45 CONTINUE
 C                           end of ICYC loop. too many iterations
       IF (ncyc .EQ. 1)  GO TO 50
          WRITE (cbf1,'(2E11.3)')  grd(i),grbfor
          CALL mnwarn('D','MNDERI',
      +         'First derivative not converged. '//cbf1)
    50 CONTINUE
 C
    60 CONTINUE
       CALL mninex(x)
       RETURN
 C                                        .  derivatives calc by fcn
   100 DO 150 iint= 1, npar
       iext = nexofi(iint)
       IF (nvarl(iext) .GT. 1)  GO TO 120
       grd(iint) = gin(iext)
       GO TO 150
   120 dd = (blim(iext)-alim(iext))*0.5 *cos(x(iint))
       grd(iint) = gin(iext)*dd
   150 CONTINUE
   200 RETURN
       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

cos
! for length to thickness conversion or v v ! integer maxnodes real Hinf ! This is used when making table for dim simulation ! The slant length for vertical height to km is ! divided by LenStep m steps ! It can cover the slant length of about km for cos
Definition: Zatmos.h:8

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

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

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

mnderi
subroutine mnderi(FCN, FUTIL)
Definition: mnderi.f:25

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