*$ CREATE COMSCW.FOR
*COPY COMSCW
*
*=== comscw ===========================================================*
*
      DOUBLE PRECISION FUNCTION COMSCW ( IJ    , XA    , YA    , ZA    ,
     &                                   MREG  , RULL  , LLO   , ICALL )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 1989-2015      by    Alfredo Ferrari & Paola Sala  *
*     All Rights Reserved.                                             *
*                                                                      *
*                                                                      *
*     New comscw for FLUKA9x-20xy                                      *
*                                                                      *
*     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!     *
*     !!! This is a completely dummy routine for Fluka9x/200x. !!!     *
*     !!! The  name has been kept the same as for older  Fluka !!!     *
*     !!! versions for back-compatibility, even though  Comscw !!!     *
*     !!! is applied only to estimators which didn't exist be- !!!     *
*     !!! fore Fluka89.                                        !!!     *
*     !!! User  developed versions  can be used for  weighting !!!     *
*     !!! density-like quantities at runtime                   !!!     *
*     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!     *
*                                                                      *
*     Input variables:                                                 *
*                                                                      *
*           Ij = (generalized) particle code                           *
*     Xa,Ya,Za = position                                              *
*         Mreg = region number                                         *
*         Rull = amount to be deposited                                *
*          Llo = particle generation                                   *
*        Icall = call id                                               *
*                                                                      *
*     Output variables:                                                *
*                                                                      *
*       Comscw = factor the scored amount will be multiplied by        *
*       Lsczer = logical flag, if true no amount will be scored        *
*                regardless of Comscw                                  *
*                                                                      *
*     Useful variables (common SCOHLP):                                *
*                                                                      *
*     Energy/Star binnings/scorings (Comscw):                          *
*          ISCRNG = 1 --> Energy    density  binning                   *
*          ISCRNG = 2 --> Star      density  binning                   *
*          ISCRNG = 3 --> Residual nuclei scoring                      *
*          ISCRNG = 4 --> Momentum transfer density binning            *
*          ISCRNG = 5 --> Activity   density binning                   *
*          ISCRNG = 6 --> Net charge density binning                   *
*          ISCRNG = 7 --> Residual nuclei density binning              *
*          ISCRNG = 8 --> Pulse height detector (DETECT option)        *
*          ISCRNG = 9 --> Annihilation at rest binning                 *
*          JSCRNG = # of the binning/detector                          *
*                                                                      *
*     Useful variables (common SOUEVT):                                *
*                                                                      *
*          X,Y,Zsoevt(i) = position    of the i_th source particle     *
*          TX,Y,Zsoev(i) = direction   of the i_th source particle     *
*              Wtsoev(i) = weight      of the i_th source particle     *
*              Pmsoev(i) = momentum    of the i_th source particle     *
*              Tksoev(i) = kin. energy of the i_th source particle     *
*              Agsoev(i) = age         of the i_th source particle     *
*              Aksoev(i) = Kaon ampl.  of the i_th source particle     *
*              Ussoev(i) = user var.   of the i_th source particle     *
*              Ijsoev(i) = identity    of the i_th source particle     *
*              Nrsoev(i) = region      of the i_th source particle     *
*              Nlsoev(i) = lattice     of the i_th source particle     *
*                Npsoev  = number of the source particles              *
*                                                                      *
*                                                                      *
*----------------------------------------------------------------------*
*
      INCLUDE '(FLKMAT)'
      INCLUDE '(SCOHLP)'
      INCLUDE '(SOUEVT)'
      INCLUDE '(TRACKR)'
*  this to have the event number
      INCLUDE '(CASLIM)'
*
      LSCZER = .FALSE.
      COMSCW = ONEONE
*     if it is not an energy deposition binning do nothing
      IF ( ISCRNG .NE. 1 ) RETURN
**    check if negative deposition
      IF ( RULL .LT. ZERZER ) THEN
** IJ and JTRACK here could be generalized edep, find the particle instead
         IF ( J0TRCK .NE. 0 ) THEN
            IIJ = J0TRCK
         ELSE
            IIJ = JTRACK
         END IF
*        should happen only with neutrons
         IF ( IIJ .NE. 8 ) THEN
            WRITE (LUNOUT, *) '??? negative edep ', NCASE, RULL, IIJ 
            CALL FLABRT("comscw","neg edep")
         ELSE
***   write on .out file just for knowledge
            WRITE (LUNOUT, *) 'comscw negative ',
     &        ' evt, edep, particle, binning, EK'
     &           , NCASE, RULL, IIJ, JSCRNG, ETRACK-AMNTRN
****  activate this if you really do not want it to be deposited
*            COMSCW = ZERZER
*            LSCZER = .TRUE.
         END IF
      END IF
* ======== In order to compute doses ========= *
*     (Medflk(n,iprodc) is the material number of region n
*      Rho(m) is the density of material m)
*     IF ( ISCRNG .EQ. 1 ) COMSCW = ONEONE / RHO (MEDFLK(MREG,IPRODC))
      RETURN
*=== End of function Comscw ===========================================*
      END

