!........................................................................
!
! Subroutine : READ_CONSTRAINTS (FILE_NAME, CON)
!
! Description: Subroutine to read the constraints for the "Z" lattice design
!              program.
!
! Arguments  :  
!    Input:
!      FILE_NAME -- Character*(*): File name.
!
!    Output:
!      CON       -- Constraint_struct:        
!
! Mod/Commons:    
!
! Calls      :      
!
! Author     : 
!
! Modified   :     
!             
!  namelist / bunch_current / con.current
! init vars
! Open file
! init
! Loop over all lines in the file
! Parse SINGLE_VARS
! Set defaults
! read single vars
! Parse CONSTRAINT_LIST
! read variable name
! read plane
! read constraint type
! read constraint target value
! read constraint weight
! read location #1
! read location #2
! Cleanup. Check that constraint stuff is valid
!        if (con%c(n_cons)%variable == particle_tracking$) read_tracking = .true.
! $BUNCH_CURRENT
!    elseif (line(:ix) == '$BUNCH_CURRENT') then
!      backspace (unit = lun)
!      read (lun, nml = bunch_current)
! $END_FILE signals end of parse.
! Check to see if everything is read.
! get res tracking info
!--------------------------------------------------------------------------
! read in a line
! strip off any comments
! trim leading blanks
!........................................................................
!
!
! $Log$
! Revision 1.23  2007/01/30 16:15:14  dcs
! merged with branch_bmad_1.
!
! Revision 1.19  2006/11/16 18:55:45  mjf7
! Bmad change in ele_struct name length caused bugs.
!
! Revision 1.18  2006/09/26 16:05:01  mjf7
! Adding sigma norming and fom_power back into main branch
!
! Revision 1.17.2.2  2006/09/25 02:59:04  mjf7
! make sigma norming optional and off by default
!
! Revision 1.17.2.1  2006/09/25 02:48:01  mjf7
! prepalat for sigma norming
!
! Revision 1.17  2006/09/24 16:33:03  mjf7
! Add fom_power as a single variable.  If omitted fom_power defaults to the normal sum of squares, but it can be set to 4, for example, for a sum of the 4th powers.
!
! Revision 1.16  2006/01/20 23:37:07  mjf7
! Formatting and linux compatibility changes
!
! Revision 1.15  2005/11/23 13:53:59  dlr
! find_change: option to type out taylor coefficients
! fourier_comp: fourier component of qs-2qx (beta**1)
! read_constraints: clean up instructions for solenoid compensation, sol_com is
! obsolete
! Solenoid_compensation: clean up instructions for solenoid compensation
!
! Revision 1.14  2005/09/15 14:57:54  dlr
! add constraints on synchrobetatron resonance
!
! Revision 1.13  2005/03/14 21:22:07  dlr
! generalize solenoid compensation so that you can specify skew quads
! fix bug in custom_set_tune
!
! Revision 1.12  2005/02/17 19:41:54  dcs
! fixed bug.
!
! Revision 1.11  2005/02/17 04:07:22  dcs
! correct Fortran standard nonconforming code.
!
! Revision 1.10  2005/01/17 19:23:13  dlr
! lrbbi_setup - correct bug in condition for parameters to calc lrbbi
! read_contraints - add weak beam bunch to single variable list
! showme - change contribution to include weight
!
! Revision 1.9  2005/01/03 17:59:37  dlr
! pre_init_set_file, define_special_variables, parasitic
!
! Revision 1.8  2004/03/09 15:14:05  dlr
! From 10 to 20 iterations before declalat cannot set tunes
!
! Revision 1.7  2004/01/30 19:15:43  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.6  2004/01/12 22:37:54  cesrulib
! Bug fix associated with multiple declarations of lunget which is initially
! declared in the sim_utils module.
!
! Revision 1.5  2003/11/10 17:01:54  dcs
! removed lat symmetry
!
! Revision 1.4  2003/09/23 18:31:29  dlr
! with carriage return, uses lattice in constraint file
!
! Revision 1.3  2003/06/07 20:44:30  cesrulib
! conform to the lahey f95 standard
!
! Revision 1.2  2003/04/30 17:14:54  cesrulib
! dlr's changes since last import
!
! Revision 1.1.1.1  2002/12/13 19:23:29  cesrulib
! import bmadz
!
!
!........................................................................
!


