*
* $Id: gpdcal.F,v 3.4 2005/07/25 11:53:20 cafagna Exp $
*
* $Log: gpdcal.F,v $
* Revision 3.4  2005/07/25 11:53:20  cafagna
* Several updates. See history for details
*
* Revision 3.3  2005/06/21 02:42:03  cafagna
* Major modification to the geometry and to the random number chain
*
* Revision 3.2  2003/12/17 11:32:48  pamela
* CALO SIMULATION COMPLETED: geometry and special tracking parameters updated and simulation checked by a comparison with the Trieste's standalone Monte Carlo simulation
*
* Revision 3.1.1.1  2002/07/11 16:02:14  cafagna
* First GPAMELA release on CVS
*
*
*CMZ :  2.03/00 31/10/2000  11.18.51  by  Francesco Cafagna
*CMZ :  2.02/00 10/10/2000  14.09.00  by  Francesco Cafagna
*CMZ :  2.01/00 05/04/2000  14.35.18  by  Marialuigia Ambriola
*CMZ :  2.00/00 29/02/2000  17.39.10  by  Francesco Cafagna
*CMZ :  1.02/00 10/02/2000  17.28.08  by  Francesco Cafagna
*CMZ :  1.01/00 21/05/96  17.33.38  by  Francesco Cafagna
*CMZ :  1.00/02 05/04/96  11.26.03  by  Francesco Cafagna
*-- Author :    Francesco Cafagna   23/02/96
      SUBROUTINE GPDCAL
************************************************************************
*                                                                      *
* To perform CAL digitization                                          *
*                                                                      *
* Called by: GUDIGI                                                    *
* Author: Francesco Cafagna, 23/02/96 12.50.38                         *
*                                                                      *
************************************************************************
#include "gcunit.inc"
#include "gcflag.inc"
#include "gpphit.inc"
      PARAMETER (NH1=NHCALI,NHM1=NHMCALI,NVOL1=2)
      PARAMETER (NH=NHCAL,NHM=NHMCAL,NVOL=3)
#include "gprhit.inc"
#include "gpcal.inc"
#include "gpsed.inc"
#include "gpkey.inc"
#include "gpgeo.inc"
*ml:21/02/02
#include "gpencal.inc"
*end ml.
*
      INTEGER IS,ID,NV,NVM,NNHM
      CHARACTER*4 CSET
      INTEGER ITRA1(NHM1),NUMD1(NVOL1),NUMBV1(NVOL1,NHM1)
      REAL VHITS1(NH1,NHM1)
*
* Vector zeroed
*
      CALL VZERO(ICAPL ,NHMCAL)
      CALL VZERO(ICASI ,NHMCAL)
      CALL VZERO(ICAST ,NHMCAL)
      CALL VZERO(XCASI,NHMCAL)
      CALL VZERO(YCASI,NHMCAL)
      CALL VZERO(ZCASI,NHMCAL)
      CALL VZERO(IPARCAL,NHMCAL)
      CALL VZERO(ERCASI,NHMCAL)
      CALL VZERO(NUMD  ,NVOL)
      CALL VZERO(NUMD1 ,NVOL1)
c ml:16/4/2003
      CALL VZERO(ICASTRIP,NHMCALI)
      CALL VZERO(ICAPLANE,NHMCALI)
      CALL VZERO(ICAMOD,NHMCALI)
      CALL VZERO(ENESTRIP,NHMCALI)
c end 16/4/2003
*
*
* The tungsten plane case
*
      NV = NVOL
      NVM= NVMAX
      IS   = ISCAL
      ID   = IDCAST
      IT = -1
      CSET = 'CAL '
*
* Check on the volume level
*
      IF (NV.GT.NVM) THEN
         WRITE(CHMAIL,10000) CSET,CNSED(IS,ID),NVOL,NVMAX,
     +                        IDRUN,IDEVT
         CALL GMAIL(1,0)
         GO TO 10
      ENDIF
      CALL VZERO(VHITS,NH*NHM)
      CALL VZERO(ITRA ,NHM)
      NHITS = -1
*
* Update the max number of hits to be retrived
*
      NNHM = NHM
