!........................................................................ ! ! Subroutine : max_or_min_delta_beta (CON, lat, nonlin, moment, i_con, & ! value, location, weight) ! ! Description: If the constrained parameter is dbeta,dalpha,dphi, or a ! determinant or dbeta_dpretz routine will find the maximum ! or minimum or target of the parameter in the range ! ! Arguments : ! INPUT: CON -- constraints structure ! NONLIN -- nonlin_ele_struct: nonlin contains energy dependence ! of twiss parameters ! i_con -- constraint number(integer) ! ! OUTPUT: CON.c(i_con).actual_value (real), value of the parameter of ! the i_con constraint ! CON.c(i_con).location (integer), LAT element number where ! minimum or maximum or target value of constrained ! parameter appears ! ! Mod/Commons: ! ! Calls : ! ! Author : ! ! Modified : ! !........................................................................ ! ! ! $Log$ ! Revision 1.8 2007/01/30 16:15:13 dcs ! merged with branch_bmad_1. ! ! Revision 1.4 2004/01/30 19:15:42 dlr ! correct calculation of electron positron differences ! correct sextupole optimization to deal properly with both beams ! increase gjdet array size for making scmating knobs ! add new constraints eletron emittance ! ! Revision 1.3 2003/08/09 19:35:33 mjf7 ! Fixed a memory leak. - mjf ! ! Revision 1.2 2003/04/30 17:14:52 cesrulib ! dlr's changes since last import ! ! Revision 1.1.1.1 2002/12/13 19:23:29 cesrulib ! import bmadz ! ! !........................................................................ ! subroutine max_or_min_delta_beta (CON, lat, nonlin, moment, i_con, & value, location, weight) use bmad use constraints_mod use nonlin_mod implicit none type (lat_struct) lat type (constraint_struct) con type (nonlin_ele_struct) nonlin type (moment_struct) moment integer i, i1, i2, j, i_con, location real(rp) value, param real(rp) weight real(rp) ave_trace, std_dev_trace integer idum ! i1 = con%c(i_con)%where1_ix i2 = con%c(i_con)%where2_ix if (i1 > i2) then print *, 'ERROR IN MAX_OR_MIN_DELTA_BETA: LOCATION1 AFTER LOCATION2!' print *, 'Variable:', var_name(con%c(i_con)%variable) print *, 'Location/index 1: ', con%c(i_con)%where1, i1 print *, 'Location/index 2: ', con%c(i_con)%where2, i2 call err_exit endif ! location = -1 ! dummy do i = i1, i2 param = 0. if (con%c(i_con)%plane == x_plane$) then if (con%c(i_con)%variable == delta_beta$) then param = nonlin%non_ele(i)%a%dbeta elseif (con%c(i_con)%variable == delta_alpha$) then param = nonlin%non_ele(i)%a%dalpha elseif (con%c(i_con)%variable == delta_phi$) then param = nonlin%non_ele(i)%a%dphi elseif (con%c(i_con)%variable == dbeta_dpretz$) then param = (nonlin%non_ele(i)%a%beta - lat%ele(i)%a%beta) & /lat%ele(i)%a%beta elseif (con%c(i_con)%variable == dbeta_dcos$) then param = moment%mdbeta_dcos_x(i) elseif (con%c(i_con)%variable == dbeta_dsin$) then param = moment%mdbeta_dsin_x(i) elseif (con%c(i_con)%variable == delta_beta_quad$) then param = moment%dbeta_x_0_norm(i) else print *, 'ERROR IN MAX_OR_MIN_DELTA_BETA: I CANNOT HANDLE THIS CONSTRAINT!' print *, 'Variable:', var_name(con%c(i_con)%variable) call err_exit endif endif if (con%c(i_con)%plane == y_plane$) then if (con%c(i_con)%variable == delta_beta$) then param = nonlin%non_ele(i)%b%dbeta elseif (con%c(i_con)%variable == delta_alpha$) then param = nonlin%non_ele(i)%b%dalpha elseif (con%c(i_con)%variable == delta_phi$) then param = nonlin%non_ele(i)%b%dphi elseif (con%c(i_con)%variable == dbeta_dpretz$) then param = (nonlin%non_ele(i)%b%beta - lat%ele(i)%b%beta) & /lat%ele(i)%b%beta elseif (con%c(i_con)%variable == dbeta_dcos$) then param = moment%mdbeta_dcos_y(i) elseif (con%c(i_con)%variable == dbeta_dsin$) then param = moment%mdbeta_dsin_y(i) elseif (con%c(i_con)%variable == delta_beta_quad$) then param = moment%dbeta_y_0_norm(i) else print *, 'ERROR IN MAX_OR_MIN_DELTA_BETA: I CANNOT HANDLE THIS CONSTRAINT!' print *, 'Variable:', var_name(con%c(i_con)%variable) call err_exit endif endif ! if (con%c(i_con)%variable == det_2by2_ul$)then param = nonlin%non_ele(i)%det%two_by2_ul(1) if(i==0)then !full turn only do idum = 1,nonlin%n_det_calc param = max(param,nonlin%non_ele(i)%det%two_by2_ul(idum)) end do endif elseif (con%c(i_con)%variable == det_2by2_lr$)then param = nonlin%non_ele(i)%det%two_by2_lr(1) if(i==0)then !full turn only do idum = 1,nonlin%n_det_calc param = max(param,nonlin%non_ele(i)%det%two_by2_lr(idum)) end do endif elseif (con%c(i_con)%variable == det_4by4$)then param = nonlin%non_ele(i)%det%four_by4(1) if(i==0)then !full turn only do idum = 1,nonlin%n_det_calc param = max(param,nonlin%non_ele(i)%det%four_by4(idum)) end do endif elseif (con%c(i_con)%variable == trace$)then if(i==0)then !full turn only ave_trace = sum(nonlin%trace(1:nonlin%n_det_calc))/nonlin%n_det_calc std_dev_trace = 0. do idum = 1,nonlin%n_det_calc std_dev_trace= (nonlin%trace(idum)-ave_trace)**2 + std_dev_trace end do param = sqrt(std_dev_trace/nonlin%n_det_calc) endif elseif (con%c(i_con)%variable == coupling_a_real$) then param = moment%ma_real(i) elseif (con%c(i_con)%variable == coupling_a_image$) then param = moment%ma_image(i) elseif (con%c(i_con)%variable == coupling_b_real$) then param = moment%mb_real(i) elseif (con%c(i_con)%variable == coupling_b_image$) then param = moment%mb_image(i) ! else ! param = 0.0000 endif if (con%c(i_con)%constraint == min$) then if (param < value .or. location < 0) then value = param location = i endif elseif (con%c(i_con)%constraint == maxz$) then if (param > value .or. location < 0) then value = param location = i endif elseif (con%c(i_con)%constraint == target$) then if (abs(param) > value .or. location < 0) then value = param location = i endif else print *, 'ERROR IN MAX_OR_MIN: CONSTRAINT TYPE IS NOT MAX OR MIN!' print *, 'Variable:', var_name(con%c(i_con)%variable) print *, 'Constraint:', con%c(i_con)%constraint call err_exit endif end do if (con%minimize_moments) weight=0. end subroutine