*$ CREATE USIMBS.FOR
*COPY USIMBS
*
*=== Usimbs ===========================================================*
*
      SUBROUTINE USIMBS ( MREG, NEWREG, FIMP )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
      INCLUDE '(PAPROP)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 2001-2008      by    Alfredo Ferrari & Paola Sala  *
*     All Rights Reserved.                                             *
*                                                                      *
*                                                                      *
*     USer defined IMportance BiaSing:                                 *
*                                                                      *
*     Created on   02 july 2001    by    Alfredo Ferrari & Paola Sala  *
*                                                   Infn - Milan       *
*                                                                      *
*     Last change on 30-oct-08     by    Alfredo Ferrari               *
*                                                                      *
*     Input variables:                                                 *
*                Mreg = region at the beginning of the step            *
*              Newreg = region at the end of the step                  *
*     (thru common TRACKR):                                            *
*              JTRACK = particle id. (Paprop numbering)                *
*              ETRACK = particle total energy (GeV)                    *
*       X,Y,ZTRACK(0) = position at the beginning of the step          *
*  X,Y,ZTRACK(NTRACK) = position at the end of the step                *
*                                                                      *
*    Output variable:                                                  *
*                Fimp = importance ratio (new position/original one)   *
*                                                                      *
*----------------------------------------------------------------------*
*
      INCLUDE '(TRACKR)'
*
      PARAMETER (SMALLSTEP=1.D-05)
      DOUBLE PRECISION RNEW, ROLD
* First loop variable
      LOGICAL	LFIRST
      DATA      LFIRST / .TRUE. /
      SAVE LFIRST
*
      IF (LFIRST) THEN
         WRITE(50,*) "*** User defined biasing ***"
         LFIRST = .FALSE.
      END IF
*     One can define a selection based on the region at the
*     beginning (MREG) and at the end (NEWREG) of the step
*     Here the list of region as defined in the input file:
*      n.01 - Region: BlackHole
*      n.02 - Region: Ground
*      n.03 - Air in the beam line section
*      n.04 - Shelding: Outer shielding
*      n.05 - Shielding: Neutron 
*      n.06 - Shielding: Neutron Moderator
*      n.07 - Neutron pipe
*      n.08 - Neutron diffuser
*      n.09 - Neutron hole
*      n.10 - Target
*      n.11 - Proton beam pipe
*      n.12 - Air in the parking
*      n.13 - Quadrupole model in the parking
*      n.14 - Aperture of the quadrupole model in the parking (with mag. field)
*      n.15 - Dipole
*      n.16 - 1st quadrupole placeholder
*      n.17 - 2nd quadrupole placeholder
*      n.18 - 3rd quadrupole placeholder
*      n.19 - 4th quadrupole placeholder
*      n.2x - Voxels  
d     WRITE(50,*) "Total Energy  E = ", ETRACK, " id." , JTRACK
d     WRITE(50,*) " ", MREG, "->", NEWREG
d     WRITE(50,*) " from (x,y,z) ", Xold, Yold, Zold 
d     WRITE(50,*) " to   (x,y,z) ", Xnew, Ynew, Znew
*     -------------------------------------------------------------
      IF ( (MREG .EQ. 4 ) .AND. (MREG .EQ. NEWREG) 
     c        .AND. JTRACK .EQ. 8  ) THEN
         
         FRADI = SQRT(XTRACK(0)**2 + YTRACK(0)**2)
         FRADF = SQRT(XTRACK(NTRACK)**2 + YTRACK(NTRACK)**2)
         FIMP  = EXP( 3.0d0*(FRADF-FRADI)/40.d0 )

      ELSE
         FIMP = ONEONE
      ENDIF

      RETURN 
*
*
*
*
*======================================================================*
*     Entry USIMST:                                                    *
*     *
*     Input variables:                                                 *
*     MREG = region at the beginning of the step            *
*                Step = length of the particle next step               *
*                                                                      *
*     utput variable:                                                  *
*     Step = possibly reduced step suggested by the user               *
*======================================================================*     
      ENTRY USIMST ( MREG, STEP )
*     
      IF ( STEP .GT. ONEONE ) STEP = HLFHLF * STEP
      RETURN
*===  End of subroutine Usimbs =========================================*
      END
