*$ 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 END IF 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