* * $Id: gpustep.F,v 3.1.1.1 2002/07/11 16:02:00 cafagna Exp $ * * $Log: gpustep.F,v $ * Revision 3.1.1.1 2002/07/11 16:02:00 cafagna * First GPAMELA release on CVS * * *CMZ : 3.00/00 11/05/2001 13.44.09 by Marialuigia Ambriola *CMZ : 2.01/00 05/04/2000 14.35.18 by Marialuigia Ambriola *CMZ : 2.00/00 03/03/2000 15.39.05 by Francesco Cafagna *CMZ : 1.01/00 30/04/96 18.28.33 by Francesco Cafagna *CMZ : 1.00/03 29/04/96 16.56.08 by Francesco Cafagna *-- Author : Francesco Cafagna 29/04/96 SUBROUTINE GPGIG ************************************************************************ * * * User action in GUSTEP * * * * Variables definition: * * IN: * * IFLAG = 1, just entered GUSTEP * * IFLAG = 2, leaving GUSTEP * * * * Called by: GUSTEP * * Author: Francesco Cafagna, 29/04/96 16.56.08 * * * ************************************************************************ #include "gpques.inc" #include "gctmed.inc" #include "gckine.inc" #include "gcking.inc" #include "gcflag.inc" #include "gctrak.inc" #include "gcvolu.inc" #include "gcsets.inc" #include "gpkey.inc" #include "gpsed.inc" * LOGICAL W,GPLOOK INTEGER IFLAG INTEGER IFL,IN,MECNAM(MAXMEC) IF(IFLAG.EQ.1) GO TO 999 IN = INWVOL IF(IN.NE.0) GO TO 999 C # open(20,file='GIG.dat',access='append') C # open(21,file='All.dat',access='append') * * Is it a gamma ? * IF ((IPART.NE.1).AND.(IPART.NE.13)) GO TO 999 IF (IPART.EQ.13) write(*,*)'particle=',IPART * * Store the mechanisms active for the current step * IF(NMEC.EQ.0)THEN MECNAM(1)=NAMEC(29) ELSE DO I=1,NMEC MEC=LMEC(I) IF(MEC.LE.MAXMEC) THEN MECNAM(I)=NAMEC(MEC) ELSEIF(MEC-100.LE.MAXME1.AND.MEC-100.GT.0) THEN MECNAM(I)=NAMEC1(MEC-100) ENDIF ENDDO ENDIF * W=GPLOOK('CAAB',NAMES,NLEVEL) IF(W) THEN c CALL GPCXYZ IF ((GETOT.GT.0.009097).AND.(GETOT.LT.0.028608).AND.(IPART.EQ.1)) + then c PRINT *, ' GPUSTEP : WE FOUND A GAMMA INTO THE W ! Energy:' c + ,GETOT C # write(20,'(1x,f7.3,1x,f6.3,1x,i4,1x,a10,1x,i4,5(1x,e13.6),1x,i4)') C # + GETOT*1000., STEP, ISTAK, KCASE, NGKINE, C # + VECT(4)*VECT(7)*1000., VECT(5)*VECT(7)*1000., C # + VECT(6)*VECT(7)*1000., VECT(7)*1000., VECT(3), NUMBER(NLEVEL) ENDIF C # IF (IPART.EQ.13) then C # write(21,'(1x,f7.3,1x,f6.3,1x,i4,1x,a10,1x,i4,5(1x,e13.6),1x,i4)') C # + GETOT*1000., STEP, ISTAK, KCASE, NGKINE, C # + VECT(4)*VECT(7)*1000., VECT(5)*VECT(7)*1000., C # + VECT(6)*VECT(7)*1000., VECT(7)*1000., VECT(3), NUMBER(NLEVEL) C # ENDIF ENDIF 999 CONTINUE C # close(20) C # close(21) RETURN END