*$ 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