PROGRAM WRITE_TT_GEOMETRY_LSM C---------------------------------------------------------------------- C- C- Purpose and Methods : Write out the LSM file sections for the trigger C- tower geometry. C- C- Inputs : Calorimeter tower database C- Outputs : LSM file section C- Controls: none C- C- Note: The current version only writes out information for the TOTAL C- tower. Also, this version expects a particular symmetry in the C- coordinate values, and will abort if it is not found. C- C- All values are rounded to 4 significant digits. C- C- Created 7-NOV-1990 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE C- C---------------------------------------------------------------------- IMPLICIT NONE INTEGER ERR INCLUDE 'D0$PARAMS:LEVEL1_LOOKUP.PARAMS' INCLUDE 'D0$INC:LEVEL1_LOOKUP.INC' INTEGER PHI INTEGER ETA INTEGER ETA_BREAK PARAMETER (ETA_BREAK = 5) INTEGER CHANNEL INTEGER SIGN INTEGER RZ REAL COMPARE REAL ERROR REAL ERROR_CHECK REAL SYMMETRY_TOLERANCE PARAMETER (SYMMETRY_TOLERANCE = 5E-4) CHARACTER*5 LSM_4_DIGITS EXTERNAL LSM_4_DIGITS C C The following parameter sets the desired location for the TOT tower C coordinate. It is a proportion of the distance between the EM tower C coordinate and the HD tower coordinate. For example, if the desired C location is halfway between EM and HD, then TOT_LOCATION_PROPORTION = C 0.5. If the desired location is ONE THIRD of the way between EM and HD, C then TOT_LOCATION_PROPORTION = 0.3333 C REAL TOT_LOCATION_PROPORTION PARAMETER (TOT_LOCATION_PROPORTION = 0.5) C ERROR_CHECK(ERROR, COMPARE) = ABS((ERROR - COMPARE) & / (COMPARE + 1E-8)) ERR = -4271 CALL ACTUAL_GEOMETRY(ERR) IF (ERR) THEN write (6,*) 'Error code from ACTUAL_GEOMETRY: ', err GOTO 999 ENDIF C C Set the Total Tower coordinates to the specified place between the EM C coordinate and the HD coordinate. C DO RZ = R_COORD, Z_COORD DO PHI = PHI_MIN, PHI_MAX DO ETA = ETA_MIN, ETA_MAX DO SIGN = POS_ETA, NEG_ETA COMPARE = TOWER_RZ_COORD(SIGN, ETA, PHI, HD_TOWER, RZ) - & TOWER_RZ_COORD(SIGN, ETA, PHI, EM_TOWER, RZ) TOWER_RZ_COORD(SIGN, ETA, PHI, TOT_TOWER, RZ) = & TOWER_RZ_COORD(SIGN, ETA, PHI, EM_TOWER, RZ) + & TOT_LOCATION_PROPORTION * COMPARE END DO END DO END DO END DO C C Check for symmetry C C R, |Z| should be symmetric across SIGN_ETA C Z should be symmetric around all PHI C R for EM should be symmetric around all PHI C R for HD, TOT should be symmetric for odd PHI with ETA <= 5 C R for HD, TOT should be symmetric for even PHI with ETA <=5 C R for HD, TOT should be symmetric for all PHI with ETA >= 6 C DO CHANNEL = EM_TOWER, TOT_TOWER DO PHI = PHI_MIN, PHI_MAX DO ETA = ETA_MIN, ETA_MAX ERROR = ERROR_CHECK( TOWER_RZ_COORD(NEG_ETA, ETA, PHI, & CHANNEL, R_COORD ), TOWER_RZ_COORD(POS_ETA, ETA, PHI, & CHANNEL, R_COORD)) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE(6,*) 'Unsymmetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO C DO CHANNEL = EM_TOWER, TOT_TOWER DO PHI = PHI_MIN, PHI_MAX DO ETA = ETA_MIN, ETA_MAX ERROR = ERROR_CHECK( - TOWER_RZ_COORD(NEG_ETA, ETA, PHI, & CHANNEL, Z_COORD ), TOWER_RZ_COORD(POS_ETA, ETA, PHI, & CHANNEL, Z_COORD)) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE(6,*) 'Unsymmetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO C DO CHANNEL = EM_TOWER, TOT_TOWER DO ETA = ETA_MIN, ETA_MAX DO SIGN = POS_ETA, NEG_ETA COMPARE = TOWER_RZ_COORD(SIGN, ETA, PHI_MIN, CHANNEL, & Z_COORD) DO PHI = PHI_MIN, PHI_MAX ERROR = ERROR_CHECK( TOWER_RZ_COORD(SIGN, ETA, PHI, & CHANNEL, Z_COORD), COMPARE) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE (6,*) 'Unsymetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO END DO C DO ETA = ETA_MIN, ETA_MAX DO SIGN = POS_ETA, NEG_ETA COMPARE = TOWER_RZ_COORD(SIGN, ETA, PHI_MIN, EM_TOWER, & R_COORD) DO PHI = PHI_MIN, PHI_MAX ERROR = ERROR_CHECK( TOWER_RZ_COORD(SIGN, ETA, PHI, & EM_TOWER, R_COORD), COMPARE) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE (6,*) 'Unsymetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO C DO CHANNEL = HD_TOWER, TOT_TOWER DO ETA = ETA_MIN, ETA_BREAK DO SIGN = POS_ETA, NEG_ETA COMPARE = TOWER_RZ_COORD(SIGN, ETA, PHI_MIN, CHANNEL, & R_COORD) DO PHI = PHI_MIN, PHI_MAX, 2 ERROR = ERROR_CHECK( TOWER_RZ_COORD(SIGN, ETA, PHI, & CHANNEL, R_COORD), COMPARE) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE (6,*) 'Unsymetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO END DO C DO CHANNEL = HD_TOWER, TOT_TOWER DO ETA = ETA_MIN, ETA_BREAK DO SIGN = POS_ETA, NEG_ETA COMPARE = TOWER_RZ_COORD(SIGN, ETA, PHI_MIN +1, CHANNEL, & R_COORD) DO PHI = PHI_MIN+1, PHI_MAX, 2 ERROR = ERROR_CHECK( TOWER_RZ_COORD(SIGN, ETA, PHI, & CHANNEL, R_COORD), COMPARE) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE (6,*) 'Unsymetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO END DO C DO CHANNEL = HD_TOWER, TOT_TOWER DO ETA = ETA_BREAK +1, ETA_MAX DO SIGN = POS_ETA, NEG_ETA COMPARE = TOWER_RZ_COORD(SIGN, ETA, PHI_MIN, CHANNEL, & R_COORD) DO PHI = PHI_MIN, PHI_MAX ERROR = ERROR_CHECK( TOWER_RZ_COORD(SIGN, ETA, PHI, & CHANNEL, R_COORD), COMPARE) IF (ERROR .GT. SYMMETRY_TOLERANCE) THEN WRITE (6,*) 'Unsymetric geometry' ERR = 1 GOTO 999 ENDIF END DO END DO END DO END DO C C Must have passed all symmetry checks to reach this point C WRITE (6,*) '!' WRITE (6,*) '! Tower Geometry' WRITE (6,*) '!' WRITE (6,*) 'Section TOWER_GEOMETRY_R' WRITE (6,*) ' With CHANNEL TOT' WRITE (6,*) ' With SIGN_ETA PLUS and MINUS' WRITE (6,*) & ' With PHI 1 and 3 and 5 and 7 and 9 and 11 and 13 and 15' WRITE (6,*) ' List MAGN_ETA 1 to 5' WRITE (6,100) (LSM_4_DIGITS(TOWER_RZ_COORD(POS_ETA, ETA, 1, & TOT_TOWER, R_COORD)), ETA = 1, 5) WRITE (6,*) ' End_List' WRITE (6,*) ' End_With' WRITE (6,*) WRITE (6,*) ' WITH PHI 17 and 19 and 21 and 23 and ' // & '25 and 27 and 29 and 31' WRITE (6,*) ' List MAGN_ETA 1 to 5' WRITE (6,100) (LSM_4_DIGITS(TOWER_RZ_COORD(POS_ETA, ETA, 1, & TOT_TOWER, R_COORD)), ETA = 1, 5) WRITE (6,*) ' End_List' WRITE (6,*) ' End_With' WRITE (6,*) & ' With PHI 2 and 4 and 6 and 8 and 10 and 12 and 14 and 16' WRITE (6,*) ' List MAGN_ETA 1 to 5' WRITE (6,100) (LSM_4_DIGITS(TOWER_RZ_COORD(POS_ETA, ETA, 2, & TOT_TOWER, R_COORD)), ETA = 1, 5) WRITE (6,*) ' End_List' WRITE (6,*) ' End_With' WRITE (6,*) WRITE (6,*) ' WITH PHI 18 and 20 and 22 and 24 and ' // & '26 and 28 and 30 and 32' WRITE (6,*) ' List MAGN_ETA 1 to 5' WRITE (6,100) (LSM_4_DIGITS(TOWER_RZ_COORD(POS_ETA, ETA, 2, & TOT_TOWER, R_COORD)), ETA = 1, 5) WRITE (6,*) ' End_List' WRITE (6,*) ' End_With' WRITE (6,*) WRITE (6,*) ' With PHI 1 to 32' WRITE (6,*) ' List MAGN_ETA 6 to 19' WRITE (6,200) (LSM_4_DIGITS(TOWER_RZ_COORD(POS_ETA, ETA, 1, & TOT_TOWER, R_COORD)), ETA = 6, 19) WRITE (6,*) ' End_List' WRITE (6,*) ' End_With' WRITE (6,*) ' End_With' WRITE (6,*) ' End_With' WRITE (6,*) 'End Section' WRITE (6,*) WRITE (6,*) 'Section TOWER_GEOMETRY_Z' WRITE (6,*) ' With SIGN_ETA PLUS AND MINUS' WRITE (6,*) ' With PHI 1 TO 32' WRITE (6,*) ' With CHANNEL TOT' WRITE (6,*) ' List MAGN_ETA 1 to 19' WRITE (6,300) (LSM_4_DIGITS(TOWER_RZ_COORD(POS_ETA, ETA, 1, & TOT_TOWER, Z_COORD)), ETA = 1, 19) WRITE (6,*) ' End_List' WRITE (6,*) ' End_With' WRITE (6,*) ' End_With' WRITE (6,*) ' End_With' WRITE (6,*) 'End_Section' C 100 FORMAT( ' ', 5(A5, ' ')) 200 FORMAT( ' ', 15(A5, ' ')) 300 FORMAT( ' ', 19(A5, ' ')) C---------------------------------------------------------------------- 999 CONTINUE END C C C FUNCTION LSM_4_DIGITS(VALUE) C---------------------------------------------------------------------- C- C- Purpose and Methods : Round VALUE to 4 significant digits. C- C- Returned value : a string containg the value C- Inputs : C- Outputs : C- Controls: C- C- Note: This routine only works correctly when 9999. >= VALUE >= 1.000 C- Created 7-NOV-1990 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE C- C---------------------------------------------------------------------- IMPLICIT NONE CHARACTER*5 LSM_4_DIGITS REAL VALUE REAL TEMP INTEGER POINT C POINT = 1 IF (VALUE .GE. 1000.) THEN POINT = 4 ELSE IF (VALUE .GE. 100.) THEN POINT = 3 ELSE IF (VALUE .GE. 10.) THEN POINT = 2 ENDIF C TEMP = FLOAT(INT(VALUE * 10**(4-POINT))) / FLOAT(10**(4-POINT)) IF (POINT .EQ. 1) THEN WRITE(LSM_4_DIGITS, 100) TEMP ELSE IF(POINT .EQ. 2) THEN WRITE(LSM_4_DIGITS, 200) TEMP C WRITE(6,*) ' !!!!! ', TEMP ELSE IF(POINT .EQ. 3) THEN WRITE(LSM_4_DIGITS, 300) TEMP ELSE IF(POINT .EQ. 4) THEN WRITE(LSM_4_DIGITS, 400) TEMP ENDIF 100 FORMAT( F5.3 ) 200 FORMAT( F5.2 ) 300 FORMAT( F5.1 ) 400 FORMAT( F5.0 ) C C---------------------------------------------------------------------- 999 RETURN END