**********************************************************************
*     ----------------------------
      integer function apip2ip(ip)
*     ----------------------------
*
*      convert apip to ntuple-dst particle code
*
*    ----------------------------------------
*    |   particle  |     apip   |  return   |
*    |---------------------------------------
*    |     gamma   |       22   |      1    |
*    |  electron   |       11   |      2    |
*    |      muon   |       13   |      3    |
*    |      pion   |      211   |      4    |
*    |      kion   |      321   |      5    |
*    |    proton   |     2212   |      6    |
*    |     other   |            |     10    |
*    ----------------------------------------
*
**********************************************************************
      implicit none
      integer ip

      apip2ip=0
      if (ip.eq.  22) apip2ip=1
      if (ip.eq.  11) apip2ip=2
      if (ip.eq.  13) apip2ip=3
      if (ip.eq. 211) apip2ip=4
      if (ip.eq. 321) apip2ip=5
      if (ip.eq.2212) apip2ip=6
      if (apip2ip.eq.0) apip2ip=10
      return
      end

**********************************************************************
*     ----------------
      subroutine getv2
*     ----------------
*
*     get vector of secondary particles
*
**********************************************************************
      implicit none

#include "mcvector_commons.h"

      INTEGER NW,IBUF(20),I
      REAL    RBUF(20)
      EQUIVALENCE (IBUF(1),RBUF(1))      

      CALL KZGET1('CONVVECT',0,NW,IBUF)
      NVECT2 = IBUF(1)
      IF (NVECT2.GT.50) NVECT2 = 50
      IF (NVECT2.NE.0) THEN
         DO I=1,NVECT2
            CALL KZGET1('CONVVECT',I,NW,IBUF)
            IORGA(I)   = IBUF(1)
            IPA2(I)    = IBUF(2)
            POSA2(1,I) = RBUF(3)
            POSA2(2,I) = RBUF(4)
            POSA2(3,I) = RBUF(5)
            PIN2(1,I) = RBUF(6)
            PIN2(2,I) = RBUF(7)
            PIN2(3,I) = RBUF(8)
            PABS2(I)  = SQRT(PIN2(1,I)**2+PIN2(2,I)**2+PIN2(3,I)**2)
         ENDDO
      ENDIF
      RETURN
      END
************************************************************************
*   30/06/89 906301732  MEMBER NAME  DIRTOT   (FORT)        FORTRAN
*
      SUBROUTINE SPDIRTOT(DIR)
*
*   DETERMINE THE DIRECTION OF TOTAL MOMENTUM BY TAKING AN WEIGHTED
*  VECTOR SUM OF DIR(3,5).
*                                   T.KAJITA   JUNE 30, 1989
*
*      COMMON /COMMUL/NRING,POS(3),DIR(3,5),IP(5),RTOT(5),AMOM(5),SMOM(5)
*     & ,CENT(3,5),ANGCER(5),DANG(5)
*
************************************************************************
      IMPLICIT NONE
#undef APMRING_H_INCLUDED_
#include "apmring.h"
      INTEGER IR
      REAL DIR(3),ABSDIR

      DIR(1)=0.
      DIR(2)=0.
      DIR(3)=0.
      DO 1200 IR=1,APNRING
      DIR(1)=DIR(1)+APDIR(1,IR)*APRTOT(IR)
      DIR(2)=DIR(2)+APDIR(2,IR)*APRTOT(IR)
      DIR(3)=DIR(3)+APDIR(3,IR)*APRTOT(IR)
 1200  CONTINUE
      ABSDIR = SQRT ( DIR(1)**2 + DIR(2)**2 + DIR(3)**2 )
      IF (ABSDIR.EQ.0.) THEN
         DIR(1)=0.
         DIR(2)=0.
         DIR(3)=0.
      ELSE
         DIR(1)=DIR(1)/ABSDIR
         DIR(2)=DIR(2)/ABSDIR
         DIR(3)=DIR(3)/ABSDIR
      ENDIF
      RETURN
      END
************************************************************************
*
      REAL FUNCTION ELAPSEDAY(NDAY,NTIM)
*
*     return elaspsed day from 1-Apr-1996
*
************************************************************************
      implicit none
      integer i,nday(3),ntim(3),iday(3),itim(3),ileap,fullday(0:1)
      integer monday(12)
      data (fullday(i),i=0,1) /365,366/
      data (monday(i),i=1,12) /31,28,31,30,31,30,31,31,30,31,30,31/

      elapseday=0
      call ucopy(nday,iday,3)
      call ucopy(ntim,itim,3)
      if (iday(1).ge.96) then
         iday(1) = iday(1) + 1900
      else
         iday(1) = iday(1) + 2000
      endif
      if ( iday(1).lt.1996 ) then
         write(6,*)'year of event too fast ',iday(1)
         iday(1) = iday(1)+100
C         stop
      endif

      elapseday = float(itim(1)*3600 + itim(2)*60 +itim(3))/86400.
      elapseday = elapseday + float(iday(3) - 1)
      ileap=0
      if ( mod(iday(1),4).eq.0 .and.
     &    (mod(iday(1),100).ne.0 .or. mod(iday(1),400).eq.0) ) ileap=1
      do while ( iday(2).ne.1 )
         iday(2) = iday(2) - 1
         elapseday = elapseday + float(monday(iday(2)))
         if ( ileap.eq.1 .and. iday(2).eq.2 )
     &              elapseday = elapseday + 1.
      enddo

      do while ( iday(1).gt.1996 )
         iday(1) = iday(1) - 1
         ileap=0
         if ( mod(iday(1),4).eq.0 .and.
     &        (mod(iday(1),100).ne.0 .or. mod(iday(1),400).eq.0) )
     &        ileap=1
         elapseday = elapseday + fullday(ileap)
      enddo

      elapseday = elapseday - (31.+29.+31.)

      return
      end


**********************************************************************
      Subroutine set_apip()

      implicit none

#undef APMRING_H_INCLUDED_
#include "skparm.h"
#include "apmring.h"
#include "appatsp.h"

      integer i,k,ir_isnan
      real real_max,r_max_normal
      logical icall
      data icall/.false./

      if ( .not. icall ) then
         real_max = r_max_normal()
         icall=.true.
      endif

      do i=1,apnring
         do k=1,6
            if ( abs(approb(k,i)).gt.real_max .or.
     $           ir_isnan(approb(k,i)).eq.1 ) then
               approb(k,i)=-10000000.*float(k)
            endif
            if ( abs(apprmslg(k,i)).gt.real_max .or.
     $           ir_isnan(apprmslg(k,i)).eq.1 ) then
               apprmslg(k,i)=-10000000.*float(k)
            endif
         enddo
         if ( apprmslg(2,i).gt.apprmslg(3,i) ) then
            apip(i) = 13
         else
            apip(i) = 11
         endif
      enddo
      if ( apnring.eq.1 ) then
         if ( approb(2,1).gt.approb(3,1) ) then
            apip(1) = 11
         else
            apip(1) = 13
         endif
      endif
      return
      end

**********************************************************************
      Subroutine set_apdir(PCFLAG)

      implicit none

#undef APMRING_H_INCLUDED_
#include "skparm.h"
#include "apmring.h"
#include "appatsp.h"

      logical PCFLAG
      integer i,ipx,sppatnum

C
C  case of PC sample 
C
      if ( pcflag ) then               !  use pcdir in case of PC 
         call getpcdir(apdir)

C
C  w/o MS infomation , use ring counting's direction
C      
      else if (apmsdir(2,1,1).eq.0. .and. apmsdir(2,2,1).eq.0. .and.
     &         apmsdir(2,3,1).eq.0. ) then

      else
C
C  case of 1 ring, use msfit direction
C
         if (apnring.eq.1) then
         else
C
C  multi-ring
C
            do i=1,apnring
               ipx = sppatnum(apip(i))
               apdir(1,i) = apmsdir(ipx,1,i)
               apdir(2,i) = apmsdir(ipx,2,i)
               apdir(3,i) = apmsdir(ipx,3,i)
            enddo
         endif
      endif
      return
      end

         
