COSMOS v7.655  COSMOSv7655
(AirShowerMC)
Functions/Subroutines
latfnc.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine latfnc (npar, gin, f, paramx, iflag)
 

Function/Subroutine Documentation

◆ latfnc()

subroutine latfnc ( integer  npar,
real*8, dimension(*)  gin,
real*8  f,
real*8, dimension(*)  paramx,
integer  iflag 
)

Definition at line 2 of file latfnc.f.

References chisq, npoint, oparam, softenpik::pw, x, and y.

Referenced by fitlat1().

2  implicit none
3  include "Zlatfit.h"
4 * npar: input. number of current variable parameters
5 * gin: optional output of gradient
6 * f: output. function value to be minimized
7 * paramx: input. vector of const and variable parameters
8 * iflag: input. depending on this value, what to do
9 * is determined.
10 * 1--> some preparation for computing f
11 * 2--> compute gin
12 * 3--> fittng finished
13 * for all other cases: we must compute f
14 *
15  integer npar
16  real*8 gin(*)
17  real*8 f
18  real*8 paramx(*)
19  integer iflag
20 c
21  integer i
22  real*8 fval, xx
23  real*8 temp
24  save
25  if (iflag .eq. 1) then
26 c write(0,*) 'current npar=',npar, ' npoint=',npoint
27 c write(0,*) ' param=',(paramx(i), i=1,npar)
28  endif
29  if(iflag .eq. 2 ) then
30  write(0,*) ' no grad computed'
31  stop
32  endif
33 c compute f
34 
35  chisq = 0.
36  maxdiff = 0.
37  answer = 0.
38  pw = paramx(4)
39  do i= 1, npoint
40  if(badindex(i) .lt. 0) cycle
41  fval = paramx(1)/
42 c * x(i)**(paramx(2) + paramx(3)* log(x(i)) )
43  * x(i)**(paramx(2) + paramx(3)* x(i)**pw )
44 c chisq= chisq + (fval-y(i))**2
45 c if(y(i) .lt. 3.) then
46 c chisq= chisq + ( fval/y(i) - 1.0 )**2
47 c else
48 cccc chisq= chisq + ( fval/y(i) - 1.0 )**2
49 c chisq= chisq + ( y(i)/fval - 1.0 )**2 NG
50 
51  if(y(i).gt. 0.) then
52  temp = ( log(fval/y(i)))**2
53 
54 c if(temp .gt. limit) answer = answer + 1.
55 
56  if(temp .gt. maxdiff)then
57  maxdiff= temp
58  maxindex = i
59  endif
60 c chisq= chisq + ( y(i)/fval + fval/y(i) - 2.0 )**2
61  chisq= chisq + temp
62  endif
63 c chisq= chisq + ( log(fval/y(i)))**2 NG
64 ccc next is NG
65 ccc chisq= chisq + ( fval - y(i) )**2/y(i)
66 
67 c endif
68  enddo
69 c if(limit .gt. 0.) then
70 c if(maxdiff .gt. limit) then
71 c chisq = chisq - maxdiff
72 c endif
73 c endif
74  f = chisq
75 
76  if(iflag .eq. 3) then
77 c do i = 1, npoint
78 c fval = paramx(1)*x(i)**(paramx(2) +
79 c write(*,*) x(i), y(i), fval
80 c enddo
81  do i = 1, npar
82  oparam(i) = paramx(i)
83  enddo
84  endif
chisq
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer op real * chisq
Definition: Zfit.h:15
i
nodes i
Definition: cstdatmos0.fNew2.h:93
nrl_atmos::temp
real(4), dimension(:), allocatable, save temp
Definition: cNRLAtmos.f:29
softenpik::pw
real(8), save pw
Definition: csoftenPiK.f:36
npoint
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer npoint
Definition: Zfit.h:15
y
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
oparam
integer maxbin nregion c minsave drx2 ! drawing region real maxdep integer maxpos integer op real x1h common Zfitc * oparam
Definition: Zfit.h:15
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
Here is the caller graph for this function: