!+ ! Subroutine track1_postprocess (start_orb, ele, param, end_orb) ! ! Dummy routine for post processing after the track1 routine is done. ! ! General rule: Your code may NOT modify any argument that is not listed as ! an output agument below. ! ! Modules Needed: ! use bmad ! ! Input: ! start_orb -- Coord_struct: Starting position. ! ele -- Ele_struct: Element. ! param -- lat_param_struct: Lattice parameters. ! end_orb -- Coord_struct: End position. ! ! Output: ! end_orb -- Coord_struct: End position. !- subroutine track1_postprocess (start_orb, ele, param, end_orb) use bmad_interface, except_dummy => track1_postprocess use ecloudmod implicit none type (coord_struct) :: start_orb type (coord_struct) :: end_orb type (ele_struct) :: ele type (lat_param_struct) :: param character(*), parameter :: r_name = 'track1_postprocess' ! Herein we should supply kicks to cloud elements based on their length ! === CUSTOM PARAMETER === integer, parameter :: calculation_index$ = custom_attribute1$ integer, parameter :: math_model$ = 1 integer, parameter :: qdens_math$ = 2 integer, parameter :: qdens_snapshot$ = 3 integer, parameter :: file_driven$ = 4 integer, parameter :: reset_value$ = custom_attribute2$ integer, parameter :: multi_val$ = custom_attribute3$ integer, parameter :: first_particle$ = custom_attribute4$ integer, parameter :: latest_particle$ = custom_attribute5$ ! === ================ === ! === Cloud definitions === real(rp),save :: cloud_mult = 1.0 real(rp),save :: reset_value = 5.7e-7 real(rp),save :: calc_type = qdens_snapshot$ integer, save :: bunch_start = 1 ! === ================= === ! Need to store field values type (em_field_struct) :: field real(rp) :: xkick, ykick, zkick type (DiscreteEcloud), save :: ecloud_data logical, save :: init_needed = .true. logical :: custom_err = .false. integer lun, lun1, lun2, lun3, ios, nargs, i character*140 arg namelist /cloud_def/cloud_mult, reset_value, calc_type, bunch_start if (ele%key == sbend$ .or. ele%key == rbend$) then xkick = 0 ykick = 0 zkick = 0 ele%value(calculation_index$) = calc_type ele%value(reset_value$) = reset_value ele%value(multi_val$) = cloud_mult !===========================================! ! First create the data structure if needed ! !===========================================! if (init_needed) then ! First get the cloud definition lun = lunget() open(unit=lun, file='snapshot/cloud_def.in', STATUS='old') read(lun, nml=cloud_def, IOSTAT=ios) close(unit=lun) write(6,nml=cloud_def) ele%value(calculation_index$) = calc_type ! Set calculation type ele%value(reset_value$) = reset_value ! Set the reset value ele%value(multi_val$) = cloud_mult ! Add a multiplier call setStartBunch(bunch_start) ! Add a start offset print *, "[*] ECLOUD TRACKING: Performing first time setup" print *, " [*] INPUT VALUES:" print *, " (1): ", ele%value(custom_attribute1$) print *, " (2): ", ele%value(custom_attribute2$) print *, " (3): ", ele%value(custom_attribute3$) print *, " (4): ", ele%value(custom_attribute4$) print *, " (5): ", ele%value(custom_attribute5$) print *, " Start bunch: ", bunch_start select case ( int(ele%value(calculation_index$)) ) case (math_model$) print *, " ","[*] MATH MODEL" ! ... case (qdens_math$) ! Calculate by reading qdens from file then using trends print *, " ","[*] QDENS MATH" lun1 = lunget() open(unit=lun1,file='snapshot/qdens.data') call calculateDiscreteFromQdensFile(lun1,ecloud_data) case (qdens_snapshot$) ! Take snapshot of bunch and scale with qdens from file print *, " ","[*] QDENS SNAPSHOT" lun1 = lunget() open(unit=lun1,file='snapshot/snapshot.data') lun2 = lunget() open(unit=lun2,file='snapshot/qdens.data') lun3 = lunget() open(unit=lun3,file='snapshot/bunchhead.data') call calculateDiscreteFromSnapshotsFiles(lun1,lun2,lun3,ecloud_data) case (file_driven$) ! Calculate by reading EM from file print *, " ","[*] FULL TRAIN FILE" lun1 = lunget() open(unit=lun1,file='snapshot/snapshot.data') lun2 = lunget() open(unit=lun2,file='snapshot/qdens.data') lun3 = lunget() open(unit=lun3,file='snapshot/bunchhead.data') call calculateDiscreteFromSnapshotsFiles(lun1,lun2,lun3,ecloud_data) end select print *, "[*] Start time offset: ", ecloud_data%bunchtimes(bunch_start) init_needed = .false. ! Check if user wanted to run tests nargs = cesr_iargc() do i=1, nargs call cesr_getarg(i,arg) if (arg .eq. '-test') then call performTests(ele,ecloud_data) exit end if end do end if !==================================================================! ! Now calculate the Ex and Ey given the position of the particles. ! ! This is either done using a Discrete structure, or the formulas. ! !==================================================================! select case ( int(ele%value(calculation_index$)) ) case (math_model$) call calculateEM(ele,start_orb%t,start_orb,field) case (qdens_math$) call calculateEMFromDiscrete_QDens(ele, start_orb%t, start_orb, ecloud_data, field, custom_err) case (qdens_snapshot$) call calculateEMFromDiscrete_SingleBunch(ele, start_orb%t, start_orb, ecloud_data, field, custom_err) case (file_driven$) call calculateEMFromDiscrete_Multibunch(ele, start_orb%t, start_orb, ecloud_data, field, custom_err) end select if (ISNAN(field%E(1)) .or. ISNAN(field%E(2))) then custom_err = .true. end if if (custom_err) then print *, " ","[!] CALCULATION ERROR" end if ! Now we have calculated the fields the particle will experience, we must now calcualte kicks xkick = (field%E(1) / ele%value(E_tot$)) * ele%s ykick = (field%E(2) / ele%value(E_tot$)) * ele%s zkick = (field%E(3) / ele%value(E_tot$)) * ele%s ! ============================================== end if end_orb%vec(2) = end_orb%vec(2) + xkick end_orb%vec(4) = end_orb%vec(4) + ykick end_orb%vec(6) = end_orb%vec(6) + zkick ! should always be 0 added end subroutine