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

Go to the source code of this file.

Functions/Subroutines

subroutine mnpars (CRDBUF, ICONDN)
 

Function/Subroutine Documentation

◆ mnpars()

subroutine mnpars ( character, dimension(*)  CRDBUF,
  ICONDN 
)

Definition at line 10 of file mnpars.f.

References a, b, c, d, e, f, g, h, softenpik::half, i, j, m, maxp, mncrck(), mnparm(), n, o, p, parameter(), up(), x, xs, and z.

Referenced by mnread().

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 MNREAD and user-callable
25 CC Implements one parameter definition, that is:
26 CC parses the string CRDBUF and calls MNPARM
27 C
28 C output conditions:
29 C ICONDN = 0 all OK
30 C ICONDN = 1 error, attempt to define parameter is ignored
31 C ICONDN = 2 end of parameter definitions
32 C
33 *
34 * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
35 *
36 * $Log: d506cm.inc,v $
37 * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni
38 * Minuit
39 *
40 *
41 *
42 *
43 * d506cm.inc
44 *
45  parameter(mne=100 , mni=50)
46  parameter(mnihl=mni*(mni+1)/2)
47  CHARACTER*10 cpnam
48  COMMON
49  1/mn7nam/ cpnam(mne)
50  2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
51  3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
52  4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
53  5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
54  6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
55  7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
56  8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
57  9/mn7fx1/ ipfix(mni) ,npfix
58  a/mn7var/ vhmat(mnihl)
59  b/mn7vat/ vthmat(mnihl)
60  c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
61 C
62  parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
63  parameter(zero=0.0, one=1.0, half=0.5)
64  COMMON
65  d/mn7npr/ maxint ,npar ,maxext ,nu
66  e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
67  e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
68  f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
69  g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
70  h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
71  i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
72  j/mn7arg/ word7(maxp)
73  k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
74  l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
75  m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
76  n/mn7cpt/ chpt(maxcpt)
77  o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
78  CHARACTER ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
79  + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
80  LOGICAL lwarn, lrepor, limset, lnolim, lnewmn, lphead
81 C
82  dimension plist(maxp)
83  CHARACTER cnamk*10, crdbuf*(*) , celmnt*20 , comand*(maxcwd)
84 C
85  lenbuf = len(crdbuf)
86 C find out whether fixed or free-field format
87  kapo1 = index(crdbuf,'''')
88  IF (kapo1 .EQ. 0) GO TO 150
89  kapo2 = index(crdbuf(kapo1+1:),'''')
90  IF (kapo2 .EQ. 0) GO TO 150
91 C new (free-field) format
92  kapo2 = kapo2 + kapo1
93 C skip leading blanks if any
94  DO 115 istart=1, kapo1-1
95  IF (crdbuf(istart:istart) .NE. ' ') GO TO 120
96  115 CONTINUE
97  GO TO 210
98  120 CONTINUE
99 C parameter number integer
100  celmnt = crdbuf(istart:kapo1-1)
101  READ (celmnt,'(BN,F20.0)',err=180) fk
102  k = fk
103  IF (k .LE. 0) GO TO 210
104  cnamk = 'PARAM '//celmnt
105  IF (kapo2-kapo1 .GT. 1) cnamk = crdbuf(kapo1+1:kapo2-1)
106 C special handling if comma or blanks and a comma follow 'name'
107  DO 135 icy= kapo2+1,lenbuf
108  IF (crdbuf(icy:icy) .EQ. ',') GO TO 139
109  IF (crdbuf(icy:icy) .NE. ' ') GO TO 140
110  135 CONTINUE
111  uk = 0.
112  wk = 0.
113  a = 0.
114  b = 0.
115  GO TO 170
116  139 CONTINUE
117  icy = icy+1
118  140 CONTINUE
119  ibegin = icy
120  CALL mncrck(crdbuf(ibegin:),maxcwd,comand,lnc,
121  + maxp,plist,llist, ierr,isyswr)
122  IF (ierr .GT. 0) GO TO 180
123  uk = plist(1)
124  wk = 0.
125  IF (llist .GE. 2) wk = plist(2)
126  a = 0.
127  IF (llist .GE. 3) a = plist(3)
128  b = 0.
129  IF (llist .GE. 4) b = plist(4)
130  GO TO 170
131 C old (fixed-field) format
132  150 CONTINUE
133  READ (crdbuf, 158,err=180) xk,cnamk,uk,wk,a,b
134  158 FORMAT (bn,f10.0, a10, 4f10.0)
135  k = xk
136  IF (k .EQ. 0) GO TO 210
137 C parameter format cracked, implement parameter definition
138  170 CALL mnparm(k,cnamk,uk,wk,a,b,ierr)
139  icondn = ierr
140  RETURN
141 C format or other error
142  180 CONTINUE
143  icondn = 1
144  RETURN
145 C end of data
146  210 CONTINUE
147  icondn = 2
148  RETURN
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
nodes z
subroutine mncrck(CRDBUF, MAXCWD, COMAND, LNC, MXP, PLIST, LLIST, IERR, ISYSWR)
Definition: mncrck.f:11
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
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 mnparm(K, CNAMJ, UK, WK, A, B, IERFLG)
Definition: mnparm.f:25
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
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
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
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: