lmrazz.F

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lmrazz.F

C **********************************************************************

      SUBROUTINE lmrazz(YNEW,PNEW)

      IMPLICIT NONE

C...This is the MINUIT routine RAZZIA.
CC        CALLED ONLY BY SIMPLEX (AND IMPROV) TO ADD A NEW POINT
CC        AND REMOVE AN OLD ONE FROM THE CURRENT SIMPLEX, AND GET THE
CC        ESTIMATED DISTANCE TO MINIMUM.
CC
      COMMON
     1/lmmine/ erp(30)  ,ern(30)
     2/lmpari/ x(15)    ,xt(15)   ,dirin(15) ,maxint     ,npar
     3/lmpare/ u(30)              ,werr(30)  ,maxext     ,nu
     4/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
     5/lmvari/ v(15,15)
     7/lmfix / ipfix(15),xs(15)   ,xts(15)   ,dirins(15) ,npfix
     7/lmfix2/ grds(15) ,g2s(15)  ,gsteps(15),aberfs(15)
     c/lmcasc/ y(16)    ,jh       ,jl
     f/lmderi/ gin(30)  ,grd(15)  ,g2(15)    ,gstep(15)  ,aberf(15)
     g/lmsimv/ p(15,16) ,pstar(15),pstst(15) ,pbar(15)   ,prho(15)
     j/lmvart/ vt(15,15)
      COMMON
     6/lmunit/ isysrd   ,isyswr   ,isyspu
     8/lmtitl/ title(13),date(2)  ,isw(7)    ,nblock
     9/lmconv/ epsi     ,apsi     ,vtest     ,nstepq     ,nfcn ,nfcnmx
     a/lmcard/ cword    ,cword2   ,cword3    ,word7(7)
     b/lmmini/ amin     ,up       ,newmin    ,itaur      ,sigma,epsmac

      REAL erp,ern
      INTEGER maxint,npar
      REAL  x,xt,dirin
      INTEGER maxext     ,nu
      REAL u,werr
      INTEGER lcode,lcorsp,limset
      REAL alim,blim
      REAL v
      INTEGER ipfix,npfix
      REAL xs,xts,dirins
      REAL grds,g2s,gsteps,aberfs
      REAL y
      INTEGER jh,jl
      REAL gin,grd,g2,gstep,aberf
      REAL p,pstar,pstst,pbar,prho
      REAL vt
*****      COMMON
      INTEGER isysrd   ,isyswr   ,isyspu
      REAL title,date
      INTEGER isw,nblock
      REAL epsi     ,apsi     ,vtest
      INTEGER nstepq     ,nfcn ,nfcnmx
      REAL cword    ,cword2   ,cword3    ,word7
      REAL amin     ,up      ,sigma,epsmac
      INTEGER newmin    ,itaur
      
      COMMON /lpflag/ lst3
      INTEGER lst3
      SAVE /lpflag/


      INTEGER i,j,nparp1
      REAL ynew,pnew,us,pbig,plit
      
      dimension pnew(15)
      DO 10 i=1,npar
10    p(i,jh)=pnew(i)
      y(jh)=ynew
      IF(ynew.GE.amin) go to 18
      DO 15 i=1,npar
15    x(i)=pnew(i)
      CALL lminto(x)
      amin=ynew
      jl=jh
18    CONTINUE
      jh=1
      nparp1=npar+1
20    DO 25 j=2,nparp1
      IF (y(j) .GT. y(jh))  jh = j
25    CONTINUE
      sigma = y(jh) - y(jl)
      IF (sigma .LE. 0.)  go to 45
      us = 1.0/sigma
      DO 35 i= 1, npar
      pbig = p(i,1)
      plit = pbig
      DO 30 j= 2, nparp1
      IF (p(i,j) .GT. pbig)  pbig = p(i,j)
      IF (p(i,j) .LT. plit)  plit = p(i,j)
   30 CONTINUE
      dirin(i) = pbig - plit
      IF (itaur .LT. 1 )  v(i,i) = 0.5*(v(i,i) +us*dirin(i)**2)
   35 CONTINUE
   40 RETURN
CMM changed
C   45 IF(LST3.GE.1) WRITE (ISYSWR, 1000)  NPAR
   45 IF(lst3.GE.6) WRITE (isyswr, 1000)  npar

      go to 40
 1000 FORMAT('0***** FUNCTION VALUE DOES NOT SEEM TO DEPEND ON ANY ',
     +'OF THE',i3,' VARIABLE PARAMETERS',/15x ,'VERIFY THAT STEP SIZES',
     +' ARE BIG ENOUGH AND CHECK FCN LOGIC.',/1x,81(1h*)/1x,81(1h*)//)
      END