Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

More from Etienne. #1194

Merged
merged 2 commits into from
Sep 16, 2024
Merged

More from Etienne. #1194

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
1bf5636
More from Etienne.
DavidSagan Sep 16, 2024
e4a7960
More from Etienne.
DavidSagan Sep 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
51 changes: 35 additions & 16 deletions forest/code/Ci_tpsa.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17849,18 +17849,19 @@ subroutine ddt_vector_field_fourier(s1,ds1)

end subroutine ddt_vector_field_fourier

subroutine print_vector_field_fourier(s1,mf,collated)
subroutine print_vector_field_fourier(s1,mf,collated,non_zero_only)
implicit none
TYPE (c_vector_field_fourier), INTENT (INout) :: S1
logical, optional :: collated
logical usual
logical, optional :: collated,non_zero_only
logical usual,nonz
INTEGER I,mf,j
usual=.false.
if(present(collated)) usual=.not.collated

write(mf,*) 0,"th mode"
call print(s1%f(0),mf) !,dospin=.false.)

nonz=.false.
if(present(non_zero_only)) nonz=non_zero_only
do i=1,n_fourier

if(usual) then
Expand All @@ -17869,16 +17870,30 @@ subroutine print_vector_field_fourier(s1,mf,collated)
call print(s1%f(-i),mf) !,dospin=.false.)
else
do j=1,s1%f(i)%n
if(nonz) then
write(mf,*) i,"th mode orbital",j
if(full_abs(s1%f(i)%v(j))/=0) call print(s1%f(i)%v(j),mf) !,dospin=.false.)
write(mf,*) -i,"th orbital",j
if(full_abs(s1%f(-i)%v(j))/=0) call print(s1%f(-i)%v(j),mf) !,dospin=.false.)
else
write(mf,*) i,"th mode orbital",j
call print(s1%f(i)%v(j),mf) !,dospin=.false.)
write(mf,*) -i,"th orbital",j
call print(s1%f(-i)%v(j),mf) !,dospin=.false.)
endif
enddo
do j=0,3
write(mf,*) i,"th quaternion",j
call print(s1%f(i)%q%x(j),mf) !,dospin=.false.)
write(mf,*) -i,"th mode quaternion",j
call print(s1%f(-i)%q%x(j),mf) !,dospin=.false.)
if(nonz) then
write(mf,*) i,"th quaternion",j
if(full_abs(s1%f(i)%q%x(j))/=0) call print(s1%f(i)%q%x(j),mf) !,dospin=.false.)
write(mf,*) -i,"th mode quaternion",j
if(full_abs(s1%f(-i)%q%x(j))/=0) call print(s1%f(-i)%q%x(j),mf) !,dospin=.false.)
else
write(mf,*) i,"th quaternion",j
call print(s1%f(i)%q%x(j),mf) !,dospin=.false.)
write(mf,*) -i,"th mode quaternion",j
call print(s1%f(-i)%q%x(j),mf) !,dospin=.false.)
endif
enddo

endif
Expand Down Expand Up @@ -21938,24 +21953,28 @@ subroutine normalise_vector_field_fourier(H,Fc,K,F1,dospin,mres,h_comoving)
jq=0
call check_kernel_ham(ki,n,je,nu,da,removeit,m,nus,jq)


!!! m.nu+k=0 => k=-p
if(removeit.and.present(mres)) then
je(ki)=je(ki)-1
ires=0
do l=1,c_%nd
ires=iabs(mres(L)-(je(2*L)-je(2*L-1)))+ires
enddo
ires=iabs(mres(-1)-jq)+ires
ires=iabs(-mres(0)-m)+ires
! ires=iabs(mres(-1)-jq)+ires
ires=iabs(-mres(0)-m)+ires !k=-p
if(ires==0) removeit=.false.
je(ki)=je(ki)+1
endif
if(removeit.and.present(mres)) then
je(ki)=je(ki)-1
ires=0
do l=1,c_%nd
ires=iabs(-mres(L)-(je(2*L)-je(2*L-1)))+ires
enddo
ires=iabs(-mres(-1)-jq)+ires
ires=iabs(mres(0)-m)+ires
! ires=iabs(-mres(-1)-jq)+ires
ires=iabs(mres(0)-m)+ires !k=-p
if(ires==0) removeit=.false.
je(ki)=je(ki)+1
endif

if(removeit) then
Expand Down Expand Up @@ -21993,14 +22012,14 @@ subroutine normalise_vector_field_fourier(H,Fc,K,F1,dospin,mres,h_comoving)


call check_kernel_ham(0,n,je,nu,da,removeit,m,nus,jq)

!!! m.nu+k=0 => k=-p
if(removeit.and.present(mres)) then
ires=0
do l=1,c_%nd
ires=iabs(mres(L)-(je(2*L)-je(2*L-1)))+ires
enddo
ires=iabs(mres(-1)-jq)+ires
ires=iabs(-mres(0)-m)+ires
ires=iabs(-mres(0)-m)+ires !k=-p
if(ires==0) removeit=.false.
endif
if(removeit.and.present(mres)) then
Expand All @@ -22009,7 +22028,7 @@ subroutine normalise_vector_field_fourier(H,Fc,K,F1,dospin,mres,h_comoving)
ires=iabs(-mres(L)-(je(2*L)-je(2*L-1)))+ires
enddo
ires=iabs(-mres(-1)-jq)+ires
ires=iabs(mres(0)-m)+ires
ires=iabs(mres(0)-m)+ires !k=-p
if(ires==0) removeit=.false.
endif

Expand Down
4 changes: 2 additions & 2 deletions regression_tests/write_foreign_test/run.py
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,8 @@
results = subprocess.run([exe], stdout=subprocess.PIPE).stdout.decode('utf-8')
d = difflib.Differ()

files = ['write_foreign_test.mad8', 'write_foreign_test.madx', 'write_foreign_test.sad',
'write_foreign_test.lte', 'write_foreign_test.julia', 'write_foreign_test.opal']
##files = ['write_foreign_test.mad8', 'write_foreign_test.madx', 'write_foreign_test.sad',
## 'write_foreign_test.lte', 'write_foreign_test.julia', 'write_foreign_test.opal']

files = ['write_foreign_test.mad8', 'write_foreign_test.madx',
'write_foreign_test.lte', 'write_foreign_test.julia']
Expand Down
1 change: 1 addition & 0 deletions regression_tests/write_foreign_test/write_foreign_test.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ program write_foreign_test
call file_suffixer(lat_file, out_file, 'julia.now', .true.)
call write_lattice_in_foreign_format ('JULIA', out_file, lat)

! This needs some work. Specifically there should be a separate lattice for testing.
!call file_suffixer(lat_file, out_file, 'opal.now', .true.)
!call write_lattice_in_foreign_format ('OPAL-T', out_file, lat)

Expand Down