lminto.F

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

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

      SUBROUTINE lminto(PINT)

      IMPLICIT NONE

C...This is the MINUIT routine INTOEX.
CC        TRANSFORMS FROM INTERNAL COORDINATES (PINT) TO EXTERNAL
CC        PARAMETERS (U).   THE MINIMIZING ROUTINES WHICH WORK IN
CC        INTERNAL COORDINATES CALL THIS ROUTINE BEFORE CALLING FCN.

      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
      INTEGER i,j
      REAL pint,al
      
      dimension pint(2)
      
      DO 100 i= 1, nu
      j = lcorsp(i)
      IF ( j )  100,100,50
   50 CONTINUE
      IF (lcode(i) .EQ. 1)  go to 80
      al = alim(i)
      u(i) = al + 0.5 *(sin(pint(j)) +1.0) * (blim(i) -al)
      go to 100
   80 u(i) = pint(j)
  100 CONTINUE
      RETURN
      END