pxprnt.f

Go to the documentation of this file.

CDECK  ID>, PXPRNT.
      SUBROUTINE pxprnt (IFST,ILST,ISZE,IPRT,ARRY,COPT)
*.*********************************************************
*. ------
*. PXPRNT
*. ------
*. SOURCE: J.W.Gary
*. Print-out of vectors from an array of vectors
*. Usage     :
*.
*.      INTEGER  ITKDM,MXTRAK
*.      PARAMETER  (ITKDM=1.or.more,MXTRAK=1.or.more)
*.      INTEGER IFST,ILST,ILEN
*.      REAL  ARRY (ITKDM,MXTRAK)
*.      CHARACTER*1  COPT
*.
*.      ... fill vectors PTRAK
*.
*.      IFST = 1.to.MXTRAK
*.      ILST = IFST.to.MXTRAK
*.      ILEN = 1.to.ITKDM
*.      COPT = '4'
*.      CALL PXPRNT (IFST,ILST,ITKDM,ILEN,ARRY,COPT)
*.
*.      ... example printout (with IFST=1,ILST=3,COPT='4')
*.
*.      Vector    Px          Py          Pz           E
*.         1 -0.1431E+00  0.2408E+00  0.2636E+00  0.4092E+00
*.         2  0.4027E+00  0.3949E+00 -0.4255E+00  0.7202E+00
*.         3 -0.1195E+00 -0.1654E+00  0.7137E-01  0.2573E+00
*.
*. INPUT     : IFST    First vector to print
*. INPUT     : ILST    Last vector to print
*. INPUT     : ITKDM   The length of each vector in the array
*. INPUT     : ILEN    The number of elements in each vector
*.                     to print (1 to ILEN)
*. INPUT     : ARRY    The array containing the vectors
*. INPUT     : COPT    Printing option
*.                       ='4' for 4-momenta
*.                       ='E' for exponential (E12.4) formatting
*.                       =' ' for "standard" (F8.2) formatting
*.
*.*********************************************************
      IMPLICIT NONE
      INTEGER  iol
      parameter(iol=6)
      INTEGER  ifst,ilst,isze,ix,jx,iprt
      REAL arry (isze,*)
      CHARACTER*1  copt

      IF (iprt.LT.1.OR.iprt.GT.10) THEN
          WRITE (iol,fmt='('' PXPRNT: Error,'',
     +      ''Array size must be between 1 and 10'')')
          RETURN
      END IF
      IF (copt.EQ.'4') THEN
          WRITE (iol,fmt='('' Vector'',4X,''Px'',10X,
     +           ''Py'',10X,''Pz'',10X,'' E'')')
      ELSE IF (copt.EQ.'E') THEN
          WRITE (iol,fmt='(:'' Vector'',I6,9(I12))')
     +          (ix,ix=1,iprt)
      ELSE
          WRITE (iol,fmt='(:'' Vector'',I6,9(I8))')
     +          (ix,ix=1,iprt)
      END IF
      DO 160  jx = ifst,ilst
          IF (copt.EQ.'4') THEN
              WRITE (iol,fmt='(1X,I4,4E12.4)')
     +               jx,(arry(ix,jx),ix=1,4)
          ELSE IF (copt.EQ.'E') THEN
              WRITE (iol,fmt='(:I5,1X,10(E12.4))')
     +           jx,(arry(ix,jx),ix=1,iprt)
          ELSE
              WRITE (iol,fmt='(:I5,1X,10(F8.2))')
     +           jx,(arry(ix,jx),ix=1,iprt)
          END IF
 160  CONTINUE
      RETURN
      END