cstack.f

Go to the documentation of this file.

!       stacking tracking information
!
      subroutine cpush(a)
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
#include  "Zevhnv.h"
      type(track)::a
      character*70  msg

!
!      call cifDead(a, icon)  ! this is moved to after cpop.
!                             ! so some ptcl may be stored even if 
!                             ! low energy.
!      if(icon .eq. 0) then
      if( a%p%code /=  0) then
         if( stack_pos .ge. max_stack_size) then
            write(msg,*) 'stack area full=',max_stack_size
            call cerrormsg(msg, 0)
         else
            stack_pos = stack_pos + 1
            stack(stack_pos) = a
         endif
      else
!           although very rare, 0 code appears;  neglect it (once /5 days)

         write(0,*) ' code=0  appeared subcode=',a%p%subcode
         write(0,*) ' charge=',a%p%charge
         write(0,*) ' px,py, pz, E, mass=',a%p%fm%p(1:4), a%p%mass
         write(0,*) ' neglected for stacking in cstack.f'
         write(0,*) 'ActiveMdl=',activemdl
!c         call checkstat("in cpush")
      endif
      end
!------------------------------------------------------------
      subroutine cpop(a, remain)
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
      type(track)::a

      integer remain
!
!         remain: int. is the number of ptcls remaining unprocessed
!                 including the current one to be processed now.
      if( stack_pos .le. 0) then
         remain = 0
      else
         remain =  stack_pos 
         a = stack(stack_pos)
         stack_pos = stack_pos -1
      endif
      end
      subroutine cgetstacked(stackpos, aTrack, icon)
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
      integer stackpos  !  input.  stack pos from which track is
                        ! to be extracted.
      type(track)::aTrack  ! output extracted track.
      integer icon   ! output. 0 OK 1--> no. track at stackpos 
!          diff. from cpop;  Stack_pos is not affected.      
      if(stackpos .le. stack_pos .and. stackpos .ge. 1) then
         atrack = stack(stackpos)
         icon = 0
      else
         icon = 1
      endif
      end

!---------------------------------------------------------
      subroutine cinitstack
!         initialize stack.
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
      stack_pos = 0
      end
      subroutine cgetcurrentstackpos(stackpos)
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
      integer stackpos
      stackpos=stack_pos
      end
      subroutine cresetstackpos(stackpos)
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
      integer stackpos
      stack_pos=stackpos
      end


      subroutine csortstack
!        sort stack dscending order 
      implicit none
#include  "Zmaxdef.h"
#include  "Ztrack.h"
#include  "Zstackv.h"
      real*8 erg(max_stack_size)
      type(track)::sorted(max_stack_size)
      integer  idx(max_stack_size)
      
      integer i, j, k
      type(track)::temp
      do  i = 1,  stack_pos
         erg(i) = stack(i)%p%fm%p(4)
      enddo
      
      call kqsortd(erg, idx, stack_pos)
      call ksortinv(idx, stack_pos)
      
      do i = 1, stack_pos
         sorted(i) = stack(idx(i))
      enddo

      do i = 1, stack_pos
         stack(i) = sorted(i)
      enddo
      end