SUBROUTINE AUSGAB
C
C*********************************************************************
C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
C*********************************************************************
C  WE USE AUSGAB TO FILL OUTPAR WITH PARTICLE COORDINATES.
C*********************************************************************
*KEEP,GENER.
      COMMON /GENER/   GEN,ALEVEL
      DOUBLE PRECISION GEN,ALEVEL
*KEND.
      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
*KEEP,PARPAR.
      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
      INTEGER          ITYPE,LEVL
*KEEP,RUNPAR.
      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
     *                 MONIOU,MDEBUG,NUCNUC,
     *                 CETAPE,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE,
     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
      COMMON /RUNPAC/  DSN,HOST,USER
      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
      REAL             STEPFC
      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE
      INTEGER          CETAPE
      CHARACTER*79     DSN
      CHARACTER*20     HOST,USER
 
      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
*KEEP,STACKE.
      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
      DOUBLE PRECISION E(60),TIME(60)
      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
*KEND.
      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
      COMMON/ACLOCK/NCLOCK,JCLOCK
      NOBS=IOBS(NP)
C*** ANGLE WITH RESPECT TO X AXIS
      IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
       ANGLEX = -ATAN2(V(NP),U(NP))
      ELSE
       ANGLEX = 0.
      END IF
C***  PARTICLE IS WRITTEN IN OUTPUT BUFFER ARRAY
      OUTPAR(1)=IQ(NP)
      OUTPAR(2)=E(NP)*0.001D0
      OUTPAR(3)=W(NP)
      OUTPAR(4)=ANGLEX
      OUTPAR(5)=-Z(NP)
      OUTPAR(6)=TIME(NP)
      OUTPAR(7)=X(NP)
      OUTPAR(8)=-Y(NP)
      OUTPAR(9)=IGEN(NP)
      OUTPAR(10)=ALEVEL
      LEVL=NOBS
      CALL OUTPUT
      IF (DEBUG.OR.(JCLOCK.GT.1 .AND. NCLOCK.GT.JCLOCK)) THEN
       WRITE(MDEBUG,* )'AUSGAB: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
       XX=X(NP)
       YY=-Y(NP)
       ZZ=-Z(NP)
       ANGLEZ=W(NP)
       ANGLX=ANGLEX
       ETOT=E(NP)*.001
       WRITE(KMPO,170) IQ(NP),ETOT,ANGLEZ,ANGLX,ZZ,TIME(NP)*1.0D3,XX,YY,
     *  IGEN(NP)
170    FORMAT(' AUSGAB:',10X,I4,1X,F10.4,1X,F7.4,1X,F7.4,1X,F9.0, F9.6,
     *   1X,F10.1,1X,F10.1,1X,I3
     * )
      END IF
      RETURN
      END