subroutine write_model (num, u, comment) use cesrv_struct use cesrv_interface implicit none type (var_struct), pointer :: avar type (universe_struct), target :: u integer ix, i, num real(rp) merit0, rel_dif character(*) comment character(89) line, comment_out character(140) f_name character(140) dat_file character(20) date_str character(16) :: a = '(10a)' logical err_flag !--------------------------------------------------------------------------- call merit_calc(merit0) call date_and_time_stamp (date_str) call cu_target_calc (u%var, u, 1.0_rp) if (num == 0) then call fullfilename ( & '$CESR_ONLINE/acc_control/program_info/cesrv/model/model.number', f_name) call increment_file_number (f_name, 5, ix, line) else ix = num endif call make_legal_comment (comment, comment_out) call form_file_name_with_number ('MODEL', ix, dat_file, err_flag) if (err_flag) return open (2, file = dat_file) write (2, a) '! Model values from the CESRV program' write (2, a) '! Phase data file: ', u%phase%file_name write (2, a) write (2, a) '&DATA_PARAMETERS' write (2, *) ' file_type = ', "'CESRV MODEL'" write (2, *) ' data_date = ', "'", date_str, "'" write (2, *) ' lattice = ', "'",trim(logic%lattice),"'" write (2, *) ' save_set = ', max(u%orbit%csr_set, u%phase%csr_set) write (2, *) ' comment = ', trim(comment_out) write (2, a) '/END' write (2, a) write (2, a) '&TUNES' write (2, *) ' tune_x_model = ', mod(u%tune%x%d(1)%model/twopi, 1.0_rp) * 390.1 write (2, *) ' tune_y_model = ', mod(u%tune%y%d(1)%model/twopi, 1.0_rp) * 390.1 write (2, *) ' tune_x_design = ', mod(u%tune%x%d(1)%design/twopi, 1.0_rp) * 390.1 write (2, *) ' tune_y_design = ', mod(u%tune%y%d(1)%design/twopi, 1.0_rp) * 390.1 write (2, a) '/END' ! Sep Model write (2, a) write (2, a) '&HSEP / Horizontal Separators' write (2, a) ' Kick (mr) | CU' write (2, a) ' I Model Design Saved | Model Design Saved' do i = lbound(u%hsep_kick%v, 1), ubound(u%hsep_kick%v, 1) avar => u%hsep_kick%v(i) if (avar%ix_ele /= 0) then write (2, '(i3, 3p3f9.3, 0pi8, 2i7, 2a)') i, & avar%model, avar%design, avar%saved, & avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_design, avar%cu_saved, & ' ! ', trim(avar%name) endif enddo ! Quad Model write (2, a) write (2, a) '&QUAD / Quadrupole' write (2, a) ' K1 | CU' write (2, a) ' I Model Design Delta %Diff | Saved Model Target Delta' do i = lbound(u%quad_k1%v, 1), ubound(u%quad_k1%v, 1) avar => u%quad_k1%v(i) if (avar%ix_ele /= 0) then if (avar%design == 0) then rel_dif = 0 else rel_dif = 100 * (avar%design - avar%model) / avar%design rel_dif = max(min(rel_dif, 999.9_rp), -99.9_rp) endif write (2, '(i3, 3f11.6, f9.4, i8, 2i7, i6, 2a)') i, & avar%model, avar%design, avar%design-avar%model, rel_dif, & avar%cu_saved, avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_target, avar%cu_target-avar%cu_saved, & ' ', trim(avar%name) endif enddo ! Skew Quad model write (2, a) write (2, a) '&SKEW_QUAD / Skew Quadrupole' write (2, a) ' K1 | CU' write (2, a) ' I Model Design Delta | Saved Model Target Delta' do i = lbound(u%skew_quad_k1%v, 1), ubound(u%skew_quad_k1%v, 1) avar => u%skew_quad_k1%v(i) if (avar%ix_ele /= 0) then write (2, '(i3, 3f10.5, i8, 3i7, 2a)') i, & avar%model, avar%design, avar%design-avar%model, & avar%cu_saved, avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_target, avar%cu_target-avar%cu_saved, & ' ', trim(avar%name) endif enddo ! Sex model write (2, a) write (2, a) '&SEX / Sextupole' write (2, a) ' K2 | CU' write (2, a) ' I Model Design Delta | Saved Model Design Target Delta' do i = lbound(u%sex_k2%v, 1), ubound(u%sex_k2%v, 1) avar => u%sex_k2%v(i) if (avar%ix_ele /= 0) then write (2, '(i3, 3f10.5, i8, 4i7, 2a)') i, & avar%model, avar%design, avar%design-avar%model, & avar%cu_saved, avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_design, avar%cu_target, avar%cu_target-avar%cu_saved, & ' ', trim(avar%name) endif enddo ! Skew Sex model write (2, a) write (2, a) '&SKEW_SEX / Skew Sextupole' write (2, a) ' K2 | CU' write (2, a) ' I Model Design Delta | Saved Model Design Target Delta' do i = lbound(u%skew_sex_k2%v, 1), ubound(u%skew_sex_k2%v, 1) avar => u%skew_sex_k2%v(i) if (avar%ix_ele /= 0) then write (2, '(i3, 3f10.5, i8, 4i7, 2a)') i, & avar%model, avar%design, avar%design-avar%model, & avar%cu_saved, avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_design, avar%cu_target, avar%cu_target-avar%cu_saved, & ' ', trim(avar%name) endif enddo ! Hsteer model write (2, a) write (2, a) '&HSTEER / Horizontal Steerings' write (2, a) ' Kick (mrad) | CU' write (2, a) ' I Model Design Delta | Saved Model Target Delta' do i = lbound(u%hsteer_kick%v, 1), ubound(u%hsteer_kick%v, 1) avar => u%hsteer_kick%v(i) if (avar%ix_ele /= 0) then write (2, '(i3, 3p3f9.3, 0pi8, 3i7, 2a)') i, & avar%model, avar%design, avar%design-avar%model, & avar%cu_saved, avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_target, avar%cu_target-avar%cu_saved, & ' ', trim(avar%name) endif enddo ! Vsteer model write (2, a) write (2, a) '&VSTEER / Vertical Steerings' write (2, a) ' Kick (mrad) | CU' write (2, a) ' I Model Design Delta | Saved Model Target Delta' do i = lbound(u%vsteer_kick%v, 1), ubound(u%vsteer_kick%v, 1) avar => u%vsteer_kick%v(i) if (avar%ix_ele /= 0) then write (2, '(i3, 3p3f9.3, 0pi8, 3i7, 2a)') i, & avar%model, avar%design, avar%design-avar%model, & avar%cu_saved, avar%cu_saved+avar%cu_design-avar%cu_target, & avar%cu_target, avar%cu_target-avar%cu_saved, & ' ', trim(avar%name) endif enddo ! close (2) print *, 'Written Model file: ', trim(dat_file) end subroutine