subroutine read_constraints (file_name, con)

  use bmad
  
  use constraints_mod
  implicit none
  
  type (constraint_struct)  con
  type (tracking_struct)  atrack
  
  integer n_cons, ix, lun, idelim, ios
  integer n_loops, n_cycles, n_print, n_trains, n_cars, n_14ns_space, j_car
  integer ivary, iplane, icmtyp, n_det_calc, sol_com
  integer qs_2qx_turns, fom_power
  integer electron_offset

  real(rp) energy_offset(3), orbit_offset(6)
  real(rp) del_Q_res_min, Jz_Ja_betaz_ratio, Q_z
  real(rp) reltyp, delta_e, beta_x_init, beta_y_init, eta_x_init
  real(rp) current
  
  character*(*) file_name
  character exclude_lrbbi(2)*40, initial_lat_file*60
  character*16 optimizer, symmetry, sextupole_symmetry
  character*60 new_bmad_file, lat_file, disp_file, post_init_set_file, pre_init_set_file
  character*80 line, line_in, special_output
  character*60 define_special_variables 
  character*40 compensating_ele(4)
  character*64 BunchPattern
  
  logical circular_machine, singles_found, cons_found, fully_coupled
  logical parsing
  logical nonlinearity, dbeta_exact
  logical pretzel, use_sextupole_fom
  logical minimize_moments, sex_compensate_natural
  logical plot, read_tracking, calc_emitt
  logical calculate_moments
  logical linearize_custom
  logical hybridize
  logical sextupole_moments, use_sigma_norm
  
  namelist / single_vars / n_loops, n_cycles, circular_machine,  &
       n_print, n_trains, lat_file, delta_e,  minimize_moments, &
       n_cars, n_14ns_space, exclude_lrbbi, optimizer, dbeta_exact,  &
       new_bmad_file, symmetry, nonlinearity, pretzel, sex_compensate_natural, &
       energy_offset, sextupole_symmetry, post_init_set_file, &
       disp_file, del_Q_res_min, Jz_Ja_BetaZ_ratio, Q_z, use_sextupole_fom, &
       n_det_calc, plot, special_output, initial_lat_file, beta_x_init, &
       beta_y_init, calc_emitt, fully_coupled, calculate_moments, orbit_offset,&
       linearize_custom, con, hybridize, sol_com, sextupole_moments, current, &
       pre_init_set_file, define_special_variables, j_car, compensating_ele, &
       qs_2qx_turns, fom_power, use_sigma_norm, bunchpattern, electron_offset, eta_x_init, &
       read_tracking

  namelist / tracking / atrack

! init vars

  singles_found = .false.
  cons_found    = .false.
  n_cons = 0
  read_tracking = .false.
  calc_emitt = .true.
  calculate_moments = .false.
  linearize_custom = .false.
  hybridize = .false.
  sol_com = -1
  BunchPattern = 'NULL'

! Open file

  lun = lunget()
  open (unit = lun, file = file_name, status = 'old', action='read')

! init

  symmetry = null_name$  ! to see if symmetry is set
  sextupole_symmetry = null_name$  ! to see if symmetry is set

