PROGRAM res3nux !use madx_ptc_module use pointer_lattice implicit none integer no,np,mf,MFM,i,ind real(dp) fix(6),PHASE_ADVANCE,PHASE_ADVANCE1,PHASE_ADVANCEJ,betax,alphax,DX_AVERAGE_DJ type(internal_state), target :: state type(layout), pointer :: ring type(c_damap) id,m,a_cs,disp,A_L,A_NL,a_spin type(probe) r0 type(probe_8) r type(c_normal_form) normal type(c_taylor) phase(3),phase_spin,beta,gamma, alpha,ct,x_average,x type(fibre),pointer :: f integer j1(lnv),j2(lnv) ! MAD-X LATTICE ! L : DRIFT, L= 1.0; ! ALPHA= 0.314159265358979; ! QF : SBEND,L= 1.0, ANGLE=ALPHA,K1=1.0; ! QD : SBEND,L= 1.0, ANGLE=ALPHA,K1=-1.0; ! SF : SEXTUPOLE, K2= 2.0; !LATTICE : LINE= 10*(QF,SF,L,QD,SF,L); call ptc_ini_no_append !call read_lattice_append(M_U,'C:\msys64\home\Etienne\MAD-X\files_for_cas\small_lattice\flat.txt') call read_lattice_append(M_U,'C:\msys64\home\Etienne\MAD-X\files_for_cas\small_lattice\flat_exercise0.txt') call read_lattice_append(M_U,'C:\msys64\home\Etienne\MAD-X\files_for_cas\small_lattice\flat_exercise.txt') ring=>m_u%start my_estate=>state state=only_4d0+delta0 !call read_ptc_command77("fit.txt") goto 1000 MF=16 OPEN(UNIT=MF,FILE="TWISS.TXT") MFM=17 OPEN(UNIT=MFM,FILE="MAPS.TXT") WRITE(MF,'(A4,6X,A7,7X,3X,A15,3X,4X,A14,9X,A10,9X,A11)') & "NAME", "PHASE_X", "DPHASE_X/DDELTA","DPHASE_X/DR2_X"," BETA "," GAMMA " WRITE(MF,*) " " no=3 np=0 state=only_2d0+delta0 call init_all(state,no,np) call alloc(r) call alloc(id,m,a_cs,disp,A_L,A_NL,a_spin) call alloc(normal) call alloc(phase_spin,beta,gamma, alpha,ct,x_average,x) call alloc(phase) FIX=0.0_DP ! FIXED POINT call find_orbit(ring,fix(1:6),1,state,1.d-5) WRITE(6,*) FIX(1:2) ! INITIALIZE THE RAY AS --> !RAY = FIXED POINT + IDENTITY (TAYLOR MAP) r0=fix ID=1 R=r0+ID ! COMPUTING A ONE-TURN MAP TO ORDER MY_ORDER call propagate(ring,r,state,fibre1=1) M=R !call print( M,mfi=MFM,title= " The one-turn map : x and p ") ! NORMALIZING THE MAP CALL c_normal(M,NORMAL,phase=phase) write(6,*) "Linear tune ", NORMAL%tune(1) call c_full_canonise(NORMAL%Atot,a_cs,a_spin,disp,A_L,A_NL) Write(mfm,*) " transformation to the delta dependent closed orbit " call print( disp,mfm) Write(mfm,*) " map around delta dependent closed orbit" M=disp**(-1)*M*disp call print( M,mfm) Write(mfm,*) " delta dependent linear Courant-Snyder transformation" call print( a_l,mfm) M=a_l**(-1)*M*a_l Write(mfm,*) " Linear part is now a delta dependent rotation" call print( M,mfm) M=A_NL**(-1)*M*A_NL Write(mfm,*) " nonlinear transformation " call print( A_NL,mfm) Write(mfm,*) " nonlinear rotation: this is the normal form " call clean(M,M,prec=1.d-10) call print( M,mfm) M=c_phasor()**(-1)*M*c_phasor() Write(mfm,*) " nonlinear rotation in phasors basis (x +/- i p)" call clean(M,M,prec=1.d-10) call print( M,mfm) call clean(M,M,prec=1.d-10) call print( M,mfm) write(mfm,*) " TUNE from one turn map" call print(phase(1),mfm) DX_AVERAGE_DJ=0.0_dp phase=0.0_dp r=a_cs+r0 f=>ring%start do i=1,ring%n call propagate(ring,r,state,fibre1=i,fibre2=i+1) a_cs=r call c_full_canonise(a_cs,a_cs,a_spin,disp,A_L,A_NL,phase=phase,nu_spin=phase_spin) r0=r r=a_cs+r0 BETAX=(A_L%V(1).INDEX.1)**2+(A_L%V(1).INDEX.2)**2 ALPHAX=-((A_L%V(1).INDEX.1)*(A_L%V(2).INDEX.1)+(A_L%V(1).INDEX.2)*(A_L%V(2).INDEX.2)) PHASE_ADVANCE=phase(1) if(c_%nd2==2) ind=3 if(c_%nd2==4) ind=5 if(c_%nd2==6) ind=5 j1=0;j1(ind)=1; PHASE_ADVANCE1=phase(1).sub.j1 j1=0;j1(1)=2; PHASE_ADVANCEJ=phase(1).sub.j1 WRITE(MF,'(A3,5(1X,E20.13))') f%mag%NAME(1:3),PHASE_ADVANCE,PHASE_ADVANCE1,PHASE_ADVANCE,BETAX,ALPHAX if(f%mag%p%nmul>=3) then DX_AVERAGE_DJ=(BETAX)**1.5_DP*f%mag%bn(3)/4.0_DP & *(-SIN(PHASE_ADVANCE*TWOPI)+SIN((PHASE_ADVANCE-NORMAL%TUNE(1))*TWOPI)) & /(1.0_DP-COS(NORMAL%TUNE(1)*TWOPI)) + DX_AVERAGE_DJ endif f=>f%next enddo write(mfm,*) "TOTAL TUNE " call print(phase(1),mfm) write(mfm,*) DX_AVERAGE_DJ= DX_AVERAGE_DJ*SQRT(BETAX) write(mfm,*) write(mfm,*) "Analytical Result d/dj " write(mfm,*) DX_AVERAGE_DJ ! 2 KS_ptc=KS_mad write(mfm,*) X=FIX(1)+ DZ_C(1) CALL AVERAGE(X,A_CS,X_AVERAGE) WRITE(MFM,*) " NON-LINEAR DISPERSION DEFINED AS = D/DJ * J + ..." WRITE(MFM,*) " TAYLOR MAP RESULTS FOR = D/DJ * J + ..." CALL PRINT(X_AVERAGE,MFM) CLOSE(MF) CLOSE(MFM) 1000 call ptc_end(graphics_maybe=1,flat_file=.false.) END PROGRAM res3nux