lmprin.F

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

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

      SUBROUTINE lmprin  (IKODE,FVAL)

      IMPLICIT NONE

C...This is the MINUIT routine MPRINT.
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        ACCORDING TO THE VALUE OF IKODE,THE PRINTOUT IS LONG FORMAT,
CC        SHORT FORMAT, OR MINOS FORMAT (0,1,2)
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 /lminuc/ namkin(4),nam(30)
      CHARACTER*10 namkin,nam
      SAVE /lminuc/

      COMMON /lpflag/ lst3
      INTEGER lst3
      SAVE /lpflag/

      
      INTEGER ikode,i,l,kount
      REAL fval,ti,e,dx,al,ba,du1,du2,x1,x2
      
C                                        . GET TIME AND PRINT HEADINGS .
      CALL ltimex(ti)
      IF(lst3.GE.5) WRITE (isyswr,1000)
      e = sigma
      kount = 0
C                                        . . . LOOP OVER PARAMETERS . .
      DO 200 i= 1, nu
      IF(nam(i).EQ.'          ') goto 200
   20 l = lcorsp(i)
      IF (l .EQ. 0)  go to 55
C              VARIABLE PARAMETER.  CALCULATE EXTERNAL ERROR IF V EXISTS
      IF (isw(2) .LT. 1)  go to 27
      dx = sqrt(abs(v(l,l)*up))
      IF (lcode(i) .LE. 1)  go to 26
      al = alim(i)
      ba = blim(i) - al
      du1 = al + 0.5 *(sin(x(l)+dx) +1.0) * ba - u(i)
      du2 = al + 0.5 *(sin(x(l)-dx) +1.0) * ba - u(i)
      IF (dx .GT. 1.0)  du1 = ba
      dx = 0.5 * (abs(du1) + abs(du2))
   26 werr(i) = dx
   27 x1 = x(l)
      x2 = dirin(l)
      IF (ikode .LT. 2)  go to 29
      x1 = erp(i)
      x2 = ern(i)
   29 IF (kount)  30,30,40
   30 kount = 1
      IF(lst3.GE.5)
     &WRITE (isyswr,1001) fval,nfcn,ti,e, l,i,nam(i),u(i),werr(i),x1,x2
      go to 45
   40 IF(lst3.GE.5) WRITE (isyswr,1002)   l,i,nam(i),u(i),werr(i),x1,x2
   45 IF (lcode(i) .LE. 1)  go to 200
      IF(lst3.GE.1.AND. abs(cos(x(l))) .LT. 0.001)  WRITE (isyswr,1004)
      go to 200
C                           FIXED PARAMETER.  PRINT ONLY IF IKODE .GT.0
   55 IF (ikode .EQ. 0)  go to 200
      IF (kount)  60,60,70
   60 kount = 1
      IF(lst3.GE.5) WRITE (isyswr,1001) fval,nfcn,ti,e, l,i,nam(i),u(i)
      go to 200
   70 IF(lst3.GE.5) WRITE (isyswr,1003)                   i,nam(i),u(i)
  200 CONTINUE
      IF(lst3.GE.5.AND.
     &ikode.GE.1 .AND.isw(2).GE.1)  WRITE (isyswr,1005)  up
      RETURN
 1000 FORMAT(/ 4x,'FCN VALUE',5x,'CALLS',4x,'TIME',4x,' EDM  ',4x ,
     +'INT.EXT. PARAMETER     VALUE         ERROR      INTERN.VALUE  ',
     +'INT.STEP SIZE')
 1001 FORMAT(e15.7,i7,f9.2,e11.2,i6,i4,1x,a10,4e14.5)
 1002 FORMAT(1h ,41x,i6,i4,1x,a10,4e14.5)
 1003 FORMAT(1h  ,47x  ,i4,1x,a10,4e14.5)
 1004 FORMAT(1h ,52x  ,'WARNING -   - ABOVE PARAMETER IS AT LIMIT.')
 1005 FORMAT(/45x,'ERRORS CORRESPOND TO FUNCTION CHANGE OF ',e12.4)
      END