!---------------------------
! Parse SINGLE_VARS
! First set defaults

  sex_compensate_natural  = .true.
  singles_found      = .true.
  dbeta_exact        = .false.
  use_sextupole_fom  = .false.
  post_init_set_file = ""
  initial_lat_file   = ""
  pre_init_set_file   = ""
  define_special_variables = ""
  plot              = .false.
  delta_e    = 3e-3
  n_det_calc = 6
  fully_coupled =     .false.
  special_output = ' '
  current        = 0.
  compensating_ele = ""
  qs_2qx_turns = 500
  con%sol_com = -1
  fom_power = 2
  use_sigma_norm = .false.
  electron_offset = 0


  read (lun, nml = single_vars, iostat = ios)
  if (ios /= 0) then
    print *, 'ERROR IN READ_CONSTARINTS: CANNOT READ "SINGLE_VARS" NAMELIST'
    print *, '      FROM THE INPUT FILE.'
    call err_exit
  endif

  call str_upcase(symmetry, symmetry)
  call str_upcase(optimizer, optimizer)
  call str_upcase(sextupole_symmetry, sextupole_symmetry)
  call str_upcase(special_output, special_output)
  
  con%n_loops            = n_loops
  con%n_cycles           = n_cycles
  con%circular_machine   = circular_machine
  con%n_print            = n_print
  con%n_trains           = n_trains
  con%n_cars             = n_cars
  con%n_14ns_space       = n_14ns_space
  con%exclude_lrbbi(1)   = exclude_lrbbi(1)
  con%exclude_lrbbi(2)   = exclude_lrbbi(2)
  con%optimizer          = optimizer
  con%new_bmad_file      = new_bmad_file
  con%lat_file           = lat_file
  con%nonlinearity       = nonlinearity
  con%pretzel            = pretzel
  con%energy_offset      = energy_offset
  con%minimize_moments   = minimize_moments
  con%disp_file          = disp_file
  con%del_Q_res_min      = del_Q_res_min
  con%q_z                = q_z
  con%delta_e            = delta_e
  con%dbeta_exact        = dbeta_exact
  con%use_sextupole_fom  = use_sextupole_fom
  con%Jz_Ja_BetaZ_ratio  = Jz_Ja_BetaZ_ratio
  con%compensate_natural = sex_compensate_natural
  con%n_det_calc         = n_det_calc
  con%plot               = plot
  con%special_output     = special_output
  con%orbit_offset%vec   = orbit_offset
  con%post_init_set_file = post_init_set_file
  con%initial_lat_file   = initial_lat_file
  con%beta_x_init        = beta_x_init
  con%beta_y_init        = beta_y_init
  con%eta_x_init        = eta_x_init
  con%emitt_calc         = calc_emitt
  con%fully_coupled      = fully_coupled
  con%calculate_moments  = calculate_moments
  con%linearize_custom   = linearize_custom
  con%hybridize          = hybridize
  con%current(1)            = current
  con%pre_init_set_file  = pre_init_set_file
  con%define_special_variables = define_special_variables
  con%j_car              = j_car
  con%compensating_ele(1:4)   = compensating_ele(1:4)
  if(con%compensating_ele(1) /= "")con%sol_com=0
  con%qs_2qx_turns  =   qs_2qx_turns
  con%fom_power     =   fom_power
  con%use_sigma_norm =  use_sigma_norm
  con%BunchPattern = BunchPattern
  con%electron_offset = electron_offset

  if(sextupole_symmetry(1:6) == 'NO_SYM')then
    con%sextupole_symmetry = .false.
  elseif(sextupole_symmetry(1:6) == 'EW_SYM')then
    con%sextupole_symmetry = .true.
  elseif (sextupole_symmetry /= null_name$) then
    print *, ' ERROR IN READ_CONSTARINTS: UNRECOGNIZABLE SYMMETRY'
    print *, '       SEXTUPOLE_SYMMETRY: ', con%sextupole_symmetry
    stop
  endif

  rewind (lun)
  
  !---------------------------
  ! Loop over all lines in the file
  
  do while (.true.)
    
    call read_next_line (lun, line, ix)
    if (ix == 0) cycle                  ! get more input if nothing on line
    if (line(:ix) == '$END_FILE' .or. line(:ix) == '&END_FILE') exit  
    
    ! Parse CONSTRAINT_LIST
    
    if (line(:ix) == '$CONSTRAINT_LIST' .or. &
        line(:ix) == '&CONSTRIANT_LIST') then
      
      cons_found = .true.
      parsing = .true.
      do while (parsing)
        
        do while (.true.)
          call read_next_line (lun, line, ix)
          if (ix /= 0) exit
        enddo

        ! end of constraint list?
        if (line(:ix) == '$END' .or. line(:ix) == '/') exit 
        
        n_cons = n_cons + 1
        
   ! read variable name
        
        call match_word (line(:ix), var_name, ivary)
        
        if (ivary <= 0) then
          print *, 'ERROR IN READ_CONSTRAINTS: BAD VARIABLE IN CONSTRAINT_LIST'
          print *, '      OFFENDING WORD: ', line(:30)
          call err_exit
        endif
        con%c(n_cons)%variable = ivary

   ! read plane

        line_in = line
        call string_trim (line(ix+1:), line, ix)
        call match_word (line, plane_name, iplane)
        
        if (iplane <= 0) then
          print *, 'ERROR IN READ_CONSTRAINTS: UNKNOWN PLANE IN CONSTRAINT_LIST'
          print *, '      ', trim(line_in)
          call err_exit
        endif
        con%c(n_cons)%plane = iplane
        
! read constraint type

        call string_trim (line(ix+1:), line, ix)
        if (line(1:3) == 'AMP') then
          con%c(n_cons)%use_amplitude = .true.
          call string_trim (line(4:), line, ix)
        else
          con%c(n_cons)%use_amplitude = .false.
        endif
        
        if (line(1:3) == 'REL') then
          con%c(n_cons)%use_relative = .true.
          call string_trim (line(4:), line, ix)
        else
          con%c(n_cons)%use_relative = .false.
        endif
        
        call match_word (line, con_name, con%c(n_cons)%constraint)
        
        if (con%c(n_cons)%constraint <= 0) then
          print *, 'ERROR IN READ_CONSTRAINTS: ',  &
               'UNKNOWN CONSTRAINT IN CONSTRAINT_LIST'
          print *, '      ', trim(line_in)
          call err_exit
        endif
        