c$$$      IF(NNHM.LE.0) THEN
c$$$         WRITE(CHMAIL,10100) CSET,CNSED(IS,ID),NTHCAL,NHM,
c$$$     +                        IDRUN,IDEVT
c$$$         CALL GMAIL(1,0)
c$$$         GO TO 10
c$$$      ENDIF
      CALL VZERO(NUMBV,NVOL*NHM)
      CALL GPRHIT(CSET,CNSED(IS,ID),IS,ID,NVOL,NH,NNHM,1,
     +           IT,NUMD,ITRA,NUMBV,VHITS,NHITS)
*
* If there was a problem in GPRHIT then exit
*
      IF(NHITS.LT.0) THEN
         WRITE(CHMAIL,10200) CSET,CNSED(IS,ID),NHITS,NHM,
     +                        IDRUN,IDEVT
         CALL GMAIL(1,0)
         GO TO 10
      ENDIF
*
* >>>>>>>>>>>>>>>>>>>>>> DIGI action
*
*
* Fill the CWN common
*
      NTHCAL=0
      DO I=1,NHITS
         NTHCAL = NTHCAL + 1
         ICAPL(NTHCAL) = NUMBV((NVCAL-2),I)
         ICASI(NTHCAL) = NUMBV((NVCAL-1),I)
         ICAST(NTHCAL) = NUMBV((NVCAL),I)
         XINCAL(NTHCAL) = VHITS(1,I)
         YINCAL(NTHCAL) = VHITS(2,I)
         ZINCAL(NTHCAL) = VHITS(3,I)
         ERELCAL(NTHCAL) = VHITS(4,I)
c         IPARCAL(NTHCAL) = VHITS(5,I)
c         P0CAL(NTHCAL) = VHITS(6,I)
      ENDDO
C
C The energy released per strip
C
      NV = NVOL1
      NVM= NVMAX
*
* The tungsten plane case
*
      IS   = ISCAL
      ID   = IDCASI
      IT = -1
      CSET = 'CAL '
*
* Check on the volume level
*
      IF (NV.GT.NVM) THEN
         WRITE(CHMAIL,10000) CSET,CNSED(IS,ID),NVOL,NVMAX,
     +                        IDRUN,IDEVT
         CALL GMAIL(1,0)
         GO TO 10
      ENDIF
      CALL VZERO(VHITS1,NH1*NHM1)
      CALL VZERO(ITRA1 ,NHM1)
      NHITS = -1
*
* Update the max number of hits to be retrived
*
      NNHM = NHM1
      IF(NNHM.LE.0) THEN
         WRITE(CHMAIL,10100) CSET,CNSED(IS,ID),NTHCALI,NHM,
     +                        IDRUN,IDEVT
         CALL GMAIL(1,0)
         GO TO 10
      ENDIF
      CALL VZERO(NUMBV1,NVOL1*NHM1)
      CALL GPRHIT(CSET,CNSED(IS,ID),IS,ID,NVOL1,NH1,NNHM,1,
     +           IT,NUMD1,ITRA1,NUMBV1,VHITS1,NHITS)
*
* If there was a problem in GPRHIT then exit
*
      IF(NHITS.LT.0) THEN
         WRITE(CHMAIL,10200) CSET,CNSED(IS,ID),NHITS,NHM,
     +                        IDRUN,IDEVT
         CALL GMAIL(1,0)
         GO TO 10
      ENDIF
*
* >>>>>>>>>>>>>>>>>>>>>> DIGI action
*
*
* Fill the CWN common
*
c     
      NTHCALI=0
      DO I=1,NHITS
         NTHCALI=NTHCALI+1
         ICASTRIP(NTHCALI)=NUMBV1(NVCALI,I)
         ICAPLANE(NTHCALI)=NUMBV1((NVCALI-1),I)
         ICAMOD(NTHCALI)=VHITS1(1,I)
         ENESTRIP(NTHCALI)=VHITS1(2,I)
      ENDDO
c
10000 FORMAT(' GPDCAL: VOLUME level too big: SET=',A4,', DET=',A4,',
     +     NVOL=',I3,', NVMAX=',I3,', RUN=',I5,', EVT=',I8)
10100 FORMAT(' GPDCAL: MAX number of hits retrived: SET=',A4,
     +     ', DET=',A4,',NHREAD=',I5,', NHMAX=',I5,
     +     ', RUN=',I5,', EVT=',I8)
10200 FORMAT(' GPDCAL: Error in GPRHIT: SET=',A4,
     +     ', DET=',A4,',NHITS=',I5,', NHMAX=',I5,
     +     ', RUN=',I5,', EVT=',I8)
 10   RETURN
      END