SUBROUTINE WRITE_CUTS(UNIT_NUM) C---------------------------------------------------------------------- C- C- Purpose and Methods : Write out a section for an LSM file. Try to find C- ranges the values are constant over. Can find symmetry over PHI and C- SIGN_ETA. C- C- Inputs : UNIT_NUM The unit number to use for output C- Outputs : none C- Controls: none C- C- Created 15-AUG-1990 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE C- C---------------------------------------------------------------------- IMPLICIT NONE C---------------------------------------------------------------------- C C Global declaratons C INCLUDE 'D0$PARAMS:LEVEL1_LOOKUP.PARAMS' INCLUDE 'D0$INC:LEVEL1_LOOKUP.INC' INCLUDE 'LSMP$SOURCE:LEVEL1_LOOKUP_EXPANSION.INC' C C Argument declarations C INTEGER UNIT_NUM C C Local variables C INTEGER PROM, INDEX, PHI, ETA, SIGN_ETA INTEGER VALUE LOGICAL CONSTANT_PHI, CONSTANT_SIGN, SYMMETRIC_PHI LOGICAL USED_PHI(PHI_MIN:PHI_MAX) INTEGER STRING_LENGTH INTEGER MAX_SIGN CHARACTER*40 MESSAGE CHARACTER*7 ST_PROM(EM_PROM:PY_PROM) CHARACTER*5 ST_SIGN(POS_ETA:NEG_ETA) C ST_PROM(EM_PROM) = 'EM_PROM' ST_PROM(HD_PROM) = 'HD_PROM' ST_PROM(PX_PROM) = 'PX_PROM' ST_PROM(PY_PROM) = 'PY_PROM' ST_SIGN(POS_ETA) = 'PLUS' ST_SIGN(NEG_ETA) = 'MINUS' C WRITE (UNIT_NUM,*) 'Section PROM_OUTPUT_CUT' DO PROM = EM_PROM, PY_PROM WRITE (UNIT_NUM,*) ' With PROM ', ST_PROM(PROM) C C Find if PROM_CUT is constant over PHI, with all others varying C CONSTANT_PHI = .TRUE. DO INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX DO SIGN_ETA = POS_ETA, NEG_ETA VALUE = PROM_CUT(SIGN_ETA, ETA, PHI_MIN, PROM, INDEX) DO PHI = PHI_MIN + 1, PHI_MAX IF (PROM_CUT(SIGN_ETA, ETA, PHI, PROM, INDEX) .NE. & VALUE) THEN CONSTANT_PHI = .FALSE. GOTO 1000 ENDIF END DO END DO END DO END DO 1000 CONTINUE C CONSTANT_SIGN = .TRUE. DO INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX DO PHI = PHI_MIN, PHI_MAX DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX IF (PROM_CUT(POS_ETA, ETA, PHI, PROM, INDEX) .NE. & PROM_CUT(NEG_ETA, ETA, PHI, PROM, INDEX) ) THEN CONSTANT_SIGN = .FALSE. GOTO 2000 ENDIF END DO END DO END DO 2000 CONTINUE C C Constant PHI and SIGN C IF (CONSTANT_PHI .AND. CONSTANT_SIGN) THEN WRITE (UNIT_NUM,*) ' With SIGN_ETA PLUS and MINUS' WRITE (UNIT_NUM,*) ' With PHI 1 to 32' WRITE (UNIT_NUM,*) & ' List MAGN_ETA 1 to 24 INDEX 1 to 8' WRITE (UNIT_NUM,*) '! 1 2 3 4 5 6 7 8' DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX WRITE(UNIT_NUM, 100) ( PROM_CUT(POS_ETA, ETA, PHI_MIN, PROM, & INDEX), INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX ), ETA 100 FORMAT (' ', 8I4, ' !', I3) END DO WRITE (UNIT_NUM,*) ' End_List' WRITE (UNIT_NUM,*) ' End_With' WRITE (UNIT_NUM,*) ' End_With' C C Not Constant PHI C ELSEIF (.NOT. CONSTANT_PHI) THEN IF (CONSTANT_SIGN) THEN MAX_SIGN = POS_ETA ELSE MAX_SIGN = NEG_ETA ENDIF C DO SIGN_ETA = POS_ETA, MAX_SIGN IF (CONSTANT_SIGN) THEN WRITE (UNIT_NUM,*) ' With SIGN_ETA PLUS and MINUS' ELSE WRITE (UNIT_NUM,*) ' With SIGN_ETA ', ST_SIGN(SIGN_ETA) ENDIF DO PHI = PHI_MIN, PHI_MAX USED_PHI(PHI) = .FALSE. END DO DO PHI = PHI_MIN, PHI_MAX IF (USED_PHI(PHI)) GOTO 1200 ! REPEAT LOOP C C Find if the value is constant over 4 PHI coordinates C MESSAGE = ' With PHI ' STRING_LENGTH = 15 WRITE (MESSAGE(16:40), 110) PHI 110 FORMAT( I2 ) STRING_LENGTH = 17 IF (PHI .LE. 8) THEN SYMMETRIC_PHI = .TRUE. DO INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX VALUE = PROM_CUT(SIGN_ETA, ETA, PHI, PROM, INDEX) IF (PHI .EQ. 1) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 16, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 17, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 32, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 2) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 15, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 18, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 31, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 3) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 14, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 19, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 30, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 4) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 13, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 20, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 29, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 5) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 12, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 21, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 28, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 6) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 11, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 22, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 27, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 7) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 10, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 23, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 26, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ELSEIF (PHI .EQ. 8) THEN IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 9, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 24, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. IF (VALUE .NE. PROM_CUT(SIGN_ETA, ETA, 25, PROM, & INDEX)) SYMMETRIC_PHI = .FALSE. ENDIF IF (.NOT. SYMMETRIC_PHI) GOTO 1100 END DO END DO C 1100 CONTINUE IF (.NOT. SYMMETRIC_PHI) THEN USED_PHI(PHI) = .TRUE. ELSE IF (PHI .EQ. 1) THEN USED_PHI(1) = .TRUE. USED_PHI(16) = .TRUE. USED_PHI(17) = .TRUE. USED_PHI(32) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 16 and 17 and 32' STRING_LENGTH = STRING_LENGTH + 21 - 1 ELSEIF (PHI .EQ. 2) THEN USED_PHI(2) = .TRUE. USED_PHI(15) = .TRUE. USED_PHI(18) = .TRUE. USED_PHI(31) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 15 and 18 and 31' STRING_LENGTH = STRING_LENGTH + 21 -1 ELSEIF (PHI .EQ. 3) THEN USED_PHI(3) = .TRUE. USED_PHI(14) = .TRUE. USED_PHI(19) = .TRUE. USED_PHI(30) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 14 and 19 and 30' STRING_LENGTH = STRING_LENGTH + 21 - 1 ELSEIF (PHI .EQ. 4) THEN USED_PHI(4) = .TRUE. USED_PHI(13) = .TRUE. USED_PHI(20) = .TRUE. USED_PHI(29) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 13 and 20 and 29' STRING_LENGTH = STRING_LENGTH + 21 - 1 ELSEIF (PHI .EQ. 5) THEN USED_PHI(5) = .TRUE. USED_PHI(12) = .TRUE. USED_PHI(21) = .TRUE. USED_PHI(28) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 12 and 21 and 28' STRING_LENGTH = STRING_LENGTH + 21 - 1 ELSEIF (PHI .EQ. 6) THEN USED_PHI(6) = .TRUE. USED_PHI(11) = .TRUE. USED_PHI(22) = .TRUE. USED_PHI(27) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 11 and 22 and 27' STRING_LENGTH = STRING_LENGTH + 21 - 1 ELSEIF (PHI .EQ. 7) THEN USED_PHI(7) = .TRUE. USED_PHI(10) = .TRUE. USED_PHI(23) = .TRUE. USED_PHI(26) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 10 and 23 and 26' STRING_LENGTH = STRING_LENGTH + 21 - 1 ELSEIF (PHI .EQ. 8) THEN USED_PHI(8) = .TRUE. USED_PHI(9) = .TRUE. USED_PHI(24) = .TRUE. USED_PHI(25) = .TRUE. STRING_LENGTH = STRING_LENGTH + 1 MESSAGE(STRING_LENGTH:40) = ' and 9 and 24 and 25' STRING_LENGTH = STRING_LENGTH + 21 - 1 ENDIF ENDIF C ELSE USED_PHI(PHI) = .TRUE. ENDIF C WRITE (UNIT_NUM,*) MESSAGE(1:STRING_LENGTH) WRITE (UNIT_NUM,*) & ' List MAGN_ETA 1 to 24 INDEX 1 to 8' WRITE (UNIT_NUM,*) & '! 1 2 3 4 5 6 7 8' DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX WRITE(UNIT_NUM,200) (PROM_CUT(SIGN_ETA, ETA, PHI, PROM, & INDEX), INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX), ETA 200 FORMAT (' ', 8I4, ' !', I3) END DO WRITE (UNIT_NUM,*) ' End_List' WRITE (UNIT_NUM,*) ' End_With' 1200 CONTINUE END DO WRITE (UNIT_NUM,*) ' End_With' END DO C C Constant PHI C ELSEIF (CONSTANT_PHI .AND. (.NOT. CONSTANT_SIGN)) THEN WRITE (UNIT_NUM,*) ' With PHI 1 to 32' WRITE (UNIT_NUM,*) ' With SIGN_ETA PLUS' WRITE (UNIT_NUM,*) & ' List MAGN_ETA 1 to 24 INDEX 1 to 8' WRITE (UNIT_NUM,*) '! 1 2 3 4 5 6 7 8' DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX WRITE(UNIT_NUM, 300) ( PROM_CUT(POS_ETA, ETA, PHI_MIN, PROM, & INDEX), INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX ), ETA 300 FORMAT (' ', 8I4, ' !', I3) END DO WRITE (UNIT_NUM,*) ' End_List' WRITE (UNIT_NUM,*) ' End_With' WRITE (UNIT_NUM,*) ' With SIGN_ETA MINUS' WRITE (UNIT_NUM,*) & ' List MAGN_ETA 1 to 24 INDEX 1 to 8' WRITE (UNIT_NUM,*) '! 1 2 3 4 5 6 7 8' DO ETA = ETA_RANGE_MIN, ETA_RANGE_MAX WRITE(UNIT_NUM, 400) ( PROM_CUT(NEG_ETA, ETA, PHI_MIN, PROM, & INDEX), INDEX = PAGE_INDEX_MIN, PAGE_INDEX_MAX ), ETA 400 FORMAT (' ', 8I4, ' !', I3) END DO WRITE (UNIT_NUM,*) ' End_List' WRITE (UNIT_NUM,*) ' End_With' WRITE (UNIT_NUM,*) ' End_With' C C Selection of symmetry code C ENDIF WRITE (UNIT_NUM,*) ' End_With' C C Loop over PROM C END DO WRITE (UNIT_NUM,*) 'End_Section' C C C 999 RETURN END