module mia_veto use mia_types use mia_input type vetoDetList ! !Contains data for detectors vetoed by the user !Used to match them to proper set of data in order to remove it. !Similar to type active_processors ! character(13) :: label real(rp) :: number logical :: firstInRange !If user vetoed a range of dets integer :: arrPos !Position of det in array end type vetoDetList type(vetoDetList), allocatable :: vetoedDets(:) !Used to automatically determine which detectors are producing !too much noise so they can be vetoed. real(rp), allocatable :: noiseSums(:,:) contains subroutine veto(data, input) ! !Calls the subroutines to veto a BPM: !Parse user's input and match with detectors in the data file, !then reallocate the data structures without the data for those !BPMs. ! type(data_set), allocatable :: data(:) character(50) :: input logical :: parseInput parseInput = .true. do while (parseInput) call parseVeto(input) !Checks that there are vetoed detectors that match the data. !Otherwise, prompt the user to enter a different BPM or quit. if (vetoedDets(1)%arrPos > -123000) then call resetData(data) parseInput = .false. else Print *, "*** Error: No match found for vetoed detector ***" Print *, " Please reenter the detector name (ex 12W, 3E) or ", & "type anything else to continue." accept "(a)", input deallocate(vetoedDets) endif end do deallocate(vetoedDets) end subroutine veto subroutine resetData(data) ! !Copies position history matrices into a temporary variable, !then reallocates the data structure for one less BPM. !Calls removeDet() to copy the old data into the new structure !sans the vetoed detectors. ! type(data_set), allocatable :: data(:) type matrixHolder !Holder for file data being reused integer :: filenum !File number type (active_processors), allocatable :: proc(:) real(rp), allocatable :: poshis(:,:) end type matrixHolder type(matrixHolder) temp(2) integer :: i,j integer :: numVetos call howManyVetoes(numVetos) ! Print *, "Num vetoes: ", numVetos do i=1,2 !Copy data into temp allocate(temp(i)%poshis(NUM_TURNS, 2*NUM_BPMS)) allocate(temp(i)%proc(NUM_BPMS)) temp(i)%poshis = data(i)%poshis(:,:) temp(i)%filenum = data(i)%filenum temp(i)%proc = data(i)%proc(:) deallocate(data(i)%poshis) deallocate(data(i)%proc) end do temp(2)%proc = temp(1)%proc deallocate(data) allocate(data(2)) NUM_BPMS = NUM_BPMS-numVetos do j=1,2 !Copy data from temp back into data set without vetoed dets call allocate_data(data(j),num_turns,num_bpms) data(j)%bpmproc = NUM_BPMS data(j)%numturns = NUM_TURNS data(j)%filenum = temp(j)%filenum call copyAndRemoveDet(data(j)%poshis,data(j)%proc, & temp(j)%poshis, temp(j)%proc) deallocate(temp(j)%poshis) deallocate(temp(j)%proc) end do end subroutine resetData subroutine copyAndRemoveDet(poshis, proc, tempPosHis, tempProc) ! !Copies input file data into a new matrix sans vetoed detectors ! type(data_set) data real(rp) :: tempPosHis(:,:), poshis(:,:) type(active_processors) :: tempProc(:), proc(:) integer :: i,j, count !Count is the position in new poshis integer :: numVetos, & !Number of BPMs being vetoed vetoCount !Counter for vetoed detector being removed logical :: range, & skip !True when data is being removed range = .false. vetoCount = 1 call howManyVetoes(NumVetos) ! numVetos = size(vetoedDets) count = 1 ! do i=1, numVetos ! Print *, i, ": ", vetoedDets(i)%arrPos ! Print *, tempProc(vetoedDets(i)%arrPos)%label ! enddo do i=1, NUM_BPMS+numVetos if (range) then Print *, "Removed ", data_struc%proc(i)%label if (i == vetoedDets(vetoCount)%arrPos) then range = .false. vetoCount = vetoCount + 1 end if else skip = .false. do j=1, size(vetoedDets) if (i == vetoedDets(j)%arrPos) then skip = .true. end if end do if (.not. skip) then poshis(:,2*count-1) = tempPosHis(:,2*i-1) poshis(:,2*count) = tempPosHis(:,2*i) proc(count) = tempProc(i) count = count+1 else Print *, "Removed ", tempProc(i)%label if (vetoCount < numVetos) then range = vetoedDets(vetoCount)%firstInRange vetoCount = vetoCount + 1 end if end if end if end do end subroutine copyAndRemoveDet subroutine parseVeto(input) ! !Parses bpm names being vetoed by the user !Does not match with detectors in the data ! character(50) :: input logical :: stillParsing integer :: numVeto integer :: slice logical :: isWest !Not used, just needed as a dummy arg !This is allocated to the maximum size until everything is parsed !and the number of detectors being removed is known. allocate(vetoedDets(NUM_BPMS)) stillParsing = .true. numVeto = 0 !Remove "veto" and any trailing/preceding blanks input = trim(adjustl(input(scan(input, "o")+1:len_trim(input)))) do while (stillParsing) if (scan(input, ":")+scan(input, ",") > 0 ) then call nonZeroMin(slice, scan(input, ":"), scan(input, ",")) numVeto = numVeto+1 if (input(slice:slice) == ":") then vetoedDets(numVeto)%firstInRange = .true. else vetoedDets(numVeto)%firstInRange = .false. end if vetoedDets(numVeto)%label = input(1:slice-1) input = trim(adjustl(input(slice+1:len_trim(input)))) else numVeto = numVeto+1 vetoedDets(numVeto)%label = input(1:len_trim(input)) vetoedDets(numVeto)%firstInRange = .false. stillParsing = .false. end if call parseDet(vetoedDets(numVeto)%label, vetoedDets(numVeto)%number,& isWest) call findBPM(vetoedDets(numVeto)%label, vetoedDets(numVeto)%number, & vetoedDets(numVeto)%arrPos) if (vetoedDets(numVeto)%arrPos < 0) then Print *, "No match found for ", vetoedDets(numVeto)%label numVeto = numVeto-1 end if ! if (vetoedDets(numVeto-1)%firstInRange) then ! numVeto = numVeto + & ! (vetoedDets(numVeto)%arrPos - vetoedDets(numVeto-1)%arrPos - 1) ! end if end do if (numVeto > 0) then call resizeVetoedDets(numVeto) else !Return something strange in case no vetoed dets are found vetoedDets(1)%arrPos = -123456 !Error code (arbitrary large number) end if end subroutine parseVeto subroutine resizeVetoedDets(numDets) ! !Resizes array vetoedDets to the proper size once the number !of vetoes is known ! !***Need to sort dets too eventually type(vetoDetList), allocatable :: temp(:) integer :: numDets, i allocate(temp(size(vetoedDets))) temp = vetoedDets(:) deallocate(vetoedDets) allocate(vetoedDets(numDets)) vetoedDets = temp(1:numDets) deallocate(temp) end subroutine resizeVetoedDets subroutine nonZeroMin(minVal, first, second) ! !Finds the minimum of two numbers if both are nonzero. !Otherwise, returns value which is nonzero. ! integer :: minVal, & first, second if (first .le. 0) then minVal = second else if (second .le. 0) then minVal = first else minVal = min(second, first) end if end subroutine nonZeroMin subroutine findBPM(detName, detNum, detPos) ! !Matches a vetoed BPM with data ! character(5) :: detName integer :: detPos integer :: i logical :: found real(rp) :: detNum found = .false. detPos = -1 i=1 !Search for a detector matching input and exit when found do while (.not. found .and. i <= NUM_BPMS) if (detNum == data_struc%proc(i)%number ) then detPos = i found = .true. else i = i+1 end if end do if (.not. found) then Print *, "Error: BPM ", detName, " not found." end if end subroutine findBPM subroutine howManyVetoes(numVetoes) integer :: numVetoes, arrSize integer :: i arrSize = size(vetoedDets) !There are at least as many vetoes as there are detectors input numVetoes = arrSize do i=2, arrSize if (vetoedDets(i-1)%firstInRange) then numVetoes = numVetoes + & (vetoedDets(i)%arrPos - vetoedDets(i-1)%arrPos - 1) end if end do end subroutine howManyVetoes !Automatic vetoing subroutines: subroutine autoVeto(data) type(data_set), allocatable :: data(:) integer :: i real(rp) :: noise(2) allocate(vetoedDets(NUM_BPMS)) allocate (noiseSums(2,NUM_BPMS)) !^^^^^^^^^^^^^^^^^^^^ noise(1) = data(1)%noise noise(2) = data(2)%noise do i=1, NUM_BPMS noiseSums(1,i) = 0 noiseSums(2,i) = 0 end do call FindNoisyDets(data) ! call checkNoise(data(1)%noise, 1) ! call checkNoise(data(2)%noise, 2) call getAutoVetos(noiseSums, noise) if (vetoedDets(1)%arrPos > 0) then call resetData(data) end if deallocate(vetoedDets) deallocate(noiseSums) end subroutine autoVeto subroutine autoCut_old(data) type(data_set), allocatable :: data(:) integer i, j, & numVeto, & !Veto counter eigen, & !Eigenmode being scanned bpm !Array position of bpm logical :: duplicate !True if vetoing the same bpm twice allocate(vetoedDets(NUM_BPMS)) numVeto = 0 duplicate = .false. do eigen=1, 8 do j=1, 2*NUM_BPMS !^^^^^^ if (data(data_struc%set_num_a)%pi_mat(j,eigen)**2 > 0.45 .or. & data(data_struc%set_num_b)%pi_mat(j,eigen)**2 > 0.45) then bpm = ceiling(j/2.0) if (numVeto > 0) then duplicate = .false. do i=1,numVeto if (vetoedDets(i)%number == data_struc%proc(bpm)%number) then duplicate = .true. end if end do end if if (.not. duplicate) then Print *, "Automatically vetoing det ", data_struc%proc(bpm)%label numVeto = numVeto + 1 vetoedDets(numVeto)%label = data_struc%proc(bpm)%label vetoedDets(numVeto)%number = data_struc%proc(bpm)%number vetoedDets(numVeto)%arrPos = bpm vetoedDets(numVeto)%firstInRange = .false. end if end if end do end do if (numVeto > 0) then vetoBPM = .true. call resizeVetoedDets(numVeto) else !Return something strange in case no vetoed dets are found Print *, "Automatic vetoing complete" vetoedDets(1)%arrPos = -123456 !Error code (arbitrary large number) end if if (vetoedDets(1)%arrPos > 0) then call resetData(data) end if deallocate(vetoedDets) end subroutine autoCut_old subroutine autoCut(data) type(data_set), allocatable :: data(:) integer i, j, & numVeto, & !Veto counter eigen, & !Eigenmode being scanned bpm !Array position of bpm logical :: duplicate !True if vetoing the same bpm twice allocate(vetoedDets(NUM_BPMS)) numVeto = 0 duplicate = .false. do eigen=1, 8 do j=1, 2*NUM_BPMS !^^^^^^ if (vetoTest(data,j,eigen)) then bpm = ceiling(j/2.0) if (numVeto > 0) then duplicate = .false. do i=1,numVeto if (vetoedDets(i)%number == data_struc%proc(bpm)%number) then duplicate = .true. end if end do end if if (.not. duplicate) then Print *, "Automatically vetoing det ", data_struc%proc(bpm)%label numVeto = numVeto + 1 vetoedDets(numVeto)%label = data_struc%proc(bpm)%label vetoedDets(numVeto)%number = data_struc%proc(bpm)%number vetoedDets(numVeto)%arrPos = bpm vetoedDets(numVeto)%firstInRange = .false. end if end if end do end do !^^^^^^^^^^^^^^^^^^^^^^ !CHECK THESE SUBROUTINES FOR SINGLE-FILE COMPATIBILITY if (.not. fftOnly) then if (numVeto > 0) then vetoBPM = .true. call resizeVetoedDets(numVeto) else !Return something strange in case no vetoed dets are found Print *, "Automatic vetoing complete" vetoedDets(1)%arrPos = -123456 !Error code (arbitrary large number) end if if (vetoedDets(1)%arrPos > 0) then call resetData(data) end if end if deallocate(vetoedDets) end subroutine autoCut logical function vetoTest(data,j,e) type(data_set) :: data(:) integer :: j,e !Indices in pi_mat if (fftOnly) then if (data(1)%pi_mat(j,e)**2 > 0.45) then vetoTest = .true. else vetoTest = .false. end if else if (data(1)%pi_mat(j,e)**2 > 0.45 .or. & data(2)%pi_mat(j,e)**2 > 0.45) then vetoTest = .true. else vetoTest = .false. end if end if return end function vetoTest subroutine findNoisyDets(data) ! !Find noisy detectors ! integer :: i type(data_set) :: data(*) !^^^^^^^^^ do i=1, NUM_BPMS ! if(not eigenmodes) if ( .not. i == data_struc%col_a_p .and. .not. i == data_struc%col_a_n)& then call sumPiNoise(data(data_struc%set_num_a)%pi_mat(:,i), & data(data_struc%set_num_a)%lambda(i), 1) end if if ( .not. i == data_struc%col_b_p .and. .not. i == data_struc%col_b_n)& then call sumPiNoise(data(data_struc%set_num_b)%pi_mat(:,i), & data(data_struc%set_num_b)%lambda(i), 2) endif end do end subroutine findNoisyDets subroutine sumPiNoise(pi_mat, lambda, file) real(rp) :: ave, pi_mat(:), lambda integer :: loc(1), bpm, file, i !Find average ave = sum(pi_mat) / NUM_TURNS !Find elements with values significantly above the average do i=1, 2*NUM_BPMS if (abs(pi_mat(i)) > 20*ave) then noiseSums(file, ceiling(i/2.0))= noiseSums(file,ceiling(i/2.0)) & + pi_mat(i)*lambda end if end do ! !See if that element is significantly above the average ! if (abs(pi_mat(loc(1))) > 100*ave) then ! bpm = ceiling(loc(1)/2.0) ! Print *, "There appears to be noise in detector ", & ! data_struc%proc(bpm)%label ! end if end subroutine sumPiNoise subroutine getAutoVetos(noiseSums,noiseLevel) real(rp) :: cutoff, noiseLevel(:) integer :: i,j, file, numVeto logical :: duplicate real(rp), allocatable :: noiseSums(:,:) numVeto = 0 !Change cutoff to vary sensitivity of automatic vetoing do file = 1, 2 cutoff = 750*noiseLevel(file) / sqrt(2.0*NUM_BPMS) Print *, "Cutoff: ", cutoff do i=1, NUM_BPMS if (noiseSums(file, i) > cutoff) then if (numVeto > 0) then duplicate = .false. do j=1,numVeto if (vetoedDets(j)%number == data_struc%proc(i)%number) then duplicate = .true. end if end do end if if (.not. duplicate) then Print *, "Automatically vetoing det ", data_struc%proc(i)%label ! Print *, "Noise level: ", noiseSums(file, i) numVeto = numVeto + 1 vetoedDets(numVeto)%label = data_struc%proc(i)%label vetoedDets(numVeto)%number = data_struc%proc(i)%number vetoedDets(numVeto)%arrPos = i vetoedDets(numVeto)%firstInRange = .false. end if end if end do end do if (numVeto > 0) then vetoBPM = .true. call resizeVetoedDets(numVeto) else !Return something strange in case no vetoed dets are found Print *, "Automatic vetoing complete" vetoedDets(1)%arrPos = -123456 !Error code (arbitrary large number) end if end subroutine getAutoVetos end module mia_veto