Fix gg_fit_mod.f90 code array set before allocation of zero_vec. (#1029)

tao/code/tao_show_this.f90

@@ -846,6 +846,7 @@ subroutine tao_show_this (what, result_id, lines, nl)
  bmad_nf => tao_branch%bmad_normal_form
  ptc_nf => tao_branch%ptc_normal_form
 
+ nl=nl+1; lines(nl) = ' Note: Calculation is done with RF off.'
  nl=nl+1; lines(nl) = ' N chrom_ptc.a.N chrom_ptc.b.N spin_tune_ptc.N'
 
  do i = 0, ptc_private%taylor_order_ptc-1
@@ -855,6 +856,8 @@ subroutine tao_show_this (what, result_id, lines, nl)
  s0 = real(ptc_nf%spin_tune .sub. expo)
  if (i == 0) then
  nl=nl+1; write (lines(nl), '(i3, 3es18.7, a)') i, z1, z2, s0, ' ! 0th order are the tunes'
+ elseif (i == 1 .and. .not. bmad_com%spin_tracking_on) then
+ nl=nl+1; write (lines(nl), '(i3, 3es18.7, a)') i, z1, z2, s0, ' ! Spin tracking off so spin tune not calculated'
  else
  nl=nl+1; write (lines(nl), '(i3, 3es18.7)') i, z1, z2, s0
  endif
@@ -4539,6 +4542,28 @@ subroutine tao_show_this (what, result_id, lines, nl)
  else
  tao_branch%spin_map_valid = .false.
  call tao_spin_polarization_calc (branch, tao_branch, excite_zero, veto)
+ if (.not. u%calc%one_turn_map) call tao_ptc_normal_form (.true., u%model, branch%ix_branch)
+
+ !
+
+ nl=nl+1; lines(nl) = ''
+ nl=nl+1; lines(nl) = ' N chrom_ptc.a.N chrom_ptc.b.N spin_tune_ptc.N'
+
+ ptc_nf => tao_branch%ptc_normal_form
+ do i = 0, ptc_private%taylor_order_ptc-1
+ expo = [0, 0, 0, 0, 0, i]
+ z1 = real(ptc_nf%phase(1) .sub. expo)
+ z2 = real(ptc_nf%phase(2) .sub. expo)
+ s0 = real(ptc_nf%spin_tune .sub. expo)
+ if (i == 0) then
+ nl=nl+1; write (lines(nl), '(i3, 3es18.7, a)') i, z1, z2, s0, ' ! 0th order are the tunes'
+ else
+ nl=nl+1; write (lines(nl), '(i3, 3es18.7)') i, z1, z2, s0
+ endif
+ enddo
+
+ !
+
  nl=nl+1; lines(nl) = ''
  nl=nl+1; write (lines(nl), '(a, es18.7)') 'spin_tune: ', tao_branch%spin%tune / twopi
  if (tao_branch%spin%valid) then

util_programs/generalized_gradient_fit/gg_fit_mod.f90

@@ -73,7 +73,6 @@ module gg_fit_mod
 real(rp) :: z_min = real_garbage$, z_max = real_garbage$, core_weight = 1, outer_plane_weight = 1
 real(rp) :: lmdif_eps = 1d-12
 
-real(rp), allocatable :: var_vec(:), merit_vec(:), dB_dvar_vec(:,:)
 real(rp) merit
 
 logical printit
@@ -414,6 +413,7 @@ subroutine fit_field()
 type (gg1_struct), pointer :: gg
 
 real(rp), allocatable :: vec0(:), weight(:), zero_vec(:), xy(:,:)
+real(rp), allocatable :: var_vec(:), merit_vec(:), dB_dvar_vec(:,:)
 real(rp) merit0, x, y, v, chisq, a_lambda, r2, r2_max, p_wgt
 
 integer i, iloop, im, id, n_gg, n, ig, nx, ny, n3
@@ -454,7 +454,6 @@ subroutine fit_field()
 
 n_var = 0
 n_gg = 0
-zero_vec = 0
 
 do im = 1, size(m_cos)
  if (m_cos(im) /= -1) then
@@ -512,11 +511,12 @@ subroutine fit_field()
 !
 
 allocate (merit_vec(n_merit), dB_dvar_vec(n_merit, n_var), zero_vec(n_merit))
-
 allocate (fit(iz_min:iz_max))
 allocate (var_vec(n_var), vec0(n_var), weight(n_merit))
+
 vec0 = 0
 var_vec = 0
+zero_vec = 0
 
 r2_max = max(abs(Nx_min*del_meters(1) + r0_meters(1)), abs(Nx_max*del_meters(1) + r0_meters(1)))**2 + &
  max(abs(Ny_min*del_meters(2) + r0_meters(2)), abs(Ny_max*del_meters(2) + r0_meters(2)))**2