Compass source library.file-id: 'DALAAA19.TOFCOR' Compass source library.file-id: 'DALAAA18.TOFCOR' SUBROUTINE TOFCOR(D1E,D2E,TOF,RC) C*********************************************************************** C* Institute: MPE * * Subroutine: * C* * * * C* DDDDDD AA LLL * GRO * TOFCOR * C* DDDDDDD AA AA LLL * COMPTEL * * C* DD DD AA AA LLL * * Revision: 2 * C* DD DD AA AA LLL ****************** * C* DD DD AAAAAAAA LLL * * Author: * C* DD DD AAAAAAAA LLL * * Cor * C* DD DD AA AA LLL * COMPASS * de Vries * C* DD DD AA AA LLL * * * C* DDDDDDD AA AA LLLLLLLL * * Date : * C* DDDDDD AA AA LLLLLLLL * * 1993-09-10 * C* * * * C* Data Access Layer * * * C*********************************************************************** C* Function: Correct ToF * C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* C * C Calls: * C ====== * C None in production version. C Name Function * C ------ --------------------------------------------- * C CPRINT LUs for print and error (in comment ONLY) * C * C Inputs: * C ======= * C Name Type Description Location * C ------ ----------- ------------------------------------- -------- * C D1ENER real D1 energy (* MHT corr) of an event * C D2ENER real D2 energy (* MHT corr) of an event * C TOF real derived TOF * C * C Outputs: * C ======== * C Name Type Description Location * C ------ ----------- ------------------------------------- -------- * C TOF real TOF after polynomial correction Argumnet * C RC integer return code Argument * C * C Modified COMMON Variables: * C ========================== * C None (debug common left in comment for potential use) * C * C Signals: * C ======== * C Only zero, omitted for current version C C C Subroutine History: C ================== C Version: Date: Author: reason for change: C 1.0 280793 B. Boer/ROL initial version C 1.1 100893 C. de Vries no printout C 2 93-09-03 R. Freuder FTN77 standardization C 2 93-09-06 H. Steinle Function text updated;; C 2 93-09-10 R. Freuder Correct all TOF C Documentation : C ============== C COM-RP-ROL-DRG-53 issue 1 B. Boer June 1993 C C Description: C =========== C corrects the measured ToF of an event, using the delivered C D1 and D2 energies of the event and the given C functions ToF(D1E) and ToF(D2E). C With these functions the ToF-shift relative to a C reference ToF, belonging the (D1E,D2E)-combination C for which TOF(D1E) and ToF(D2E) are determined, C is calculated. C C The D1-energy range is split in 2 intervals; C for each of these intervals the coefficients of a C polynomial fit to ToF(D1E) are given. C C First the interval in which the D1-energy of the event falls C is determined, and then the corresponding coefficients C are used to calculate the ToF-correction for this D1E. C C The same is done for the D2-energy, whereby C the D2E-range is split in 3 intervals. C C Finally the corrections are combined. C C NOTE, that the fit is only valid within the C D1E and D2E intervals: C D1E: 50 keV - 20 MeV C D2E: 600 keV - 30 MeV C C if the event's D1E and/or D2E is outside these intervals, C correction is made as if the D1E were 50 kev or 20 MEV and/or C D2E were 600 kev or 30 Mev. C C*********************************************************************** C*********************************************************************** C IMPLICIT NONE INTEGER RC C INTEGER PRLU,ERLU,RETGP,RETNO C LOGICAL FIRST C DATA FIRST/.TRUE./ C*********************************************************************** C in- and output variables C*********************************************************************** REAL D1E,D2E C \ C delivered D1 and D2 energies (in keV) C REAL TOF C \ C input: measured time-of-flight C output: corrected time-of-flight C C*********************************************************************** C local parameters C*********************************************************************** C REAL D1ENER, D2ENER C \ D1e & D2e variables used in TOF calculation REAL TOFREF C \ C reference ToF: the ToF corrections are calculated with C respect to this TOF. C REAL TOFCEN C \ C ToF the corrected peak will be centered at C C C*********************************************************************** C INTEGER D1STA,D1END C \ C begin and end of D1E-range C for which fit is valid C INTEGER D2STA,D2END C \ C begin and end of D2E-range C for which fit is valid C C*********************************************************************** C coefficients of ToF(D1E) C*********************************************************************** INTEGER NDEGD1 C \ C degree of polyn. fit to ToF(D1E) REAL D1EBRK C \ C D1-energy 'breaking' the C D1E-fit range in 2 intervals REAL D11COF(7),D12COF(7) C to be dimension NDEGD1+1 C C*********************************************************************** C coefficients of ToF(D2E) C*********************************************************************** INTEGER NDEGD2 C REAL D2EBR1,D2EBR2 C REAL D21COF(5),D22COF(5),D23COF(5) C to be dimension NDEGD2 C C*********************************************************************** C local variables C*********************************************************************** INTEGER I REAL D1ECOR,D1EMEV,D1EDUM REAL D2ECOR,D2EMEV,D2EDUM C ! ! \--> energy dummies C ! ! C ! \--> energies converted in MeV C ! C \--> ToF corrections due to D1E and D2E C PARAMETER (D1STA=50.0,D1END=20000.0) C \ C begin and end of D1E-range C for which fit is valid PARAMETER (D2STA=600.0,D2END=30000.0) C \ C begin and end of D2E-range PARAMETER (NDEGD1=6) C \ C degree of polyn. fit to ToF(D1E) C for which fit is valid PARAMETER (D1EBRK=2250.0) C \ C D1-energy 'breaking' the C D1E-fit range in 2 intervals PARAMETER (NDEGD2=4) C \ C degree of polyn. fit to ToF(D2E) PARAMETER (D2EBR1=1400.0,D2EBR2=5500.0) C \ C D2-energies 'breaking' the C D2E-fit range in 3 intervals DATA TOFREF/118.30/ C \ C reference ToF: the ToF corrections are calculated with C respect to this TOF. DATA TOFCEN/120.0/ C \ C ToF the corrected peak will be centered at DATA D11COF/111.74858,28.280247,-45.024305,35.183210, + -14.639463,3.1342536,-0.2711735/ C \ C polynomial coefficients of ToF(D1E) C for interval 1: D1E < D1EBRK DATA D12COF/116.25374,0.500407092,0.38182720,-0.080145513, + 0.0065569790,-0.00024650067,3.5077240E-6/ C \ C polynomial coefficients of ToF(D1E) C for interval 2: D1E > D1EBRK DATA D21COF/181.77024,-252.41070,371.09898, + -232.83985,52.918785/ C \ C polynomial coefficients of ToF(D2E) C for interval 1: D2E < D2EBRK1 DATA D22COF/120.91608,-0.15048490,-0.45526025, + 0.11710009,-0.0082172427/ C \ C polynomial coefficients of ToF(D2E) C for interval 2: D2EBRK1 < D2E < D2EBRK2 DATA D23COF/119.24278,-0.43134699,0.060183080, + -0.0026847790,3.7720986E-5/ C \ C polynomial coefficients of ToF(D2E) C for interval 3: D2EBRK2 < D2E C*********************************************************************** C end of declarations; now start C*********************************************************************** RC=0 C IF (FIRST) THEN C CALL CPRINT(PRLU,ERLU,RETGP,RETNO) C WRITE (PRLU,'('' TOFCOR: time-of-flight correction applied'')' C FIRST = .FALSE. C ENDIF C C*********************************************************************** C check if D1E and D2E are within fit-ranges C Original treatment was to set an error return non-zero. C*********************************************************************** D1ENER = D1E D2ENER = D2E IF (D1ENER.LT.D1STA) D1ENER = D1STA IF (D1ENER.GT.D1END) D1ENER = D1END IF (D2ENER.LT.D2STA) D2ENER = D2STA IF (D2ENER.GT.D2END) D2ENER = D2END C C C*********************************************************************** C compute D1-correction C*********************************************************************** D1ECOR = -TOFREF D1EMEV = D1ENER/1000. D1EDUM = 1. IF (D1ENER.LE.D1EBRK) THEN DO 10 I=1,NDEGD1+1 D1ECOR = D1ECOR + D11COF(I) * D1EDUM D1EDUM = D1EDUM * D1EMEV 10 CONTINUE ELSE IF (D1ENER.GT.D1EBRK) THEN DO 20 I=1,NDEGD1+1 D1ECOR = D1ECOR + D12COF(I) * D1EDUM D1EDUM = D1EDUM * D1EMEV 20 CONTINUE ENDIF C C*********************************************************************** C compute D2-correction C*********************************************************************** C D2ECOR = -TOFREF D2EMEV = D2ENER/1000. D2EDUM = 1. IF (D2ENER.LE.D2EBR1) THEN DO 30 I=1,NDEGD2+1 D2ECOR = D2ECOR + D21COF(I) * D2EDUM D2EDUM = D2EDUM * D2EMEV 30 CONTINUE ELSE IF ((D2ENER.GT.D2EBR1).AND.(D2ENER.LE.D2EBR2)) THEN DO 40 I=1,NDEGD2+1 D2ECOR = D2ECOR + D22COF(I) * D2EDUM D2EDUM = D2EDUM * D2EMEV 40 CONTINUE ELSE IF (D2ENER.GT.D2EBR2) THEN DO 50 I=1,NDEGD2+1 D2ECOR = D2ECOR + D23COF(I) * D2EDUM D2EDUM = D2EDUM * D2EMEV 50 CONTINUE ENDIF C C*********************************************************************** C compute total correction C*********************************************************************** C TOF = TOF + TOFCEN - (TOFREF + D1ECOR + D2ECOR) C C*********************************************************************** C 999 CONTINUE RETURN END