*$ CREATE DETOUTPUT.FOR
*COPY DETOUTPUT
*
      PROGRAM DETOUTPUT
      
      CHARACTER FILE*80, RUNTIT*80, RUNTIM*32, CHNAME*10
  
*========= detect ===========================================================*
*============================================================================*
*       S. Wurth 12/07/2007 inspired by                                      *
*           routine usbrea.f by  A. Ferrari & A. Fasso'                      *  
*                                                                            *
*       RUNTIT : title of the job                                            *
*       RUNTIM : time of the job                                             *
*       WEIPRI : total weight of the primary particles                       *
*       NCASE : number of primary particles                                  *
*       NEDT : detector number                                               *
*       CHNAME : detector name                                               *
*       NBIN : number of energy bins                                         *
*       EMIN : minimum total energy                                          *
*       EBIN : width of energy bin                                           *
*       ECUT : cut-off energy for the signal                                 *
*       NBIN values IV(I) : they are the spectrum channels, or energy bins   *
*                                                                            *
*============================================================================*
      INTEGER*4 NCASE, NDET, NBIN, IV(1024)
      REAL EMIN, EBIN, ECUT
      CHARACTER CHFORM*20
      PARAMETER (NRGNMX = 10)
      PARAMETER (NDTCMX = 10)
      PARAMETER (NSCRMX = 10)
      PARAMETER (NDTBIN = 1024)
      PARAMETER (IPUSBNN = -17)
      PARAMETER (MXXRGN = 10) 
      CHARACTER*10 TITDET,TITSCO
      LOGICAL LDTCTR
      COMMON /DETCT/  EDTMIN(NDTCMX), EDTBIN(NDTCMX), EDTCUT(NDTCMX),
     &        KDTREG(NRGNMX,NDTCMX), KDTDET(NDTCMX,NSCRMX),
     &        NDTSCO, NDTDET, LDTCTR, IDTREG(MXXRGN),
     &        DTSCD(NSCRMX)
      COMMON /DETCH/  TITDET(NDTCMX), TITSCO(NSCRMX)
*      SAVE / DETCT /, / DETCH / 
      PARAMETER (NDTCM2 = 10)
      COMMON /DETLOC/ ACCUMP (NDTCM2), ACCUMN (NDTCM2),
     &		  ICOINC(NDTCM2), NCLAS
*      SAVE / DETLOC /
      DIMENSION JB(NRGNMX), LIO(NRGNMX) 
      LOGICAL LOPEN, LSTATI, LREFLX, LREFLY, LRFLZ
           MIO   =0
           NCTOT =0
           WCTOT =0.E+00
           LSTATI=.FALSE.
         WRITE(*,'('' Type the input file name: '',$)')
         READ (*,'(A)')FILE
           LQ=LNNBLN(FILE)
         IF (LQ .LE. 0) GO TO 500
         OPEN (UNIT=1,FILE=FILE,STATUS='OLD',FORM='UNFORMATTED')
           IRECRD = 0
         READ (1) RUNTIT,RUNTIM,WEIRPI,NCASE
           IRECRD = IRECRD + 1
         WRITE(*,*)RUNTIT
         WRITE(*,*)RUNTIM
         WRITE(*,*)WEIRPI
         WRITE(*,*)NCASE
         READ (1) NDET,CHNAME,NBIN,EMIN,EBIN,ECUT
           IRECRD=IRECRD + 1
           IRECRD=0
	 READ(1) (IV(II), II=1, NBIN)  
	   IRECRD = IRECRD +1
         DO 400 II = 1, NBIN
*         WRITE(*,*)IV(II)
400     CONTINUE 
           IRECRD = 0
*        BACKSPACE 1
*        REWIND 1
*        DO 500 IR=1, IRECRD
*          READ (1)
*        ENDDO
500     CONTINUE
        CLOSE (UNIT=1)           
        WRITE(*,'('' Type the output file name: '',$)')
        READ (*,'(A)')FILE
* Start UNIX_seq
        OPEN (UNIT=1,FILE=FILE,STATUS='UNKNOWN',FORM='FORMATTED')
*        LUNOUT=11
* End of UNIX_Seq
         WRITE (UNIT=1,
     &   FMT='(/,25X,''***** Title of the run: '',A80,  '' *****'')')
     &   RUNTIT 	
         WRITE (UNIT=1,
     &   FMT='(/,15X, ''***** Detector number: '',I5,  '' *****''
     &   /,15X, ''***** Detector name: '',A10,  '' *****''
     &   /,15X, ''***** Number of energy bins: '',I6, '' *****''
     &   /,15X, ''***** Minimun total energy (GeV): '',1P,E11.4, 
     &   '' *****''/,15X, ''***** Width of each energy bin (GeV): '',
     &   1P,E11.4, '' *****''
     &   /,15X, ''***** Cutoff energy for the signal (GeV): '' 
     &   ,1P,E11.4, '' *****'')')
     &   NDET,CHNAME,NBIN,EMIN,EBIN,ECUT
900       CONTINUE
          WRITE (UNIT=1,
     &    FMT='(/15X, ''***** The spectrum follows: *****'',/)')  
          DO 1000 II = 1, NBIN
          WRITE (UNIT=1,
     &    FMT='(I6 '':'',I8)')
     &    II,IV(II)
1000    CONTINUE          
        STOP
	END
		
*$ CREATE LNNBLN.FOR
*COPY LNNBLN
*
*=== Lnnbln ===========================================================*
*
      INTEGER FUNCTION LNNBLN (CARD)
*
*
      CHARACTER CARD*(*)
*
      LENGTH = LEN (CARD)
      DO 100 LQ = LENGTH, 1, -1
         IF ( CARD (LQ:LQ).NE.' ') GO TO 200
  100 CONTINUE
      LQ     = 0
  200 CONTINUE
      LNNBLN = LQ
      RETURN
*=== End of function Lnnbln ===========================================*
      END

