doxygen/v8.037/mnprin_8f_source.html

 *
 * $Id: mnprin.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
 *
 * $Log: mnprin.F,v $
 * Revision 1.1.1.1  1996/03/07 14:31:31  mclareni
 * Minuit
 *
 *
       SUBROUTINE mnprin  (INKODE,FVAL)
 *
 * $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        Prints the values of the parameters at the time of the call.
 CC        also prints other relevant information such as function value,
 CC        estimated distance to minimum, parameter errors, step sizes.
 CC
 C         According to the value of IKODE, the printout is:
 C    IKODE=INKODE= 0    only info about function value
 C                  1    parameter values, errors, limits
 C                  2    values, errors, step sizes, internal values
 C                  3    values, errors, step sizes, first derivs.
 C                  4    values, parabolic errors, MINOS errors
 C    when INKODE=5, MNPRIN chooses IKODE=1,2, or 3, according to ISW(2)
 C
 *
 * $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
 C
       CHARACTER*14 COLHDU(6),COLHDL(6), CX2,CX3,CGETX
       CHARACTER*11 CNAMBF, CBLANK
       CHARACTER  CHEDM*10, CHEVAL*15
       parameter(cgetx='PLEASE GET X..')
       DATA cblank/'          '/
 C
       IF (nu .EQ. 0)  THEN
        WRITE (isyswr,'(A)') ' THERE ARE CURRENTLY NO PARAMETERS DEFINED'
        GO TO 700
       ENDIF
 C                  get value of IKODE based in INKODE, ISW(2)
       ikode = inkode
       IF (inkode .EQ. 5) THEN
          ikode = isw(2)+1
          IF (ikode .GT. 3)  ikode=3
       ENDIF
 C                  set 'default' column headings
       DO 5 k= 1, 6
       colhdu(k) = 'UNDEFINED'
     5 colhdl(k) = 'COLUMN HEAD'
 C              print title if Minos errors, and title exists.
       IF (ikode.EQ.4 .AND. ctitl.NE.cundef)
      +            WRITE (isyswr,'(/A,A)')  ' MINUIT TASK: ',ctitl
 C              report function value and status
       IF (fval .EQ. undefi) THEN
          cheval = ' unknown       '
       ELSE
          WRITE (cheval,'(G15.7)') fval
       ENDIF
          IF (edm .EQ. bigedm) THEN
             chedm = ' unknown  '
          ELSE
             WRITE (chedm, '(E10.2)') edm
          ENDIF
       nc = nfcn-nfcnfr
       WRITE (isyswr,905)  cheval,cfrom,cstatu,nc,nfcn
   905 FORMAT (/' FCN=',a,' FROM ',a8,'  STATUS=',a10,i6,' CALLS',
      +         i9,' TOTAL')
       m = isw(2)
       IF (m.EQ.0 .OR. m.EQ.2 .OR. dcovar.EQ.zero) THEN
         WRITE (isyswr,907) chedm,istrat,covmes(m)
   907   FORMAT (21x,'EDM=',a,'    STRATEGY=',i2,6x,a)
       ELSE
         dcmax = 1.
         dc = min(dcovar,dcmax) * 100.
         WRITE (isyswr,908) chedm,istrat,dc
   908   FORMAT (21x,'EDM=',a,'  STRATEGY=',i1,'  ERROR MATRIX',
      +     ' UNCERTAINTY=',f5.1,'%')
       ENDIF
 C
       IF (ikode .EQ. 0)  GO TO 700
 C               find longest name (for Rene!)
       ntrail = 10
       DO 20 i= 1, nu
          IF (nvarl(i) .LT. 0)  GO TO 20
          DO 15 ic= 10,1,-1
             IF (cpnam(i)(ic:ic) .NE. ' ') GO TO 16
    15    CONTINUE
          ic = 1
    16    lbl = 10-ic
          IF (lbl .LT. ntrail)  ntrail=lbl
    20 CONTINUE
       nadd = ntrail/2 + 1
       IF (ikode .EQ. 1)  THEN
          colhdu(1) = '              '
          colhdl(1) = '      ERROR   '
          colhdu(2) = '      PHYSICAL'
          colhdu(3) = ' LIMITS       '
          colhdl(2) = '    NEGATIVE  '
          colhdl(3) = '    POSITIVE  '
       ENDIF
       IF (ikode .EQ. 2)  THEN
          colhdu(1) = '              '
          colhdl(1) = '      ERROR   '
          colhdu(2) = '    INTERNAL  '
          colhdl(2) = '    STEP SIZE '
          colhdu(3) = '    INTERNAL  '
          colhdl(3) = '      VALUE   '
       ENDIF
       IF (ikode .EQ. 3)  THEN
          colhdu(1) = '              '
          colhdl(1) = '      ERROR   '
          colhdu(2) = '       STEP   '
          colhdl(2) = '       SIZE   '
          colhdu(3) = '      FIRST   '
          colhdl(3) = '   DERIVATIVE '
       ENDIF
       IF (ikode .EQ. 4)  THEN
          colhdu(1) = '    PARABOLIC '
          colhdl(1) = '      ERROR   '
          colhdu(2) = '        MINOS '
          colhdu(3) = 'ERRORS        '
          colhdl(2) = '   NEGATIVE   '
          colhdl(3) = '   POSITIVE   '
       ENDIF
 C
       IF (ikode .NE. 4)  THEN
          IF (isw(2) .LT. 3) colhdu(1)='  APPROXIMATE '
          IF (isw(2) .LT. 1) colhdu(1)=' CURRENT GUESS'
       ENDIF
       ncol = 3
       WRITE (isyswr, 910) (colhdu(kk),kk=1,ncol)
       WRITE (isyswr, 911) (colhdl(kk),kk=1,ncol)
   910 FORMAT (/'  EXT PARAMETER ',     13x       ,6a14)
   911 FORMAT ( '  NO.   NAME    ','    VALUE    ',6a14)
 C
 C                                        . . . loop over parameters . .
       DO 200 i= 1, nu
       IF (nvarl(i) .LT. 0)  GO TO 200
       l = niofex(i)
       cnambf = cblank(1:nadd)//cpnam(i)
       IF (l .EQ. 0)  GO TO 55
 C              variable parameter.
       x1 = werr(l)
       cx2 = cgetx
       cx3 = cgetx
       IF (ikode .EQ. 1) THEN
          IF (nvarl(i) .LE. 1) THEN
             WRITE (isyswr, 952)  i,cnambf,u(i),x1
             GO TO 200
          ELSE
          x2 = alim(i)
          x3 = blim(i)
          ENDIF
       ENDIF
       IF (ikode .EQ. 2) THEN
          x2 = dirin(l)
          x3 = x(l)
       ENDIF
       IF (ikode .EQ. 3) THEN
          x2 = dirin(l)
          x3 = grd(l)
          IF (nvarl(i).GT.1 .AND. abs(cos(x(l))) .LT. 0.001)
      +      cx3 = '** at limit **'
       ENDIF
       IF (ikode .EQ. 4) THEN
          x2 = ern(l)
            IF (x2.EQ.zero)   cx2=' '
            IF (x2.EQ.undefi) cx2='   at limit   '
          x3 = erp(l)
            IF (x3.EQ.zero)   cx3=' '
            IF (x3.EQ.undefi) cx3='   at limit   '
       ENDIF
       IF (cx2.EQ.cgetx) WRITE (cx2,'(G14.5)') x2
       IF (cx3.EQ.cgetx) WRITE (cx3,'(G14.5)') x3
       WRITE (isyswr,952)   i,cnambf,u(i),x1,cx2,cx3
   952 FORMAT (i4,1x,a11,2g14.5,2a)
 C               check if parameter is at limit
       IF (nvarl(i) .LE. 1 .OR. ikode .EQ. 3)  GO TO 200
       IF (abs(cos(x(l))) .LT. 0.001)  WRITE (isyswr,1004)
  1004 FORMAT (1h ,32x,42hwarning -   - above PARAMETER is at limit.)
       GO TO 200
 C
 C                                print constant or fixed parameter.
    55 CONTINUE
                           colhdu(1) = '   constant   '
       IF (nvarl(i).GT.0)  colhdu(1) = '     fixed    '
       IF (nvarl(i).EQ.4 .AND. ikode.EQ.1) THEN
         WRITE (isyswr,'(I4,1X,A11,G14.5,A,2G14.5)')
      +     i,cnambf,u(i),colhdu(1),alim(i),blim(i)
       ELSE
         WRITE (isyswr,'(I4,1X,A11,G14.5,A)')  i,cnambf,u(i),colhdu(1)
       ENDIF
   200 CONTINUE
 C
       IF (up.NE.updflt)  WRITE (isyswr,'(31X,A,G10.3)') 'ERR DEF=',up
   700 CONTINUE
       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

x1
block data include Zlatfit h c fitting region data x1(1)/0.03/

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

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

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

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

nc
real cut integer nc
Definition: Zprivate.h:1

x2
block data include Zlatfit h c fitting region data x2(1)/0.5/data x1(2)/0.3/

n
integer n
Definition: Zcinippxc.h:1

is
block data cblkIncident data *Za1ry is
Definition: cblkIncident.h:5

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