! read constraint target value

        call string_trim (line(ix+1:), line, ix)
        if (line(1:ix) == 'INITIAL_VALUE') then
          con%c(n_cons)%set_target_to_initial_value = .true.
        else
          con%c(n_cons)%set_target_to_initial_value = .false.
          read (line, *, iostat = ios) con%c(n_cons)%target_value
          if (ios /= 0) then
            print *, 'ERROR IN READ_CONSTRAINTS: BAD VALUE IN CONSTRAINT_LIST'
            print *, '      ', trim(line_in)
            call err_exit
          endif
        endif

! read constraint target sigma

        if (con%use_sigma_norm) then
          call string_trim (line(ix+1:), line, ix)
          read (line, *, iostat = ios) con%c(n_cons)%target_sigma
          if (ios /= 0) then
            print *, 'ERROR IN READ_CONSTRAINTS: BAD VALUE IN CONSTRAINT_LIST'
            print *, '      ', trim(line_in)
            call err_exit
          endif
        endif

! read constraint weight
        
        call string_trim (line(ix+1:), line, ix)
        read (line, *, iostat = ios) con%c(n_cons)%weight
        if (ios /= 0) then
          print *, 'ERROR IN READ_CONSTRAINTS: BAD WEIGHT IN CONSTRAINT_LIST'
          print *, '      ', trim(line_in)
          call err_exit
        endif
        
! read location #1

        call string_trim (line(ix+1:), line, ix)
        
        if (ix == 0) then
          print *, 'ERROR IN READ_CONSTRAINTS: ',  &
                    'NO LOCATION GIVEN IN CONSTRAINT_LIST:', trim(line_in)
          call err_exit
        endif
        con%c(n_cons)%where1 = line(:ix)
        
! read location #2

        call string_trim (line(ix+1:), line, ix)

        if (ix /= 0) then
          if (line(:ix) == 'TO') then
            call string_trim (line(ix+1:), line, ix)
            if (ix == 0) then
              print *, 'ERROR IN READ_CONSTRAINTS: NOTHING AFTER "TO"'
              print *, trim(line_in)
              call err_exit
            endif
            con%c(n_cons)%where2 = line(:ix)
          else
            print *, 'ERROR IN READ_CONSTRAINTS: UNKNOWN SOMETHING AFTER LOCATION'
            print *, trim(line_in)
            call err_exit
          endif
        else
          con%c(n_cons)%where2 = null_name$
        endif

! Cleanup. Check that constraint stuff is valid

        if (con%c(n_cons)%variable == variable_limit$) then
          if (con%c(n_cons)%constraint /= maxz$) then
            print *, 'ERROR IN READ_CONSTRAINTS: FOR "VARIABLE_LIMIT" CONSTRAINT MUST BE "MAX"!'
            call err_exit
          endif
        endif

!        if (con%c(n_cons)%variable == particle_tracking$) read_tracking = .true.

      enddo   ! parsing a constraint line

    endif

  enddo   ! looping over all lines in file

! Check to see if everything is read.

  if (.not. singles_found) print *, 'Warning from READ_CONSTRAINTS: ',  &
       '&SINGLE_VARS line not found in file: ', file_name
  if (.not. cons_found) print *, 'Warning from READ_CONSTRAINTS: ',  &
       '&CONSTRAINT_LIST line not found in file: ', file_name
  
  con%n_constraint = n_cons

!---------------------------
! get res tracking info

  if (read_tracking) then
    rewind (lun)
    read (lun, nml = tracking, iostat = ios)
    if (ios /= 0) then
      print *, 'ERROR IN READ_CONSTARINTS: CANNOT READ "TRACKING" NAMELIST'
      print *, '      FROM THE INPUT FILE.'
      call err_exit
    endif
    con%track = atrack
  endif
  
! cleanup

  close (unit = lun)

end subroutine read_constraints


!--------------------------------------------------------------------------


subroutine read_next_line (lun, line, ix)

  implicit none

  integer lun, ix
  character*(*) line

! read in a line

  read (lun, '(a)', end=9000) line
  call str_upcase (line, line)  ! convert to upper case,

! strip off any comments

  ix = index(line, '!')
  if (ix == 1) then
    line = ' '
  elseif (ix > 1) then
    line = line(:ix-1)
  endif

! trim leading blanks

  call string_trim (line, line, ix)

  return

9000  print *
  print *, 'ERROR IN READ_CONSTRAINTS: END OF FILE ENCOUNTERED IN INPUT FILE'
  stop
  end