From 755a7b1ff2656b0d75e7cbf8bc67eb3235e1f931 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Tue, 13 Feb 2024 00:43:57 -0500 Subject: [PATCH 01/97] test commit --- equil/direct.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 69703590..522dc4f1 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -152,7 +152,7 @@ SUBROUTINE direct_run rzphi%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) rzphi%xtitle="psifac" rzphi%ytitle="theta " - rzphi%title=(/" r2 "," deta "," dphi "," jac "/) + rzphi%title=(/" r2 "," deta "," dphi "," jac "/) ! deta = eta - theta, dphi = phi - zeta eqfun%title=(/" b0 "," "," " /) eqfun%xs=sq%xs eqfun%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) From 6f34609d03c54df8d67124010233a86438f7bcf4 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 13:56:20 -0400 Subject: [PATCH 02/97] Prep for nstepd to be a potential user input --- equil/direct.f | 5 +++-- input/equil.in | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 522dc4f1..aa58df99 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -10,6 +10,7 @@ c 2. direct_get_bfield. c 3. direct_position. c 4. direct_fl_int. +c 4.5 find_fl_surface. c 5. direct_fl_der. c 6. direct_refine. c 7. direct_output. @@ -37,6 +38,7 @@ MODULE direct_mod END TYPE direct_bfield_type REAL(r8) :: etol=1e-8 + INTEGER :: nstepd=2048 CONTAINS c----------------------------------------------------------------------- @@ -49,7 +51,7 @@ MODULE direct_mod SUBROUTINE direct_run INTEGER :: ir,iz,itheta,ipsi - INTEGER, PARAMETER :: nstep=2048 + !INTEGER, PARAMETER :: nstepd=20048 REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q REAL(r8), DIMENSION(0:nstep,0:4) :: y_out REAL(r8), DIMENSION(2, mpsi+1) :: xdx @@ -437,7 +439,6 @@ SUBROUTINE direct_fl_int(ipsi,y_out,bf) INTEGER, PARAMETER :: neq=4,liw=30,lrw=22+neq*16 INTEGER :: iopt,istate,itask,itol,jac,mf,ir INTEGER, DIMENSION(liw) :: iwork - INTEGER, PARAMETER :: nstep=2048 REAL(r8), PARAMETER :: eps=1e-12 REAL(r8) :: atol,rtol,rfac,deta,r,z,eta,err,psi0,psifac,dr REAL(r8), DIMENSION(neq) :: y diff --git a/input/equil.in b/input/equil.in index 5dac71a1..a5af9922 100644 --- a/input/equil.in +++ b/input/equil.in @@ -14,6 +14,7 @@ mtheta=256 ! Number of equally spaced poloidal grid intervals for all splines newq0=0 ! Grad-Shafranov solution invariant adjustment of the q profile to give the specified value of q at the axis. Default 0 uses input file value. etol = 1e-7 ! Tolerance for direct equilibrium reconstruction of flux surfaces/coordinates + nstepd=2048 ! Total number of lsode steps during equilibrium field line integration. Must increase if etol is made smaller use_classic_splines = f ! Use a classical cubic spline instead of tri-diagonal solution for splines with extrapolation boundary conditions input_only=f ! Generate information about the input and then quit with no further calculation From eb5a6489b90fc677e546cfa020925d6a914ca575 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 14:23:34 -0400 Subject: [PATCH 03/97] prep for nstepd to be a user input --- equil/equil.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equil/equil.f b/equil/equil.f index 7fa24063..58839f7b 100644 --- a/equil/equil.f +++ b/equil/equil.f @@ -39,7 +39,7 @@ SUBROUTINE equil_read(unit, op_psihigh, op_psilow) NAMELIST/equil_control/eq_filename,eq_type,grid_type,mpsi,mtheta, $ newq0,psihigh,psilow,input_only,jac_type,power_bp,power_r, $ power_b,jac_method,convert_type,power_flag,ns1, - $ sp_pfac,sp_nx,sp_dx1,sp_dx2,use_galgrid,etol, + $ sp_pfac,sp_nx,sp_dx1,sp_dx2,use_galgrid,etol,nstepd, $ use_classic_splines NAMELIST/equil_output/bin_2d,bin_eq_1d,bin_eq_2d,out_2d,out_eq_1d, $ out_eq_2d,bin_fl,out_fl,interp,gse_flag,dump_flag,verbose From 5e573812f6fdaae42d9d7c06eff4746cc3a4a1b0 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 14:54:25 -0400 Subject: [PATCH 04/97] added logic during loop over psi surfaces to call x-point scripts or not. Also loop now goes from axis to edge instead of edge to axis --- equil/direct.f | 98 +++++++++++++++++++++++++++++++------------------- 1 file changed, 62 insertions(+), 36 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index aa58df99..709fd030 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -51,15 +51,19 @@ MODULE direct_mod SUBROUTINE direct_run INTEGER :: ir,iz,itheta,ipsi - !INTEGER, PARAMETER :: nstepd=20048 + !INTEGER, PARAMETER :: nstepd=2048 REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q - REAL(r8), DIMENSION(0:nstep,0:4) :: y_out + REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out, y_out_last REAL(r8), DIMENSION(2, mpsi+1) :: xdx REAL(r8), DIMENSION(3,3) :: v - REAL(r8) :: xm,dx,rholow,rhohigh + LOGICAL :: use_analytic,run_xpt + TYPE(direct_bfield_type) :: bf TYPE(spline_type) :: ff + + use_analytic=.FALSE. + run_xpt=.FALSE. c----------------------------------------------------------------------- c warning. c----------------------------------------------------------------------- @@ -127,55 +131,77 @@ SUBROUTINE direct_run IF(bin_fl)CALL bin_open(bin_2d_unit,"flint.bin","UNKNOWN", $ "REWIND","none") c----------------------------------------------------------------------- -c start loop over flux surfaces and integrate over field line. +c start loop over flux surfaces. c----------------------------------------------------------------------- IF(verbose) WRITE(*,'(a,1p,es10.3)')" etol = ",etol - DO ipsi=mpsi,0,-1 - CALL direct_fl_int(ipsi,y_out,bf) + IF(verbose) WRITE(*,'(a,1p,i6)')" nstepd = ",nstepd + DO ipsi=0,mpsi,+1 +c----------------------------------------------------------------------- +c logic whether to integrate around whole field line or use analytic +c integral formulas near separatrix. +c----------------------------------------------------------------------- + IF(use_analytic .AND. run_xpt)THEN + ELSE + CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_out,bf, + $ len_y_out) +c----------------------------------------------------------------------- +c checks whether q-integral is diverging. +c----------------------------------------------------------------------- + IF(sq%xs(ipsi)>0.999 .AND. run_xpt)THEN + ENDIF c----------------------------------------------------------------------- c fit data to cubic splines. c----------------------------------------------------------------------- - CALL spline_alloc(ff,istep,4) - ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) - ff%fs(0:istep,1)=y_out(0:istep,2)**2 - ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) - ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs - CALL spline_fit(ff,"periodic") + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs + CALL spline_fit(ff,"periodic") c----------------------------------------------------------------------- c allocate space for rzphi and define grids. c----------------------------------------------------------------------- - IF(ipsi == mpsi)THEN - IF(mtheta == 0)mtheta=istep - CALL bicube_alloc(rzphi,mpsi,mtheta,4) - CALL bicube_alloc(eqfun,mpsi,mtheta,3) ! new eq information - rzphi%xs=sq%xs - rzphi%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) - rzphi%xtitle="psifac" - rzphi%ytitle="theta " - rzphi%title=(/" r2 "," deta "," dphi "," jac "/) ! deta = eta - theta, dphi = phi - zeta - eqfun%title=(/" b0 "," "," " /) - eqfun%xs=sq%xs - eqfun%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) - ENDIF + IF(ipsi == 0)THEN + IF(mtheta == 0)mtheta=istep + CALL bicube_alloc(rzphi,mpsi,mtheta,4) !change mtheta + CALL bicube_alloc(eqfun,mpsi,mtheta,3) ! new eq information + rzphi%xs=sq%xs + rzphi%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) + rzphi%xtitle="psifac" + rzphi%ytitle="theta " + rzphi%title=(/" r2 "," deta "," dphi "," jac "/) ! deta = eta - theta, dphi = phi - zeta + eqfun%title=(/" b0 "," "," " /) + eqfun%xs=sq%xs + eqfun%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) + ENDIF c----------------------------------------------------------------------- c interpolate to uniform grid. c----------------------------------------------------------------------- - DO itheta=0,mtheta - CALL spline_eval(ff,rzphi%ys(itheta),1) - rzphi%fs(ipsi,itheta,1:3)=ff%f(1:3) - rzphi%fs(ipsi,itheta,4)=(1+ff%f1(4)) + DO itheta=0,mtheta + CALL spline_eval(ff,rzphi%ys(itheta),1) + rzphi%fs(ipsi,itheta,1:3)=ff%f(1:3) + rzphi%fs(ipsi,itheta,4)=(1+ff%f1(4)) $ *y_out(istep,1)*twopi*psio - ENDDO + ENDDO c----------------------------------------------------------------------- c store surface quantities. c----------------------------------------------------------------------- - sq%fs(ipsi,1)=bf%f*twopi - sq%fs(ipsi,2)=bf%p - sq%fs(ipsi,3)=y_out(istep,1)*twopi*psio - sq%fs(ipsi,4)=y_out(istep,3)*bf%f/twopi - CALL spline_dealloc(ff) + sq%fs(ipsi,1)=bf%f*twopi + sq%fs(ipsi,2)=bf%p + sq%fs(ipsi,3)=y_out(istep,1)*twopi*psio + sq%fs(ipsi,4)=y_out(istep,3)*bf%f/twopi + CALL spline_dealloc(ff) +c----------------------------------------------------------------------- +c log maximum y_out, flast for x-point plotting. +c----------------------------------------------------------------------- + IF (ipsi == mpsi) THEN + y_out_last = y_out + len_y_last=len_y_out + flast = bf%f*twopi + ENDIF + ENDIF ENDDO c----------------------------------------------------------------------- c close output files. From 3bf55184e127af6a2288e78ab2ad9146902a8ced Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 15:00:06 -0400 Subject: [PATCH 05/97] changing direct_fl_int to start and end at arbitrary etas (formatting still needs to be fixed). relies on new function find_fl_surface --- equil/direct.f | 44 ++++++++++++++------------------------------ 1 file changed, 14 insertions(+), 30 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 709fd030..0bc23f80 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -454,19 +454,20 @@ END SUBROUTINE direct_position c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_fl_int(ipsi,y_out,bf) + SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) - INTEGER, INTENT(IN) :: ipsi + REAL(r8), INTENT(IN) :: psifac,eta1,eta2 + INTEGER, INTENT(OUT) :: len_y_out REAL(r8), DIMENSION(0:,0:), INTENT(OUT) :: y_out TYPE(direct_bfield_type), INTENT(OUT) :: bf CHARACTER(64) :: message INTEGER, PARAMETER :: neq=4,liw=30,lrw=22+neq*16 - INTEGER :: iopt,istate,itask,itol,jac,mf,ir + INTEGER :: iopt,istate,itask,itol,jac,mf INTEGER, DIMENSION(liw) :: iwork REAL(r8), PARAMETER :: eps=1e-12 - REAL(r8) :: atol,rtol,rfac,deta,r,z,eta,err,psi0,psifac,dr + REAL(r8) :: atol,rtol,rfac,deta,r,z,eta,err,psi0 REAL(r8), DIMENSION(neq) :: y REAL(r8), DIMENSION(lrw) :: rwork c----------------------------------------------------------------------- @@ -480,29 +481,14 @@ SUBROUTINE direct_fl_int(ipsi,y_out,bf) c----------------------------------------------------------------------- c find flux surface. c----------------------------------------------------------------------- - psifac=sq%xs(ipsi) - psi0=psio*(1-psifac) - r=ro+SQRT(psifac)*(rs2-ro) - z=zo - ir = 0 - DO - CALL direct_get_bfield(r,z,bf,1) - dr=(psi0-bf%psi)/bf%psir - r=r+dr - IF(ABS(dr) <= eps*r)EXIT - - ir = ir+1 - IF (ir > direct_infinite_loop_count) THEN - direct_infinite_loop_flag = .TRUE. - CALL program_stop("Took too many steps to find flux surf.") - ENDIF - ENDDO + CALL find_fl_surface(psifac,eta1,r,z) + CALL direct_get_bfield(r,z,bf,1) psi0=bf%psi c----------------------------------------------------------------------- c initialize variables. c----------------------------------------------------------------------- istep=0 - eta=0 + eta=eta1 deta=twopi/mtheta y=0 y(2)=SQRT((r-ro)**2+(z-zo)**2) @@ -518,7 +504,7 @@ SUBROUTINE direct_fl_int(ipsi,y_out,bf) atol=etol*y(2) iwork=0 rwork=0 - rwork(1)=twopi + rwork(1)=eta2 rwork(11)=0 c----------------------------------------------------------------------- c write header. @@ -548,22 +534,20 @@ SUBROUTINE direct_fl_int(ipsi,y_out,bf) c----------------------------------------------------------------------- c advance differential equations. c----------------------------------------------------------------------- - IF(eta >= twopi .OR. istep >= nstep .OR. istate < 0 + IF(eta >= eta2 .OR. istep >= nstepd .OR. istate < 0 $ .OR. ABS(err) >= 1)EXIT istep=istep+1 - CALL lsode(direct_fl_der,neq,y,eta,twopi,itol,rtol,atol, + CALL lsode(direct_fl_der,neq,y,eta,eta2,itol,rtol,atol, $ itask,istate,iopt,rwork,lrw,iwork,liw,jac,mf) ENDDO IF(out_fl)WRITE(out_2d_unit,20) IF(bin_fl)WRITE(bin_2d_unit) c----------------------------------------------------------------------- -c abort if istep > nstep. +c abort if istep > nstepd. c----------------------------------------------------------------------- - IF(eta < twopi)THEN - WRITE(message,40)"direct_int: istep = nstep = ",nstep, - $ " at eta = ",eta,", ipsi = ",ipsi - CALL program_stop(message) + IF(eta < eta2)THEN ENDIF + len_y_out = istep c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- From 9dac974396567af802f71c311664e67eaee70956 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 15:46:47 -0400 Subject: [PATCH 06/97] updated formatting/printing for direct_fl_int (not certain if correct..) --- equil/direct.f | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 0bc23f80..e3b2defd 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -478,6 +478,9 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) $ "z",9x,"psi",8x,"err"/) 30 FORMAT(i4,1p,8e11.3) 40 FORMAT(a,i4,a,es10.3,a,i3) + 51 FORMAT(1x,"psifac =",es10.3) + 61 FORMAT(1x,"direct_int: steps taken = ",i3," of ",i3,".") + 11 FORMAT(" eta reached ",es10.3," of [",es10.3,",",es10.3,"]") c----------------------------------------------------------------------- c find flux surface. c----------------------------------------------------------------------- @@ -510,7 +513,7 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) c write header. c----------------------------------------------------------------------- IF(out_fl)THEN - WRITE(out_2d_unit,10)ipsi,psifac + WRITE(out_2d_unit,51)psifac WRITE(out_2d_unit,20) ENDIF c----------------------------------------------------------------------- @@ -530,7 +533,8 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) IF(out_fl)WRITE(out_2d_unit,30) $ istep,eta,rwork(11),y(1:2),r,z,bf%psi,err IF(bin_fl)WRITE(bin_2d_unit) - $ REAL(eta,4),REAL(y(1:2),4),REAL(r,4),REAL(z,4),REAL(err,4) + $ REAL(eta,4),REAL(rwork(11),4),REAL(y(1:4),4),REAL(r,4), + $ REAL(z,4),REAL(psifac,4),REAL(err,4) c----------------------------------------------------------------------- c advance differential equations. c----------------------------------------------------------------------- @@ -546,6 +550,20 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) c abort if istep > nstepd. c----------------------------------------------------------------------- IF(eta < eta2)THEN + WRITE(message,61)istep,nstepd + WRITE(message,11)eta,eta1,eta2 + !WRITE(out_2d_unit,10)eta + !WRITE(out_2d_unit,10)eta2 + !write (*,'(A, F8.3)') 'psifac = ', psifac + !write (*,'(A, F8.3)') 'eta = ', eta + !write (*,'(A, F8.3)') 'eta2 = ', eta2 + !print "(i6)", istep + !write (*,'(A, F8.1)') 'Stopped early', one + !CALL program_stop("what occurgin") + ELSE + WRITE(message,61)istep,nstepd + !print "(i6)", istep + !write (*,'(A, F8.1)') 'Ran proper', zero ENDIF len_y_out = istep c----------------------------------------------------------------------- From 2626a9e49ff0975d3f28e6c9b291730ab8ee5e7d Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 17:28:29 -0400 Subject: [PATCH 07/97] 'find flux surface' section within direct_fl_int now its own function that can operate at any poloidal angle eta --- equil/direct.f | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index e3b2defd..636ee115 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -572,6 +572,54 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) RETURN END SUBROUTINE direct_fl_int c----------------------------------------------------------------------- +c subprogram 4.5. find_fl_surface. +c finds r,z given psi, eta. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE find_fl_surface(psifac,eta,r,z) + + REAL(r8), INTENT(IN) :: psifac,eta + REAL(r8), INTENT(OUT) :: r,z + + TYPE(direct_bfield_type) :: bf + REAL(r8), PARAMETER :: eps=1e-13 + INTEGER :: ir + REAL(r8) :: cosfac,sinfac,radius,dradius,dfdradius,psi0 +c----------------------------------------------------------------------- +c find flux surface. +c----------------------------------------------------------------------- + cosfac=COS(eta) + sinfac=SIN(eta) + + psi0=psio*(1-psifac) + radius=SQRT(psifac)*(rs2-ro) + r=ro+cosfac*radius + z=zo+sinfac*radius + ir = 0 + DO + CALL direct_get_bfield(r,z,bf,1) + dfdradius = -bf%psir*cosfac-bf%psiz*sinfac + dradius = -(psi0-bf%psi)/dfdradius + + radius=radius+dradius + r=ro+cosfac*radius + z=zo+sinfac*radius + IF(ABS(dradius) <= eps*r)EXIT + + ir = ir+1 + IF (ir > direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to find flux surf.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE find_fl_surface +c----------------------------------------------------------------------- c subprogram 5. direct_fl_der. c contains differential equations for field line averages. c----------------------------------------------------------------------- From 8416c35800b4d2c662bab943a378337abf823576 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 17:46:10 -0400 Subject: [PATCH 08/97] formatting/error messanging on direct_fl_int working now --- equil/direct.f | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 636ee115..0135ac3d 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -461,7 +461,7 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) REAL(r8), DIMENSION(0:,0:), INTENT(OUT) :: y_out TYPE(direct_bfield_type), INTENT(OUT) :: bf - CHARACTER(64) :: message + CHARACTER(64) :: message,message2 INTEGER, PARAMETER :: neq=4,liw=30,lrw=22+neq*16 INTEGER :: iopt,istate,itask,itol,jac,mf @@ -473,14 +473,13 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) c----------------------------------------------------------------------- c format statements. c----------------------------------------------------------------------- - 10 FORMAT(1x,"ipsi = ",i3,", psifac =",es10.3) 20 FORMAT(/2x,"is",5x,"eta",8x,"deta",8x,"s",9x,"rfac",8x,"r",10x, $ "z",9x,"psi",8x,"err"/) 30 FORMAT(i4,1p,8e11.3) 40 FORMAT(a,i4,a,es10.3,a,i3) 51 FORMAT(1x,"psifac =",es10.3) - 61 FORMAT(1x,"direct_int: steps taken = ",i3," of ",i3,".") - 11 FORMAT(" eta reached ",es10.3," of [",es10.3,",",es10.3,"]") + 61 FORMAT(1x,"direct_int: steps taken =",i6," of ",i6,".") + 11 FORMAT(1x,"Incomplete: eta=",es10.2," of [",es10.2,",",es10.2,"]") c----------------------------------------------------------------------- c find flux surface. c----------------------------------------------------------------------- @@ -551,19 +550,13 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) c----------------------------------------------------------------------- IF(eta < eta2)THEN WRITE(message,61)istep,nstepd - WRITE(message,11)eta,eta1,eta2 - !WRITE(out_2d_unit,10)eta - !WRITE(out_2d_unit,10)eta2 - !write (*,'(A, F8.3)') 'psifac = ', psifac - !write (*,'(A, F8.3)') 'eta = ', eta - !write (*,'(A, F8.3)') 'eta2 = ', eta2 - !print "(i6)", istep - !write (*,'(A, F8.1)') 'Stopped early', one - !CALL program_stop("what occurgin") + WRITE(message2,11)eta,eta1,eta2 + PRINT "(A)", message + PRINT "(A)", "Increase nstepd or decrease etol." + CALL program_stop(message2) ELSE WRITE(message,61)istep,nstepd - !print "(i6)", istep - !write (*,'(A, F8.1)') 'Ran proper', zero + IF(verbose)PRINT "(A)", message ENDIF len_y_out = istep c----------------------------------------------------------------------- From b578f801d119ad9e2491700b352fdaf4aada4aa4 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 17:48:17 -0400 Subject: [PATCH 09/97] adding global module variables that contain x-point info --- equil/direct.f | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 0135ac3d..649483c0 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -28,9 +28,13 @@ MODULE direct_mod INTEGER, PRIVATE :: istep REAL(r8) :: rmin,rmax,zmin,zmax,rs1,rs2 + REAL(r8), DIMENSION(2) :: xpt_etas, rxs, zxs, xpt_b11s + REAL(r8), DIMENSION(2) :: xpt_gammas, xpt_varthetas + REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in LOGICAL :: direct_infinite_loop_flag INTEGER :: direct_infinite_loop_count = 2000 + INTEGER :: num_xpts TYPE :: direct_bfield_type REAL(r8) :: psi,psir,psiz,psirz,psirr,psizz,f,f1,p,p1 From a8ce25d7ea4672b7be8ae0be007a5f395d5e85b2 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 17:50:48 -0400 Subject: [PATCH 10/97] Returning a pre-existing line that was eliminated for some reason --- equil/direct.f | 1 + 1 file changed, 1 insertion(+) diff --git a/equil/direct.f b/equil/direct.f index 649483c0..a891fced 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -63,6 +63,7 @@ SUBROUTINE direct_run LOGICAL :: use_analytic,run_xpt + REAL(r8) :: xm,dx,rholow,rhohigh TYPE(direct_bfield_type) :: bf TYPE(spline_type) :: ff From 7f7d1feb8f43dc0b352e39b19ce57cb92222900f Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 17:58:33 -0400 Subject: [PATCH 11/97] modifying direct_run to call direct_initialise_xpoints --- equil/direct.f | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a891fced..6f1383a5 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -14,6 +14,7 @@ c 5. direct_fl_der. c 6. direct_refine. c 7. direct_output. +c 12. direct_initialise_xpoints. c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. @@ -54,21 +55,28 @@ MODULE direct_mod c----------------------------------------------------------------------- SUBROUTINE direct_run - INTEGER :: ir,iz,itheta,ipsi - !INTEGER, PARAMETER :: nstepd=2048 - REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q + INTEGER :: ir,iz,itheta,ipsi,len_y_out,len_y_last + INTEGER :: maxima_count,i + REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q,flast REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out, y_out_last REAL(r8), DIMENSION(2, mpsi+1) :: xdx REAL(r8), DIMENSION(3,3) :: v + REAL(r8), DIMENSION(3,2) :: eta_brackets + REAL(r8), DIMENSION(3) :: eta_maxes LOGICAL :: use_analytic,run_xpt - REAL(r8) :: xm,dx,rholow,rhohigh + REAL(r8) :: xm,dx,rholow,rhohigh,rx,zx TYPE(direct_bfield_type) :: bf TYPE(spline_type) :: ff use_analytic=.FALSE. run_xpt=.FALSE. + xpt_etas=0.0 + eta_maxes=0.0 + eta_brackets=0.0 + num_xpts=0 + maxima_count=0 c----------------------------------------------------------------------- c warning. c----------------------------------------------------------------------- @@ -153,6 +161,8 @@ SUBROUTINE direct_run c checks whether q-integral is diverging. c----------------------------------------------------------------------- IF(sq%xs(ipsi)>0.999 .AND. run_xpt)THEN + CALL direct_initialise_xpoints(y_out,len_y_out,.TRUE., + $ bf%f*twopi,eta_maxes,eta_brackets,maxima_count) ENDIF c----------------------------------------------------------------------- c fit data to cubic splines. From 182a0241bf59176ef2d78f9a3749e109d0d1a9f3 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 18:14:10 -0400 Subject: [PATCH 12/97] adding inputs/outputs of direct_initialise_xpoints. Note eta_maxes,eta_brackets,maxima_count are local versions of xpt_etas, xpt_brackets, num_xpts respectively, that necessary whenever running direct_initialise_xpoints on some eta interval that isn't [0,2pi] --- equil/direct.f | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 6f1383a5..e13801cb 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -791,4 +791,29 @@ SUBROUTINE direct_output c----------------------------------------------------------------------- RETURN END SUBROUTINE direct_output +c----------------------------------------------------------------------- +c subprogram 12. direct_initialise_xpoints. +c scans the field-line integral to find likely x-point locations, +c denoted by diverging regions in the q-integral +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, + $ f,eta_maxes,eta_brackets,maxima_count) + + INTEGER, INTENT(IN) :: len_y_out + LOGICAL, INTENT(IN) :: wrap + REAL(r8), DIMENSION(0:,0:), INTENT(IN) :: y_out + REAL(r8), INTENT(IN) :: f + + INTEGER, INTENT(OUT) :: maxima_count + REAL(r8), DIMENSION(1:), INTENT(OUT) :: eta_maxes + REAL(r8), DIMENSION(1:,1:), INTENT(OUT) :: eta_brackets +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_initialise_xpoints +c----------------------------------------------------------------------- END MODULE direct_mod From 1a9d8bb087167b708f36b2cd768875105e8de865 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 27 May 2024 22:56:23 -0400 Subject: [PATCH 13/97] direct_initialise_xpoints debugged, working well --- equil/direct.f | 133 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 133 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index e13801cb..cad15d41 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -810,6 +810,139 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, INTEGER, INTENT(OUT) :: maxima_count REAL(r8), DIMENSION(1:), INTENT(OUT) :: eta_maxes REAL(r8), DIMENSION(1:,1:), INTENT(OUT) :: eta_brackets + + REAL(r8), PARAMETER :: dq_eps=100 + INTEGER :: i + LOGICAL :: prev_above_threshold,wrap_max,wrap_ + REAL(r8), DIMENSION(1:len_y_out) :: dqdeta + REAL(r8), DIMENSION(100) :: max_dqdeta,max_locations + + max_locations=0.0 + eta_maxes=0.0 + maxima_count=0 + wrap_max=.FALSE. + wrap_=wrap + prev_above_threshold=.FALSE. +c----------------------------------------------------------------------- +c sanity check that final eta is less than twopi. +c only called when wrap = .TRUE. and we are analysing the whole +c [0,2pi] interval. lsode integrator makes sure final eta is twopi +c----------------------------------------------------------------------- + IF (y_out(len_y_out,0) > twopi .AND. wrap) THEN + CALL program_stop("eta wrap error... debug direct.f") + ENDIF +c----------------------------------------------------------------------- +c turn y_out into dqdeta. +c----------------------------------------------------------------------- + DO i=0,(len_y_out-1),+1 + dqdeta(i+1) = (f/twopi)*(y_out(i+1,3)-y_out(i,3)) + $ /(y_out(i+1,0)-y_out(i,0))! + ENDDO +c----------------------------------------------------------------------- +c identifies all regions of eta above threshold. calculates the +c maximum value of d_q_int/d_eta as well as eta for each region. +c----------------------------------------------------------------------- + DO i=1,len_y_out-1,+1 + IF((dqdeta(i)>dq_eps).AND.(.NOT.prev_above_threshold)) THEN + IF(i==1)THEN + wrap_max=.TRUE. + ENDIF + maxima_count=maxima_count+1 + + eta_brackets(maxima_count,1)=y_out(i-1,0) + eta_brackets(maxima_count,2)=y_out(i,0) + + max_dqdeta(maxima_count)=dqdeta(i) + max_locations(maxima_count) = 0.5*(y_out(i,0)+ + $ y_out(i-1,0)) + prev_above_threshold=.TRUE. + ELSEIF ((dqdeta(i)>dq_eps) .AND. prev_above_threshold) THEN + eta_brackets(maxima_count,2)=y_out(i,0) + + IF (dqdeta(i)>max_dqdeta(maxima_count)) THEN + max_dqdeta(maxima_count)=dqdeta(i) + max_locations(maxima_count) = 0.5*(y_out(i,0)+ + $ y_out(i-1,0)) + ENDIF + prev_above_threshold=.TRUE. + ELSE + prev_above_threshold=.FALSE. + ENDIF + ENDDO +c----------------------------------------------------------------------- +c case where whole range is under threshold doesn't require wrapping +c----------------------------------------------------------------------- + IF(MINVAL(dqdeta) > dq_eps)THEN + wrap_=.FALSE. + ENDIF +c----------------------------------------------------------------------- +c final datapoint is a special case due to the possibility of the +c region wrapping around to eta=0 region. +c----------------------------------------------------------------------- + IF (dqdeta(len_y_out)>dq_eps .AND. wrap_) THEN + IF (prev_above_threshold) THEN + IF (dqdeta(len_y_out)>max_dqdeta(maxima_count)) THEN + max_dqdeta(maxima_count)=dqdeta(len_y_out) + max_locations(maxima_count) = + $ 0.5*(y_out(len_y_out-1,0)+y_out(len_y_out,0)) + ENDIF + eta_brackets(maxima_count,2)=y_out(0,0) + + IF (wrap_max) THEN + eta_brackets(1,1)=eta_brackets(maxima_count,1) + + IF (max_dqdeta(maxima_count)>=max_dqdeta(1)) THEN + max_dqdeta(1)=max_dqdeta(maxima_count) + max_locations(1)=max_locations(maxima_count) + ENDIF + + eta_brackets(maxima_count,1)=0.0 + eta_brackets(maxima_count,2)=0.0 + + max_dqdeta(maxima_count)=0.0 + max_locations(maxima_count)=0.0 + maxima_count=maxima_count-1 + ENDIF + + ELSEIF (wrap_max) THEN !.AND. !prev_above_threshold) + eta_brackets(1,1)=y_out(len_y_out-1,0) + + IF (dqdeta(len_y_out)>max_dqdeta(1)) THEN + max_dqdeta(1)=dqdeta(len_y_out) + max_locations(1)=0.5*(y_out(len_y_out-1,0) + $ +y_out(len_y_out,0)) + ENDIF + ELSE + maxima_count=maxima_count+1 + + eta_brackets(maxima_count,1)=y_out(len_y_out-1,0) + eta_brackets(maxima_count,2)=y_out(0,0) + + max_dqdeta(maxima_count)=dqdeta(len_y_out) + max_locations(maxima_count) = + $ 0.5*(y_out(len_y_out-1,0)+y_out(len_y_out,0)) + ENDIF + ENDIF +c----------------------------------------------------------------------- +c warning if theres more than 2 xpoints. +c----------------------------------------------------------------------- + IF(maxima_count>2 .AND. wrap)THEN + CALL program_stop("More than 2 x-points detected.") + ENDIF +c----------------------------------------------------------------------- +c filling out xpt_etas output. +c----------------------------------------------------------------------- + IF (maxima_count==0) THEN + xpt_etas(1)=0.0 + ELSE + DO i=1,maxima_count,+1 + eta_maxes(i)=max_locations(i) + IF(wrap)THEN + xpt_etas(i)=max_locations(i) + xpt_etas(i)=xpt_etas(i)-twopi*floor(xpt_etas(i)/twopi) + ENDIF + ENDDO + ENDIF c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- From 50e09e3e7d888f64064f3caf5df3f421d06ad48f Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Tue, 28 May 2024 21:01:12 -0400 Subject: [PATCH 14/97] direct_local_xpoint debugged, finds local xpoint w newton method --- equil/direct.f | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index cad15d41..9c28352a 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -792,6 +792,48 @@ SUBROUTINE direct_output RETURN END SUBROUTINE direct_output c----------------------------------------------------------------------- +c subprogram 8. direct_local_xpoint. +c finds location of nearby x-point +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_local_xpoint(r,z) + + REAL(r8), INTENT(INOUT) :: r,z + REAL(r8) :: ajac(2,2),det,dr,dz + REAL(r8), PARAMETER :: eps=1e-13 + TYPE(direct_bfield_type) :: bf + INTEGER :: ir +c----------------------------------------------------------------------- +c use newton iteration to find x-point. +c----------------------------------------------------------------------- + ir = 0 + DO + CALL direct_get_bfield(r,z,bf,2) + ajac(1,1)=bf%brr + ajac(1,2)=bf%brz + ajac(2,1)=bf%bzr + ajac(2,2)=bf%bzz + det=ajac(1,1)*ajac(2,2)-ajac(1,2)*ajac(2,1) + dr=(ajac(1,2)*bf%bz-ajac(2,2)*bf%br)/det + dz=(ajac(2,1)*bf%br-ajac(1,1)*bf%bz)/det + r=r+dr + z=z+dz + IF(ABS(dr) <= eps*r .AND. ABS(dz) <= eps*r)EXIT + + ir = ir+1 + IF (ir > direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to find x-point.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_local_xpoint +c----------------------------------------------------------------------- c subprogram 12. direct_initialise_xpoints. c scans the field-line integral to find likely x-point locations, c denoted by diverging regions in the q-integral From 545844dd02ae6563766aba720fc32b972649a36e Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Tue, 28 May 2024 22:15:23 -0400 Subject: [PATCH 15/97] updating direct_local_xpoint description --- equil/direct.f | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 9c28352a..93d9a63d 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -14,6 +14,7 @@ c 5. direct_fl_der. c 6. direct_refine. c 7. direct_output. +c 8. direct_local_xpoint. c 12. direct_initialise_xpoints. c----------------------------------------------------------------------- c subprogram 0. direct_mod. @@ -493,7 +494,7 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) 30 FORMAT(i4,1p,8e11.3) 40 FORMAT(a,i4,a,es10.3,a,i3) 51 FORMAT(1x,"psifac =",es10.3) - 61 FORMAT(1x,"direct_int: steps taken =",i6," of ",i6,".") + 61 FORMAT(1x,"direct_int:",i6," steps taken of max",i6,".") 11 FORMAT(1x,"Incomplete: eta=",es10.2," of [",es10.2,",",es10.2,"]") c----------------------------------------------------------------------- c find flux surface. @@ -793,7 +794,8 @@ SUBROUTINE direct_output END SUBROUTINE direct_output c----------------------------------------------------------------------- c subprogram 8. direct_local_xpoint. -c finds location of nearby x-point +c finds location of nearby x-point where |Bp|=0 using Newton method. +c can and will search outside separatrix. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. From 82581a6e46f863cb78385ff0db928a13878b9641 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Wed, 29 May 2024 02:57:48 -0400 Subject: [PATCH 16/97] added direct_Bnu, direct_saddle_angle both in a working state --- equil/direct.f | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 93d9a63d..d3b1ab5a 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -836,6 +836,78 @@ SUBROUTINE direct_local_xpoint(r,z) RETURN END SUBROUTINE direct_local_xpoint c----------------------------------------------------------------------- +c subprogram 9. direct_saddle_angle. +c finds angle location of nearby saddle-node eigenvector using +c a binary search type algorithm +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_saddle_angle(rx,zx,rho,nu1i,nu2i,nu) + + REAL(r8), INTENT(IN) :: rx,zx,rho,nu1i,nu2i + REAL(r8), INTENT(OUT) :: nu + + INTEGER, PARAMETER :: ird=4 + REAL(r8), PARAMETER :: nu_eps=1e-13 + + REAL(r8), DIMENSION(ird) :: nus,nu_tmp + REAL(r8) :: bnorm,bnu,nustep,pos,nu1,nu2 + INTEGER :: i,inuh + + nu1=nu1i + nu2=nu2i + pos=1.0 + inuh=0 +c----------------------------------------------------------------------- +c looping over narrower nu-intervals +c----------------------------------------------------------------------- + CALL direct_Bnu(rx,zx,nu1i,rho,bnorm) + IF(bnorm 80)THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to find x-pt angle.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_saddle_angle +c----------------------------------------------------------------------- c subprogram 12. direct_initialise_xpoints. c scans the field-line integral to find likely x-point locations, c denoted by diverging regions in the q-integral @@ -993,4 +1065,31 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, RETURN END SUBROUTINE direct_initialise_xpoints c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c subprogram . direct_Bnu. +c calculates local B-field displaced from some r,z point in polar +c coordinates +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_Bnu(r,z,nu,rho,Bnu) + + REAL(r8), INTENT(IN) :: r,z,nu,rho + REAL(r8), INTENT(OUT) :: Bnu + REAL(r8) :: cosfac,sinfac + TYPE(direct_bfield_type) :: bf +c----------------------------------------------------------------------- +c finding angle of o-point from perspective of x-point. +c----------------------------------------------------------------------- + cosfac=COS(nu) + sinfac=SIN(nu) + CALL direct_get_bfield(r+rho*cosfac,z+rho*sinfac,bf,1) + !Brho=cosfac*bf%br+sinfact*bf%bz + Bnu=-sinfac*bf%br+cosfac*bf%bz +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_Bnu END MODULE direct_mod From ecc259e38979df76d05c061bd821f8e36a5d3b9d Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 20:13:16 -0400 Subject: [PATCH 17/97] updating direct_Bnu to also calculate B_rho --- equil/direct.f | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index d3b1ab5a..6ca37276 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -15,7 +15,9 @@ c 6. direct_refine. c 7. direct_output. c 8. direct_local_xpoint. +c 9. direct_saddle_angle. c 12. direct_initialise_xpoints. +c 17. direct_Blocal c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. @@ -1066,30 +1068,37 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, END SUBROUTINE direct_initialise_xpoints c----------------------------------------------------------------------- c----------------------------------------------------------------------- -c subprogram . direct_Bnu. +c subprogram 17. direct_Blocal. c calculates local B-field displaced from some r,z point in polar -c coordinates +c coordinates. either Bnu or Brho depending on Bcase c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_Bnu(r,z,nu,rho,Bnu) + SUBROUTINE direct_Blocal(r,z,nu,rho,Bcase,Bout) REAL(r8), INTENT(IN) :: r,z,nu,rho - REAL(r8), INTENT(OUT) :: Bnu + CHARACTER, INTENT(IN) :: Bcase + REAL(r8), INTENT(OUT) :: Bout REAL(r8) :: cosfac,sinfac TYPE(direct_bfield_type) :: bf c----------------------------------------------------------------------- -c finding angle of o-point from perspective of x-point. +c calculation of Bout. c----------------------------------------------------------------------- cosfac=COS(nu) sinfac=SIN(nu) CALL direct_get_bfield(r+rho*cosfac,z+rho*sinfac,bf,1) - !Brho=cosfac*bf%br+sinfact*bf%bz - Bnu=-sinfac*bf%br+cosfac*bf%bz + SELECT CASE (Bcase) + CASE ('n') + Bout=-sinfac*bf%br+cosfac*bf%bz + CASE ('r') + Bout=cosfac*bf%br+sinfac*bf%bz + CASE DEFAULT + CALL program_stop("Invalid Bcase in direct_Blocal") + END SELECT c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN - END SUBROUTINE direct_Bnu + END SUBROUTINE direct_Blocal END MODULE direct_mod From 146c4cfd5d5bcfda15e83f657de505caf8dbf3a5 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 20:17:15 -0400 Subject: [PATCH 18/97] udated direct_saddle_angle to also calc angle where Brho = 0 --- equil/direct.f | 54 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 37 insertions(+), 17 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 6ca37276..3951e3b9 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -840,63 +840,83 @@ END SUBROUTINE direct_local_xpoint c----------------------------------------------------------------------- c subprogram 9. direct_saddle_angle. c finds angle location of nearby saddle-node eigenvector using -c a binary search type algorithm +c a binary search type algorithm. can find point where Bnu = 0 or +c Brho = 0. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_saddle_angle(rx,zx,rho,nu1i,nu2i,nu) + SUBROUTINE direct_saddle_angle(rx,zx,rho,nustart_in,nu_var_in,nu, + $ Bcase,debug) - REAL(r8), INTENT(IN) :: rx,zx,rho,nu1i,nu2i + REAL(r8), INTENT(IN) :: rx,zx,rho,nustart_in,nu_var_in + CHARACTER, INTENT(IN) :: Bcase + LOGICAL, INTENT(IN) :: debug REAL(r8), INTENT(OUT) :: nu INTEGER, PARAMETER :: ird=4 REAL(r8), PARAMETER :: nu_eps=1e-13 REAL(r8), DIMENSION(ird) :: nus,nu_tmp - REAL(r8) :: bnorm,bnu,nustep,pos,nu1,nu2 + REAL(r8) :: bnorm,Bout,nustep,pos,nustart,nu_var INTEGER :: i,inuh - nu1=nu1i - nu2=nu2i + + nustart=nustart_in + nu_var=nu_var_in pos=1.0 inuh=0 c----------------------------------------------------------------------- c looping over narrower nu-intervals c----------------------------------------------------------------------- - CALL direct_Bnu(rx,zx,nu1i,rho,bnorm) + CALL direct_Blocal(rx,zx,nustart_in,rho,Bcase,bnorm) IF(bnorm 80)THEN From 8a904bd0cf56d4fb22b1f1dcede09ff7e27391bd Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 20:28:51 -0400 Subject: [PATCH 19/97] fixing up debug statement in direct_saddle_angle --- equil/direct.f | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 3951e3b9..f2623002 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -16,6 +16,7 @@ c 7. direct_output. c 8. direct_local_xpoint. c 9. direct_saddle_angle. +c 10. direct_psisaddle. c 12. direct_initialise_xpoints. c 17. direct_Blocal c----------------------------------------------------------------------- @@ -910,7 +911,11 @@ SUBROUTINE direct_saddle_angle(rx,zx,rho,nustart_in,nu_var_in,nu, nu_var=nus(i)-nus(i-1) nu=(nus(i)+nus(i-1))/2 CALL direct_Blocal(rx,zx,nu,rho,Bcase,Bout) - IF(debug)PRINT "(es16.10)", ABS(nu-nustart) + + IF(debug)THEN + PRINT "(A)", "Delta nu" + PRINT "(es16.10)", ABS(nu-nustart) + ENDIF EXIT ENDIF IF(i==ird) CALL program_stop("couldn't find x-pt angle") From 58f1a00c65999175755dccd7c608be2995f6bf30 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 20:30:17 -0400 Subject: [PATCH 20/97] Newton method direct_saddle_angle_DEPRECATED (doesn't seem work, but good to have the algorithm saved) --- equil/direct.f | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index f2623002..2698abec 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -839,6 +839,63 @@ SUBROUTINE direct_local_xpoint(r,z) RETURN END SUBROUTINE direct_local_xpoint c----------------------------------------------------------------------- +c subprogram 9. direct_saddle_angle_DEPRECATED. +c finds angle location of nearby saddle-node eigenvector using +c Newton iteration. Ends up infinite looping... I suspect the +c analytic form of the zero crosssing of Bout is unfriendly to +c the Newton method (I double checked formulas etc) +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_saddle_angle_DEPRECATED(rx,zx,nu,Bnorm) + + REAL(r8), INTENT(IN) :: rx,zx,Bnorm + REAL(r8), INTENT(INOUT) :: nu + REAL(r8), PARAMETER :: r_eps1=1e-9,r_eps2=1e-10,nu_eps=1e-13 + INTEGER :: ir + REAL(r8) :: Bout,dBout_dnu,cosfac,sinfac,dnu + TYPE(direct_bfield_type) :: bf + +c----------------------------------------------------------------------- +c use newton iteration to find point where Bout = 0. +c----------------------------------------------------------------------- +c vtheta = -sin(theta)*Rhat+cos(theta)*Zhat +c B = bf%br*Rhat+bf%bz*Zhat +c CHJECK LINEARITY OF LEG? +c ONLY TWO X-pts, can check if need the good treatment for them both + ir=0 + DO + cosfac=COS(nu) + sinfac=SIN(nu) + CALL direct_get_bfield(rx+r_eps1*rx*cosfac, + $ zx+r_eps1*rx*sinfac,bf,1) + Bout = (-sinfac*bf%br+cosfac*bf%bz) + dBout_dnu = ((-cosfac*bf%br-sinfac*bf%bz) + + $ (-sinfac*bf%brr+cosfac*bf%bzr)*(-r_eps1*rx*sinfac) + + $ (-sinfac*bf%brz+cosfac*bf%bzz)*(r_eps1*rx*cosfac)) + dnu = -Bout/dBout_dnu + nu=nu+dnu + IF(ABS(dnu) <= nu_eps)EXIT + + PRINT "(e16.3)", Bout/Bnorm + + ir = ir+1 + IF (ir > 50) THEN !direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to find x-pt angle.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c make sure nu is in [0,2pi). works even if nu is negative +c----------------------------------------------------------------------- + nu = nu - twopi*floor(nu/twopi) +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_saddle_angle_DEPRECATED +c----------------------------------------------------------------------- c subprogram 9. direct_saddle_angle. c finds angle location of nearby saddle-node eigenvector using c a binary search type algorithm. can find point where Bnu = 0 or From 06b7c02abe453b65a9c1b8f6db1580f18eb4a8f8 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 20:34:15 -0400 Subject: [PATCH 21/97] direct_psisaddle first commit, runs but not debugged --- equil/direct.f | 102 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 2698abec..37dabb44 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -992,6 +992,108 @@ SUBROUTINE direct_saddle_angle(rx,zx,rho,nustart_in,nu_var_in,nu, RETURN END SUBROUTINE direct_saddle_angle c----------------------------------------------------------------------- +c subprogram 10. direct_psisaddle. +c calculates the linear term of psi_in at the saddle point, as well +c as gamma, and vartheta +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_psisaddle(rx,zx,oangle, + $ nu,b11,gamma,vartheta,lincheck) + + REAL(r8), INTENT(IN) :: rx,zx,oangle + REAL(r8), DIMENSION(2), INTENT(IN) :: nu + REAL(r8), INTENT(OUT) :: b11,lincheck,gamma,vartheta + + REAL(r8), PARAMETER :: nuh_eps=1e-13, nuh_eps2=1e-6 + INTEGER :: inuh, ir + REAL(r8) :: nuh,nuperf,Br,dBr_dnuh,cosfac,sinfac,cosfact,sinfact + REAL(r8) :: dnuh,psix,psinuh,r,Rlocal,Zlocal,x,y,chi + REAL(r8), DIMENSION(4) :: r_eps + TYPE(direct_bfield_type) :: bf + + r_eps(1) = 1e-7 + r_eps(2) = 1e-8 + r_eps(3) = 1e-9 + r_eps(4) = 1e-10 +c----------------------------------------------------------------------- +c finding correct initialisation point for nuh (read nu-half). +c gamma should be less than pi for a real x-point +c----------------------------------------------------------------------- + nuperf = (nu(1)+nu(2))/2 + gamma = nu(1)-nu(2) + nuh = nuperf + + IF (gamma > pi) THEN + CALL program_stop("Angle between separatrix legs > pi.") + ENDIF +c----------------------------------------------------------------------- +c loop to make sure we reach linear region. +c----------------------------------------------------------------------- + ir=1 + DO +c----------------------------------------------------------------------- +c finding angle where Brho = 0. +c----------------------------------------------------------------------- + CALL direct_saddle_angle(rx,zx,rx*r_eps(ir),nu(2),nu(1)-nu(2) + $ ,nuh,'r',.FALSE.) +c----------------------------------------------------------------------- +c make sure nuh is in [0,2pi). works even if nuh is negative. +c----------------------------------------------------------------------- + nuh = nuh - twopi*floor(nuh/twopi) +c----------------------------------------------------------------------- +c comparison of nuh to the its starting point. ending loop. +c----------------------------------------------------------------------- + ir=ir+1 + lincheck = abs(nuh-nuperf) + PRINT "(es16.10)", lincheck + !1.0080298818E-08 + !1.0609619849E-09 + !1.2763864632E-08 + !5.9485469883E-09 + !4.4211843520E-08 + !5.7568033007E-08 + IF(lincheck < nuh_eps2 .OR. ir >4)EXIT + ENDDO + ir = ir-1 +c----------------------------------------------------------------------- +c defining rotated saddle-point coordinate frame to extract linear +c component. +c----------------------------------------------------------------------- + IF (oangle>nu(2)) THEN + vartheta = nu(1)-pi/2.0 + ELSE + vartheta = nu(2)-pi/2.0 + ENDIF + vartheta = vartheta - twopi*floor(vartheta/twopi) + + r = r_eps(ir)*rx + cosfac=COS(nuh) + sinfac=SIN(nuh) + cosfact=COS(vartheta) + sinfact=SIN(vartheta) + + Rlocal = r*cosfac + Zlocal = r*sinfac + x = cosfact*Rlocal + sinfact*Zlocal + y = -sinfact*Rlocal + cosfact*Zlocal + chi = -COS(gamma)*x+SIN(gamma)*y +c----------------------------------------------------------------------- +c extracting linear component b11, where psi = psi(rx,zx)+b11*x*chi. +c----------------------------------------------------------------------- + CALL direct_get_bfield(rx,zx,bf,1) + psix = bf%psi + CALL direct_get_bfield(rx+r*cosfac,zx+r*sinfac,bf,1) + psinuh = bf%psi + + b11 = (psinuh-psix)/(x*chi) +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_psisaddle +c----------------------------------------------------------------------- c subprogram 12. direct_initialise_xpoints. c scans the field-line integral to find likely x-point locations, c denoted by diverging regions in the q-integral From 3f1b6e942c6c4249272e04bb5bc8b92fa2f6732e Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 20:47:35 -0400 Subject: [PATCH 22/97] cleaned up direct_psisaddle's linear psi regime logic --- equil/direct.f | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 37dabb44..c4500a09 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1007,11 +1007,12 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, REAL(r8), INTENT(OUT) :: b11,lincheck,gamma,vartheta REAL(r8), PARAMETER :: nuh_eps=1e-13, nuh_eps2=1e-6 - INTEGER :: inuh, ir - REAL(r8) :: nuh,nuperf,Br,dBr_dnuh,cosfac,sinfac,cosfact,sinfact - REAL(r8) :: dnuh,psix,psinuh,r,Rlocal,Zlocal,x,y,chi + INTEGER :: ir + REAL(r8) :: nuh,nuperf,cosfac,sinfac,cosfact,sinfact + REAL(r8) :: psix,psinuh,r,Rlocal,Zlocal,x,y,chi REAL(r8), DIMENSION(4) :: r_eps TYPE(direct_bfield_type) :: bf + LOGICAL :: debug=.TRUE. r_eps(1) = 1e-7 r_eps(2) = 1e-8 @@ -1036,27 +1037,23 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, c----------------------------------------------------------------------- c finding angle where Brho = 0. c----------------------------------------------------------------------- - CALL direct_saddle_angle(rx,zx,rx*r_eps(ir),nu(2),nu(1)-nu(2) + CALL direct_saddle_angle(rx,zx,rx*r_eps(3),nu(2),nu(1)-nu(2) $ ,nuh,'r',.FALSE.) c----------------------------------------------------------------------- c make sure nuh is in [0,2pi). works even if nuh is negative. c----------------------------------------------------------------------- - nuh = nuh - twopi*floor(nuh/twopi) + nuh = nuh - twopi*floor(nuh/twopi) c----------------------------------------------------------------------- -c comparison of nuh to the its starting point. ending loop. +c in the linear approaximation of psi at the x-point, Brho=0 halfway +c between the two separatrix legs. we check if we are within +c nuh_eps2 of this case c----------------------------------------------------------------------- - ir=ir+1 - lincheck = abs(nuh-nuperf) + lincheck = abs(nuh-nuperf) + IF(lincheck > nuh_eps2 .OR. debug)THEN + PRINT"(A)","nu value where Brho=0 deviates from linear case by" PRINT "(es16.10)", lincheck - !1.0080298818E-08 - !1.0609619849E-09 - !1.2763864632E-08 - !5.9485469883E-09 - !4.4211843520E-08 - !5.7568033007E-08 - IF(lincheck < nuh_eps2 .OR. ir >4)EXIT - ENDDO - ir = ir-1 + CALL program_stop("psi isn't well approximated at the x-point") + ENDIF c----------------------------------------------------------------------- c defining rotated saddle-point coordinate frame to extract linear c component. From 8638998e5d29e5c793d91058a730ee99baf9328a Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 21:17:36 -0400 Subject: [PATCH 23/97] fixed occasional segfault in direct_psisaddle --- equil/direct.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index c4500a09..ff4fd11d 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1012,12 +1012,13 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, REAL(r8) :: psix,psinuh,r,Rlocal,Zlocal,x,y,chi REAL(r8), DIMENSION(4) :: r_eps TYPE(direct_bfield_type) :: bf - LOGICAL :: debug=.TRUE. + LOGICAL :: debug=.FALSE. r_eps(1) = 1e-7 r_eps(2) = 1e-8 r_eps(3) = 1e-9 r_eps(4) = 1e-10 + ir=3 c----------------------------------------------------------------------- c finding correct initialisation point for nuh (read nu-half). c gamma should be less than pi for a real x-point @@ -1037,7 +1038,7 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, c----------------------------------------------------------------------- c finding angle where Brho = 0. c----------------------------------------------------------------------- - CALL direct_saddle_angle(rx,zx,rx*r_eps(3),nu(2),nu(1)-nu(2) + CALL direct_saddle_angle(rx,zx,rx*r_eps(ir),nu(2),nu(1)-nu(2) $ ,nuh,'r',.FALSE.) c----------------------------------------------------------------------- c make sure nuh is in [0,2pi). works even if nuh is negative. From 9a051d93c6e8ce306abd185ccdc0d595950b24b6 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 21:34:33 -0400 Subject: [PATCH 24/97] improving direct_psisaddle's debug statement --- equil/direct.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index ff4fd11d..702c87e7 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1050,9 +1050,11 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, c nuh_eps2 of this case c----------------------------------------------------------------------- lincheck = abs(nuh-nuperf) - IF(lincheck > nuh_eps2 .OR. debug)THEN + IF(debug .OR. lincheck > nuh_eps2)THEN PRINT"(A)","nu value where Brho=0 deviates from linear case by" PRINT "(es16.10)", lincheck + ENDIF + IF(lincheck > nuh_eps2)THEN CALL program_stop("psi isn't well approximated at the x-point") ENDIF c----------------------------------------------------------------------- From caefef11a5f05f5843a5bfa4458970379d323c8a Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Fri, 31 May 2024 21:37:17 -0400 Subject: [PATCH 25/97] direct_xpoint added, runs but not properly debugged yet --- equil/direct.f | 127 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 127 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 702c87e7..b45e02ea 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -17,6 +17,7 @@ c 8. direct_local_xpoint. c 9. direct_saddle_angle. c 10. direct_psisaddle. +c 11. direct_xpoint. c 12. direct_initialise_xpoints. c 17. direct_Blocal c----------------------------------------------------------------------- @@ -1094,6 +1095,132 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, RETURN END SUBROUTINE direct_psisaddle c----------------------------------------------------------------------- +c subprogram 11. direct_xpoint. +c finds location and angles of nearby x-point, checks if it's inside +C separatrix. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_xpoint(rin,zin,x_i) + + REAL(r8), INTENT(IN) :: rin,zin + INTEGER, INTENT(IN) :: x_i + + INTEGER, PARAMETER :: ird=4 + REAL(r8), PARAMETER :: psi_eps=1e-4, r_eps1=1e-9 + REAL(r8) :: r,z + REAL(r8) :: b11,lincheck,gamma,vartheta + REAL(r8), DIMENSION(1:2) :: nu + REAL(r8) :: oangle,nu_var,Bnu,Bnua,Bnub,Bnuc + TYPE(direct_bfield_type) :: bf + LOGICAL :: test_direct_local_xpoint,test_direct_saddle_angle + + r=rin + z=zin + nu=0.0 + test_direct_local_xpoint=.FALSE. + test_direct_saddle_angle=.FALSE. +c----------------------------------------------------------------------- +c testing direct_local_xpoint. +c----------------------------------------------------------------------- + IF(test_direct_local_xpoint)THEN + CALL direct_get_bfield(ro,zo,bf,1) + PRINT "(A)", "psi at origin" + PRINT "(f16.10)", bf%psi + PRINT "(A)", "r,z b4 direct_local_xpoint" + PRINT "(f16.5)", r + PRINT "(f16.5)", z + CALL direct_get_bfield(r,z,bf,1) + PRINT "(A)", "|Bp| b4 direct_local_xpoint" + PRINT "(f16.10)", SQRT(bf%br**2+bf%bz**2) + PRINT "(A)", "psi b4 direct_local_xpoint" + PRINT "(f16.10)", bf%psi + CALL direct_local_xpoint(r,z) + PRINT "(A)", "r,z aftr direct_local_xpoint" + PRINT "(f16.5)", r + PRINT "(f16.5)", z + CALL direct_get_bfield(r,z,bf,1) + PRINT "(A)", "|Bp| after direct_local_xpoint" + PRINT "(f16.10)", SQRT(bf%br**2+bf%bz**2) + PRINT "(A)", "psi after direct_local_xpoint" + PRINT "(f16.10)", bf%psi + ENDIF +c----------------------------------------------------------------------- +c finds x-point and fills out global module variables +c----------------------------------------------------------------------- + CALL direct_local_xpoint(r,z) + CALL direct_get_bfield(r,z,bf,1) + rxs(x_i) = r + zxs(x_i) = z +c----------------------------------------------------------------------- +c checks if outside separatrix. ended up not needing... +c----------------------------------------------------------------------- + !IF (bf%psi < -psi_eps*psio) THEN + ! near_sep = .FALSE. + ! RETURN + !ENDIF +c----------------------------------------------------------------------- +c updating xpt_etas with a more exact value than that calculated by +c direct_initialise_xpoints. +c----------------------------------------------------------------------- + xpt_etas(x_i)=ATAN2(zxs(x_i)-zo,rxs(x_i)-ro) + xpt_etas(x_i)=xpt_etas(x_i) - twopi*floor(xpt_etas(x_i)/twopi) +c----------------------------------------------------------------------- +c finding angle of o-point from perspective of x-point (oangle). +c----------------------------------------------------------------------- + oangle = xpt_etas(x_i)+pi + oangle = oangle - twopi*floor(oangle/twopi) + nu_var = pi/2 +c----------------------------------------------------------------------- +c calculating separatrix leg angles (nu). nu(1) is always more than +c oangle, nu(2) is always less than oangle. +c----------------------------------------------------------------------- + CALL direct_saddle_angle(rxs(x_i),zxs(x_i),r_eps1*rxs(x_i),oangle, + $ nu_var,nu(1),'n',.FALSE.) + CALL direct_saddle_angle(rxs(x_i),zxs(x_i),r_eps1*rxs(x_i),oangle, + $ -nu_var,nu(2),'n',.FALSE.) +c----------------------------------------------------------------------- +c testing direct_saddle_angle AGAGAG +c----------------------------------------------------------------------- + IF(test_direct_saddle_angle)THEN + CALL direct_Blocal(rxs(x_i),zxs(x_i),nu(1),r_eps1*rxs(x_i), + $ 'n',Bnua) + CALL direct_Blocal(rxs(x_i),zxs(x_i),oangle,r_eps1*rxs(x_i), + $ 'n',Bnub) + CALL direct_Blocal(rxs(x_i),zxs(x_i),nu(2),r_eps1*rxs(x_i), + $ 'n',Bnuc) + PRINT "(A)", "First x-point leg's angle nu:" + PRINT "(f16.3)", nu(1)/pi + PRINT "(A)", "First leg B_nu" + PRINT "(e16.3)", Bnua + PRINT "(A)", "nu angle pointing from x-pt to mag. axis:" + PRINT "(f16.3)", oangle/pi + PRINT "(A)", "B_nu at angle pointing from x-pt to mag. axis:" + PRINT "(e16.3)", Bnub + PRINT "(A)", "Second x-point leg's angle nu:" + PRINT "(f16.3)", nu(2)/pi + PRINT "(A)", "Second leg B_nu" + PRINT "(e16.3)", Bnuc + PRINT "(A)", "Angle between x-point legs (gamma)" + PRINT "(f16.3)", (nu(1)-nu(2))/pi + ENDIF +c----------------------------------------------------------------------- +c calculating xpoint angles gamma, vartheta, and linear term b11. +c----------------------------------------------------------------------- + CALL direct_psisaddle(r,z,oangle,nu,b11,gamma,vartheta,lincheck) +c----------------------------------------------------------------------- +c filling out x-point module variables. +c----------------------------------------------------------------------- + xpt_b11s(x_i) = b11 + xpt_gammas(x_i) = gamma + xpt_varthetas(x_i) = vartheta +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_xpoint +c----------------------------------------------------------------------- c subprogram 12. direct_initialise_xpoints. c scans the field-line integral to find likely x-point locations, c denoted by diverging regions in the q-integral From 388e2f91a913b2e871057c24912f8dbd3a5d7c6d Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 3 Jun 2024 20:06:38 -0400 Subject: [PATCH 26/97] direct_initialise_xpoints: dq_eps now an input + minor changes --- equil/direct.f | 51 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 39 insertions(+), 12 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index b45e02ea..1d9b7f73 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1032,11 +1032,6 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, CALL program_stop("Angle between separatrix legs > pi.") ENDIF c----------------------------------------------------------------------- -c loop to make sure we reach linear region. -c----------------------------------------------------------------------- - ir=1 - DO -c----------------------------------------------------------------------- c finding angle where Brho = 0. c----------------------------------------------------------------------- CALL direct_saddle_angle(rx,zx,rx*r_eps(ir),nu(2),nu(1)-nu(2) @@ -1228,19 +1223,19 @@ END SUBROUTINE direct_xpoint c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, - $ f,eta_maxes,eta_brackets,maxima_count) + SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, + $ bf,dq_eps,eta_maxes,eta_brackets,maxima_count) INTEGER, INTENT(IN) :: len_y_out - LOGICAL, INTENT(IN) :: wrap + LOGICAL, INTENT(IN) :: wrap,debug REAL(r8), DIMENSION(0:,0:), INTENT(IN) :: y_out - REAL(r8), INTENT(IN) :: f + REAL(r8), INTENT(IN) :: dq_eps + TYPE(direct_bfield_type), INTENT(IN) :: bf INTEGER, INTENT(OUT) :: maxima_count REAL(r8), DIMENSION(1:), INTENT(OUT) :: eta_maxes REAL(r8), DIMENSION(1:,1:), INTENT(OUT) :: eta_brackets - REAL(r8), PARAMETER :: dq_eps=100 INTEGER :: i LOGICAL :: prev_above_threshold,wrap_max,wrap_ REAL(r8), DIMENSION(1:len_y_out) :: dqdeta @@ -1257,14 +1252,14 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, c only called when wrap = .TRUE. and we are analysing the whole c [0,2pi] interval. lsode integrator makes sure final eta is twopi c----------------------------------------------------------------------- - IF (y_out(len_y_out,0) > twopi .AND. wrap) THEN + IF ((y_out(len_y_out,0)-y_out(0,0)) > twopi .AND. wrap) THEN CALL program_stop("eta wrap error... debug direct.f") ENDIF c----------------------------------------------------------------------- c turn y_out into dqdeta. c----------------------------------------------------------------------- DO i=0,(len_y_out-1),+1 - dqdeta(i+1) = (f/twopi)*(y_out(i+1,3)-y_out(i,3)) + dqdeta(i+1) = (bf%f)*(y_out(i+1,3)-y_out(i,3)) $ /(y_out(i+1,0)-y_out(i,0))! ENDDO c----------------------------------------------------------------------- @@ -1373,6 +1368,38 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap, ENDDO ENDIF c----------------------------------------------------------------------- +c debug print statements. +c----------------------------------------------------------------------- + + IF(debug)PRINT "(A)", "Num points::::::::::::::::::::::::::::::::" + IF(debug)PRINT "(i6)", maxima_count + IF(maxima_count>0 .AND. debug)THEN + DO i=1,maxima_count + PRINT "(A)", "Point " + PRINT "(i6)", i + PRINT "(f16.5)", (eta_brackets(i,1) + $ -twopi*floor(eta_brackets(i,1)/twopi)) + PRINT "(f16.5)", (eta_maxes(i) + $ -twopi*floor(eta_maxes(i)/twopi)) + PRINT "(f16.5)", (eta_brackets(i,2) + $ -twopi*floor(eta_brackets(i,2)/twopi)) + ENDDO + ENDIF + IF (debug)THEN + PRINT "(A)", "Total theta values over interval " + PRINT "(f16.5)", y_out(0,0) + PRINT "(f16.5)", y_out(len_y_out,0) + PRINT "(A)", "Total q values over interval " + PRINT "(es16.5)", y_out(0,3) + PRINT "(es16.5)", y_out(len_y_out,3) + PRINT "(es16.5)", (y_out(len_y_out,3)/(y_out(len_y_out,0)- + $ y_out(0,0))) + PRINT "(A)", "max and min dqdeta" + PRINT "(es16.5)", MAXVAL(dqdeta) + PRINT "(es16.5)", MINVAL(dqdeta) + ENDIF + IF(debug)PRINT "(A)", "::::::::::::::::::::::::::::::::::::::::::" +c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN From 32555bcdba758deb1a6158f1255474c0c0e776ba Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 3 Jun 2024 20:19:19 -0400 Subject: [PATCH 27/97] fixed direct_initialise_xpoints non-wrap case treatment of final point --- equil/direct.f | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 1d9b7f73..3a59aec8 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1346,6 +1346,30 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, max_locations(maxima_count) = $ 0.5*(y_out(len_y_out-1,0)+y_out(len_y_out,0)) ENDIF + ELSEIF (dqdeta(len_y_out)>dq_eps) THEN +c----------------------------------------------------------------------- +c non wrap case treated same as i=1:len_y_out-1 +c----------------------------------------------------------------------- + IF(prev_above_threshold) THEN + eta_brackets(maxima_count,2)=y_out(len_y_out,0) + + IF (dqdeta(len_y_out)>max_dqdeta(maxima_count)) THEN + max_dqdeta(maxima_count)=dqdeta(len_y_out) + max_locations(maxima_count) = 0.5*(y_out(len_y_out,0)+ + $ y_out(len_y_out-1,0)) + ENDIF + prev_above_threshold=.TRUE. + ELSE + maxima_count=maxima_count+1 + + eta_brackets(maxima_count,1)=y_out(len_y_out-1,0) + eta_brackets(maxima_count,2)=y_out(len_y_out,0) + + max_dqdeta(maxima_count)=dqdeta(len_y_out) + max_locations(maxima_count) = 0.5*(y_out(len_y_out,0)+ + $ y_out(len_y_out-1,0)) + prev_above_threshold=.TRUE. + ENDIF ENDIF c----------------------------------------------------------------------- c warning if theres more than 2 xpoints. From 303deb7bc6613fdad10f5daca305abdb86bb842a Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 3 Jun 2024 23:22:36 -0400 Subject: [PATCH 28/97] prepping direct_run for inclusion of direct_mixed_spline_builder --- equil/direct.f | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 3a59aec8..1d40dcc1 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -34,8 +34,8 @@ MODULE direct_mod INTEGER, PRIVATE :: istep REAL(r8) :: rmin,rmax,zmin,zmax,rs1,rs2 - REAL(r8), DIMENSION(2) :: xpt_etas, rxs, zxs, xpt_b11s - REAL(r8), DIMENSION(2) :: xpt_gammas, xpt_varthetas + REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_b11s + REAL(r8), DIMENSION(1:2) :: xpt_gammas, xpt_varthetas REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in LOGICAL :: direct_infinite_loop_flag @@ -76,7 +76,7 @@ SUBROUTINE direct_run TYPE(spline_type) :: ff use_analytic=.FALSE. - run_xpt=.FALSE. + run_xpt=.TRUE. xpt_etas=0.0 eta_maxes=0.0 eta_brackets=0.0 @@ -159,6 +159,7 @@ SUBROUTINE direct_run c integral formulas near separatrix. c----------------------------------------------------------------------- IF(use_analytic .AND. run_xpt)THEN + CALL direct_mixed_spline_builder(sq%xs(ipsi)) ELSE CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_out,bf, $ len_y_out) @@ -167,7 +168,22 @@ SUBROUTINE direct_run c----------------------------------------------------------------------- IF(sq%xs(ipsi)>0.999 .AND. run_xpt)THEN CALL direct_initialise_xpoints(y_out,len_y_out,.TRUE., - $ bf%f*twopi,eta_maxes,eta_brackets,maxima_count) + $ .TRUE.,bf,10*one,eta_maxes,eta_brackets,maxima_count) + + IF(maxima_count > 0 .AND. run_xpt)THEN + use_analytic = .TRUE. + num_xpts=maxima_count + + DO i=1,maxima_count,+1 + xpt_etas(i)=eta_maxes(i) !updated by direct_xpoint + xpt_brackets(i,1)=eta_brackets(i,1) + xpt_brackets(i,2)=eta_brackets(i,2) + + CALL find_fl_surface(one,xpt_etas(i),rx,zx) + CALL direct_xpoint(rx,zx,i) + ENDDO + CYCLE + ENDIF ENDIF c----------------------------------------------------------------------- c fit data to cubic splines. @@ -1107,7 +1123,7 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) REAL(r8) :: r,z REAL(r8) :: b11,lincheck,gamma,vartheta REAL(r8), DIMENSION(1:2) :: nu - REAL(r8) :: oangle,nu_var,Bnu,Bnua,Bnub,Bnuc + REAL(r8) :: oangle,nu_var,Bnua,Bnub,Bnuc TYPE(direct_bfield_type) :: bf LOGICAL :: test_direct_local_xpoint,test_direct_saddle_angle @@ -1402,11 +1418,11 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, PRINT "(A)", "Point " PRINT "(i6)", i PRINT "(f16.5)", (eta_brackets(i,1) - $ -twopi*floor(eta_brackets(i,1)/twopi)) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) PRINT "(f16.5)", (eta_maxes(i) - $ -twopi*floor(eta_maxes(i)/twopi)) + $ )!-twopi*floor(eta_maxes(i)/twopi)) PRINT "(f16.5)", (eta_brackets(i,2) - $ -twopi*floor(eta_brackets(i,2)/twopi)) + $ )!-twopi*floor(eta_brackets(i,2)/twopi)) ENDDO ENDIF IF (debug)THEN From 6b8d3dd91985893ba9c08916dc7133c846be6da2 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 3 Jun 2024 23:36:03 -0400 Subject: [PATCH 29/97] direct_mixed_spline_builder first push, for num_xpts=1, will evaluate numerical integral and check for a second x-point --- equil/direct.f | 113 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 113 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 1d40dcc1..618288fb 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1445,6 +1445,119 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, RETURN END SUBROUTINE direct_initialise_xpoints c----------------------------------------------------------------------- +c subprogram 15. direct_mixed_spline_builder. +c builds the ff spline using a combination of analytic integrals +c over divergent x-point regions, and numerically integrated +c sections inbetween x-points. +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_mixed_spline_builder(psifac) + + REAL(r8), INTENT(IN) :: psifac + + REAL(r8) :: eta,eta1,eta2,R,Z + REAL(r8) :: eta3,eta4,r_loc1,r_loc2,y_out1_max,y_out3_max + REAL(r8), DIMENSION(1:nstep2,0:4) :: yi1, yi2, yi_interim + + REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out1,y_out2 + INTEGER :: len_y1_out,len_y2_out,maxima_count,tot_steps,ist1,ist2 + INTEGER :: i1,i2,i + + REAL(r8), DIMENSION(6,2) :: eta_brackets + REAL(r8), DIMENSION(6) :: eta_maxes + + TYPE(direct_bfield_type) :: bf + TYPE(spline_type) :: ff + + yi1=0.0 + yi2=0.0 + y_out1=0.0 + y_out2=0.0 +c----------------------------------------------------------------------- +c adddressing case of only one x-point. +c----------------------------------------------------------------------- + IF(num_xpts==1)THEN +c----------------------------------------------------------------------- +c ordering the two etas for numerical field line integration +c----------------------------------------------------------------------- + eta1 = xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) + eta2 = xpt_brackets(1,2) - twopi*floor(xpt_brackets(1,2)/twopi) + + IF(eta20)THEN +c----------------------------------------------------------------------- +c if first maxima not unique, eliminate it +c----------------------------------------------------------------------- + IF(ABS(eta_brackets(1,1)-eta2)<1e-6 .AND. + $ ABS(eta_maxes(1)-eta2)<1e-3)THEN + maxima_count=maxima_count-1 + DO i=1,maxima_count,+1 + eta_brackets(i,1:2)=eta_brackets(i+1,1:2) + eta_maxes(i)=eta_maxes(i+1) + ENDDO + ENDIF +c----------------------------------------------------------------------- +c if last maxima not unique, eliminate it +c----------------------------------------------------------------------- + IF(ABS(eta_brackets(maxima_count,2)-eta1)<1e-6 .AND. + $ ABS(eta_maxes(maxima_count)-eta1)<1e-3)THEN + eta_brackets(maxima_count,1:2)=0.0 + eta_maxes(maxima_count)=0.0 + maxima_count=maxima_count-1 + ENDIF + ENDIF +c----------------------------------------------------------------------- +c loop over new unique local maxes that flag as x-points. +c----------------------------------------------------------------------- + DO i=1,maxima_count,+1 +c----------------------------------------------------------------------- +c making sure all angles are in [0,2pi). +c----------------------------------------------------------------------- + eta_maxes(i)=eta_maxes(i) - twopi*floor(eta_maxes(i)/twopi) + eta_brackets(i,1)= + $ eta_brackets(i,1) - twopi*floor(eta_brackets(i,1)/twopi) + eta_brackets(i,2)= + $ eta_brackets(i,2) - twopi*floor(eta_brackets(i,2)/twopi) +c----------------------------------------------------------------------- +c updating module variables. +c----------------------------------------------------------------------- + num_xpts=num_xpts+1 + IF(num_xpts>2) + $ CALL program_stop("More than 2 x-points detected") + + xpt_etas(num_xpts)=eta_maxes(i) + xpt_brackets(num_xpts,1)=eta_brackets(i,1) + xpt_brackets(num_xpts,2)=eta_brackets(i,2) + + CALL find_fl_surface(one,xpt_etas(num_xpts),r,z) + CALL direct_xpoint(r,z,num_xpts) + ENDDO + + ENDIF +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_mixed_spline_builder c----------------------------------------------------------------------- c subprogram 17. direct_Blocal. c calculates local B-field displaced from some r,z point in polar From 3a0694daf06066994af6094d56d005aa5650de56 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 3 Jun 2024 23:53:48 -0400 Subject: [PATCH 30/97] added some debug statements for direct_mixed_spline_builder --- equil/direct.f | 49 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 48 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 618288fb..7371e8bb 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1463,6 +1463,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac) REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out1,y_out2 INTEGER :: len_y1_out,len_y2_out,maxima_count,tot_steps,ist1,ist2 INTEGER :: i1,i2,i + LOGICAL :: dbg1xpt REAL(r8), DIMENSION(6,2) :: eta_brackets REAL(r8), DIMENSION(6) :: eta_maxes @@ -1474,6 +1475,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac) yi2=0.0 y_out1=0.0 y_out2=0.0 + dbg1xpt=.TRUE. c----------------------------------------------------------------------- c adddressing case of only one x-point. c----------------------------------------------------------------------- @@ -1499,7 +1501,22 @@ SUBROUTINE direct_mixed_spline_builder(psifac) c calling direct_initialise_xpoints to check for a second x-point. c----------------------------------------------------------------------- CALL direct_initialise_xpoints(y_out1,len_y1_out,.FALSE., - $ .FALSE.,bf,10.03*one,eta_maxes,eta_brackets,maxima_count) + $ .FALSE.,bf,100*one,eta_maxes,eta_brackets,maxima_count)!10.03 + IF(dbg1xpt)PRINT "(A)", "Maxima count for numerical integral" + IF(dbg1xpt)PRINT "(i6)", maxima_count + IF(dbg1xpt .AND. maxima_count>0)THEN + PRINT "(A)", "|||||||||||||||||||||||||||||||||||||||||||" + PRINT "(i6)", maxima_count + DO i=1,maxima_count + PRINT "(i6)", i + PRINT "(f16.5)", (eta_brackets(i,1) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + PRINT "(f16.5)", (eta_maxes(i) + $ )!-twopi*floor(eta_maxes(i)/twopi)) + PRINT "(f16.5)", (eta_brackets(i,2) + $ )!-twopi*floor(eta_brackets(i,2)/twopi)) + ENDDO + ENDIF c----------------------------------------------------------------------- c check first and last maxima to make sure they are unique. c----------------------------------------------------------------------- @@ -1515,6 +1532,20 @@ SUBROUTINE direct_mixed_spline_builder(psifac) eta_maxes(i)=eta_maxes(i+1) ENDDO ENDIF + IF(dbg1xpt)PRINT "(A)", "Maxima count for numerical int." + IF(dbg1xpt)PRINT "(i6)", maxima_count + IF(dbg1xpt .AND. maxima_count>0)THEN + PRINT "(A)", "||||||||||||||||||||||||||||||||||||||||||" + DO i=1,maxima_count + PRINT "(i6)", i + PRINT "(f16.5)", (eta_brackets(i,1) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + PRINT "(f16.5)", (eta_maxes(i) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + PRINT "(f16.5)", (eta_brackets(i,2) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + ENDDO + ENDIF c----------------------------------------------------------------------- c if last maxima not unique, eliminate it c----------------------------------------------------------------------- @@ -1524,6 +1555,22 @@ SUBROUTINE direct_mixed_spline_builder(psifac) eta_maxes(maxima_count)=0.0 maxima_count=maxima_count-1 ENDIF + IF(dbg1xpt .AND. maxima_count>0)THEN + PRINT "(A)", "||||||||||||||||||||||||||||||||||||||||||" + PRINT "(i6)", maxima_count + DO i=1,maxima_count + PRINT "(i6)", i + PRINT "(f16.5)", (eta_brackets(i,1) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + PRINT "(f16.5)", (eta_maxes(i) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + PRINT "(f16.5)", (eta_brackets(i,2) + $ )!-twopi*floor(eta_brackets(i,1)/twopi)) + ENDDO + ELSE + IF(dbg1xpt)PRINT "(A)", "|||||||||||||||||||||||||||||||" + IF(dbg1xpt)PRINT "(i6)", maxima_count + ENDIF ENDIF c----------------------------------------------------------------------- c loop over new unique local maxes that flag as x-points. From bc53478ae0db089071bcb6e3de8969869fae343b Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Tue, 4 Jun 2024 02:43:52 -0400 Subject: [PATCH 31/97] direct_mixed_spline_builder numerical int now working for num_xtps=2 --- equil/direct.f | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 7371e8bb..0763211b 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1599,7 +1599,68 @@ SUBROUTINE direct_mixed_spline_builder(psifac) CALL direct_xpoint(r,z,num_xpts) ENDDO + ELSE +c----------------------------------------------------------------------- +c 2 x-points: making sure all brackets are in [0,2pi) +c----------------------------------------------------------------------- + xpt_brackets(1,1)= + $ xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) + xpt_brackets(1,2)= + $ xpt_brackets(1,2) - twopi*floor(xpt_brackets(1,2)/twopi) + xpt_brackets(2,1)= + $ xpt_brackets(2,1) - twopi*floor(xpt_brackets(2,1)/twopi) + xpt_brackets(2,2)= + $ xpt_brackets(2,2) - twopi*floor(xpt_brackets(2,2)/twopi) +c----------------------------------------------------------------------- +c making sure there are no wrap-arounds within each set of brackets +c----------------------------------------------------------------------- + IF(xpt_brackets(1,2)xpt_brackets(1,1))THEN + IF(xpt_brackets(2,1) Date: Wed, 5 Jun 2024 01:38:57 -0400 Subject: [PATCH 32/97] xpt_varthetas2 added to make sure x1 in direct_analytic_ints correctly approaches 0 as psifac goes to 1 --- equil/direct.f | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 0763211b..77fd831b 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -36,6 +36,7 @@ MODULE direct_mod REAL(r8) :: rmin,rmax,zmin,zmax,rs1,rs2 REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_b11s REAL(r8), DIMENSION(1:2) :: xpt_gammas, xpt_varthetas + REAL(r8), DIMENSION(1:2) :: xpt_varthetas2 REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in LOGICAL :: direct_infinite_loop_flag @@ -1227,6 +1228,18 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) xpt_gammas(x_i) = gamma xpt_varthetas(x_i) = vartheta c----------------------------------------------------------------------- +c second vartheta to make sure x1 in direct_analytic_ints correctly +c approaches 0 as psifac goes to 1. +c----------------------------------------------------------------------- + CALL find_fl_surface(one,xpt_brackets(x_i,1),r,z) + xpt_varthetas2(x_i) = ATAN2(z-zxs(x_i),r-rxs(x_i))-pi/2 + xpt_varthetas2(x_i) = xpt_varthetas2(x_i) + $ - twopi*floor(xpt_varthetas2(x_i)/twopi) + IF(ABS(xpt_varthetas(x_i)-xpt_varthetas2(x_i))>twopi/100)THEN + PRINT "(A)", "Straight x-point leg assumption bad," + CALL program_stop("increase dq_eps.") + ENDIF +c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN @@ -1599,7 +1612,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac) CALL direct_xpoint(r,z,num_xpts) ENDDO - ELSE + ELSE c----------------------------------------------------------------------- c 2 x-points: making sure all brackets are in [0,2pi) c----------------------------------------------------------------------- From fb9f2c5d9427deb5cd8c2f47cbf7f626aa5679aa Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Wed, 5 Jun 2024 01:40:01 -0400 Subject: [PATCH 33/97] b11 sign fix --- equil/direct.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 77fd831b..a43bbec1 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1100,7 +1100,7 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, CALL direct_get_bfield(rx+r*cosfac,zx+r*sinfac,bf,1) psinuh = bf%psi - b11 = (psinuh-psix)/(x*chi) + b11 = -(psinuh-psix)/(x*chi) c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- From 002ad261dca67e29eb5bfe1958aac01a185daf2f Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Wed, 5 Jun 2024 01:42:13 -0400 Subject: [PATCH 34/97] swapping float4 1.0 with float8 'one' --- equil/direct.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a43bbec1..a5824295 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -79,6 +79,7 @@ SUBROUTINE direct_run use_analytic=.FALSE. run_xpt=.TRUE. xpt_etas=0.0 + xpt_brackets=0.0 eta_maxes=0.0 eta_brackets=0.0 num_xpts=0 @@ -940,13 +941,13 @@ SUBROUTINE direct_saddle_angle(rx,zx,rho,nustart_in,nu_var_in,nu, nustart=nustart_in nu_var=nu_var_in - pos=1.0 + pos=one inuh=0 c----------------------------------------------------------------------- c looping over narrower nu-intervals c----------------------------------------------------------------------- CALL direct_Blocal(rx,zx,nustart_in,rho,Bcase,bnorm) - IF(bnorm Date: Thu, 6 Jun 2024 16:13:46 -0400 Subject: [PATCH 35/97] direct_saddle_coords, direct_saddle_coords_inv added and half-debugged --- equil/direct.f | 100 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 98 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a5824295..b411ddaa 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -19,7 +19,8 @@ c 10. direct_psisaddle. c 11. direct_xpoint. c 12. direct_initialise_xpoints. -c 17. direct_Blocal +c 13. direct_saddle_coords. +c 14. direct_saddle_coords_inv. c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. @@ -1459,7 +1460,102 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, RETURN END SUBROUTINE direct_initialise_xpoints c----------------------------------------------------------------------- -c subprogram 15. direct_mixed_spline_builder. +c subprogram 13. direct_saddle_coords. +c transforms us into a local coordinate frame aligned with one leg +c of the x-point. takes x-point data from module variables. +c r1 is radius from the magnetic axis, not major radius +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) + + INTEGER, INTENT(IN) :: x_i + + REAL(r8), INTENT(IN) :: r1,eta1 + REAL(r8), INTENT(OUT) :: x,y,chi + !LOGICAL :: usevth2 + + REAL(r8) :: cosfac,sinfac,cosfact,sinfact + REAL(r8) :: Rshft,Zshft,Rlocal,Zlocal + + !usevth2=.TRUE. +c----------------------------------------------------------------------- +c precalculating trig components. +c----------------------------------------------------------------------- + cosfac=COS(eta1) + sinfac=SIN(eta1) +c----------------------------------------------------------------------- +c local R,Z coordinates centered on x-point. +c----------------------------------------------------------------------- + Rshft = ro + r1*cosfac + Zshft = zo + r1*sinfac + + Rlocal = Rshft-rxs(x_i) + Zlocal = Zshft-zxs(x_i) +c----------------------------------------------------------------------- +c rotating local R,Z coordinates to align with x-point leg that +c approaches the x-point by travelling anticlockwise around the +c separatrix. this is captured in the vartheta variable +c----------------------------------------------------------------------- + x = cosfact*Rlocal + sinfact*Zlocal + y = -sinfact*Rlocal + cosfact*Zlocal + Zlocal = Zshft-zxs(x_i) +c----------------------------------------------------------------------- +c calculating chi angle variable, defined such that nabla chi is +c orthogonal to the x-point leg that leaves the +c x-point when travelling anticlockwise around the separatrix. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_saddle_coords +c----------------------------------------------------------------------- +c subprogram 14. direct_saddle_coords_inv. +c inverse of direct_saddle_coords. takes x,y, returns R,Z,rho,eta. +c rho is minor radius +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta) + + INTEGER, INTENT(IN) :: x_i + REAL(r8), INTENT(IN) :: x,y + REAL(r8), INTENT(OUT) :: R,Z,rho,eta + + REAL(r8) :: cosfact,sinfact + REAL(r8) :: Rlocal,Zlocal + +c----------------------------------------------------------------------- +c precalculating trig components. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c inverse coordinate transform. commented out lines are the forwards +c transform from direct_saddle_coords. +c----------------------------------------------------------------------- + !Rshft = ro + r1*cosfac + !Zshft = zo + r1*sinfac + !Rlocal = Rshft-rxs(x_i) + !Zlocal = Zshft-zxs(x_i) + !x = cosfact*Rlocal + sinfact*Zlocal + !y = -sinfact*Rlocal + cosfact*Zlocal + + Rlocal = cosfact*x - sinfact*y + Zlocal = sinfact*x + cosfact*y + + R = Rlocal + rxs(x_i) + Z = Zlocal + zxs(x_i) + + rho = SQRT((R-ro)**2+(Z-zo)**2) + eta = ATAN2(Z-zo,R-ro) +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_saddle_coords_inv +c----------------------------------------------------------------------- c builds the ff spline using a combination of analytic integrals c over divergent x-point regions, and numerically integrated c sections inbetween x-points. From d1a12cd6e4ec36d8f9d5e908792b60ee56ae881d Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 6 Jun 2024 16:16:23 -0400 Subject: [PATCH 36/97] option usevth2 added, fixes failure to replicate correct asymptotic behaviour --- equil/direct.f | 48 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 42 insertions(+), 6 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index b411ddaa..251d89d8 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -37,10 +37,10 @@ MODULE direct_mod REAL(r8) :: rmin,rmax,zmin,zmax,rs1,rs2 REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_b11s REAL(r8), DIMENSION(1:2) :: xpt_gammas, xpt_varthetas - REAL(r8), DIMENSION(1:2) :: xpt_varthetas2 + REAL(r8), DIMENSION(1:2) :: xpt_gammas2, xpt_varthetas2 REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in - LOGICAL :: direct_infinite_loop_flag + LOGICAL :: direct_infinite_loop_flag, usevth2=.TRUE. INTEGER :: direct_infinite_loop_count = 2000 INTEGER :: num_xpts @@ -1234,10 +1234,29 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) c approaches 0 as psifac goes to 1. c----------------------------------------------------------------------- CALL find_fl_surface(one,xpt_brackets(x_i,1),r,z) - xpt_varthetas2(x_i) = ATAN2(z-zxs(x_i),r-rxs(x_i))-pi/2 + nu(1)=ATAN2(z-zxs(x_i),r-rxs(x_i)) + CALL find_fl_surface(one,xpt_brackets(x_i,2),r,z) + nu(2)=ATAN2(z-zxs(x_i),r-rxs(x_i)) +c----------------------------------------------------------------------- +c defining xpt_varthetas2, xpt_gammas2. these angles are +c calculated out at the eta-location where we switch from numerical +c to analytic integrals (xpt_brackets), instead of asymptotically +c close to the x-point as is the case for xpt_varthetas, xpt_gammas. +c----------------------------------------------------------------------- + xpt_varthetas2(x_i) = nu(1)-pi/2 + xpt_gammas2(x_i) = nu(1)-nu(2) + xpt_varthetas2(x_i) = xpt_varthetas2(x_i) $ - twopi*floor(xpt_varthetas2(x_i)/twopi) - IF(ABS(xpt_varthetas(x_i)-xpt_varthetas2(x_i))>twopi/100)THEN + xpt_gammas2(x_i) = xpt_gammas2(x_i) + $ - twopi*floor(xpt_gammas2(x_i)/twopi) +c----------------------------------------------------------------------- +c making sure there isn't much difference between the varthetas and +c gamma angles asymptotically close to the x-point vs at the +c switch-over location +c----------------------------------------------------------------------- + IF(ABS(xpt_varthetas(x_i)-xpt_varthetas2(x_i))>twopi/100 .OR. + $ ABS(xpt_gammas2(x_i)-xpt_gammas(x_i))>twopi/100)THEN PRINT "(A)", "Straight x-point leg assumption bad," CALL program_stop("increase dq_eps.") ENDIF @@ -1474,17 +1493,22 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) REAL(r8), INTENT(IN) :: r1,eta1 REAL(r8), INTENT(OUT) :: x,y,chi - !LOGICAL :: usevth2 REAL(r8) :: cosfac,sinfac,cosfact,sinfact REAL(r8) :: Rshft,Zshft,Rlocal,Zlocal - !usevth2=.TRUE. c----------------------------------------------------------------------- c precalculating trig components. c----------------------------------------------------------------------- cosfac=COS(eta1) sinfac=SIN(eta1) + IF(usevth2)THEN + cosfact=COS(xpt_varthetas2(x_i)) + sinfact=SIN(xpt_varthetas2(x_i)) + ELSE + cosfact=COS(xpt_varthetas(x_i)) + sinfact=SIN(xpt_varthetas(x_i)) + ENDIF c----------------------------------------------------------------------- c local R,Z coordinates centered on x-point. c----------------------------------------------------------------------- @@ -1506,6 +1530,11 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) c orthogonal to the x-point leg that leaves the c x-point when travelling anticlockwise around the separatrix. c----------------------------------------------------------------------- + IF(usevth2)THEN + chi = -COS(xpt_gammas2(x_i))*x+SIN(xpt_gammas2(x_i))*y + ELSE + chi = -COS(xpt_gammas(x_i))*x+SIN(xpt_gammas(x_i))*y + ENDIF c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- @@ -1531,6 +1560,13 @@ SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta) c----------------------------------------------------------------------- c precalculating trig components. c----------------------------------------------------------------------- + IF(usevth2)THEN + cosfact=COS(xpt_varthetas2(x_i)) + sinfact=SIN(xpt_varthetas2(x_i)) + ELSE + cosfact=COS(xpt_varthetas(x_i)) + sinfact=SIN(xpt_varthetas(x_i)) + ENDIF c----------------------------------------------------------------------- c inverse coordinate transform. commented out lines are the forwards c transform from direct_saddle_coords. From 7a30db3ef10a36d134c7f01b958ec4608fce54cb Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 6 Jun 2024 16:25:53 -0400 Subject: [PATCH 37/97] added direct_analytic_ints, NOT DEGBUGGED YET --- equil/direct.f | 108 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 251d89d8..8ea79d8c 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1592,6 +1592,114 @@ SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta) RETURN END SUBROUTINE direct_saddle_coords_inv c----------------------------------------------------------------------- +c subprogram 15. direct_analytic_ints. +c takes the linear term b11, angle and position data, and calculates +c integrals y(1), y(2), y(3), y(4) replacing direct_fl_int. assumes +c logarithmic trajectories near the saddle point. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, + $ outmat,debug) + + REAL(r8), INTENT(IN) :: r1,eta1,eta2 + INTEGER, INTENT(IN) :: x_i + LOGICAL, INTENT(IN) :: debug + + REAL(r8), INTENT(OUT) :: yi1,yi2,yi3,yi4 + REAL(r8), DIMENSION(1:3,1:2,0:1),INTENT(OUT) :: outmat + + REAL(r8) :: x1,y1,x2,y2,chi,I1,I2,I3,bt,b,root,xo,yo,chio + REAL(r8) :: cosvt,sinvt,cotgam,singam,cscgam,etax,vartheta,gamma + TYPE(direct_bfield_type) :: bf + + outmat=0.0 +c----------------------------------------------------------------------- +c getting local coordinates. +c----------------------------------------------------------------------- + CALL direct_saddle_coords(x_i,r1,eta1,x1,y1,chi) + CALL direct_saddle_coords(x_i,zero,zero,xo,yo,chio) +c----------------------------------------------------------------------- +c pre-calculationg useful terms +c----------------------------------------------------------------------- + IF(usevth2)THEN + vartheta=xpt_varthetas2(x_i) + gamma=xpt_gammas2(x_i) + ELSE + vartheta=xpt_varthetas(x_i) + gamma=xpt_gammas(x_i) + ENDIF + + cosvt = COS(vartheta) + sinvt = SIN(vartheta) + + cotgam = one/TAN(gamma) + singam = SIN(gamma) + + cscgam = one/singam + etax = xpt_etas(x_i) + bt=abs(bf%f/rxs(x_i)) +c----------------------------------------------------------------------- +c calculating x2 by assuming logarithmic Bp trajectory near x-point. +c----------------------------------------------------------------------- + root = -sqrt((xo*TAN(eta2-vartheta)-yo)**2 + $-4*one*(cotgam-TAN(eta2-vartheta))*(x1*y1-x1*x1*cotgam)) + x2 = (one/2)*(yo-xo*TAN(eta2-vartheta)+root)/ + $ (cotgam-TAN(eta2-vartheta)) + y2 = (x2-xo)*TAN(eta2-vartheta)+yo +c----------------------------------------------------------------------- +c coordinate information for debugging. 1 and 2 refer to initial and +c final point respectively. rho is minor radius, eta poloidal angle. +c outmat(2,1,0) = R1, outmat(2,2,0) = Z1 +c outmat(3,1,0) = rho1, outmat(3,2,0) = eta1 +c outmat(2,1,1) = R2, outmat(2,2,1) = Z2 +c outmat(3,1,1) = rho2, outmat(3,2,1) = eta2 +c----------------------------------------------------------------------- + IF(debug)THEN + y2 = (x2-xo)*TAN(eta2-vartheta)+yo + outmat(1,1,0)=x1 + outmat(1,1,1)=x2 + outmat(1,2,0)=y1 + outmat(1,2,1)=y2 + + CALL direct_saddle_coords_inv(x_i,x1,y1,outmat(2,1,0), + $ outmat(2,2,0),outmat(3,1,0),outmat(3,2,0)) + CALL direct_saddle_coords_inv(x_i,x2,y2,outmat(2,1,1), + $ outmat(2,2,1),outmat(3,1,1),outmat(3,2,1)) + ENDIF +c----------------------------------------------------------------------- +c evaluating integrals +c----------------------------------------------------------------------- + yi1 = -(cscgam/xpt_b11s(x_i))*(rxs(x_i)*LOG(x2/x1) + $ +(cosvt-cotgam*sinvt)*(x2-x1)+sinvt*(y1-x1)*(x1/x2-one)) + yi2 = -(cscgam/xpt_b11s(x_i))*abs(-SIN(etax+gamma + s -vartheta)*(x2-x1) + $ +singam*SIN(etax-vartheta)*(y1-x1)*(one-x1/x2)) + yi3 = -(cscgam/(xpt_b11s(x_i)*rxs(x_i)))*(LOG(x2/x1) + $ -(cosvt-cotgam*sinvt)*(x2-x1)/rxs(x_i) + $ +sinvt*(y1-x1)*(one-x1/x2)/rxs(x_i)) +c----------------------------------------------------------------------- +c y4 special case. +c----------------------------------------------------------------------- + IF(abs(power_bp)>1e-13)THEN + CALL program_stop("Analytic sep. incompat. w power_bp =/= 0") + ELSE + I1 = LOG(x2/x1) + I2 = x2-x1 + I3 = -(one/x2)+one/x1 + ENDIF + yi4 = -cscgam*(b**power_b)*(xpt_b11s(x_i)**(power_bp-one))*( + $ I1*rxs(x_i)**(one-power_r)+ + $ I2*(one-power_r)*(cosvt-cotgam*sinvt)/(rxs(x_i)**power_r) + $ -I3*(one-power_r)*sinvt*(x1*y1-x1*x1)/(rxs(x_i)**power_r)) +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_analytic_ints +c----------------------------------------------------------------------- +c subprogram 16. direct_mixed_spline_builder. c builds the ff spline using a combination of analytic integrals c over divergent x-point regions, and numerically integrated c sections inbetween x-points. From 42ec51eabc847ffcca3675442c4f05df6b7c242e Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 6 Jun 2024 16:33:59 -0400 Subject: [PATCH 38/97] direct_analytic_ints minor radius formula fixed --- equil/direct.f | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 8ea79d8c..86a8ec76 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1649,15 +1649,15 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, $ (cotgam-TAN(eta2-vartheta)) y2 = (x2-xo)*TAN(eta2-vartheta)+yo c----------------------------------------------------------------------- -c coordinate information for debugging. 1 and 2 refer to initial and -c final point respectively. rho is minor radius, eta poloidal angle. +c outputting coordinate information. c outmat(2,1,0) = R1, outmat(2,2,0) = Z1 c outmat(3,1,0) = rho1, outmat(3,2,0) = eta1 c outmat(2,1,1) = R2, outmat(2,2,1) = Z2 c outmat(3,1,1) = rho2, outmat(3,2,1) = eta2 +c 1 and 2 refer to initial and final point respectively. rho is +c minor radius, eta poloidal angle. an output yi2=rho2=outmat(3,1,1) c----------------------------------------------------------------------- IF(debug)THEN - y2 = (x2-xo)*TAN(eta2-vartheta)+yo outmat(1,1,0)=x1 outmat(1,1,1)=x2 outmat(1,2,0)=y1 @@ -1665,17 +1665,18 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, CALL direct_saddle_coords_inv(x_i,x1,y1,outmat(2,1,0), $ outmat(2,2,0),outmat(3,1,0),outmat(3,2,0)) - CALL direct_saddle_coords_inv(x_i,x2,y2,outmat(2,1,1), - $ outmat(2,2,1),outmat(3,1,1),outmat(3,2,1)) ENDIF + CALL direct_saddle_coords_inv(x_i,x2,y2,outmat(2,1,1), + $ outmat(2,2,1),outmat(3,1,1),outmat(3,2,1)) c----------------------------------------------------------------------- c evaluating integrals c----------------------------------------------------------------------- yi1 = -(cscgam/xpt_b11s(x_i))*(rxs(x_i)*LOG(x2/x1) $ +(cosvt-cotgam*sinvt)*(x2-x1)+sinvt*(y1-x1)*(x1/x2-one)) - yi2 = -(cscgam/xpt_b11s(x_i))*abs(-SIN(etax+gamma - s -vartheta)*(x2-x1) - $ +singam*SIN(etax-vartheta)*(y1-x1)*(one-x1/x2)) + yi2=outmat(3,1,1) + !yi2 = -(cscgam/xpt_b11s(x_i))*abs(-SIN(etax+gamma + !$ -vartheta)*(x2-x1) + !$ +singam*SIN(etax-vartheta)*(y1-x1)*(one-x1/x2)) yi3 = -(cscgam/(xpt_b11s(x_i)*rxs(x_i)))*(LOG(x2/x1) $ -(cosvt-cotgam*sinvt)*(x2-x1)/rxs(x_i) $ +sinvt*(y1-x1)*(one-x1/x2)/rxs(x_i)) From 57a42629d3bf1fb5afbeb65548e8eff19223c962 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 6 Jun 2024 16:42:24 -0400 Subject: [PATCH 39/97] simplify vartheta calculation since nu(1) should always be greater than oangle --- equil/direct.f | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 86a8ec76..523b89a8 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1076,11 +1076,7 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, c defining rotated saddle-point coordinate frame to extract linear c component. c----------------------------------------------------------------------- - IF (oangle>nu(2)) THEN - vartheta = nu(1)-pi/2.0 - ELSE - vartheta = nu(2)-pi/2.0 - ENDIF + vartheta = nu(1)-pi/2.0 vartheta = vartheta - twopi*floor(vartheta/twopi) r = r_eps(ir)*rx From 980973df8fb89a258a4cb4e5a63e921b5eec769d Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Mon, 10 Jun 2024 17:06:41 -0400 Subject: [PATCH 40/97] direct_analytic_ints debugged, tested and working for all jacobians save power_bp =/= 0 --- equil/direct.f | 60 ++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 53 insertions(+), 7 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 523b89a8..c754e86a 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -21,6 +21,7 @@ c 12. direct_initialise_xpoints. c 13. direct_saddle_coords. c 14. direct_saddle_coords_inv. +c 15. direct_analytic_ints. c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. @@ -1604,14 +1605,29 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, LOGICAL, INTENT(IN) :: debug REAL(r8), INTENT(OUT) :: yi1,yi2,yi3,yi4 - REAL(r8), DIMENSION(1:3,1:2,0:1),INTENT(OUT) :: outmat + REAL(r8), DIMENSION(1:4,1:2,0:1),INTENT(OUT) :: outmat REAL(r8) :: x1,y1,x2,y2,chi,I1,I2,I3,bt,b,root,xo,yo,chio + REAL(r8) :: y3d,y3r1,y3r2,singmt,a,c,yi2b,yi3b REAL(r8) :: cosvt,sinvt,cotgam,singam,cscgam,etax,vartheta,gamma TYPE(direct_bfield_type) :: bf outmat=0.0 c----------------------------------------------------------------------- +c Asymptotic assumptions that are necessary for the formulas used +c in this function +c----------------------------------------------------------------------- +c chi/a<<1 must be a small number, x/a<<1 must be a small number +c ^Important for the definition of Bp as a linear term +c ^a here is minor radius. chi and x calculated by +c direct_saddle_coords +c |Bp|/|Bt|<<1 must be a small number +c ^important for ignoring |Bp| when calculating |B|. +c I don't think x1/x2 necessarily has to be small, however I'll +c still double check. +c Initial observation shows that y(2) - aka minor radius has its +c error grow the fastest as the above assumptions are relaxed +c----------------------------------------------------------------------- c getting local coordinates. c----------------------------------------------------------------------- CALL direct_saddle_coords(x_i,r1,eta1,x1,y1,chi) @@ -1632,10 +1648,13 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, cotgam = one/TAN(gamma) singam = SIN(gamma) + singmt = SIN(gamma-vartheta) cscgam = one/singam etax = xpt_etas(x_i) + CALL direct_get_bfield(rxs(x_i),zxs(x_i),bf,1) bt=abs(bf%f/rxs(x_i)) + b=bt c----------------------------------------------------------------------- c calculating x2 by assuming logarithmic Bp trajectory near x-point. c----------------------------------------------------------------------- @@ -1646,12 +1665,14 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, y2 = (x2-xo)*TAN(eta2-vartheta)+yo c----------------------------------------------------------------------- c outputting coordinate information. +c outmat(1,1,0) = x1, outmat(1,2,0) = y1 c outmat(2,1,0) = R1, outmat(2,2,0) = Z1 c outmat(3,1,0) = rho1, outmat(3,2,0) = eta1 +c outmat(1,1,1) = x2, outmat(1,2,1) = y2 c outmat(2,1,1) = R2, outmat(2,2,1) = Z2 c outmat(3,1,1) = rho2, outmat(3,2,1) = eta2 c 1 and 2 refer to initial and final point respectively. rho is -c minor radius, eta poloidal angle. an output yi2=rho2=outmat(3,1,1) +c minor radius, eta poloidal angle. output yi2=rho2=outmat(3,1,1) c----------------------------------------------------------------------- IF(debug)THEN outmat(1,1,0)=x1 @@ -1665,17 +1686,42 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, CALL direct_saddle_coords_inv(x_i,x2,y2,outmat(2,1,1), $ outmat(2,2,1),outmat(3,1,1),outmat(3,2,1)) c----------------------------------------------------------------------- -c evaluating integrals +c evaluating y1 c----------------------------------------------------------------------- yi1 = -(cscgam/xpt_b11s(x_i))*(rxs(x_i)*LOG(x2/x1) $ +(cosvt-cotgam*sinvt)*(x2-x1)+sinvt*(y1-x1)*(x1/x2-one)) +c----------------------------------------------------------------------- +c evaluating y2 +c----------------------------------------------------------------------- yi2=outmat(3,1,1) - !yi2 = -(cscgam/xpt_b11s(x_i))*abs(-SIN(etax+gamma - !$ -vartheta)*(x2-x1) - !$ +singam*SIN(etax-vartheta)*(y1-x1)*(one-x1/x2)) - yi3 = -(cscgam/(xpt_b11s(x_i)*rxs(x_i)))*(LOG(x2/x1) + + !The following formula is wrong... + IF(debug)yi2b = -(cscgam/xpt_b11s(x_i))*abs(-SIN(etax+gamma + $ -vartheta)*(x2-x1) + $ +singam*SIN(etax-vartheta)*(y1-x1)*(one-x1/x2)) +c----------------------------------------------------------------------- +c evaluating y3 +c----------------------------------------------------------------------- + a=cscgam*singmt + c=x1*(x1-y1)*sinvt + + y3d=rxs(x_i)**2-4*a*c + + y3r1=(one/(2*a))*(-rxs(x_i)+SQRT(y3d)) + y3r2=(one/(2*a))*(-rxs(x_i)-SQRT(y3d)) + + yi3 = -(cscgam/xpt_b11s(x_i))*(one/SQRT(y3d))* + $ LOG((x2-y3r1)*(x1-y3r2)/((x2-y3r2)*(x1-y3r1))) + IF(debug)yi3b = -(cscgam/(xpt_b11s(x_i)*rxs(x_i)))*(LOG(x2/x1) $ -(cosvt-cotgam*sinvt)*(x2-x1)/rxs(x_i) $ +sinvt*(y1-x1)*(one-x1/x2)/rxs(x_i)) + + IF(debug)THEN + outmat(4,1,0)=yi2 + outmat(4,1,1)=yi2b + outmat(4,2,0)=yi3 + outmat(4,2,1)=yi3b + ENDIF c----------------------------------------------------------------------- c y4 special case. c----------------------------------------------------------------------- From d2279dce35bf50c378b1fddec9ea462e95d31542 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Tue, 11 Jun 2024 17:13:27 -0400 Subject: [PATCH 41/97] adding ff construction in direct_mixed_spline_builder IMPORTANT: ff$fs(:,3) is misbehaving here --- equil/direct.f | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index c754e86a..a20fc8d6 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1778,6 +1778,28 @@ SUBROUTINE direct_mixed_spline_builder(psifac) c----------------------------------------------------------------------- IF(num_xpts==1)THEN c----------------------------------------------------------------------- +c calling direct_analytic_ints on the initial x-point over full eta +c span. Note we don't need to call find_fl_surface, direct_xpoint +c since these were already called for this x-point in direct_run's +c psi loop +c----------------------------------------------------------------------- + + CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + CALL direct_get_bfield(r,z,bf,1) + + DO i=1,nstep2,+1 + eta=xpt_brackets(1,1)+(xpt_brackets(1,2)- + $ xpt_brackets(1,1))*(one*i/nstep2) + yi1(i,0)=eta + + CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1) + $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.FALSE.) + verbose=.FALSE. + IF(debug)CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, + $ y_out1,bf,len_y1_out) + ENDDO +c----------------------------------------------------------------------- c ordering the two etas for numerical field line integration c----------------------------------------------------------------------- eta1 = xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) @@ -1895,7 +1917,47 @@ SUBROUTINE direct_mixed_spline_builder(psifac) CALL find_fl_surface(one,xpt_etas(num_xpts),r,z) CALL direct_xpoint(r,z,num_xpts) ENDDO +c----------------------------------------------------------------------- +c adding consecutive integral sections +c----------------------------------------------------------------------- + yi1(:,1)=yi1(:,1)+y_out1(len_y1_out,1) + yi1(:,3)=yi1(:,3)+y_out1(len_y1_out,3) + yi1(:,4)=yi1(:,4)+y_out1(len_y1_out,4) +c----------------------------------------------------------------------- +c constructing ff +c----------------------------------------------------------------------- + tot_steps=istep+nstep2 + CALL spline_alloc(ff,tot_steps,4) + ff%xs(0:istep)=y_out1(0:istep,4)/yi1(nstep2,4) + ff%fs(0:istep,1)=y_out1(0:istep,2)**2 + !ff%fs(0:istep,2)=y_out1(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,2)=(y_out1(0:istep,0)/twopi+one)-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* + $ (y_out1(0:istep,3)-ff%xs(0:istep)*yi1(nstep2,3)) + ff%fs(0:istep,4)=y_out1(0:istep,1)/yi1(nstep2,1)-ff%xs + + i1=istep+1 + i2=tot_steps + ff%xs(i1:i2)=yi1(1:nstep2,4)/yi1(nstep2,4) + ff%fs(i1:i2,1)=yi1(1:nstep2,2)**2 + !ff%fs(i1:i2,2)=(yi1(1:nstep2,0)/twopi-ff%xs(i1:i2) + ff%fs(i1:i2,2)=(yi1(1:nstep2,0)/twopi+one)-ff%xs(i1:i2) + ff%fs(i1:i2,3)=bf%f* + $ (yi1(1:nstep2,3)-ff%xs(i1:i2)*yi1(nstep2,3)) + ff%fs(i1:i2,4)=yi1(1:nstep2,1)/yi1(nstep2,1)-ff%xs(i1:i2) + + PRINT "(A)", "O ELLO THERE" + PRINT "(es20.10)", ff%fs(0,1) + !PRINT "(es20.10)", yi1(nstep2,3) + !PRINT "(es20.10)", ff%fs(i2,3) + !PRINT "(i6)", i2 + + y_out1_max=yi1(nstep2,1) + y_out3_max=yi1(nstep2,3) + + + CALL spline_fit(ff,"periodic") ELSE c----------------------------------------------------------------------- c 2 x-points: making sure all brackets are in [0,2pi) From 81e63487e3d1631d85e91959c58ec6fae59f3851 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 14:28:07 -0400 Subject: [PATCH 42/97] case of x-point slightly outside separatrix now automatically sets usevth2 =FALSE for that x-point, as that method will introduce big error in the x-point angles --- equil/direct.f | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a20fc8d6..96e3403a 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -39,9 +39,10 @@ MODULE direct_mod REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_b11s REAL(r8), DIMENSION(1:2) :: xpt_gammas, xpt_varthetas REAL(r8), DIMENSION(1:2) :: xpt_gammas2, xpt_varthetas2 + LOGICAL, DIMENSION(1:2) :: outside_sep,usevth2 REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in - LOGICAL :: direct_infinite_loop_flag, usevth2=.TRUE. + LOGICAL :: direct_infinite_loop_flag INTEGER :: direct_infinite_loop_count = 2000 INTEGER :: num_xpts @@ -1165,12 +1166,15 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) rxs(x_i) = r zxs(x_i) = z c----------------------------------------------------------------------- -c checks if outside separatrix. ended up not needing... +c checks if outside separatrix. c----------------------------------------------------------------------- - !IF (bf%psi < -psi_eps*psio) THEN - ! near_sep = .FALSE. - ! RETURN - !ENDIF + IF (bf%psi < -psi_eps*psio) THEN + outside_sep(x_i)=.TRUE. + usevth2(x_i)=.FALSE. + ELSE + outside_sep(x_i)=.FALSE. + usevth2(x_i)=.TRUE. + ENDIF c----------------------------------------------------------------------- c updating xpt_etas with a more exact value than that calculated by c direct_initialise_xpoints. @@ -1250,11 +1254,17 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) c----------------------------------------------------------------------- c making sure there isn't much difference between the varthetas and c gamma angles asymptotically close to the x-point vs at the -c switch-over location -c----------------------------------------------------------------------- - IF(ABS(xpt_varthetas(x_i)-xpt_varthetas2(x_i))>twopi/100 .OR. - $ ABS(xpt_gammas2(x_i)-xpt_gammas(x_i))>twopi/100)THEN - PRINT "(A)", "Straight x-point leg assumption bad," +c switch-over location. Note if the x-point is slightly outside the +c separatrix such that outside_sep(x_i)=.TRUE., xpt_varthetas2 +c amd xpt_gammas2 will have big error and should not be used. +c----------------------------------------------------------------------- + IF((ABS(xpt_varthetas(x_i)-xpt_varthetas2(x_i))>twopi/100 .OR. + $ ABS(xpt_gammas2(x_i)-xpt_gammas(x_i))>twopi/100) .AND. + $ (.NOT.outside_sep(x_i)))THEN + PRINT "(A)", "Straight x-point leg assumption bad for Xpt" + !PRINT "(i6)", x_i + !PRINT "(es16.10)", xpt_gammas(x_i)/pi + !PRINT "(es16.10)", xpt_gammas2(x_i)/pi CALL program_stop("increase dq_eps.") ENDIF c----------------------------------------------------------------------- @@ -1499,7 +1509,7 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) c----------------------------------------------------------------------- cosfac=COS(eta1) sinfac=SIN(eta1) - IF(usevth2)THEN + IF(usevth2(x_i))THEN cosfact=COS(xpt_varthetas2(x_i)) sinfact=SIN(xpt_varthetas2(x_i)) ELSE @@ -1527,7 +1537,7 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) c orthogonal to the x-point leg that leaves the c x-point when travelling anticlockwise around the separatrix. c----------------------------------------------------------------------- - IF(usevth2)THEN + IF(usevth2(x_i))THEN chi = -COS(xpt_gammas2(x_i))*x+SIN(xpt_gammas2(x_i))*y ELSE chi = -COS(xpt_gammas(x_i))*x+SIN(xpt_gammas(x_i))*y @@ -1557,7 +1567,7 @@ SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta) c----------------------------------------------------------------------- c precalculating trig components. c----------------------------------------------------------------------- - IF(usevth2)THEN + IF(usevth2(x_i))THEN cosfact=COS(xpt_varthetas2(x_i)) sinfact=SIN(xpt_varthetas2(x_i)) ELSE @@ -1635,7 +1645,7 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, c----------------------------------------------------------------------- c pre-calculationg useful terms c----------------------------------------------------------------------- - IF(usevth2)THEN + IF(usevth2(x_i))THEN vartheta=xpt_varthetas2(x_i) gamma=xpt_gammas2(x_i) ELSE From 5ea8796550166fc9b55f0ff0d584e13c2d185921 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 14:31:19 -0400 Subject: [PATCH 43/97] aded new function find_fl_surface2: finds r,z given psi, eta. Uses a bisection method instead of the Newton method used in find_fl_surface, motivated by special cases --- equil/direct.f | 144 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 142 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 96e3403a..43fbd621 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -11,6 +11,7 @@ c 3. direct_position. c 4. direct_fl_int. c 4.5 find_fl_surface. +c 4.6 find_fl_surface2. c 5. direct_fl_der. c 6. direct_refine. c 7. direct_output. @@ -644,8 +645,9 @@ SUBROUTINE find_fl_surface(psifac,eta,r,z) ir = ir+1 IF (ir > direct_infinite_loop_count) THEN - direct_infinite_loop_flag = .TRUE. - CALL program_stop("Took too many steps to find flux surf.") + PRINT"(A)","find_fl_surface failed, using find_fl_surface2" + CALL find_fl_surface2(psifac,eta,radius,r,z) + EXIT ENDIF ENDDO c----------------------------------------------------------------------- @@ -654,6 +656,144 @@ SUBROUTINE find_fl_surface(psifac,eta,r,z) RETURN END SUBROUTINE find_fl_surface c----------------------------------------------------------------------- +c subprogram 4.6. find_fl_surface2. +c finds r,z given psi, eta. Uses a bisection method instead of the +c Newton method used in find_fl_surface, motivated by special cases. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE find_fl_surface2(psifac,eta,radius1,r,z) + + REAL(r8), INTENT(IN) :: psifac,eta,radius1 + REAL(r8), INTENT(OUT) :: r,z + + TYPE(direct_bfield_type) :: bf + REAL(r8), PARAMETER :: eps=1e-13 + INTEGER :: ir + REAL(r8) :: cosfac,sinfac,dradius1,dfdradius,psi0,pos + REAL(r8) :: rbrack_l,rbrack_h,dradius2,dradius3 + + REAL(r8), DIMENSION(1:3) :: radii + + pos=one + rbrack_l=1e-1 + rbrack_h=1e-5 +c----------------------------------------------------------------------- +c find flux surface. +c----------------------------------------------------------------------- + cosfac=COS(eta) + sinfac=SIN(eta) + + psi0=psio*(1-psifac) +c----------------------------------------------------------------------- +c finding lower bound within chosen surface. +c dradius1 should always be greater than 0. +c----------------------------------------------------------------------- + ir=0 + DO + r=ro+cosfac*radius1*(one-rbrack_l) + z=zo+sinfac*radius1*(one-rbrack_l) + CALL direct_get_bfield(r,z,bf,1) + dfdradius = -bf%psir*cosfac-bf%psiz*sinfac + dradius1 = -(psi0-bf%psi)/dfdradius + IF(dradius1<0.0)THEN + rbrack_l=rbrack_l*10 + IF(rbrack_l>radius1)THEN + CALL program_stop("find_fl_surface2 failed.") + ENDIF + ELSE + EXIT + ENDIF + + ir=ir+1 + IF (ir > direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to get rbrack_l.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c finding upper bound outside chosen surface +c dradius3 should always be less than 0. +c----------------------------------------------------------------------- + ir=0 + DO + r=ro+cosfac*radius1*(one+rbrack_h) + z=zo+sinfac*radius1*(one+rbrack_h) + CALL direct_get_bfield(r,z,bf,1) + dfdradius = -bf%psir*cosfac-bf%psiz*sinfac + dradius3 = -(psi0-bf%psi)/dfdradius + IF(dradius3>0.0)THEN + rbrack_h=rbrack_h*10 + IF(rbrack_h>radius1)THEN + CALL program_stop("find_fl_surface2 failed.") + ENDIF + ELSE + EXIT + ENDIF + + ir=ir+1 + IF (ir > direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to get rbrack_h.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c looping to narrow radii-intervals +c----------------------------------------------------------------------- + radii(1)=radius1-rbrack_l + radii(3)=radius1+rbrack_h + + ir=0 + DO + radii(2) = 0.5*(radii(3)+radii(1)) + IF(0.5*(radii(3)-radii(1)) < eps*ro)EXIT + + r=ro+cosfac*radii(1) + z=zo+sinfac*radii(1) + CALL direct_get_bfield(r,z,bf,1) + dfdradius = -bf%psir*cosfac-bf%psiz*sinfac + dradius1 = -(psi0-bf%psi)/dfdradius + + r=ro+cosfac*radii(2) + z=zo+sinfac*radii(2) + CALL direct_get_bfield(r,z,bf,1) + dfdradius = -bf%psir*cosfac-bf%psiz*sinfac + dradius2 = -(psi0-bf%psi)/dfdradius + + r=ro+cosfac*radii(3) + z=zo+sinfac*radii(3) + CALL direct_get_bfield(r,z,bf,1) + dfdradius = -bf%psir*cosfac-bf%psiz*sinfac + dradius3 = -(psi0-bf%psi)/dfdradius + + IF(dradius3>0.0 .OR. dradius1<0.0) + $ CALL program_stop("find_fl_surface2 error, needs debug.") + + IF(dradius2<0.0)THEN + radii(3)=radii(2) + ELSE + radii(1)=radii(2) + ENDIF + + ir=ir+1 + IF (ir > direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("find_fl_surface2 failed.") + ENDIF + !PRINT "(es25.14)",radii(2) + ENDDO +c----------------------------------------------------------------------- +c calculating r, z. +c----------------------------------------------------------------------- + r=ro+cosfac*radii(2) + z=zo+sinfac*radii(2) +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE find_fl_surface2 +c----------------------------------------------------------------------- c subprogram 5. direct_fl_der. c contains differential equations for field line averages. c----------------------------------------------------------------------- From 199c744ff098aaddfb0e320f80dbfed1d1d8fb01 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 14:32:36 -0400 Subject: [PATCH 44/97] cleaning up direct_psisaddle --- equil/direct.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 43fbd621..cc6387bf 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1161,10 +1161,10 @@ END SUBROUTINE direct_saddle_angle c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_psisaddle(rx,zx,oangle, + SUBROUTINE direct_psisaddle(rx,zx, $ nu,b11,gamma,vartheta,lincheck) - REAL(r8), INTENT(IN) :: rx,zx,oangle + REAL(r8), INTENT(IN) :: rx,zx REAL(r8), DIMENSION(2), INTENT(IN) :: nu REAL(r8), INTENT(OUT) :: b11,lincheck,gamma,vartheta @@ -1180,7 +1180,7 @@ SUBROUTINE direct_psisaddle(rx,zx,oangle, r_eps(2) = 1e-8 r_eps(3) = 1e-9 r_eps(4) = 1e-10 - ir=3 + ir=1 c----------------------------------------------------------------------- c finding correct initialisation point for nuh (read nu-half). c gamma should be less than pi for a real x-point From b720407da67ec6d9efed8ff983a7cfc55b28ef2b Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 14:37:32 -0400 Subject: [PATCH 45/97] direct_fl_int print statments improved --- equil/direct.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index cc6387bf..4ec85c3b 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -519,7 +519,7 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) $ "z",9x,"psi",8x,"err"/) 30 FORMAT(i4,1p,8e11.3) 40 FORMAT(a,i4,a,es10.3,a,i3) - 51 FORMAT(1x,"psifac =",es10.3) + 51 FORMAT(1x,"psifac =",f18.15) 61 FORMAT(1x,"direct_int:",i6," steps taken of max",i6,".") 11 FORMAT(1x,"Incomplete: eta=",es10.2," of [",es10.2,",",es10.2,"]") c----------------------------------------------------------------------- @@ -598,6 +598,8 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) CALL program_stop(message2) ELSE WRITE(message,61)istep,nstepd + WRITE(message2,51)psifac + IF(verbose)PRINT "(A)", message2 IF(verbose)PRINT "(A)", message ENDIF len_y_out = istep From 284b604b17973a45674f35555cc0687bcaddc8c7 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 14:45:09 -0400 Subject: [PATCH 46/97] direct_xpoint now has optional print statements for direct_local_xpoint and direct_saddle_angle --- equil/direct.f | 89 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 60 insertions(+), 29 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 4ec85c3b..a5aeae9d 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1279,26 +1279,32 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) c testing direct_local_xpoint. c----------------------------------------------------------------------- IF(test_direct_local_xpoint)THEN + PRINT "(A)", "__________________________________________" + PRINT "(A)", "direct_local_xpoint output =>" + PRINT "(A)", "X-point number:" + PRINT "(i6)", x_i CALL direct_get_bfield(ro,zo,bf,1) - PRINT "(A)", "psi at origin" - PRINT "(f16.10)", bf%psi - PRINT "(A)", "r,z b4 direct_local_xpoint" - PRINT "(f16.5)", r - PRINT "(f16.5)", z + PRINT "(A)", "psi at origin:" + PRINT "(f20.14)", bf%psi + PRINT "(A)", "r,z before direct_local_xpoint:" + PRINT "(f16.10)", r + PRINT "(f16.10)", z CALL direct_get_bfield(r,z,bf,1) - PRINT "(A)", "|Bp| b4 direct_local_xpoint" - PRINT "(f16.10)", SQRT(bf%br**2+bf%bz**2) - PRINT "(A)", "psi b4 direct_local_xpoint" - PRINT "(f16.10)", bf%psi + PRINT "(A)", "|Bp| before direct_local_xpoint:" + PRINT "(f20.14)", SQRT(bf%br**2+bf%bz**2) + PRINT "(A)", "psi before direct_local_xpoint:" + PRINT "(f20.14)", bf%psi CALL direct_local_xpoint(r,z) - PRINT "(A)", "r,z aftr direct_local_xpoint" - PRINT "(f16.5)", r - PRINT "(f16.5)", z + PRINT "(A)", "r,z after direct_local_xpoint:" + PRINT "(f16.10)", r + PRINT "(f16.10)", z CALL direct_get_bfield(r,z,bf,1) - PRINT "(A)", "|Bp| after direct_local_xpoint" - PRINT "(f16.10)", SQRT(bf%br**2+bf%bz**2) - PRINT "(A)", "psi after direct_local_xpoint" - PRINT "(f16.10)", bf%psi + PRINT "(A)", "|Bp| after direct_local_xpoint:" + PRINT "(f20.14)", SQRT(bf%br**2+bf%bz**2) + PRINT "(A)", "psi after direct_local_xpoint:" + PRINT "(f20.14)", bf%psi + !PRINT "(A)", "direct_local_xpoint output <=" + PRINT "(A)", "------------------------------------------" ENDIF c----------------------------------------------------------------------- c finds x-point and fills out global module variables @@ -1347,25 +1353,28 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) $ 'n',Bnub) CALL direct_Blocal(rxs(x_i),zxs(x_i),nu(2),r_eps1*rxs(x_i), $ 'n',Bnuc) - PRINT "(A)", "First x-point leg's angle nu:" - PRINT "(f16.3)", nu(1)/pi - PRINT "(A)", "First leg B_nu" - PRINT "(e16.3)", Bnua + PRINT "(A)", "__________________________________________" + PRINT "(A)", "direct_saddle_angle output =>" + PRINT "(A)", "first x-point leg's angle nu:" + PRINT "(f17.14)", nu(1)/pi + PRINT "(A)", "first leg B_nu:" + PRINT "(es16.3)", Bnua PRINT "(A)", "nu angle pointing from x-pt to mag. axis:" - PRINT "(f16.3)", oangle/pi + PRINT "(f17.14)", oangle/pi PRINT "(A)", "B_nu at angle pointing from x-pt to mag. axis:" - PRINT "(e16.3)", Bnub - PRINT "(A)", "Second x-point leg's angle nu:" - PRINT "(f16.3)", nu(2)/pi - PRINT "(A)", "Second leg B_nu" - PRINT "(e16.3)", Bnuc - PRINT "(A)", "Angle between x-point legs (gamma)" - PRINT "(f16.3)", (nu(1)-nu(2))/pi + PRINT "(es16.3)", Bnub + PRINT "(A)", "second x-point leg's angle nu:" + PRINT "(f17.14)", nu(2)/pi + PRINT "(A)", "second leg B_nu:" + PRINT "(es16.3)", Bnuc + PRINT "(A)", "angle between x-point legs (gamma):" + PRINT "(f17.14)", (nu(1)-nu(2))/pi + PRINT "(A)", "------------------------------------------" ENDIF c----------------------------------------------------------------------- c calculating xpoint angles gamma, vartheta, and linear term b11. c----------------------------------------------------------------------- - CALL direct_psisaddle(r,z,oangle,nu,b11,gamma,vartheta,lincheck) + CALL direct_psisaddle(r,z,nu,b11,gamma,vartheta,lincheck) c----------------------------------------------------------------------- c filling out x-point module variables. c----------------------------------------------------------------------- @@ -1381,6 +1390,28 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) CALL find_fl_surface(one,xpt_brackets(x_i,2),r,z) nu(2)=ATAN2(z-zxs(x_i),r-rxs(x_i)) c----------------------------------------------------------------------- +c some useful debugging statements. +c----------------------------------------------------------------------- + !IF(x_i==2)THEN + ! xpt_brackets(x_i,1)=xpt_etas(x_i)-1e-3 + ! xpt_brackets(x_i,2)=xpt_etas(x_i)+1e-3 + !ENDIF + + !CALL direct_get_bfield(rxs(x_i),zxs(x_i),bf,1) + + !IF(x_i==2)THEN + ! CALL direct_get_bfield(rxs(x_i),zxs(x_i),bf,1) + ! CALL find_fl_surface(one,xpt_brackets(x_i,1),r,z) + ! nu(1)=ATAN2(z-zxs(x_i),r-rxs(x_i)) + ! PRINT "(A)", "First x-point leg's angle nu (mthd 2):" + ! PRINT "(f17.14)", nu(1)/pi + ! CALL find_fl_surface(bf%f,xpt_brackets(x_i,2),r,z) + ! nu(2)=ATAN2(z-zxs(x_i),r-rxs(x_i)) + ! PRINT "(A)", "Second x-point leg's angle nu (mthd 2):" + ! PRINT "(f17.14)", nu(2)/pi + !ELSE + !ENDIF +c----------------------------------------------------------------------- c defining xpt_varthetas2, xpt_gammas2. these angles are c calculated out at the eta-location where we switch from numerical c to analytic integrals (xpt_brackets), instead of asymptotically From 98b83536c091848275bb6a4be6938b2255cc6f95 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 17:29:28 -0400 Subject: [PATCH 47/97] preparing direct_run to recieve direct_mixed_spline_builder --- equil/direct.f | 110 +++++++++++++++++++++++++++++-------------------- 1 file changed, 66 insertions(+), 44 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a5aeae9d..454756c8 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -23,6 +23,7 @@ c 13. direct_saddle_coords. c 14. direct_saddle_coords_inv. c 15. direct_analytic_ints. +c 16. direct_mixed_spline_builder. c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. @@ -52,8 +53,10 @@ MODULE direct_mod REAL(r8) :: br,bz,brr,brz,bzr,bzz END TYPE direct_bfield_type - REAL(r8) :: etol=1e-8 + REAL(r8) :: etol=1e-8, dqdeps_tol=300, BpBt_tol=0.001 INTEGER :: nstepd=2048 + INTEGER :: nstep2=2048 + REAL(r8) :: xcheck=0.99 CONTAINS c----------------------------------------------------------------------- @@ -68,13 +71,14 @@ SUBROUTINE direct_run INTEGER :: ir,iz,itheta,ipsi,len_y_out,len_y_last INTEGER :: maxima_count,i REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q,flast - REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out, y_out_last + REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out_last + REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4) :: y_out,y_outa REAL(r8), DIMENSION(2, mpsi+1) :: xdx REAL(r8), DIMENSION(3,3) :: v REAL(r8), DIMENSION(3,2) :: eta_brackets REAL(r8), DIMENSION(3) :: eta_maxes - LOGICAL :: use_analytic,run_xpt + LOGICAL :: use_analytic,run_xpt,debug,xmsg REAL(r8) :: xm,dx,rholow,rhohigh,rx,zx TYPE(direct_bfield_type) :: bf @@ -82,12 +86,15 @@ SUBROUTINE direct_run use_analytic=.FALSE. run_xpt=.TRUE. + debug=.FALSE. + xmsg=.TRUE. xpt_etas=0.0 xpt_brackets=0.0 eta_maxes=0.0 eta_brackets=0.0 num_xpts=0 maxima_count=0 + y_outa=0 c----------------------------------------------------------------------- c warning. c----------------------------------------------------------------------- @@ -165,16 +172,18 @@ SUBROUTINE direct_run c integral formulas near separatrix. c----------------------------------------------------------------------- IF(use_analytic .AND. run_xpt)THEN - CALL direct_mixed_spline_builder(sq%xs(ipsi)) + CALL direct_mixed_spline_builder(sq%xs(ipsi),ff,y_out,debug) + istep=SIZE(ff%xs,1)-1 ELSE CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_out,bf, $ len_y_out) c----------------------------------------------------------------------- c checks whether q-integral is diverging. c----------------------------------------------------------------------- - IF(sq%xs(ipsi)>0.999 .AND. run_xpt)THEN + IF(sq%xs(ipsi)>xcheck .AND. run_xpt)THEN CALL direct_initialise_xpoints(y_out,len_y_out,.TRUE., - $ .TRUE.,bf,10*one,eta_maxes,eta_brackets,maxima_count) + $ .FALSE.,bf,dqdeps_tol,BpBt_tol,eta_maxes, + $ eta_brackets,maxima_count) IF(maxima_count > 0 .AND. run_xpt)THEN use_analytic = .TRUE. @@ -188,61 +197,74 @@ SUBROUTINE direct_run CALL find_fl_surface(one,xpt_etas(i),rx,zx) CALL direct_xpoint(rx,zx,i) ENDDO - CYCLE +c----------------------------------------------------------------------- +c no x-points found, fit numerically integrated +c data to cubic splines +c----------------------------------------------------------------------- + ELSE + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* + $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs + CALL spline_fit(ff,"periodic") ENDIF - ENDIF + ELSE c----------------------------------------------------------------------- -c fit data to cubic splines. +c if not diverging, fit numerically integrated data to cubic splines c----------------------------------------------------------------------- - CALL spline_alloc(ff,istep,4) - ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) - ff%fs(0:istep,1)=y_out(0:istep,2)**2 - ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) - ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs - CALL spline_fit(ff,"periodic") + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs + CALL spline_fit(ff,"periodic") + ENDIF + ENDIF c----------------------------------------------------------------------- c allocate space for rzphi and define grids. c----------------------------------------------------------------------- - IF(ipsi == 0)THEN - IF(mtheta == 0)mtheta=istep - CALL bicube_alloc(rzphi,mpsi,mtheta,4) !change mtheta - CALL bicube_alloc(eqfun,mpsi,mtheta,3) ! new eq information - rzphi%xs=sq%xs - rzphi%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) - rzphi%xtitle="psifac" - rzphi%ytitle="theta " - rzphi%title=(/" r2 "," deta "," dphi "," jac "/) ! deta = eta - theta, dphi = phi - zeta - eqfun%title=(/" b0 "," "," " /) - eqfun%xs=sq%xs - eqfun%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) - ENDIF + IF(ipsi == 0)THEN + IF(mtheta == 0)mtheta=istep + CALL bicube_alloc(rzphi,mpsi,mtheta,4) !change mtheta + CALL bicube_alloc(eqfun,mpsi,mtheta,3) ! new eq information + rzphi%xs=sq%xs + rzphi%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) + rzphi%xtitle="psifac" + rzphi%ytitle="theta " + rzphi%title=(/" r2 "," deta "," dphi "," jac "/) ! deta = eta - theta, dphi = phi - zeta + eqfun%title=(/" b0 "," "," " /) + eqfun%xs=sq%xs + eqfun%ys=(/(itheta,itheta=0,mtheta)/)/REAL(mtheta,r8) + ENDIF c----------------------------------------------------------------------- c interpolate to uniform grid. c----------------------------------------------------------------------- - DO itheta=0,mtheta - CALL spline_eval(ff,rzphi%ys(itheta),1) - rzphi%fs(ipsi,itheta,1:3)=ff%f(1:3) - rzphi%fs(ipsi,itheta,4)=(1+ff%f1(4)) + DO itheta=0,mtheta + CALL spline_eval(ff,rzphi%ys(itheta),1) + rzphi%fs(ipsi,itheta,1:3)=ff%f(1:3) + rzphi%fs(ipsi,itheta,4)=(1+ff%f1(4)) $ *y_out(istep,1)*twopi*psio - ENDDO + ENDDO c----------------------------------------------------------------------- c store surface quantities. c----------------------------------------------------------------------- - sq%fs(ipsi,1)=bf%f*twopi - sq%fs(ipsi,2)=bf%p - sq%fs(ipsi,3)=y_out(istep,1)*twopi*psio - sq%fs(ipsi,4)=y_out(istep,3)*bf%f/twopi - CALL spline_dealloc(ff) + sq%fs(ipsi,1)=bf%f*twopi + sq%fs(ipsi,2)=bf%p + sq%fs(ipsi,3)=y_out(istep,1)*twopi*psio + sq%fs(ipsi,4)=y_out(istep,3)*bf%f/twopi + CALL spline_dealloc(ff) c----------------------------------------------------------------------- c log maximum y_out, flast for x-point plotting. c----------------------------------------------------------------------- - IF (ipsi == mpsi) THEN - y_out_last = y_out - len_y_last=len_y_out - flast = bf%f*twopi - ENDIF + IF (ipsi == mpsi) THEN + y_out_last = y_out + len_y_last=len_y_out + flast = bf%f*twopi ENDIF ENDDO c----------------------------------------------------------------------- From fba20841aa467d37bb9801e2aebdbe449950bf3c Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 17:30:35 -0400 Subject: [PATCH 48/97] direct_run print and verbose statements added --- equil/direct.f | 52 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 50 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 454756c8..78de3bcc 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -82,7 +82,9 @@ SUBROUTINE direct_run REAL(r8) :: xm,dx,rholow,rhohigh,rx,zx TYPE(direct_bfield_type) :: bf - TYPE(spline_type) :: ff + TYPE(spline_type) :: ff,ffa + + CHARACTER(64) :: message use_analytic=.FALSE. run_xpt=.TRUE. @@ -95,11 +97,14 @@ SUBROUTINE direct_run num_xpts=0 maxima_count=0 y_outa=0 +412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) +413 FORMAT(1x,"ipsi =",i4,"/",i4) +414 FORMAT(1x,"psifac =",f13.10) c----------------------------------------------------------------------- c warning. c----------------------------------------------------------------------- direct_flag=.TRUE. - IF(psihigh >= 1-1e-6)WRITE(*,'(1x,a,es10.3,a)') + IF(psihigh >= 1-1e-6)WRITE(*,'(1x,a,e17.10,a)') $ "Warning: direct equilibrium with psihigh =",psihigh, $ " could hang on separatrix." direct_infinite_loop_flag = .FALSE. @@ -167,6 +172,16 @@ SUBROUTINE direct_run IF(verbose) WRITE(*,'(a,1p,es10.3)')" etol = ",etol IF(verbose) WRITE(*,'(a,1p,i6)')" nstepd = ",nstepd DO ipsi=0,mpsi,+1 + IF(verbose.AND.xmsg.AND.sq%xs(ipsi)>xcheck.AND.run_xpt)THEN + PRINT "(A)", "________________________________________________" + PRINT"(A)"," checking for x-points... =>" + xmsg=.FALSE. + ENDIF + + IF(verbose)WRITE(message,413)ipsi,mpsi + IF(verbose)PRINT "(A)", message + IF(verbose)WRITE(message,414)sq%xs(ipsi) + IF(verbose)PRINT "(A)", message c----------------------------------------------------------------------- c logic whether to integrate around whole field line or use analytic c integral formulas near separatrix. @@ -185,6 +200,28 @@ SUBROUTINE direct_run $ .FALSE.,bf,dqdeps_tol,BpBt_tol,eta_maxes, $ eta_brackets,maxima_count) + IF(debug)THEN + CALL ascii_open(out_xpt_unit,"y_out.csv","UNKNOWN") + DO i=0,len_y_out,+1 + WRITE(out_xpt_unit,412) + $ y_out(i,0), + $ y_out(i,1), + $ y_out(i,2), + $ y_out(i,3), + $ y_out(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + + + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* + $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs + ENDIF + IF(maxima_count > 0 .AND. run_xpt)THEN use_analytic = .TRUE. num_xpts=maxima_count @@ -197,6 +234,17 @@ SUBROUTINE direct_run CALL find_fl_surface(one,xpt_etas(i),rx,zx) CALL direct_xpoint(rx,zx,i) ENDDO + + IF(debug)THEN + CALL direct_mixed_spline_builder(sq%xs(ipsi), + $ ffa,y_outa,debug) + CALL direct_spline_comparison(ff,ffa,y_out,y_outa) + CALL program_stop("Running xpt debug, stopping") + ELSE + CALL direct_mixed_spline_builder(sq%xs(ipsi), + $ ff,y_out,debug) + istep=SIZE(ff%xs,1)-1 + ENDIF c----------------------------------------------------------------------- c no x-points found, fit numerically integrated c data to cubic splines From 51358470ed7be83e0cbbe804ffa497161f15d5ee Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 17:44:58 -0400 Subject: [PATCH 49/97] improving print statements in direct_fl_int --- equil/direct.f | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 78de3bcc..a91b5c50 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -590,7 +590,8 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) 30 FORMAT(i4,1p,8e11.3) 40 FORMAT(a,i4,a,es10.3,a,i3) 51 FORMAT(1x,"psifac =",f18.15) - 61 FORMAT(1x,"direct_int:",i6," steps taken of max",i6,".") + 61 FORMAT(3x,"integrator took",i6," steps of max",i6,".") + 62 FORMAT(3x,"non. div. integrator took",i6," steps of max",i6,".") 11 FORMAT(1x,"Incomplete: eta=",es10.2," of [",es10.2,",",es10.2,"]") c----------------------------------------------------------------------- c find flux surface. @@ -666,10 +667,11 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) PRINT "(A)", message PRINT "(A)", "Increase nstepd or decrease etol." CALL program_stop(message2) - ELSE + ELSEIF(verbose .AND. eta2==twopi .AND. eta1==zero)THEN WRITE(message,61)istep,nstepd - WRITE(message2,51)psifac - IF(verbose)PRINT "(A)", message2 + IF(verbose)PRINT "(A)", message + ELSEIF(verbose)THEN + WRITE(message,62)istep,nstepd IF(verbose)PRINT "(A)", message ENDIF len_y_out = istep From 971911904c06df3cbd373fc1da58ae3cef49c552 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 18:01:10 -0400 Subject: [PATCH 50/97] building ff and y_out for 1-xpoint in direct_mixed_spline_builder. Including deprecated print statements (will be removed next push) --- equil/direct.f | 573 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 527 insertions(+), 46 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a91b5c50..ff992230 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2004,30 +2004,49 @@ END SUBROUTINE direct_analytic_ints c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_mixed_spline_builder(psifac) + SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) - REAL(r8), INTENT(IN) :: psifac + REAL(r8), INTENT(INOUT) :: psifac + LOGICAL, INTENT(IN) :: debug_in - REAL(r8) :: eta,eta1,eta2,R,Z - REAL(r8) :: eta3,eta4,r_loc1,r_loc2,y_out1_max,y_out3_max - REAL(r8), DIMENSION(1:nstep2,0:4) :: yi1, yi2, yi_interim + REAL(r8) :: eta,eta1,eta2,R,Z,etat,y01,y02,y03,y04 + REAL(r8) :: bt1,bp1,bt2,bp2 + REAL(r8) :: eta3,eta4,r_loc1,r_loc2 + REAL(r8), DIMENSION(1:nstep2,0:4) :: yi1, yi2, yi_i REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out1,y_out2 + REAL(r8), DIMENSION(0:(nstepd+1),0:4) :: y_out2i + REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4) :: y_out + REAL(r8), DIMENSION(1:4,1:2,0:1) :: outmat INTEGER :: len_y1_out,len_y2_out,maxima_count,tot_steps,ist1,ist2 - INTEGER :: i1,i2,i - LOGICAL :: dbg1xpt + INTEGER :: i1,i2,i,j,k,eta0i + LOGICAL :: dbg1xpt,debug,out REAL(r8), DIMENSION(6,2) :: eta_brackets REAL(r8), DIMENSION(6) :: eta_maxes TYPE(direct_bfield_type) :: bf - TYPE(spline_type) :: ff + TYPE(spline_type) :: yi,ffi + TYPE(spline_type), INTENT(OUT) :: ff yi1=0.0 yi2=0.0 y_out1=0.0 y_out2=0.0 - dbg1xpt=.TRUE. + dbg1xpt=.FALSE. + debug=.FALSE. + out=.FALSE. +c----------------------------------------------------------------------- +c preparing print statements. +c----------------------------------------------------------------------- +400 FORMAT(/,"R_X",10x,"Z_X",11x,"r_x",10x,"eta_x"/) +401 FORMAT(/,"psi_fac=",f15.13/) +410 FORMAT(f12.10,",",f13.10,",",f12.10,",",f12.10) +411 FORMAT(f13.10,",",f13.10,",",f12.10,",",f13.10,",",f13.10 + $ ,",",f13.10,",",f12.10) +412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) +413 FORMAT(f13.10,",",f13.10,",",f13.10,",",f13.10,",",f12.10 + $ ,",",f13.10,",",f12.10,",",f13.10,",",f13.10,",",f12.10) c----------------------------------------------------------------------- c adddressing case of only one x-point. c----------------------------------------------------------------------- @@ -2043,17 +2062,317 @@ SUBROUTINE direct_mixed_spline_builder(psifac) r_loc1 = SQRT((r-ro)**2+(z-zo)**2) CALL direct_get_bfield(r,z,bf,1) + IF(out)CALL ascii_open(out_xpt_unit,"yi1.csv","UNKNOWN") + DO i=1,nstep2,+1 eta=xpt_brackets(1,1)+(xpt_brackets(1,2)- $ xpt_brackets(1,1))*(one*i/nstep2) yi1(i,0)=eta - + CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1) - $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.FALSE.) - verbose=.FALSE. + $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.TRUE.) + IF(debug)CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, $ y_out1,bf,len_y1_out) + + IF(i==nstep2)THEN + CALL direct_get_bfield(outmat(2,1,0),outmat(2,2,0),bf,1) + bp1=SQRT(bf%br**2+bf%bz**2) + bt1=bf%f/outmat(2,1,0) + CALL direct_get_bfield(outmat(2,1,1),outmat(2,2,1),bf,1) + bp2=SQRT(bf%br**2+bf%bz**2) + bt2=bf%f/outmat(2,1,1) + PRINT "(A,es10.3)"," max Bp/Bt (x-point)=", + $ MAX(bp1/bt1,bp2/bt2) + ENDIF + + IF(out)WRITE(out_xpt_unit,412) + $ eta, + $ yi1(i,1), + $ yi1(i,2), + $ yi1(i,3), + $ yi1(i,4) + ENDDO + + IF(out)CALL ascii_close(out_xpt_unit) +c----------------------------------------------------------------------- +c path prints. COMMENTED OUT +c----------------------------------------------------------------------- + IF(.FALSE.)THEN + nstep2=100 + PRINT "(A)", "STARTING THE PATH SHOW:::::::::::::::::::::::::" + + !xpt_brackets(1,1)=4.32562 + !xpt_brackets(1,2)=4.33276 + + + + CALL ascii_open(out_xpt_unit,"xpt.out","UNKNOWN") + k=1 + DO j=1,9,+3 + psifac=one-(10*one)**(-1-j) + DO k=1,4,+1 + CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + CALL direct_get_bfield(r,z,bf,1) + IF (k==1 .AND. j==1)THEN + PRINT "(A)", "Ro, Zo" + !WRITE(out_2d_unit) "(A)", "Ro, Zo" + PRINT "(f12.10,A,f12.10)",ro,",",zo + PRINT "(A)", "RX, ZX, rx, etax" + WRITE(out_xpt_unit,400) + PRINT 410,rxs(1),zxs(1),SQRT((ro-rxs(1))**2+ + $ (zo-zxs(1))**2),xpt_etas(1) + WRITE(out_xpt_unit,410)rxs(1),zxs(1), + $ SQRT((ro-rxs(1))**2+(zo-zxs(1))**2),xpt_etas(1) + PRINT "(A)", "Rsep, Zsep" + ELSE + IF(K==2 .AND. j==1)PRINT "(A)", "psifac:" + IF(K==2 .AND. j==1)THEN + PRINT "(f15.13)", psifac + WRITE(out_xpt_unit,401)psifac + ENDIF + IF(K==1 .AND. j>1)PRINT "(A)", "psifac:" + IF(K==1 .AND. j>1)THEN + PRINT "(f15.13)", psifac + WRITE(out_xpt_unit,401)psifac + ENDIF + IF (k==2)THEN + PRINT "(A)", "R_Numerical, Z_Numerical,r_num,eta_num" + etat=ATAN2(z-zo,r-ro) + etat=etat-twopi*floor(etat/twopi) + PRINT 410,r,z,SQRT((ro-r)**2+(zo-z)**2),etat + WRITE(out_xpt_unit,410)r,z, + $ SQRT((ro-r)**2+(zo-z)**2),etat + ENDIF + IF (k==3)THEN + PRINT "(A)", "R_A, Z_A,r_a,eta_a, origvarthetas" + usevth2(1)=.FALSE. + ENDIF + IF (k==4)THEN + PRINT "(A)", "R_A, Z_A,r_a,eta_a, new varthetas" + usevth2(1)=.TRUE. + ENDIF + + ENDIF + DO i=1,nstep2,+1 + eta=xpt_brackets(1,1)+(xpt_brackets(1,2)- + $ xpt_brackets(1,1))*(one*i/nstep2) + yi1(i,0)=eta + + !PRINT "(es16.9)", one*i/nstep2 + CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1) + $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.TRUE.) + verbose=.FALSE. + CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, + $ y_out1,bf,len_y1_out) + + IF (k==1 .AND. j==1)THEN !Sep values + CALL find_fl_surface(one,eta,r,z) + etat=ATAN2(z-zo,r-ro) + etat=etat-twopi*floor(etat/twopi) + PRINT 410,r,z,SQRT((ro-r)**2+(zo-z)**2),etat + WRITE(out_xpt_unit,410)r,z, + $ SQRT((ro-r)**2+(zo-z)**2),etat + ELSEIF(k==2)THEN !Numerical int values + r=ro+y_out1(istep,2)*COS(y_out1(istep,0)) + z=zo+y_out1(istep,2)*SIN(y_out1(istep,0)) + etat=y_out1(istep,0) + etat=etat-twopi*floor(etat/twopi) + PRINT 410,r,z,y_out1(istep,2),etat + WRITE(out_xpt_unit,410)r,z,y_out1(istep,2),etat + ELSEIF(k==3 .OR. k==4)THEN !Analytic int values + etat=outmat(3,2,0) + etat=etat-twopi*floor(etat/twopi) + IF(i==1)THEN + PRINT 410,outmat(2,1,0),outmat(2,2,0), + $ outmat(3,1,0),etat + WRITE(out_xpt_unit,410)outmat(2,1,0), + $ outmat(2,2,0),outmat(3,1,0),etat + ENDIF + etat=outmat(3,2,1) + etat=etat-twopi*floor(etat/twopi) + PRINT 410,outmat(2,1,1),outmat(2,2,1),outmat(3,1,1) + $ ,etat + WRITE(out_xpt_unit,410)outmat(2,1,1),outmat(2,2,1) + $ ,outmat(3,1,1),etat + ENDIF + + IF (.FALSE.)THEN + PRINT "(A)", "y(1)" + PRINT "(f16.9)", y_out1(istep,1)-y_out1(0,1) + PRINT "(f16.9)", yi1(1,1) + PRINT "(A)", "y(2)" + PRINT "(f16.9)", y_out1(istep,2)-y_out1(0,2) + PRINT "(f16.9)", yi1(1,2) + PRINT "(A)", "y(3)" + PRINT "(f16.9)", y_out1(istep,3)-y_out1(0,3) + PRINT "(f16.9)", yi1(1,3) + PRINT "(A)", "y(4)" + PRINT "(f16.9)", y_out1(istep,4)-y_out1(0,4) + PRINT "(f16.9)", yi1(1,4) + ENDIF + ENDDO + ENDDO + ENDDO + + CALL ascii_close(out_xpt_unit) + CALL program_stop("thickems") + $ + ENDIF +c----------------------------------------------------------------------- +c int prints. COMMENTED OUT +c----------------------------------------------------------------------- + IF(.FALSE.)THEN + !nstep2=100 + + PRINT "(A)", "STARTING THE INT SHOW:::::::::::::::::::::::::" + !two cases we care about: + !k==2 (num ints) + !k==4 (new varthetas) + k=1 + usevth2(1)=.TRUE. + + !PRINT "(A)", "power_bp:" + !PRINT "(i6)", power_bp + !PRINT "(A)", "power_b:" + !PRINT "(i6)", power_b + !PRINT "(A)", "power_t:" + !PRINT "(i6)", power_r + !CALL program_stop("a$$") + + DO j=1,1,+3!,+3 + !psifac=one-(10*one)**(-1-j) + + DO k=2,4,+2 + IF(k==2)PRINT "(A)", "psifac:" + IF(k==2)PRINT "(f15.13)", psifac + + IF(k==2)PRINT "(A)", "" + IF(k==2)PRINT "(f15.13)", psifac + + IF(k==2)PRINT "(A)", "Num ints:" + IF(k==4)PRINT "(A)", "Analytic ints:" + CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + CALL direct_get_bfield(r,z,bf,1) + + IF(k==2)CALL ascii_open(out_xpt_unit,"y_n.out","UNKNOWN") + IF(k==4)CALL ascii_open(out_xpt_unit,"y_a.out","UNKNOWN") + + DO i=1,nstep2,+1 + eta=xpt_brackets(1,1)+(xpt_brackets(1,2)- + $ xpt_brackets(1,1))*(one*i/nstep2) + yi1(i,0)=eta + + !PRINT "(es16.9)", one*i/nstep2 + CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1) + $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.TRUE.) + verbose=.FALSE. + CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, + $ y_out1,bf,len_y1_out) + + IF(k==2)THEN !Numerical int values + r=ro+y_out1(istep,2)*COS(y_out1(istep,0)) + z=zo+y_out1(istep,2)*SIN(y_out1(istep,0)) + etat=y_out1(istep,0) + etat=etat-twopi*floor(etat/twopi) + WRITE(out_xpt_unit,412) + $ y_out1(istep,0), + $ (y_out1(istep,1)-y_out1(0,1)), + $ (y_out1(istep,2)),!-y_out1(0,2)), + $ (y_out1(istep,3)-y_out1(0,3)), + $ (y_out1(istep,4)-y_out1(0,4)) + + ELSEIF(k==4)THEN !Analytic int values + etat=outmat(3,2,0) + etat=etat-twopi*floor(etat/twopi) + IF(i==1)THEN + ENDIF + WRITE(out_xpt_unit,412) + $ eta, + $ yi1(i,1), + $ yi1(i,2),!-y_out1(0,2)), $ outmat(4,1,1), $ outmat(4,2,1), + $ yi1(i,3), + $ yi1(i,4) + ENDIF + + IF (.FALSE.)THEN + PRINT "(A)", "y(1)" + PRINT "(f16.9)", y_out1(istep,1)-y_out1(0,1) + PRINT "(f16.9)", yi1(1,1) + PRINT "(A)", "y(2)" + PRINT "(f16.9)", y_out1(istep,2)-y_out1(0,2) + PRINT "(f16.9)", yi1(1,2) + PRINT "(A)", "y(3)" + PRINT "(f16.9)", y_out1(istep,3)-y_out1(0,3) + PRINT "(f16.9)", yi1(1,3) + PRINT "(A)", "y(4)" + PRINT "(f16.9)", y_out1(istep,4)-y_out1(0,4) + PRINT "(f16.9)", yi1(1,4) + ENDIF + ENDDO + CALL ascii_close(out_xpt_unit) + ENDDO ENDDO + + !CALL ascii_close(out_xpt_unit) + CALL program_stop("thickems_NOW") + $ + ENDIF +c----------------------------------------------------------------------- +c field line int comparison COMMENTED OUT +c----------------------------------------------------------------------- + IF(.FALSE.)THEN + !PRINT "(A)", "rx:" + !PRINT "(f16.9)",rxs(1) + !PRINT "(A)", "zx:" + !PRINT "(f16.9)",zxs(1) + !PRINT "(A)", "vartheta:" + !PRINT "(f16.9)",xpt_varthetas(1) + DO i=1,10,+1 + psifac=one-(10*one)**(-1-i) + PRINT "(A)", "psifac:" + PRINT "(f16.9)",psifac + + !CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + !PRINT "(A)", "r:" + !PRINT "(f16.9)",r + !PRINT "(A)", "z:" + !PRINT "(f16.9)",z + + + !r=rxs(1) + !z=zxs(1) + !r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + !CALL direct_saddle_coords(1,r_loc1,xpt_etas(1),x1,y1,chi) + + !PRINT "(A)", "x1:" + !PRINT "(f16.9)", x1 + + CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + CALL direct_get_bfield(r,z,bf,1) + CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1), + $ xpt_brackets(1,2),yi1(1,1),yi1(1,2),yi1(1,3),yi1(1,4), + $ outmat,.FALSE.) + yi1(1,0)=xpt_brackets(1,2) + !verbose=.FALSE. + CALL direct_fl_int(psifac,xpt_brackets(1,1),xpt_brackets(1,2), + $ y_out1,bf,len_y1_out) + + !PRINT "(f16.5)", yi1(0,0) + !PRINT "(f16.9)", y_out1(istep,0) + !PRINT "(f16.9)", yi1(nstep2,0) + + ENDDO + + !want x1 to be going to 0. but its not. This is a problem + !with direct_saddle_coords, and maybe the definition of + !xpt_varthetas + CALL program_stop("thickems_dep") + $ + ENDIF c----------------------------------------------------------------------- c ordering the two etas for numerical field line integration c----------------------------------------------------------------------- @@ -2071,11 +2390,25 @@ SUBROUTINE direct_mixed_spline_builder(psifac) c calling numerical integration between field lines c----------------------------------------------------------------------- CALL direct_fl_int(psifac,eta2,eta1,y_out1,bf,len_y1_out) + + IF(out)THEN + CALL ascii_open(out_xpt_unit,"y_out1.out","UNKNOWN") + DO i=0,len_y1_out,+1 + WRITE(out_xpt_unit,412) + $ y_out1(i,0), + $ y_out1(i,1), + $ y_out1(i,2), + $ y_out1(i,3), + $ y_out1(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + ENDIF c----------------------------------------------------------------------- c calling direct_initialise_xpoints to check for a second x-point. c----------------------------------------------------------------------- CALL direct_initialise_xpoints(y_out1,len_y1_out,.FALSE., - $ .FALSE.,bf,100*one,eta_maxes,eta_brackets,maxima_count)!10.03 + $ .FALSE.,bf,dqdeps_tol,BpBt_tol, + $ eta_maxes,eta_brackets,maxima_count) IF(dbg1xpt)PRINT "(A)", "Maxima count for numerical integral" IF(dbg1xpt)PRINT "(i6)", maxima_count IF(dbg1xpt .AND. maxima_count>0)THEN @@ -2141,9 +2474,6 @@ SUBROUTINE direct_mixed_spline_builder(psifac) PRINT "(f16.5)", (eta_brackets(i,2) $ )!-twopi*floor(eta_brackets(i,1)/twopi)) ENDDO - ELSE - IF(dbg1xpt)PRINT "(A)", "|||||||||||||||||||||||||||||||" - IF(dbg1xpt)PRINT "(i6)", maxima_count ENDIF ENDIF c----------------------------------------------------------------------- @@ -2172,47 +2502,198 @@ SUBROUTINE direct_mixed_spline_builder(psifac) CALL find_fl_surface(one,xpt_etas(num_xpts),r,z) CALL direct_xpoint(r,z,num_xpts) ENDDO + c----------------------------------------------------------------------- -c adding consecutive integral sections +c interpolating the numerical integral around an eta=0.0 point. +c I assume eta=0.0 won't be within the xpt_brackets since most +c tokamaks wont have an xpoint in line with the magnetic axis c----------------------------------------------------------------------- - yi1(:,1)=yi1(:,1)+y_out1(len_y1_out,1) - yi1(:,3)=yi1(:,3)+y_out1(len_y1_out,3) - yi1(:,4)=yi1(:,4)+y_out1(len_y1_out,4) + DO i=0,len_y1_out,+1 + IF(y_out1(i,0)>zero)THEN + eta0i=i + EXIT + ENDIF + ENDDO + + i=MAX(eta0i-5,0) + j=MIN(eta0i+5,len_y1_out) + + CALL spline_alloc(yi,j-i,4) + + DO k=i,j,+1 + yi%xs(k-i)=y_out1(k,0) + yi%fs(k-i,1)=y_out1(k,1) + yi%fs(k-i,2)=y_out1(k,2) + yi%fs(k-i,3)=y_out1(k,3) + yi%fs(k-i,4)=y_out1(k,4) + + ENDDO + + CALL spline_fit(yi,"extrap") + CALL spline_eval(yi,zero,0) + y01=yi%f(1) + y02=yi%f(2) + y03=yi%f(3) + y04=yi%f(4) + CALL spline_dealloc(yi) c----------------------------------------------------------------------- -c constructing ff +c adding consecutive integral sections. spline length of tot_steps +c +1 is used to make space for the interpolated point at eta=0.0 c----------------------------------------------------------------------- - tot_steps=istep+nstep2 - CALL spline_alloc(ff,tot_steps,4) - ff%xs(0:istep)=y_out1(0:istep,4)/yi1(nstep2,4) - ff%fs(0:istep,1)=y_out1(0:istep,2)**2 - !ff%fs(0:istep,2)=y_out1(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,2)=(y_out1(0:istep,0)/twopi+one)-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* - $ (y_out1(0:istep,3)-ff%xs(0:istep)*yi1(nstep2,3)) - ff%fs(0:istep,4)=y_out1(0:istep,1)/yi1(nstep2,1)-ff%xs + IF(istep /= len_y1_out)CALL program_stop("minor err. direct.f") + istep=len_y1_out + tot_steps=istep+nstep2 i1=istep+1 i2=tot_steps - ff%xs(i1:i2)=yi1(1:nstep2,4)/yi1(nstep2,4) - ff%fs(i1:i2,1)=yi1(1:nstep2,2)**2 - !ff%fs(i1:i2,2)=(yi1(1:nstep2,0)/twopi-ff%xs(i1:i2) - ff%fs(i1:i2,2)=(yi1(1:nstep2,0)/twopi+one)-ff%xs(i1:i2) - ff%fs(i1:i2,3)=bf%f* - $ (yi1(1:nstep2,3)-ff%xs(i1:i2)*yi1(nstep2,3)) - ff%fs(i1:i2,4)=yi1(1:nstep2,1)/yi1(nstep2,1)-ff%xs(i1:i2) - - PRINT "(A)", "O ELLO THERE" - PRINT "(es20.10)", ff%fs(0,1) - !PRINT "(es20.10)", yi1(nstep2,3) - !PRINT "(es20.10)", ff%fs(i2,3) - !PRINT "(i6)", i2 - y_out1_max=yi1(nstep2,1) - y_out3_max=yi1(nstep2,3) + CALL spline_alloc(yi,tot_steps+1,4) +c----------------------------------------------------------------------- +c filling out points up to eta = 0.0 +c----------------------------------------------------------------------- + yi%xs(0:(eta0i-1))=y_out1(0:(eta0i-1),0) + yi%fs(0:(eta0i-1),1)=y_out1(0:(eta0i-1),1) + yi%fs(0:(eta0i-1),2)=y_out1(0:(eta0i-1),2) + yi%fs(0:(eta0i-1),3)=y_out1(0:(eta0i-1),3) + yi%fs(0:(eta0i-1),4)=y_out1(0:(eta0i-1),4) +c----------------------------------------------------------------------- +c putting in interpolated point at eta = 0.0 +c----------------------------------------------------------------------- + yi%xs(eta0i)=zero + yi%fs(eta0i,1)=y01 + yi%fs(eta0i,2)=y02 + yi%fs(eta0i,3)=y03 + yi%fs(eta0i,4)=y04 +c----------------------------------------------------------------------- +c putting in the rest of the numerically integrated points +c----------------------------------------------------------------------- + yi%xs((eta0i+1):istep+1)=y_out1(eta0i:istep,0) + yi%fs((eta0i+1):istep+1,1)=y_out1(eta0i:istep,1) + yi%fs((eta0i+1):istep+1,2)=y_out1(eta0i:istep,2) + yi%fs((eta0i+1):istep+1,3)=y_out1(eta0i:istep,3) + yi%fs((eta0i+1):istep+1,4)=y_out1(eta0i:istep,4) +c----------------------------------------------------------------------- +c adding analytic integral sections +c----------------------------------------------------------------------- + yi%xs((i1+1):(i2+1))=yi1(1:nstep2,0) + yi%fs((i1+1):(i2+1),1)=yi1(1:nstep2,1)+yi%fs(i1,1) + yi%fs((i1+1):(i2+1),2)=yi1(1:nstep2,2) + yi%fs((i1+1):(i2+1),3)=yi1(1:nstep2,3)+yi%fs(i1,3) + yi%fs((i1+1):(i2+1),4)=yi1(1:nstep2,4)+yi%fs(i1,4) +c----------------------------------------------------------------------- +c wrapping around to start yi at eta = 0.0 +c----------------------------------------------------------------------- + istep=tot_steps+1 + + DO i=0,istep,+1 + j=eta0i+i + + IF(j>istep)THEN + j=j-istep-1 + y_out(i,1)=yi%fs(j,1)+yi%fs(istep,1) + y_out(i,3)=yi%fs(j,3)+yi%fs(istep,3) + y_out(i,4)=yi%fs(j,4)+yi%fs(istep,4) + ELSE + y_out(i,1)=yi%fs(j,1) + y_out(i,3)=yi%fs(j,3) + y_out(i,4)=yi%fs(j,4) + ENDIF + y_out(i,2)=yi%fs(j,2) + + IF(yi%xs(j)<0.0)THEN + y_out(i,0)=yi%xs(j)+twopi + ELSE + y_out(i,0)=yi%xs(j) + ENDIF + ENDDO + y_out(:,1)=y_out(:,1)-yi%fs(eta0i,1) + y_out(:,3)=y_out(:,3)-yi%fs(eta0i,3) + y_out(:,4)=y_out(:,4)-yi%fs(eta0i,4) +c----------------------------------------------------------------------- +c building ff +c----------------------------------------------------------------------- + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* + $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) + $ -ff%xs +c----------------------------------------------------------------------- +c optional output to compare analytical and numerical integrals over +c the divergent regions +c----------------------------------------------------------------------- + IF(out)THEN + CALL ascii_open(out_xpt_unit,"yi.csv","UNKNOWN") + DO i=0,istep,+1 + WRITE(out_xpt_unit,412) + $ yi%xs(i), + $ yi%fs(i,1), + $ yi%fs(i,2), + $ yi%fs(i,3), + $ yi%fs(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + CALL ascii_open(out_xpt_unit,"y_outtest.csv","UNKNOWN") + DO i=0,istep,+1 + WRITE(out_xpt_unit,412) + $ y_out(i,0), + $ y_out(i,1), + $ y_out(i,2), + $ y_out(i,3), + $ y_out(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + ENDIF + + CALL spline_dealloc(yi) + + IF(debug_in)PRINT "(A)", "ff x-pt start point:" + IF(debug_in)PRINT "(i6)", (istep+1-eta0i) +c----------------------------------------------------------------------- +c adding analytic integral sections +c----------------------------------------------------------------------- + !yi_i(:,1)=yi1(:,1)+y_out1(len_y1_out,1) + !yi_i(:,3)=yi1(:,3)+y_out1(len_y1_out,3) + !yi_i(:,4)=yi1(:,4)+y_out1(len_y1_out,4) +c----------------------------------------------------------------------- +c constructing ff first by making +c----------------------------------------------------------------------- + !tot_steps=istep+nstep2 + !CALL spline_alloc(ff,tot_steps,4) + !ff%xs(0:istep)=y_out1(0:istep,4)/yi_i(nstep2,4) + !ff%fs(0:istep,1)=y_out1(0:istep,2)**2 + !ff%fs(0:istep,2)=y_out1(0:istep,0)/twopi-ff%xs(0:istep) + !ff%fs(0:istep,2)=(y_out1(0:istep,0)/twopi+one)-ff%xs(0:istep) + !ff%fs(0:istep,3)=bf%f* + !$ (y_out1(0:istep,3)-ff%xs(0:istep)*yi_i(nstep2,3)) + !ff%fs(0:istep,4)=y_out1(0:istep,1)/yi_i(nstep2,1)-ff%xs + + !i1=istep+1 + !i2=tot_steps + !ff%xs(i1:i2)=yi_i(1:nstep2,4)/yi_i(nstep2,4) + !ff%fs(i1:i2,1)=yi_i(1:nstep2,2)**2 + !ff%fs(i1:i2,2)=(yi_i(1:nstep2,0)/twopi-ff%xs(i1:i2) + !ff%fs(i1:i2,2)=(yi_i(1:nstep2,0)/twopi+one)-ff%xs(i1:i2) + !ff%fs(i1:i2,3)=bf%f*( + !$ yi_i(1:nstep2,3)- + !$ yi_i(1:nstep2,4)* + !$ yi_i(nstep2,3)/yi_i(nstep2,4)) + !ff%fs(i1:i2,3)=ff%fs(i1:i2,3)+ff%fs(istep,3) + !ff%fs(i1:i2,4)=yi_i(1:nstep2,1)/yi_i(nstep2,1)-ff%xs(i1:i2) + + !PRINT "(A)", "O ELLO THERE" + !PRINT "(es20.10)", ff%fs(0,1) + !PRINT "(es20.10)", yi1(nstep2,3) + !PRINT "(es20.10)", ff%fs(i2,3) + !PRINT "(i6)", i2 - CALL spline_fit(ff,"periodic") + !y_out1_max=yi_i(nstep2,1) + !y_out3_max=yi_i(nstep2,3) + !CALL spline_fit(ff,"periodic") ELSE c----------------------------------------------------------------------- c 2 x-points: making sure all brackets are in [0,2pi) From 348995b8e65d4b4fff0b2eae6e11a59f3f7dd43a Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 18:09:35 -0400 Subject: [PATCH 51/97] clarifying debug/output statements in direct_mixed_spline_builder --- equil/direct.f | 87 ++++++++------------------------------------------ 1 file changed, 13 insertions(+), 74 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index ff992230..83280351 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2096,17 +2096,15 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) IF(out)CALL ascii_close(out_xpt_unit) c----------------------------------------------------------------------- -c path prints. COMMENTED OUT +c printing field line paths comparison between numerical and +c analytic methods. COMMENTED OUT c----------------------------------------------------------------------- IF(.FALSE.)THEN - nstep2=100 PRINT "(A)", "STARTING THE PATH SHOW:::::::::::::::::::::::::" !xpt_brackets(1,1)=4.32562 !xpt_brackets(1,2)=4.33276 - - CALL ascii_open(out_xpt_unit,"xpt.out","UNKNOWN") k=1 DO j=1,9,+3 @@ -2217,29 +2215,26 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) ENDDO CALL ascii_close(out_xpt_unit) - CALL program_stop("thickems") + CALL program_stop("numerical vs analytic integral paths print") $ ENDIF c----------------------------------------------------------------------- -c int prints. COMMENTED OUT +c printing divergent integrals, comparison between numerical and +c analytic methods. COMMENTED OUT c----------------------------------------------------------------------- IF(.FALSE.)THEN !nstep2=100 PRINT "(A)", "STARTING THE INT SHOW:::::::::::::::::::::::::" - !two cases we care about: - !k==2 (num ints) - !k==4 (new varthetas) k=1 usevth2(1)=.TRUE. - !PRINT "(A)", "power_bp:" - !PRINT "(i6)", power_bp - !PRINT "(A)", "power_b:" - !PRINT "(i6)", power_b - !PRINT "(A)", "power_t:" - !PRINT "(i6)", power_r - !CALL program_stop("a$$") + PRINT "(A)", "power_bp:" + PRINT "(i6)", power_bp + PRINT "(A)", "power_b:" + PRINT "(i6)", power_b + PRINT "(A)", "power_t:" + PRINT "(i6)", power_r DO j=1,1,+3!,+3 !psifac=one-(10*one)**(-1-j) @@ -2316,62 +2311,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) ENDDO ENDDO - !CALL ascii_close(out_xpt_unit) - CALL program_stop("thickems_NOW") - $ - ENDIF -c----------------------------------------------------------------------- -c field line int comparison COMMENTED OUT -c----------------------------------------------------------------------- - IF(.FALSE.)THEN - !PRINT "(A)", "rx:" - !PRINT "(f16.9)",rxs(1) - !PRINT "(A)", "zx:" - !PRINT "(f16.9)",zxs(1) - !PRINT "(A)", "vartheta:" - !PRINT "(f16.9)",xpt_varthetas(1) - DO i=1,10,+1 - psifac=one-(10*one)**(-1-i) - PRINT "(A)", "psifac:" - PRINT "(f16.9)",psifac - - !CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) - !PRINT "(A)", "r:" - !PRINT "(f16.9)",r - !PRINT "(A)", "z:" - !PRINT "(f16.9)",z - - - !r=rxs(1) - !z=zxs(1) - !r_loc1 = SQRT((r-ro)**2+(z-zo)**2) - !CALL direct_saddle_coords(1,r_loc1,xpt_etas(1),x1,y1,chi) - - !PRINT "(A)", "x1:" - !PRINT "(f16.9)", x1 - - CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) - r_loc1 = SQRT((r-ro)**2+(z-zo)**2) - CALL direct_get_bfield(r,z,bf,1) - CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1), - $ xpt_brackets(1,2),yi1(1,1),yi1(1,2),yi1(1,3),yi1(1,4), - $ outmat,.FALSE.) - yi1(1,0)=xpt_brackets(1,2) - !verbose=.FALSE. - CALL direct_fl_int(psifac,xpt_brackets(1,1),xpt_brackets(1,2), - $ y_out1,bf,len_y1_out) - - !PRINT "(f16.5)", yi1(0,0) - !PRINT "(f16.9)", y_out1(istep,0) - !PRINT "(f16.9)", yi1(nstep2,0) - - ENDDO - - !want x1 to be going to 0. but its not. This is a problem - !with direct_saddle_coords, and maybe the definition of - !xpt_varthetas - CALL program_stop("thickems_dep") - $ + CALL program_stop("divergent integral numerical comparison ") ENDIF c----------------------------------------------------------------------- c ordering the two etas for numerical field line integration @@ -2622,8 +2562,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) $ -ff%xs c----------------------------------------------------------------------- -c optional output to compare analytical and numerical integrals over -c the divergent regions +c optional output, DEPRECATED => debug in direct_run does the same c----------------------------------------------------------------------- IF(out)THEN CALL ascii_open(out_xpt_unit,"yi.csv","UNKNOWN") From b9504df15fe5d63fe12b6676bab17eb31a65b5e4 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 18:13:39 -0400 Subject: [PATCH 52/97] removed deprecated output from direct_mixed_spline_builder, improved print statements in direct_initialise_xpoints, direct_xpoint --- equil/direct.f | 138 +++++++++++++++++++++++-------------------------- 1 file changed, 66 insertions(+), 72 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 83280351..a78a4531 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1341,6 +1341,7 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) REAL(r8) :: oangle,nu_var,Bnua,Bnub,Bnuc TYPE(direct_bfield_type) :: bf LOGICAL :: test_direct_local_xpoint,test_direct_saddle_angle + CHARACTER(64) :: message r=rin z=zin @@ -1513,6 +1514,30 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) CALL program_stop("increase dq_eps.") ENDIF c----------------------------------------------------------------------- +c regular print statements. eta bracket describes the region where +c the analytic formulas will take over from the numerical +c integrator. +c----------------------------------------------------------------------- +c501 FORMAT(1x,i1," x-point(s) detected:") +c502 FORMAT(1x,"over eta bracket (",f10.8,",",f10.8,")") +600 FORMAT(1x,"x-point detected at eta = ",f7.5,". analytic") +601 FORMAT(1x,"2nd x-point detected at eta = ",f7.5,". analytic") +603 FORMAT(1x,"integrals applied for eta = (", + $ f7.5,",",f7.5,").") + IF(verbose)THEN + PRINT "(A)", "________________________________________________" + IF(x_i==1)THEN + WRITE(message,600)xpt_etas(x_i) + PRINT "(A)",message + ELSEIF(x_i==2)THEN + WRITE(message,601)xpt_etas(x_i) + PRINT "(A)",message + ENDIF + WRITE(message,603)xpt_brackets(x_i,1),xpt_brackets(x_i,2) + PRINT "(A)",message + PRINT "(A)", "------------------------------------------------" + ENDIF +c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN @@ -1526,17 +1551,18 @@ END SUBROUTINE direct_xpoint c declarations. c----------------------------------------------------------------------- SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, - $ bf,dq_eps,eta_maxes,eta_brackets,maxima_count) + $ bf,dq_eps,BpBt,eta_maxes,eta_brackets,maxima_count) INTEGER, INTENT(IN) :: len_y_out LOGICAL, INTENT(IN) :: wrap,debug REAL(r8), DIMENSION(0:,0:), INTENT(IN) :: y_out - REAL(r8), INTENT(IN) :: dq_eps + REAL(r8), INTENT(IN) :: dq_eps, BpBt TYPE(direct_bfield_type), INTENT(IN) :: bf INTEGER, INTENT(OUT) :: maxima_count REAL(r8), DIMENSION(1:), INTENT(OUT) :: eta_maxes REAL(r8), DIMENSION(1:,1:), INTENT(OUT) :: eta_brackets + CHARACTER(64) :: message INTEGER :: i LOGICAL :: prev_above_threshold,wrap_max,wrap_ @@ -1694,10 +1720,9 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, ENDDO ENDIF c----------------------------------------------------------------------- -c debug print statements. +c debug print statements. lots of information. c----------------------------------------------------------------------- - - IF(debug)PRINT "(A)", "Num points::::::::::::::::::::::::::::::::" + IF(debug)PRINT "(A)", "Num X-points::::::::::::::::::::::::::::::" IF(debug)PRINT "(i6)", maxima_count IF(maxima_count>0 .AND. debug)THEN DO i=1,maxima_count @@ -1726,6 +1751,40 @@ SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, ENDIF IF(debug)PRINT "(A)", "::::::::::::::::::::::::::::::::::::::::::" c----------------------------------------------------------------------- +c regular print statements. eta bracket describes the region where +c the analytic formulas will take over from the numerical +c integrator. +c----------------------------------------------------------------------- +501 FORMAT(1x,i1," x-point(s) detected:") +c502 FORMAT(1x,"over eta bracket (",f10.8,",",f10.8,")") +503 FORMAT(4x,"1st x-point eta bracket = (",f7.5,",",f7.5,")") +504 FORMAT(4x,"2nd x-point eta bracket = (",f7.5,",",f7.5,")") +505 FORMAT(3x,"max q-gradient",e10.3," <",e10.3) +506 FORMAT(3x,"max q-gradient",e10.3," >",e10.3) + IF(verbose .AND. wrap)THEN + IF(MAXVAL(dqdeta)0 .AND. wrap .AND. .FALSE.)THEN + PRINT "(A)", "________________________________________________" + WRITE(message,501)maxima_count + PRINT "(A)",message + DO i=1,maxima_count,+1 + IF(i==1)THEN + WRITE(message,503)eta_brackets(i,1),eta_brackets(i,2) + PRINT "(A)",message + ELSEIF(i==2)THEN + WRITE(message,504)eta_brackets(i,1),eta_brackets(i,2) + PRINT "(A)",message + ENDIF + ENDDO + PRINT "(A)", "------------------------------------------------" + ENDIF +c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN @@ -2562,77 +2621,12 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) $ -ff%xs c----------------------------------------------------------------------- -c optional output, DEPRECATED => debug in direct_run does the same +c deallocating spline, printing important information for +c direct_spline_comparison c----------------------------------------------------------------------- - IF(out)THEN - CALL ascii_open(out_xpt_unit,"yi.csv","UNKNOWN") - DO i=0,istep,+1 - WRITE(out_xpt_unit,412) - $ yi%xs(i), - $ yi%fs(i,1), - $ yi%fs(i,2), - $ yi%fs(i,3), - $ yi%fs(i,4) - ENDDO - CALL ascii_close(out_xpt_unit) - CALL ascii_open(out_xpt_unit,"y_outtest.csv","UNKNOWN") - - DO i=0,istep,+1 - WRITE(out_xpt_unit,412) - $ y_out(i,0), - $ y_out(i,1), - $ y_out(i,2), - $ y_out(i,3), - $ y_out(i,4) - ENDDO - CALL ascii_close(out_xpt_unit) - ENDIF - CALL spline_dealloc(yi) - IF(debug_in)PRINT "(A)", "ff x-pt start point:" IF(debug_in)PRINT "(i6)", (istep+1-eta0i) -c----------------------------------------------------------------------- -c adding analytic integral sections -c----------------------------------------------------------------------- - !yi_i(:,1)=yi1(:,1)+y_out1(len_y1_out,1) - !yi_i(:,3)=yi1(:,3)+y_out1(len_y1_out,3) - !yi_i(:,4)=yi1(:,4)+y_out1(len_y1_out,4) -c----------------------------------------------------------------------- -c constructing ff first by making -c----------------------------------------------------------------------- - !tot_steps=istep+nstep2 - !CALL spline_alloc(ff,tot_steps,4) - !ff%xs(0:istep)=y_out1(0:istep,4)/yi_i(nstep2,4) - !ff%fs(0:istep,1)=y_out1(0:istep,2)**2 - !ff%fs(0:istep,2)=y_out1(0:istep,0)/twopi-ff%xs(0:istep) - !ff%fs(0:istep,2)=(y_out1(0:istep,0)/twopi+one)-ff%xs(0:istep) - !ff%fs(0:istep,3)=bf%f* - !$ (y_out1(0:istep,3)-ff%xs(0:istep)*yi_i(nstep2,3)) - !ff%fs(0:istep,4)=y_out1(0:istep,1)/yi_i(nstep2,1)-ff%xs - - !i1=istep+1 - !i2=tot_steps - !ff%xs(i1:i2)=yi_i(1:nstep2,4)/yi_i(nstep2,4) - !ff%fs(i1:i2,1)=yi_i(1:nstep2,2)**2 - !ff%fs(i1:i2,2)=(yi_i(1:nstep2,0)/twopi-ff%xs(i1:i2) - !ff%fs(i1:i2,2)=(yi_i(1:nstep2,0)/twopi+one)-ff%xs(i1:i2) - !ff%fs(i1:i2,3)=bf%f*( - !$ yi_i(1:nstep2,3)- - !$ yi_i(1:nstep2,4)* - !$ yi_i(nstep2,3)/yi_i(nstep2,4)) - !ff%fs(i1:i2,3)=ff%fs(i1:i2,3)+ff%fs(istep,3) - !ff%fs(i1:i2,4)=yi_i(1:nstep2,1)/yi_i(nstep2,1)-ff%xs(i1:i2) - - !PRINT "(A)", "O ELLO THERE" - !PRINT "(es20.10)", ff%fs(0,1) - !PRINT "(es20.10)", yi1(nstep2,3) - !PRINT "(es20.10)", ff%fs(i2,3) - !PRINT "(i6)", i2 - - !y_out1_max=yi_i(nstep2,1) - !y_out3_max=yi_i(nstep2,3) - !CALL spline_fit(ff,"periodic") ELSE c----------------------------------------------------------------------- c 2 x-points: making sure all brackets are in [0,2pi) From 4a6969ab3d65c68eaf1aa014ea0ef81b5a589a6f Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 18:18:25 -0400 Subject: [PATCH 53/97] direct_mixed_spline_builder now builds y_out, ff for 2 x-point cases --- equil/direct.f | 269 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 257 insertions(+), 12 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index a78a4531..12c0da85 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2057,9 +2057,9 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, END SUBROUTINE direct_analytic_ints c----------------------------------------------------------------------- c subprogram 16. direct_mixed_spline_builder. -c builds the ff spline using a combination of analytic integrals -c over divergent x-point regions, and numerically integrated -c sections inbetween x-points. +c builds y_out and ff spline using a combination of analytic +c integrals over divergent x-point regions, and numerically +c integrated sections inbetween x-points. c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- @@ -2116,7 +2116,6 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) c since these were already called for this x-point in direct_run's c psi loop c----------------------------------------------------------------------- - CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) r_loc1 = SQRT((r-ro)**2+(z-zo)**2) CALL direct_get_bfield(r,z,bf,1) @@ -2649,10 +2648,64 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) xpt_brackets(2,2)=xpt_brackets(2,2)+twopi ENDIF c----------------------------------------------------------------------- +c calculating minor radii that start each divergent analytic int. +c----------------------------------------------------------------------- + CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + CALL find_fl_surface(psifac,xpt_brackets(2,1),r,z) + r_loc2 = SQRT((r-ro)**2+(z-zo)**2) +c----------------------------------------------------------------------- +c calculating divergent analytic integrals over x-point brackets +c----------------------------------------------------------------------- + DO i=1,nstep2,+1 +c----------------------------------------------------------------------- +c first x-point divergent analytic integrals: +c----------------------------------------------------------------------- + eta=xpt_brackets(1,1)+ + $ (xpt_brackets(1,2)-xpt_brackets(1,1))*(one*i/nstep2) + yi1(i,0)=eta + CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1), + $ eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.FALSE.) + !PRINT "(f20.10)",eta +c----------------------------------------------------------------------- +c printing maximum value of Bp/Bt at first x-point +c----------------------------------------------------------------------- + IF(i==nstep2)THEN + CALL direct_get_bfield(outmat(2,1,0),outmat(2,2,0),bf,1) + bp1=SQRT(bf%br**2+bf%bz**2) + bt1=bf%f/outmat(2,1,0) + CALL direct_get_bfield(outmat(2,1,1),outmat(2,2,1),bf,1) + bp2=SQRT(bf%br**2+bf%bz**2) + bt2=bf%f/outmat(2,1,1) + PRINT "(A,es10.3)"," max Bp/Bt (1st x-point) =", + $ MAX(bp1/bt1,bp2/bt2) + ENDIF +c----------------------------------------------------------------------- +c second x-point divergent analytic integrals: +c----------------------------------------------------------------------- + eta=xpt_brackets(2,1) + $ +(xpt_brackets(2,2)-xpt_brackets(2,1))*(one*i/nstep2) + yi2(i,0)=eta + CALL direct_analytic_ints(2,r_loc2,xpt_brackets(2,1), + $ eta,yi2(i,1),yi2(i,2),yi2(i,3),yi2(i,4),outmat,.FALSE.) +c----------------------------------------------------------------------- +c printing maximum value of Bp/Bt at second x-point +c----------------------------------------------------------------------- + IF(i==nstep2)THEN + CALL direct_get_bfield(outmat(2,1,0),outmat(2,2,0),bf,1) + bp1=SQRT(bf%br**2+bf%bz**2) + bt1=bf%f/outmat(2,1,0) + CALL direct_get_bfield(outmat(2,1,1),outmat(2,2,1),bf,1) + bp2=SQRT(bf%br**2+bf%bz**2) + bt2=bf%f/outmat(2,1,1) + PRINT "(A,es10.3)"," max Bp/Bt (2nd x-point) =", + $ MAX(bp1/bt1,bp2/bt2) + ENDIF + ENDDO c----------------------------------------------------------------------- c ordering etas in the brackets to define two non-divergent c intervals: [eta1,eta2] and [eta3,eta4]. x points should lie in -c [eta2,eta3] and [eta4-twopi,eta1]. +c [eta2,eta3] and [eta4-twopi,eta1]. twopi will be between eta3,eta4 c----------------------------------------------------------------------- IF(xpt_brackets(2,1)>xpt_brackets(1,1))THEN IF(xpt_brackets(2,1)twopi)THEN + eta0i=i + EXIT + ENDIF + ENDDO + + i=MAX(eta0i-5,0) + j=MIN(eta0i+5,ist2) + + CALL spline_alloc(yi,j-i,4) + DO k=i,j,+1 + yi%xs(k-i)=y_out2(k,0) + yi%fs(k-i,1)=y_out2(k,1) + yi%fs(k-i,2)=y_out2(k,2) + yi%fs(k-i,3)=y_out2(k,3) + yi%fs(k-i,4)=y_out2(k,4) + ENDDO + + CALL spline_fit(yi,"extrap") + CALL spline_eval(yi,twopi,0) + y01=yi%f(1) + y02=yi%f(2) + y03=yi%f(3) + y04=yi%f(4) + CALL spline_dealloc(yi) +c----------------------------------------------------------------------- +c filling out points up to eta = twopi +c----------------------------------------------------------------------- + y_out2i(0:(eta0i-1),0)=y_out2(0:(eta0i-1),0) + y_out2i(0:(eta0i-1),1)=y_out2(0:(eta0i-1),1) + y_out2i(0:(eta0i-1),2)=y_out2(0:(eta0i-1),2) + y_out2i(0:(eta0i-1),3)=y_out2(0:(eta0i-1),3) + y_out2i(0:(eta0i-1),4)=y_out2(0:(eta0i-1),4) +c----------------------------------------------------------------------- +c putting in interpolated point at eta = twopi +c----------------------------------------------------------------------- + y_out2i(eta0i,0)=twopi + y_out2i(eta0i,1)=y01 + y_out2i(eta0i,2)=y02 + y_out2i(eta0i,3)=y03 + y_out2i(eta0i,4)=y04 +c----------------------------------------------------------------------- +c putting in the rest of the numerically integrated points +c----------------------------------------------------------------------- + y_out2i((eta0i+1):(ist2+1),0)=y_out2(eta0i:ist2,0) + y_out2i((eta0i+1):(ist2+1),1)=y_out2(eta0i:ist2,1) + y_out2i((eta0i+1):(ist2+1),2)=y_out2(eta0i:ist2,2) + y_out2i((eta0i+1):(ist2+1),3)=y_out2(eta0i:ist2,3) + y_out2i((eta0i+1):(ist2+1),4)=y_out2(eta0i:ist2,4) +c----------------------------------------------------------------------- +c redefining y_out2 with the new interpolated point at eta=twopi +c----------------------------------------------------------------------- + y_out2 = y_out2i + ist2=ist2+1 +c----------------------------------------------------------------------- +c adding consecutive integrals +c----------------------------------------------------------------------- + DO i=1,4,+1 + IF(i==2)CYCLE + y_out1(:,i)=y_out1(:,i)+yi1(nstep2,i) + yi2(:,i)=yi2(:,i)+y_out1(ist1,i) + y_out2(:,i)=y_out2(:,i)+yi2(nstep2,i) + ENDDO +c----------------------------------------------------------------------- +c constructing y_out and ff +c----------------------------------------------------------------------- + tot_steps=2*nstep2+ist1+1+ist2 !extra 1 because both y_out1, y_out2 are indexed from 0 + + CALL spline_alloc(yi,tot_steps,4) + !CALL spline_alloc(y_out,tot_steps,4) + CALL spline_alloc(ff,tot_steps,4) + CALL spline_alloc(ffi,tot_steps,4) + + yi%xs(0:(nstep2-1))=yi1(1:nstep2,0) + yi%fs(0:(nstep2-1),1)=yi1(1:nstep2,1) + yi%fs(0:(nstep2-1),2)=yi1(1:nstep2,2) + yi%fs(0:(nstep2-1),3)=yi1(1:nstep2,3) + yi%fs(0:(nstep2-1),4)=yi1(1:nstep2,4) + ffi%xs(0:(nstep2-1))=yi1(1:nstep2,4)/y_out2(ist2,4) + ffi%fs(0:(nstep2-1),1)=yi1(1:nstep2,2)**2 + ffi%fs(0:(nstep2-1),2)=yi1(1:nstep2,0)/twopi- + $ ffi%xs(0:(nstep2-1)) + ffi%fs(0:(nstep2-1),3)=bf%f* + $ (yi1(1:nstep2,3)-ffi%xs(0:(nstep2-1))*y_out2(ist2,3)) + ffi%fs(0:(nstep2-1),4)=yi1(1:nstep2,1)/y_out2(ist2,1)- + $ ffi%xs(0:(nstep2-1)) + + i1=nstep2 + i2=nstep2+ist1 + + yi%xs(i1:i2)=y_out1(0:ist1,0) + yi%fs(i1:i2,1)=y_out1(0:ist1,1) + yi%fs(i1:i2,2)=y_out1(0:ist1,2) + yi%fs(i1:i2,3)=y_out1(0:ist1,3) + yi%fs(i1:i2,4)=y_out1(0:ist1,4) + ffi%xs(i1:i2)=y_out1(0:ist1,4)/y_out2(ist2,4) + ffi%fs(i1:i2,1)=y_out1(0:ist1,2)**2 + ffi%fs(i1:i2,2)=y_out1(0:ist1,0)/twopi- + $ ffi%xs(i1:i2) + ffi%fs(i1:i2,3)=bf%f* + $ (y_out1(0:ist1,3)-ffi%xs(i1:i2)*y_out2(ist2,3)) + ffi%fs(i1:i2,4)=y_out1(0:ist1,1)/y_out2(ist2,1)- + $ ffi%xs(i1:i2) + + i1=nstep2+ist1+1 + i2=nstep2+ist1+1+(nstep2-1) + + yi%xs(i1:i2)=yi2(1:nstep2,0) + yi%fs(i1:i2,1)=yi2(1:nstep2,1) + yi%fs(i1:i2,2)=yi2(1:nstep2,2) + yi%fs(i1:i2,3)=yi2(1:nstep2,3) + yi%fs(i1:i2,4)=yi2(1:nstep2,4) + ffi%xs(i1:i2)=yi2(1:nstep2,4)/y_out2(ist2,4) + ffi%fs(i1:i2,1)=yi2(1:nstep2,2)**2 + ffi%fs(i1:i2,2)=yi2(1:nstep2,0)/twopi- + $ ffi%xs(i1:i2) + ffi%fs(i1:i2,3)=bf%f* + $ (yi2(1:nstep2,3)-ffi%xs(i1:i2)*y_out2(ist2,3)) + ffi%fs(i1:i2,4)=yi2(1:nstep2,1)/y_out2(ist2,1)- + $ ffi%xs(i1:i2) + + i1=nstep2+ist1+1+nstep2 + i2=nstep2+ist1+1+nstep2+ist2 + + yi%xs(i1:i2)=y_out2(0:ist2,0) + yi%fs(i1:i2,1)=y_out2(0:ist2,1) + yi%fs(i1:i2,2)=y_out2(0:ist2,2) + yi%fs(i1:i2,3)=y_out2(0:ist2,3) + yi%fs(i1:i2,4)=y_out2(0:ist2,4) + ffi%xs(i1:i2)=y_out2(0:ist2,4)/y_out2(ist2,4) + ffi%fs(i1:i2,1)=y_out2(0:ist2,2)**2 + ffi%fs(i1:i2,2)=y_out2(0:ist2,0)/twopi- + $ ffi%xs(i1:i2) + ffi%fs(i1:i2,3)=bf%f* + $ (y_out2(0:ist2,3)-ffi%xs(i1:i2)*y_out2(ist2,3)) + ffi%fs(i1:i2,4)=y_out2(0:ist2,1)/y_out2(ist2,1)- + $ ffi%xs(i1:i2) +c----------------------------------------------------------------------- +c wrapping ff spline to start at eta=0 +c----------------------------------------------------------------------- + eta0i=2*nstep2+ist1+1+eta0i + + DO i=0,tot_steps,+1 + j=i+eta0i + + IF(j>tot_steps)THEN + j=j-tot_steps-1 + ff%xs(i)=ffi%xs(j)+ffi%xs(tot_steps) + y_out(i,1)=yi%fs(j,1)+yi%fs(tot_steps,1) + y_out(i,3)=yi%fs(j,3)+yi%fs(tot_steps,3) + y_out(i,4)=yi%fs(j,4)+yi%fs(tot_steps,4) + ELSE + ff%xs(i)=ffi%xs(j) + y_out(i,1)=yi%fs(j,1) + y_out(i,3)=yi%fs(j,3) + y_out(i,4)=yi%fs(j,4) + ENDIF + + ff%fs(i,1)=ffi%fs(j,1) + ff%fs(i,2)=ffi%fs(j,2) + ff%fs(i,3)=ffi%fs(j,3) + ff%fs(i,4)=ffi%fs(j,4) + y_out(i,2)=yi%fs(j,2) + + IF(yi%xs(j)>twopi)THEN + y_out(i,0)=yi%xs(j)-twopi + ELSE + y_out(i,0)=yi%xs(j) + ENDIF + ENDDO + + ff%xs(:)=ff%xs(:)-ff%xs(0) + ff%fs(:,2)=ff%fs(:,2)-ff%fs(0,2) + ff%fs(:,3)=ff%fs(:,3)-ff%fs(0,3) + ff%fs(:,4)=ff%fs(:,4)-ff%fs(0,4) + y_out(:,1)=y_out(:,1)-yi%fs(eta0i,1) + y_out(:,3)=y_out(:,3)-yi%fs(eta0i,3) + y_out(:,4)=y_out(:,4)-yi%fs(eta0i,4) + + y_out(0,0)=zero + + IF(debug_in)PRINT "(A)", "ff 1st x-pt start point:" + IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i) + IF(debug_in)PRINT "(A)", "ff 2nd x-pt start point:" + IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i+nstep2+ist1+1) + + CALL spline_dealloc(ffi) + CALL spline_dealloc(yi) + ENDIF c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- From 635cf497a9131db51959ab5c0459638301218bc6 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 18:21:32 -0400 Subject: [PATCH 54/97] added function direct_spline_comparison to output a comparison between numerical and mixed integrated splines --- equil/direct.f | 87 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 86 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 12c0da85..f5c4c1bd 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -24,6 +24,8 @@ c 14. direct_saddle_coords_inv. c 15. direct_analytic_ints. c 16. direct_mixed_spline_builder. +c 17. direct_spline_comparison. +c 18. direct_Blocal c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. @@ -2940,7 +2942,90 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) RETURN END SUBROUTINE direct_mixed_spline_builder c----------------------------------------------------------------------- -c subprogram 17. direct_Blocal. +c subprogram 17. direct_spline_comparison. +c print data from mixed analytic/numerical method, and solely +c numerically integrated method +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_spline_comparison(ff,ffa,y_out,y_outa) + + TYPE(spline_type), INTENT(IN) :: ff,ffa + REAL(r8), INTENT(IN), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4):: + $ y_out,y_outa + REAL(r8) :: r,z + INTEGER :: i,len_ff,len_ffa +c----------------------------------------------------------------------- +c checking lengths. +c----------------------------------------------------------------------- + len_ff=SIZE(ff%xs,1) + len_ffa=SIZE(ffa%xs,1) + + !IF(len_ff/=SIZE(y_out,1))CALL program_stop("blerg1") + !IF(len_ffa/=SIZE(y_outa,1))CALL program_stop("blerg2") + + PRINT "(A)", "Length ff:" + PRINT "(i6)", len_ff + PRINT "(A)", "Length ffa:" + PRINT "(i6)", len_ffa +c----------------------------------------------------------------------- +c printing the splines +c----------------------------------------------------------------------- +412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) + + CALL ascii_open(out_xpt_unit,"ff_test_new.csv","UNKNOWN") + !PRINT "(A)", "ff" + DO i=0,(len_ff-1),+1 + IF(.TRUE.)WRITE(out_xpt_unit,412)ff%xs(i), + $ ff%fs(i,1), + $ ff%fs(i,2), + $ ff%fs(i,3), + $ ff%fs(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + + CALL ascii_open(out_xpt_unit,"ffa_test_new.csv","UNKNOWN") + !PRINT "(A)", "ffa" + DO i=0,(len_ffa-1),+1 + IF(.TRUE.)WRITE(out_xpt_unit,412)ffa%xs(i), + $ ffa%fs(i,1), + $ ffa%fs(i,2), + $ ffa%fs(i,3), + $ ffa%fs(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + + CALL ascii_open(out_xpt_unit,"y_out.csv","UNKNOWN") + !PRINT "(A)", "y_out" + DO i=0,(len_ff-1),+1 + IF(.TRUE.)WRITE(out_xpt_unit,412) + $ y_out(i,0), + $ y_out(i,1), + $ y_out(i,2), + $ y_out(i,3), + $ y_out(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) + + CALL ascii_open(out_xpt_unit,"y_outa.csv","UNKNOWN") + !PRINT "(A)", "y_outa" + DO i=0,(len_ffa-1),+1 + IF(.TRUE.)WRITE(out_xpt_unit,412) + $ y_outa(i,0), + $ y_outa(i,1), + $ y_outa(i,2), + $ y_outa(i,3), + $ y_outa(i,4) + ENDDO + CALL ascii_close(out_xpt_unit) +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_spline_comparison +c----------------------------------------------------------------------- +c subprogram 18. direct_Blocal. c calculates local B-field displaced from some r,z point in polar c coordinates. either Bnu or Brho depending on Bcase c----------------------------------------------------------------------- From c78c20c8c57084fccbb0d14a2035809bbd2c3c67 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Thu, 13 Jun 2024 18:39:35 -0400 Subject: [PATCH 55/97] replicating latest GPEC commit --- gpec/gpout.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gpec/gpout.f b/gpec/gpout.f index c5e51cb8..4dabf168 100644 --- a/gpec/gpout.f +++ b/gpec/gpout.f @@ -1768,10 +1768,10 @@ SUBROUTINE gpout_singfld(egnum,xspmn,spot,nspot, IF (verbose) THEN IF (callen_threshold_flag .OR. slayer_threshold_flag) THEN - IF(ising == 1) WRITE(*,'(1x,7a12)') + IF(ising == 1) WRITE(*,'(1x,7a13)') $ "psi","q","singflx","chirikov", $ "w_island","w_crit","singflx_crit" - WRITE(*,'(1x,es12.3,f12.3,es12.3,f12.3,3es12.3)') + WRITE(*,'(1x,es13.3,f13.3,es13.3,f13.3,3es13.3)') $ respsi,sq%f(4),ABS(singflx_mn(resnum(ising),ising)), $ chirikov(ising),2*island_hwidth(ising), $ 2*hw_crit(ising),b_crit(ising) From a72b6be13e98c2fa5bc583b9017548603ffda3d8 Mon Sep 17 00:00:00 2001 From: logan-nc <6198372+logan-nc@users.noreply.github.com> Date: Fri, 14 Jun 2024 16:16:43 -0400 Subject: [PATCH 56/97] Empty-Commit to establish new branch From 504930529a6a0182ac8cc79b866a2d8988cca89f Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 18 Aug 2024 15:37:02 -0400 Subject: [PATCH 57/97] new convergence & result printing capabilities added (code is rough, will need to be cleaned up) --- equil/direct.f | 521 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 408 insertions(+), 113 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 993c224d..2edb83ec 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -46,7 +46,7 @@ MODULE direct_mod LOGICAL, DIMENSION(1:2) :: outside_sep,usevth2 REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in - LOGICAL :: direct_infinite_loop_flag + LOGICAL :: direct_infinite_loop_flag,plot_convergence1 INTEGER :: direct_infinite_loop_count = 2000 INTEGER :: num_xpts @@ -55,10 +55,10 @@ MODULE direct_mod REAL(r8) :: br,bz,brr,brz,bzr,bzz END TYPE direct_bfield_type - REAL(r8) :: etol=1e-8, dqdeps_tol=500, BpBt_tol=0.001 + REAL(r8) :: etol=1e-8, dqdeps_tol=80, BpBt_tol=0.00001 INTEGER :: nstepd=2048 INTEGER :: nstep2=2048 - REAL(r8) :: xcheck=0.99 + REAL(r8) :: xcheck=0.99, dqdeps_tmp CONTAINS c----------------------------------------------------------------------- @@ -71,26 +71,31 @@ MODULE direct_mod SUBROUTINE direct_run INTEGER :: ir,iz,itheta,ipsi,len_y_out,len_y_last - INTEGER :: maxima_count,i + INTEGER :: maxima_count,i,ipri,pl REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q,flast REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out_last - REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4) :: y_out,y_outa + REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4) :: y_out,y_outnum REAL(r8), DIMENSION(2, mpsi+1) :: xdx REAL(r8), DIMENSION(3,3) :: v REAL(r8), DIMENSION(3,2) :: eta_brackets REAL(r8), DIMENSION(3) :: eta_maxes + INTEGER, DIMENSION(2) :: xpt_starts - LOGICAL :: use_analytic,run_xpt,debug,xmsg + LOGICAL :: use_analytic,run_xpt,debug,xmsg,plot_convergence + LOGICAL :: new_xpt - REAL(r8) :: xm,dx,rholow,rhohigh,rx,zx + REAL(r8) :: xm,dx,rholow,rhohigh,rx,zx,maxBpBt TYPE(direct_bfield_type) :: bf - TYPE(spline_type) :: ff,ffa + TYPE(spline_type) :: ff,ffnum CHARACTER(64) :: message - use_analytic=.FALSE. - run_xpt=.TRUE. - debug=.FALSE. + pl=25 + plot_convergence=.FALSE. ! + plot_convergence1=plot_convergence + use_analytic=.FALSE. !must be initialised to false + run_xpt=.TRUE. !set to false to avoid all x-point scripts + debug=.FALSE. !dumps all spline info to csv xmsg=.TRUE. xpt_etas=0.0 xpt_brackets=0.0 @@ -98,7 +103,8 @@ SUBROUTINE direct_run eta_brackets=0.0 num_xpts=0 maxima_count=0 - y_outa=0 + y_outnum=0 + dqdeps_tmp=dqdeps_tol 412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) 413 FORMAT(1x,"ipsi =",i4,"/",i4) 414 FORMAT(1x,"psifac =",f13.10) @@ -189,8 +195,30 @@ SUBROUTINE direct_run c integral formulas near separatrix. c----------------------------------------------------------------------- IF(use_analytic .AND. run_xpt)THEN - CALL direct_mixed_spline_builder(sq%xs(ipsi),ff,y_out,debug) - istep=SIZE(ff%xs,1)-1 + IF(debug)THEN + CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_outnum,bf, + $ len_y_out) + CALL spline_alloc(ffnum,istep,4) + ffnum%xs(0:istep)=y_outnum(0:istep,4)/y_outnum(istep,4) + ffnum%fs(0:istep,1)=y_outnum(0:istep,2)**2 + ffnum%fs(0:istep,2)=y_outnum(0:istep,0)/twopi + $ -ffnum%xs(0:istep) + ffnum%fs(0:istep,3)=bf%f* + $ (y_outnum(0:istep,3)-ffnum%xs(0:istep)*y_outnum(istep,3)) + ffnum%fs(0:istep,4)=y_outnum(0:istep,1)/y_outnum(istep,1) + $ -ffnum%xs + + CALL direct_mixed_spline_builder(sq%xs(ipsi),ff,y_out, + $ debug,maxBpBt,xpt_starts) + istep=SIZE(ff%xs,1)-1 + + CALL direct_spline_comparison(ffnum,ff,y_outnum,len_y_out + $ ,bf,y_out,ipsi,0,sq%xs(ipsi),maxBpBt,xpt_starts,dqdeps_tol) + ELSE + CALL direct_mixed_spline_builder(sq%xs(ipsi),ff,y_out, + $ debug,maxBpBt,xpt_starts) + istep=SIZE(ff%xs,1)-1 + ENDIF ELSE CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_out,bf, $ len_y_out) @@ -198,69 +226,101 @@ SUBROUTINE direct_run c checks whether q-integral is diverging. c----------------------------------------------------------------------- IF(sq%xs(ipsi)>xcheck .AND. run_xpt)THEN - CALL direct_initialise_xpoints(y_out,len_y_out,.TRUE., + IF(.NOT.plot_convergence)THEN + pl=-1 + ENDIF + DO ipri=0,pl,+1 + IF(plot_convergence)THEN + IF(ipri>0)THEN + dqdeps_tol=dqdeps_tol*sqrt(sqrt(sqrt(10.0))) + IF(ipri0)THEN + CALL spline_dealloc(ffnum) + ENDIF + ENDIF + ELSE + dqdeps_tol=dqdeps_tmp + ENDIF + xpt_etas=0.0 + xpt_brackets=0.0 + eta_maxes=0.0 + eta_brackets=0.0 + num_xpts=0 + maxima_count=0 + y_outnum=0 + ENDIF + CALL direct_initialise_xpoints(y_out,len_y_out,.TRUE., $ .FALSE.,bf,dqdeps_tol,BpBt_tol,eta_maxes, $ eta_brackets,maxima_count) - IF(debug)THEN - CALL ascii_open(out_xpt_unit,"y_out.csv","UNKNOWN") - DO i=0,len_y_out,+1 - WRITE(out_xpt_unit,412) - $ y_out(i,0), - $ y_out(i,1), - $ y_out(i,2), - $ y_out(i,3), - $ y_out(i,4) - ENDDO - CALL ascii_close(out_xpt_unit) - - - CALL spline_alloc(ff,istep,4) - ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) - ff%fs(0:istep,1)=y_out(0:istep,2)**2 - ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* - $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) - ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs - ENDIF - - IF(maxima_count > 0 .AND. run_xpt)THEN - use_analytic = .TRUE. - num_xpts=maxima_count - - DO i=1,maxima_count,+1 - xpt_etas(i)=eta_maxes(i) !updated by direct_xpoint - xpt_brackets(i,1)=eta_brackets(i,1) - xpt_brackets(i,2)=eta_brackets(i,2) - - CALL find_fl_surface(one,xpt_etas(i),rx,zx) - CALL direct_xpoint(rx,zx,i) - ENDDO - - IF(debug)THEN - CALL direct_mixed_spline_builder(sq%xs(ipsi), - $ ffa,y_outa,debug) - CALL direct_spline_comparison(ff,ffa,y_out,y_outa) - CALL program_stop("Running xpt debug, stopping") - ELSE - CALL direct_mixed_spline_builder(sq%xs(ipsi), - $ ff,y_out,debug) - istep=SIZE(ff%xs,1)-1 - ENDIF + IF(maxima_count > 0 .AND. run_xpt)THEN + IF(.NOT.plot_convergence)THEN + use_analytic=.TRUE. + ENDIF + num_xpts=maxima_count + + DO i=1,maxima_count,+1 + xpt_etas(i)=eta_maxes(i)!updated by direct_xpoint + xpt_brackets(i,1)=eta_brackets(i,1) + xpt_brackets(i,2)=eta_brackets(i,2) + + CALL find_fl_surface(one,xpt_etas(i),rx,zx) + CALL direct_xpoint(rx,zx,i,new_xpt) + ENDDO + + IF(debug)THEN +41234 FORMAT(I9.9,",",I9.9,",",I9.9,",",f17.14,",", + $ f17.14,",",f17.14,",",f17.14,",",f17.14) + message="" + WRITE (message, "(A18)") "xpt_tests/data.csv" + CALL ascii_open(out_xpt_unit,trim(message) + $ ,"UNKNOWN") + WRITE(out_xpt_unit,41234)ipsi,mpsi,mtheta, + $ sq%xs(ipsi),ro,zo,rxs(1),zxs(1) + CALL ascii_close(out_xpt_unit) + + CALL spline_alloc(ffnum,istep,4) + ffnum%xs(0:istep)=y_out(0:istep,4)/ + $ y_out(istep,4) + ffnum%fs(0:istep,1)=y_out(0:istep,2)**2 + ffnum%fs(0:istep,2)=y_out(0:istep,0)/twopi + $ -ffnum%xs(0:istep) + ffnum%fs(0:istep,3)=bf%f* + $ (y_out(0:istep,3)-ffnum%xs(0:istep)*y_out(istep,3)) + ffnum%fs(0:istep,4)=y_out(0:istep,1)/ + $ y_out(istep,1) -ffnum%xs + y_outnum=y_out + PRINT "(A)","Fakeout NORan" + CALL direct_mixed_spline_builder(sq%xs(ipsi), + $ ff,y_out,debug,maxBpBt,xpt_starts) + PRINT "(A)","Fakeout Ran" + CALL direct_spline_comparison(ffnum,ff,y_outnum, + $ len_y_out,bf,y_out,ipsi,ipri,sq%xs(ipsi),maxBpBt, + $ xpt_starts,dqdeps_tol) + ELSE + CALL direct_mixed_spline_builder(sq%xs(ipsi), + $ ff,y_out,debug,maxBpBt,xpt_starts) + istep=SIZE(ff%xs,1)-1 + ENDIF c----------------------------------------------------------------------- c no x-points found, fit numerically integrated c data to cubic splines c----------------------------------------------------------------------- - ELSE - CALL spline_alloc(ff,istep,4) - ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) - ff%fs(0:istep,1)=y_out(0:istep,2)**2 - ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* + ELSE + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi + $ -ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) - ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1)-ff%xs - CALL spline_fit(ff,"periodic") - ENDIF + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) + $ -ff%xs + CALL spline_fit(ff,"periodic") + ENDIF + IF(.NOT.plot_convergence)EXIT + ENDDO ELSE c----------------------------------------------------------------------- c if not diverging, fit numerically integrated data to cubic splines @@ -384,6 +444,9 @@ SUBROUTINE direct_run ENDDO ENDDO CALL bicube_fit(eqfun,"extrap","periodic") + IF(plot_convergence)THEN + CALL program_stop("plotting convergence done") + ENDIF c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- @@ -650,10 +713,13 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) $ REAL(eta,4),REAL(rwork(11),4),REAL(y(1:4),4),REAL(r,4), $ REAL(z,4),REAL(psifac,4),REAL(err,4) c----------------------------------------------------------------------- -c advance differential equations. +c stopping conditions. c----------------------------------------------------------------------- IF(eta >= eta2 .OR. istep >= nstepd .OR. istate < 0 $ .OR. ABS(err) >= 1)EXIT +c----------------------------------------------------------------------- +c advance differential equations. +c----------------------------------------------------------------------- istep=istep+1 CALL lsode(direct_fl_der,neq,y,eta,eta2,itol,rtol,atol, $ itask,istate,iopt,rwork,lrw,iwork,liw,jac,mf) @@ -1330,12 +1396,14 @@ END SUBROUTINE direct_psisaddle c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_xpoint(rin,zin,x_i) + SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) REAL(r8), INTENT(IN) :: rin,zin INTEGER, INTENT(IN) :: x_i + LOGICAL, INTENT(OUT) :: new_xpt INTEGER, PARAMETER :: ird=4 + INTEGER :: i REAL(r8), PARAMETER :: psi_eps=1e-4, r_eps1=1e-9 REAL(r8) :: r,z REAL(r8) :: b11,lincheck,gamma,vartheta @@ -1350,6 +1418,7 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) nu=0.0 test_direct_local_xpoint=.FALSE. test_direct_saddle_angle=.FALSE. + new_xpt=.FALSE. c----------------------------------------------------------------------- c testing direct_local_xpoint. c----------------------------------------------------------------------- @@ -1382,10 +1451,24 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) PRINT "(A)", "------------------------------------------" ENDIF c----------------------------------------------------------------------- -c finds x-point and fills out global module variables +c finds x-point c----------------------------------------------------------------------- CALL direct_local_xpoint(r,z) CALL direct_get_bfield(r,z,bf,1) +c----------------------------------------------------------------------- +c checks if this xpoint has already been identified +c----------------------------------------------------------------------- + IF(x_i>0)THEN + DO i=1,(x_i-1),+1 + IF(ABS(r-rxs(i))<(0.001*ro) .AND. + $ ABS(z-zxs(i))<(0.001*ro))THEN + RETURN + ENDIF + ENDDO + ENDIF +c----------------------------------------------------------------------- +c fills out global module variables +c----------------------------------------------------------------------- rxs(x_i) = r zxs(x_i) = z c----------------------------------------------------------------------- @@ -1419,7 +1502,7 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) CALL direct_saddle_angle(rxs(x_i),zxs(x_i),r_eps1*rxs(x_i),oangle, $ -nu_var,nu(2),'n',.FALSE.) c----------------------------------------------------------------------- -c testing direct_saddle_angle AGAGAG +c testing direct_saddle_angle c----------------------------------------------------------------------- IF(test_direct_saddle_angle)THEN CALL direct_Blocal(rxs(x_i),zxs(x_i),nu(1),r_eps1*rxs(x_i), @@ -1500,6 +1583,10 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) xpt_gammas2(x_i) = xpt_gammas2(x_i) $ - twopi*floor(xpt_gammas2(x_i)/twopi) c----------------------------------------------------------------------- +c acknowledges new xpoint after all module variables filled +c----------------------------------------------------------------------- + new_xpt=.TRUE. +c----------------------------------------------------------------------- c making sure there isn't much difference between the varthetas and c gamma angles asymptotically close to the x-point vs at the c switch-over location. Note if the x-point is slightly outside the @@ -1513,7 +1600,9 @@ SUBROUTINE direct_xpoint(rin,zin,x_i) !PRINT "(i6)", x_i !PRINT "(es16.10)", xpt_gammas(x_i)/pi !PRINT "(es16.10)", xpt_gammas2(x_i)/pi - CALL program_stop("increase dq_eps.") + IF(.NOT.plot_convergence1)THEN + CALL program_stop("increase dq_eps.") + ENDIF ENDIF c----------------------------------------------------------------------- c regular print statements. eta bracket describes the region where @@ -2065,9 +2154,12 @@ END SUBROUTINE direct_analytic_ints c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) + SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in, + $ maxBpBt,xpt_starts) REAL(r8), INTENT(INOUT) :: psifac + REAL(r8), INTENT(OUT) :: maxBpBt + INTEGER, DIMENSION(2), INTENT(OUT) :: xpt_starts LOGICAL, INTENT(IN) :: debug_in REAL(r8) :: eta,eta1,eta2,R,Z,etat,y01,y02,y03,y04 @@ -2077,11 +2169,12 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out1,y_out2 REAL(r8), DIMENSION(0:(nstepd+1),0:4) :: y_out2i - REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4) :: y_out + REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4), + $ INTENT(INOUT) :: y_out REAL(r8), DIMENSION(1:4,1:2,0:1) :: outmat INTEGER :: len_y1_out,len_y2_out,maxima_count,tot_steps,ist1,ist2 INTEGER :: i1,i2,i,j,k,eta0i - LOGICAL :: dbg1xpt,debug,out + LOGICAL :: dbg1xpt,debug,out,fakeout,new_xpt REAL(r8), DIMENSION(6,2) :: eta_brackets REAL(r8), DIMENSION(6) :: eta_maxes @@ -2094,9 +2187,13 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) yi2=0.0 y_out1=0.0 y_out2=0.0 + y_out=0.0 + maxBpBt=0.0 + xpt_starts=-1 dbg1xpt=.FALSE. debug=.FALSE. out=.FALSE. + fakeout=.TRUE. c----------------------------------------------------------------------- c preparing print statements. c----------------------------------------------------------------------- @@ -2111,7 +2208,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) c----------------------------------------------------------------------- c adddressing case of only one x-point. c----------------------------------------------------------------------- - IF(num_xpts==1)THEN + IF(num_xpts==1 .AND. (.NOT.fakeout))THEN c----------------------------------------------------------------------- c calling direct_analytic_ints on the initial x-point over full eta c span. Note we don't need to call find_fl_surface, direct_xpoint @@ -2144,6 +2241,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) bt2=bf%f/outmat(2,1,1) PRINT "(A,es10.3)"," max Bp/Bt (x-point)=", $ MAX(bp1/bt1,bp2/bt2) + maxBpBt=MAX(bp1/bt1,bp2/bt2) ENDIF IF(out)WRITE(out_xpt_unit,412) @@ -2500,7 +2598,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) xpt_brackets(num_xpts,2)=eta_brackets(i,2) CALL find_fl_surface(one,xpt_etas(num_xpts),r,z) - CALL direct_xpoint(r,z,num_xpts) + CALL direct_xpoint(r,z,num_xpts,new_xpt) ENDDO c----------------------------------------------------------------------- @@ -2626,8 +2724,159 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) c direct_spline_comparison c----------------------------------------------------------------------- CALL spline_dealloc(yi) - IF(debug_in)PRINT "(A)", "ff x-pt start point:" - IF(debug_in)PRINT "(i6)", (istep+1-eta0i) + !IF(debug_in)PRINT "(A)", "ff x-pt start point:" + !IF(debug_in)PRINT "(i6)", (istep+1-eta0i) + xpt_starts(1)=(istep+1-eta0i) +c----------------------------------------------------------------------- +c fakeout option is used for testing integrator error/debugging. +c won't be used in normal operation +c----------------------------------------------------------------------- + ELSEIF(num_xpts==1 .AND. fakeout)THEN +c----------------------------------------------------------------------- +c testing script to identify mysterious error source 0_0 :3 +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c calling direct_analytic_ints on the initial x-point over full eta +c span. Note we don't need to call find_fl_surface, direct_xpoint +c since these were already called for this x-point in direct_run's +c psi loop +c----------------------------------------------------------------------- + CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) + r_loc1 = SQRT((r-ro)**2+(z-zo)**2) + CALL direct_get_bfield(r,z,bf,1) +c----------------------------------------------------------------------- +c ordering the two etas for numerical field line integration +c----------------------------------------------------------------------- + eta1 = xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) + eta2 = xpt_brackets(1,2) - twopi*floor(xpt_brackets(1,2)/twopi) + + IF(eta2zero)THEN + eta0i=i + EXIT + ENDIF + ENDDO + + i=MAX(eta0i-5,0) + j=MIN(eta0i+5,len_y1_out) + + CALL spline_alloc(yi,j-i,4) + + DO k=i,j,+1 + yi%xs(k-i)=y_out1(k,0) + yi%fs(k-i,1)=y_out1(k,1) + yi%fs(k-i,2)=y_out1(k,2) + yi%fs(k-i,3)=y_out1(k,3) + yi%fs(k-i,4)=y_out1(k,4) + + ENDDO + + CALL spline_fit(yi,"extrap") + CALL spline_eval(yi,zero,0) + y01=yi%f(1) + y02=yi%f(2) + y03=yi%f(3) + y04=yi%f(4) + CALL spline_dealloc(yi) +c----------------------------------------------------------------------- +c adding consecutive integral sections. spline length of tot_steps +c +1 is used to make space for the interpolated point at eta=0.0 +c----------------------------------------------------------------------- + IF(istep /= len_y1_out)CALL program_stop("minor err. direct.f") + istep=len_y1_out + + tot_steps=istep + + CALL spline_alloc(yi,tot_steps+1,4) +c----------------------------------------------------------------------- +c filling out points up to eta = 0.0 +c----------------------------------------------------------------------- + yi%xs(0:(eta0i-1))=y_out1(0:(eta0i-1),0) + yi%fs(0:(eta0i-1),1)=y_out1(0:(eta0i-1),1) + yi%fs(0:(eta0i-1),2)=y_out1(0:(eta0i-1),2) + yi%fs(0:(eta0i-1),3)=y_out1(0:(eta0i-1),3) + yi%fs(0:(eta0i-1),4)=y_out1(0:(eta0i-1),4) +c----------------------------------------------------------------------- +c putting in interpolated point at eta = 0.0 +c----------------------------------------------------------------------- + yi%xs(eta0i)=zero + yi%fs(eta0i,1)=y01 + yi%fs(eta0i,2)=y02 + yi%fs(eta0i,3)=y03 + yi%fs(eta0i,4)=y04 +c----------------------------------------------------------------------- +c putting in the rest of the numerically integrated points +c----------------------------------------------------------------------- + yi%xs((eta0i+1):istep+1)=y_out1(eta0i:istep,0) + yi%fs((eta0i+1):istep+1,1)=y_out1(eta0i:istep,1) + yi%fs((eta0i+1):istep+1,2)=y_out1(eta0i:istep,2) + yi%fs((eta0i+1):istep+1,3)=y_out1(eta0i:istep,3) + yi%fs((eta0i+1):istep+1,4)=y_out1(eta0i:istep,4) +c----------------------------------------------------------------------- +c wrapping around to start yi at eta = 0.0 +c----------------------------------------------------------------------- + istep=tot_steps+1 + + DO i=0,istep,+1 + j=eta0i+i + + IF(j>istep)THEN + j=j-istep-1 + y_out(i,1)=yi%fs(j,1)+yi%fs(istep,1) + y_out(i,3)=yi%fs(j,3)+yi%fs(istep,3) + y_out(i,4)=yi%fs(j,4)+yi%fs(istep,4) + ELSE + y_out(i,1)=yi%fs(j,1) + y_out(i,3)=yi%fs(j,3) + y_out(i,4)=yi%fs(j,4) + ENDIF + y_out(i,2)=yi%fs(j,2) + + IF(yi%xs(j)<0.0)THEN + y_out(i,0)=yi%xs(j)+twopi + ELSE + y_out(i,0)=yi%xs(j) + ENDIF + ENDDO + + y_out(:,1)=y_out(:,1)-yi%fs(eta0i,1) + y_out(:,3)=y_out(:,3)-yi%fs(eta0i,3) + y_out(:,4)=y_out(:,4)-yi%fs(eta0i,4) +c----------------------------------------------------------------------- +c building ff +c----------------------------------------------------------------------- + CALL spline_alloc(ff,istep,4) + ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) + ff%fs(0:istep,1)=y_out(0:istep,2)**2 + ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) + ff%fs(0:istep,3)=bf%f* + $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) + ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) + $ -ff%xs +c----------------------------------------------------------------------- +c deallocating spline, printing important information for +c direct_spline_comparison +c----------------------------------------------------------------------- + CALL spline_dealloc(yi) + !IF(debug_in)PRINT "(A)", "ff x-pt start point:" + !IF(debug_in)PRINT "(i6)", (istep+1-eta0i) + xpt_starts(1)=(istep+1-eta0i) ELSE c----------------------------------------------------------------------- c 2 x-points: making sure all brackets are in [0,2pi) @@ -2681,6 +2930,7 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) bt2=bf%f/outmat(2,1,1) PRINT "(A,es10.3)"," max Bp/Bt (1st x-point) =", $ MAX(bp1/bt1,bp2/bt2) + maxBpBt=MAX(bp1/bt1,bp2/bt2) ENDIF c----------------------------------------------------------------------- c second x-point divergent analytic integrals: @@ -2702,6 +2952,9 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) bt2=bf%f/outmat(2,1,1) PRINT "(A,es10.3)"," max Bp/Bt (2nd x-point) =", $ MAX(bp1/bt1,bp2/bt2) + IF(MAX(bp1/bt1,bp2/bt2)>maxBpBt)THEN + maxBpBt=MAX(bp1/bt1,bp2/bt2) + ENDIF ENDIF ENDDO c----------------------------------------------------------------------- @@ -2928,10 +3181,12 @@ SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in) y_out(0,0)=zero - IF(debug_in)PRINT "(A)", "ff 1st x-pt start point:" - IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i) - IF(debug_in)PRINT "(A)", "ff 2nd x-pt start point:" - IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i+nstep2+ist1+1) + !IF(debug_in)PRINT "(A)", "ff 1st x-pt start point:" + !IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i) + !IF(debug_in)PRINT "(A)", "ff 2nd x-pt start point:" + !IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i+nstep2+ist1+1) + xpt_starts(1)=(tot_steps+1-eta0i) + xpt_starts(2)=(tot_steps+1-eta0i+nstep2+ist1+1) CALL spline_dealloc(ffi) CALL spline_dealloc(yi) @@ -2949,44 +3204,78 @@ END SUBROUTINE direct_mixed_spline_builder c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_spline_comparison(ff,ffa,y_out,y_outa) + SUBROUTINE direct_spline_comparison(ffnum,ffa,y_outnum,len_y_out, + $ bf,y_outa,ipsi,ipri,psifac,maxBpBt,xpt_starts,dq_deps_in) - TYPE(spline_type), INTENT(IN) :: ff,ffa + TYPE(spline_type), INTENT(IN) :: ffnum,ffa REAL(r8), INTENT(IN), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4):: - $ y_out,y_outa - REAL(r8) :: r,z + $ y_outnum,y_outa + REAL(r8), INTENT(IN) :: psifac,dq_deps_in,maxBpBt + INTEGER, INTENT(IN) :: ipsi,ipri,len_y_out + TYPE(direct_bfield_type), INTENT(IN) :: bf + INTEGER, DIMENSION(2), INTENT(IN) :: xpt_starts + + CHARACTER(1024) :: filename + REAL(r8), DIMENSION(1:len_y_out) :: dqdeta + REAL(r8) :: maxdqdeps INTEGER :: i,len_ff,len_ffa c----------------------------------------------------------------------- c checking lengths. c----------------------------------------------------------------------- - len_ff=SIZE(ff%xs,1) + len_ff=SIZE(ffnum%xs,1) len_ffa=SIZE(ffa%xs,1) - !IF(len_ff/=SIZE(y_out,1))CALL program_stop("blerg1") + !IF(len_ff/=SIZE(y_outnum,1))CALL program_stop("blerg1") !IF(len_ffa/=SIZE(y_outa,1))CALL program_stop("blerg2") - PRINT "(A)", "Length ff:" - PRINT "(i6)", len_ff - PRINT "(A)", "Length ffa:" - PRINT "(i6)", len_ffa + !PRINT "(A)", "Length ffnum:" + !PRINT "(i6)", len_ff + !PRINT "(A)", "Length ffa:" + !PRINT "(i6)", len_ffa +c----------------------------------------------------------------------- +c generate maxdqdeta from numerical y_outnum. +c----------------------------------------------------------------------- + DO i=0,(len_y_out-1),+1 + dqdeta(i+1) = (bf%f)*(y_outnum(i+1,3)-y_outnum(i,3)) + $ /(y_outnum(i+1,0)-y_outnum(i,0))! + ENDDO + maxdqdeps=MAXVAL(dqdeta) +c----------------------------------------------------------------------- +c printing data +c----------------------------------------------------------------------- +415 FORMAT(f16.12,",",f16.12,",",f40.12,",",I9.9,",",I9.9,",",I9.9, + $ ",",f40.12) + filename="" + WRITE (filename, "(A17,I5.5,A1,I5.5,A4)") "xpt_tests/spldata", + $ ipsi,"_",ipri,".csv" + CALL ascii_open(out_xpt_unit,TRIM(filename),"UNKNOWN") + WRITE(out_xpt_unit,415)psifac,maxBpBt,maxdqdeps,nstep2, + $ xpt_starts(1),xpt_starts(2),dq_deps_in + CALL ascii_close(out_xpt_unit) c----------------------------------------------------------------------- c printing the splines c----------------------------------------------------------------------- 412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) - CALL ascii_open(out_xpt_unit,"ff_test_new.csv","UNKNOWN") - !PRINT "(A)", "ff" + filename="" + WRITE (filename, "(A16,I5.5,A1,I5.5,A4)") "xpt_tests/ff_num", + $ ipsi,"_",ipri,".csv" + CALL ascii_open(out_xpt_unit,TRIM(filename),"UNKNOWN") + DO i=0,(len_ff-1),+1 - IF(.TRUE.)WRITE(out_xpt_unit,412)ff%xs(i), - $ ff%fs(i,1), - $ ff%fs(i,2), - $ ff%fs(i,3), - $ ff%fs(i,4) + IF(.TRUE.)WRITE(out_xpt_unit,412)ffnum%xs(i), + $ ffnum%fs(i,1), + $ ffnum%fs(i,2), + $ ffnum%fs(i,3), + $ ffnum%fs(i,4) ENDDO CALL ascii_close(out_xpt_unit) - CALL ascii_open(out_xpt_unit,"ffa_test_new.csv","UNKNOWN") - !PRINT "(A)", "ffa" + filename="" + WRITE (filename, "(A14,I5.5,A1,I5.5,A4)") "xpt_tests/ff_a", + $ ipsi,"_",ipri,".csv" + CALL ascii_open(out_xpt_unit,TRIM(filename),"UNKNOWN") + DO i=0,(len_ffa-1),+1 IF(.TRUE.)WRITE(out_xpt_unit,412)ffa%xs(i), $ ffa%fs(i,1), @@ -2996,20 +3285,26 @@ SUBROUTINE direct_spline_comparison(ff,ffa,y_out,y_outa) ENDDO CALL ascii_close(out_xpt_unit) - CALL ascii_open(out_xpt_unit,"y_out.csv","UNKNOWN") - !PRINT "(A)", "y_out" + filename="" + WRITE (filename, "(A18,I5.5,A1,I5.5,A4)") "xpt_tests/y_outnum", + $ ipsi,"_",ipri,".csv" + CALL ascii_open(out_xpt_unit,TRIM(filename),"UNKNOWN") + DO i=0,(len_ff-1),+1 IF(.TRUE.)WRITE(out_xpt_unit,412) - $ y_out(i,0), - $ y_out(i,1), - $ y_out(i,2), - $ y_out(i,3), - $ y_out(i,4) + $ y_outnum(i,0), + $ y_outnum(i,1), + $ y_outnum(i,2), + $ y_outnum(i,3), + $ y_outnum(i,4) ENDDO CALL ascii_close(out_xpt_unit) - CALL ascii_open(out_xpt_unit,"y_outa.csv","UNKNOWN") - !PRINT "(A)", "y_outa" + filename="" + WRITE (filename, "(A16,I5.5,A1,I5.5,A4)") "xpt_tests/y_outa", + $ ipsi,"_",ipri,".csv" + CALL ascii_open(out_xpt_unit,TRIM(filename),"UNKNOWN") + DO i=0,(len_ffa-1),+1 IF(.TRUE.)WRITE(out_xpt_unit,412) $ y_outa(i,0), From b3ac452c843aba4b786f24244b46310d2ed7dc56 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 18 Aug 2024 15:37:48 -0400 Subject: [PATCH 58/97] direct_fl_int draft changes added (commented out) --- equil/direct.f | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 2edb83ec..019a1e45 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -632,8 +632,11 @@ END SUBROUTINE direct_position c declarations. c----------------------------------------------------------------------- SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) + !$ min_BpOnBt,max_dy1,eval_BpOnBt,eval_dy1,probe_xpt) - REAL(r8), INTENT(IN) :: psifac,eta1,eta2 + REAL(r8), INTENT(IN) :: psifac,eta1,eta2!,min_BpOnBt,max_dy1 + !REAL(r8), INTENT(OUT) :: eval_BpOnBt,eval_dy1 + !LOGICAL, INTENT(IN) :: probe_xpt INTEGER, INTENT(OUT) :: len_y_out REAL(r8), DIMENSION(0:,0:), INTENT(OUT) :: y_out TYPE(direct_bfield_type), INTENT(OUT) :: bf @@ -644,9 +647,10 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) INTEGER :: iopt,istate,itask,itol,jac,mf INTEGER, DIMENSION(liw) :: iwork REAL(r8), PARAMETER :: eps=1e-12 - REAL(r8) :: atol,rtol,rfac,deta,r,z,eta,err,psi0 + REAL(r8) :: atol,rtol,rfac,deta,r,z,eta,err,psi0,bp,bt,rx,zx,dy1 REAL(r8), DIMENSION(neq) :: y REAL(r8), DIMENSION(lrw) :: rwork + LOGICAL :: new_xpt c----------------------------------------------------------------------- c format statements. c----------------------------------------------------------------------- @@ -705,6 +709,13 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) y_out(istep,:)=(/eta,y/) err=(bf%psi-psi0)/bf%psi c----------------------------------------------------------------------- +c compute ratio of Bp to Bt, as well as divergent integrand related +c to q (dy1) +c----------------------------------------------------------------------- + !bp=SQRT(bf%br**2+bf%bz**2) + !bt=bf%f/r + !dy1=rfac/(bf%bz*COS(eta)-bf%br*SIN(eta)) +c----------------------------------------------------------------------- c compute and print output for each step. c----------------------------------------------------------------------- IF(out_fl)WRITE(out_2d_unit,30) @@ -717,6 +728,7 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) c----------------------------------------------------------------------- IF(eta >= eta2 .OR. istep >= nstepd .OR. istate < 0 $ .OR. ABS(err) >= 1)EXIT + !$ .OR. ((bp/bt)max_dy1))EXIT c----------------------------------------------------------------------- c advance differential equations. c----------------------------------------------------------------------- @@ -729,7 +741,18 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) c----------------------------------------------------------------------- c abort if istep > nstepd. c----------------------------------------------------------------------- - IF(eta < eta2)THEN + IF(.FALSE.)THEN!(bp/bt)<=min_BpOnBt .AND. ABS(dy1)>max_dy1)THEN + !IF(probe_xpt)THEN + ! rx=r + ! zx=z + ! CALL direct_xpoint(rx,zx,num_xpts+1,new_xpt) + ! IF(new_xpt)THEN + ! num_xpts=num_xpts+1 + ! ENDIF + !ENDIF + !eval_dy1=ABS(dy1) + !eval_BpOnBt=(bp/bt) + ELSEIF(eta < eta2)THEN WRITE(message,61)istep,nstepd WRITE(message2,11)eta,eta1,eta2 PRINT "(A)", message @@ -743,6 +766,8 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) IF(verbose)PRINT "(A)", message ENDIF len_y_out = istep + !eval_dy1=-1.0 + !eval_BpOnBt=-1.0 c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- From 9451ca7924609f2d1b5f4dde88cf4a8ffc5fa7ba Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 18 Aug 2024 15:38:43 -0400 Subject: [PATCH 59/97] bug fix: DO loop start no longer set to -1 (causes error) --- equil/direct.f | 3 --- 1 file changed, 3 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 019a1e45..85d6b8e8 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -226,9 +226,6 @@ SUBROUTINE direct_run c checks whether q-integral is diverging. c----------------------------------------------------------------------- IF(sq%xs(ipsi)>xcheck .AND. run_xpt)THEN - IF(.NOT.plot_convergence)THEN - pl=-1 - ENDIF DO ipri=0,pl,+1 IF(plot_convergence)THEN IF(ipri>0)THEN From 382d786a74d1bbf5c53d79219dcf0253da60f37c Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:12:53 -0500 Subject: [PATCH 60/97] adding & adjusting new control variables --- equil/direct.f | 5 +++-- equil/equil.f | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 85d6b8e8..e59b768f 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -55,8 +55,9 @@ MODULE direct_mod REAL(r8) :: br,bz,brr,brz,bzr,bzz END TYPE direct_bfield_type - REAL(r8) :: etol=1e-8, dqdeps_tol=80, BpBt_tol=0.00001 - INTEGER :: nstepd=2048 + REAL(r8) :: etol=1e-8, dqdeps_tol=40, BpBt_tol=0.01, r_tol=1e-5 + REAL(r8) :: xpt_tol=0.2 + INTEGER :: nstepd=20000 INTEGER :: nstep2=2048 REAL(r8) :: xcheck=0.99, dqdeps_tmp diff --git a/equil/equil.f b/equil/equil.f index 39a3cb90..4e34a1e4 100644 --- a/equil/equil.f +++ b/equil/equil.f @@ -39,8 +39,8 @@ SUBROUTINE equil_read(unit, op_psihigh, op_psilow) NAMELIST/equil_control/eq_filename,eq_type,grid_type,mpsi,mtheta, $ newq0,psihigh,psilow,input_only,jac_type,power_bp,power_r, $ power_b,jac_method,convert_type,power_flag,ns1, - $ sp_pfac,sp_nx,sp_dx1,sp_dx2,use_galgrid,etol,nstepd, - $ use_classic_splines + $ sp_pfac,sp_nx,sp_dx1,sp_dx2,use_galgrid,etol,nstepd,nstep2, + $ use_classic_splines,dqdeps_tol,BpBt_tol,xpt_tol,r_tol NAMELIST/equil_output/bin_2d,bin_eq_1d,bin_eq_2d,out_2d,out_eq_1d, $ out_eq_2d,bin_fl,out_fl,interp,gse_flag,dump_flag,verbose c----------------------------------------------------------------------- From 1df65beb1f2ccd4610fd83beb52f09a0c824492c Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:13:40 -0500 Subject: [PATCH 61/97] adding module variables to control printing of results --- equil/direct.f | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index e59b768f..84174fb5 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -50,6 +50,13 @@ MODULE direct_mod INTEGER :: direct_infinite_loop_count = 2000 INTEGER :: num_xpts + LOGICAL :: debug_xpt,plot_convergence + INTEGER :: btsc1=10 ! used in plot_convergence + INTEGER :: btsc2=30 ! used in plot_convergence + INTEGER :: psfc1=10 ! used in plot_convergence + INTEGER :: psfc2=30 ! used in plot_convergence + LOGICAL :: onecase=.FALSE. ! set true to print local x-point ints + TYPE :: direct_bfield_type REAL(r8) :: psi,psir,psiz,psirz,psirr,psizz,f,f1,p,p1 REAL(r8) :: br,bz,brr,brz,bzr,bzz From 6f67cc0659de387e745cef0139838232fcd33d2c Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:14:36 -0500 Subject: [PATCH 62/97] adding variable that checks whether xpoint is inside separatrix or not --- equil/direct.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 84174fb5..1116242f 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -43,7 +43,7 @@ MODULE direct_mod REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_b11s REAL(r8), DIMENSION(1:2) :: xpt_gammas, xpt_varthetas REAL(r8), DIMENSION(1:2) :: xpt_gammas2, xpt_varthetas2 - LOGICAL, DIMENSION(1:2) :: outside_sep,usevth2 + LOGICAL, DIMENSION(1:2) :: outside_sep REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in LOGICAL :: direct_infinite_loop_flag,plot_convergence1 From da784963111b8e6cc66f1a59ab5322a2feeeed43 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:21:01 -0500 Subject: [PATCH 63/97] New finalised function list --- equil/direct.f | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 1116242f..245c6d2c 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -10,22 +10,28 @@ c 2. direct_get_bfield. c 3. direct_position. c 4. direct_fl_int. -c 4.5 find_fl_surface. -c 4.6 find_fl_surface2. c 5. direct_fl_der. c 6. direct_refine. c 7. direct_output. -c 8. direct_local_xpoint. -c 9. direct_saddle_angle. -c 10. direct_psisaddle. -c 11. direct_xpoint. -c 12. direct_initialise_xpoints. -c 13. direct_saddle_coords. -c 14. direct_saddle_coords_inv. -c 15. direct_analytic_ints. -c 16. direct_mixed_spline_builder. -c 17. direct_spline_comparison. -c 18. direct_Blocal +c 8. find_fl_surface. +c 9. find_fl_surface2. +c 10. direct_xpt_y_out. +c 11. direct_local_xpoint. +c 12. direct_saddle_angle. +c 13. direct_psisaddle. +c 14. direct_xpoint. +c 15. direct_saddle_coords. +c 16. direct_saddle_coords_inv. +c 17. int_validity_check. +c 18. direct_analytic_ints. +c 19. interp_through_zero. +c 20. patch_two_a. +c 21. patch_two_b. +c 22. patch_two_c. +c 23. yinterim. +c 24. analytic_y_out. +c 25. direct_Blocal. +c 26. plot_xpt_convergence. c----------------------------------------------------------------------- c subprogram 0. direct_mod. c module declarations. From f21a63a833151d3e54e0a0e31d0b83fe58648105 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:30:56 -0500 Subject: [PATCH 64/97] updating direct_run input variable list and initialisations --- equil/direct.f | 43 +++++++++++++++---------------------------- 1 file changed, 15 insertions(+), 28 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 245c6d2c..6f660b77 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -84,44 +84,31 @@ MODULE direct_mod c----------------------------------------------------------------------- SUBROUTINE direct_run - INTEGER :: ir,iz,itheta,ipsi,len_y_out,len_y_last - INTEGER :: maxima_count,i,ipri,pl - REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q,flast - REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out_last - REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4) :: y_out,y_outnum + INTEGER :: ir,iz,itheta,ipsi + INTEGER :: len_y_out1,len_y_out + INTEGER, DIMENSION(2) :: x_starts + REAL(r8) :: f0fac,f0,ffac,rfac,eta,r,jacfac,w11,w12,delpsi,q + REAL(r8), DIMENSION(0:(4*nstepd+2*nstep2+6),0:4) :: y_out + REAL(r8), DIMENSION(0:(nstepd+2),0:4) :: y_out1 REAL(r8), DIMENSION(2, mpsi+1) :: xdx REAL(r8), DIMENSION(3,3) :: v - REAL(r8), DIMENSION(3,2) :: eta_brackets - REAL(r8), DIMENSION(3) :: eta_maxes - INTEGER, DIMENSION(2) :: xpt_starts + REAL(r8), DIMENSION(1:4) :: difs + REAL(r8), DIMENSION(1:17) :: outmat2f - LOGICAL :: use_analytic,run_xpt,debug,xmsg,plot_convergence - LOGICAL :: new_xpt + LOGICAL :: debug - REAL(r8) :: xm,dx,rholow,rhohigh,rx,zx,maxBpBt + REAL(r8) :: xm,dx,rholow,rhohigh + REAL(r8) :: eval_BpOnBt,eval_dy1,eval_xpt_tol TYPE(direct_bfield_type) :: bf - TYPE(spline_type) :: ff,ffnum - - CHARACTER(64) :: message + TYPE(spline_type) :: ff - pl=25 - plot_convergence=.FALSE. ! - plot_convergence1=plot_convergence - use_analytic=.FALSE. !must be initialised to false - run_xpt=.TRUE. !set to false to avoid all x-point scripts + plot_convergence=.False. debug=.FALSE. !dumps all spline info to csv - xmsg=.TRUE. + debug_xpt=.TRUE. !verbose x-point outputs + xpt_etas=0.0 xpt_brackets=0.0 - eta_maxes=0.0 - eta_brackets=0.0 num_xpts=0 - maxima_count=0 - y_outnum=0 - dqdeps_tmp=dqdeps_tol -412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) -413 FORMAT(1x,"ipsi =",i4,"/",i4) -414 FORMAT(1x,"psifac =",f13.10) c----------------------------------------------------------------------- c warning. c----------------------------------------------------------------------- From a50091ac98cc15deb693a7f9f88c70e87fc03a59 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:31:10 -0500 Subject: [PATCH 65/97] intermittent error for large arrays --- equil/direct.f | 2 ++ 1 file changed, 2 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 6f660b77..e9a45564 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -117,6 +117,8 @@ SUBROUTINE direct_run $ "Warning: direct equilibrium with psihigh =",psihigh, $ " could hang on separatrix." direct_infinite_loop_flag = .FALSE. + IF(nstepd>30000)CALL program_stop( + $ "Random pointer errors may appear for large arrays..") c----------------------------------------------------------------------- c fit input to cubic splines and diagnose. c----------------------------------------------------------------------- From f952bea6d9d8e4b472d495d84664b7c2acac5f18 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:33:10 -0500 Subject: [PATCH 66/97] initial search for x-points added to direct_run. Also option to call plot_xpt_convergence immediately afterwards --- equil/direct.f | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index e9a45564..a0538007 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -178,6 +178,26 @@ SUBROUTINE direct_run IF(bin_fl)CALL bin_open(bin_2d_unit,"flint.bin","UNKNOWN", $ "REWIND","none") c----------------------------------------------------------------------- +c check for and initialise x-points if present. +c----------------------------------------------------------------------- + !Integrated around psi=1 anticlockwise, auto exits calling + !direct_fl_int if BpBt_tol or xpt_tol exceeded. + CALL direct_fl_int(1.d0-1.d-14,zero,twopi,y_out1,len_y_out1 + $ ,eval_BpOnBt,eval_dy1,eval_xpt_tol,.TRUE.,bf, .FALSE.) + IF(num_xpts>0 .AND. xpt_etas(1)" - xmsg=.FALSE. - ENDIF - - IF(verbose)WRITE(message,413)ipsi,mpsi - IF(verbose)PRINT "(A)", message - IF(verbose)WRITE(message,414)sq%xs(ipsi) - IF(verbose)PRINT "(A)", message + DO ipsi=mpsi,0,-1 + IF(debug_xpt)WRITE(*,*)"psifac:" + IF(debug_xpt)WRITE(*,*)sq%xs(ipsi) c----------------------------------------------------------------------- -c logic whether to integrate around whole field line or use analytic -c integral formulas near separatrix. +c integrating anticlockwise. c----------------------------------------------------------------------- IF(use_analytic .AND. run_xpt)THEN IF(debug)THEN @@ -358,7 +349,7 @@ SUBROUTINE direct_run c----------------------------------------------------------------------- c allocate space for rzphi and define grids. c----------------------------------------------------------------------- - IF(ipsi == 0)THEN + IF(ipsi == mpsi)THEN IF(mtheta == 0)mtheta=istep CALL bicube_alloc(rzphi,mpsi,mtheta,4) !change mtheta CALL bicube_alloc(eqfun,mpsi,mtheta,3) ! new eq information From 366ae841517f574a77691bbb43ab48946b431360 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:38:41 -0500 Subject: [PATCH 68/97] simplifying interior of direct_run to use a separate function (direct_xpt_y_out) if xpoints detected during integration along a particular field line --- equil/direct.f | 165 ++++++++----------------------------------------- 1 file changed, 26 insertions(+), 139 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 21a0d56e..668f18d4 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -208,144 +208,39 @@ SUBROUTINE direct_run c----------------------------------------------------------------------- c integrating anticlockwise. c----------------------------------------------------------------------- - IF(use_analytic .AND. run_xpt)THEN - IF(debug)THEN - CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_outnum,bf, - $ len_y_out) - CALL spline_alloc(ffnum,istep,4) - ffnum%xs(0:istep)=y_outnum(0:istep,4)/y_outnum(istep,4) - ffnum%fs(0:istep,1)=y_outnum(0:istep,2)**2 - ffnum%fs(0:istep,2)=y_outnum(0:istep,0)/twopi - $ -ffnum%xs(0:istep) - ffnum%fs(0:istep,3)=bf%f* - $ (y_outnum(0:istep,3)-ffnum%xs(0:istep)*y_outnum(istep,3)) - ffnum%fs(0:istep,4)=y_outnum(0:istep,1)/y_outnum(istep,1) - $ -ffnum%xs - - CALL direct_mixed_spline_builder(sq%xs(ipsi),ff,y_out, - $ debug,maxBpBt,xpt_starts) - istep=SIZE(ff%xs,1)-1 - - CALL direct_spline_comparison(ffnum,ff,y_outnum,len_y_out - $ ,bf,y_out,ipsi,0,sq%xs(ipsi),maxBpBt,xpt_starts,dqdeps_tol) - ELSE - CALL direct_mixed_spline_builder(sq%xs(ipsi),ff,y_out, - $ debug,maxBpBt,xpt_starts) - istep=SIZE(ff%xs,1)-1 - ENDIF - ELSE - CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_out,bf, - $ len_y_out) -c----------------------------------------------------------------------- -c checks whether q-integral is diverging. -c----------------------------------------------------------------------- - IF(sq%xs(ipsi)>xcheck .AND. run_xpt)THEN - DO ipri=0,pl,+1 - IF(plot_convergence)THEN - IF(ipri>0)THEN - dqdeps_tol=dqdeps_tol*sqrt(sqrt(sqrt(10.0))) - IF(ipri0)THEN - CALL spline_dealloc(ffnum) - ENDIF - ENDIF - ELSE - dqdeps_tol=dqdeps_tmp - ENDIF - xpt_etas=0.0 - xpt_brackets=0.0 - eta_maxes=0.0 - eta_brackets=0.0 - num_xpts=0 - maxima_count=0 - y_outnum=0 - ENDIF - CALL direct_initialise_xpoints(y_out,len_y_out,.TRUE., - $ .FALSE.,bf,dqdeps_tol,BpBt_tol,eta_maxes, - $ eta_brackets,maxima_count) + CALL direct_fl_int(sq%xs(ipsi),zero,twopi,y_out1,len_y_out1 + $ ,eval_BpOnBt,eval_dy1,eval_xpt_tol,.FALSE.,bf, .FALSE.) - IF(maxima_count > 0 .AND. run_xpt)THEN - IF(.NOT.plot_convergence)THEN - use_analytic=.TRUE. - ENDIF - num_xpts=maxima_count - - DO i=1,maxima_count,+1 - xpt_etas(i)=eta_maxes(i)!updated by direct_xpoint - xpt_brackets(i,1)=eta_brackets(i,1) - xpt_brackets(i,2)=eta_brackets(i,2) - - CALL find_fl_surface(one,xpt_etas(i),rx,zx) - CALL direct_xpoint(rx,zx,i,new_xpt) - ENDDO - - IF(debug)THEN -41234 FORMAT(I9.9,",",I9.9,",",I9.9,",",f17.14,",", - $ f17.14,",",f17.14,",",f17.14,",",f17.14) - message="" - WRITE (message, "(A18)") "xpt_tests/data.csv" - CALL ascii_open(out_xpt_unit,trim(message) - $ ,"UNKNOWN") - WRITE(out_xpt_unit,41234)ipsi,mpsi,mtheta, - $ sq%xs(ipsi),ro,zo,rxs(1),zxs(1) - CALL ascii_close(out_xpt_unit) - - CALL spline_alloc(ffnum,istep,4) - ffnum%xs(0:istep)=y_out(0:istep,4)/ - $ y_out(istep,4) - ffnum%fs(0:istep,1)=y_out(0:istep,2)**2 - ffnum%fs(0:istep,2)=y_out(0:istep,0)/twopi - $ -ffnum%xs(0:istep) - ffnum%fs(0:istep,3)=bf%f* - $ (y_out(0:istep,3)-ffnum%xs(0:istep)*y_out(istep,3)) - ffnum%fs(0:istep,4)=y_out(0:istep,1)/ - $ y_out(istep,1) -ffnum%xs - y_outnum=y_out - PRINT "(A)","Fakeout NORan" - CALL direct_mixed_spline_builder(sq%xs(ipsi), - $ ff,y_out,debug,maxBpBt,xpt_starts) - PRINT "(A)","Fakeout Ran" - CALL direct_spline_comparison(ffnum,ff,y_outnum, - $ len_y_out,bf,y_out,ipsi,ipri,sq%xs(ipsi),maxBpBt, - $ xpt_starts,dqdeps_tol) - ELSE - CALL direct_mixed_spline_builder(sq%xs(ipsi), - $ ff,y_out,debug,maxBpBt,xpt_starts) - istep=SIZE(ff%xs,1)-1 - ENDIF + IF(y_out1(len_y_out1,0) Date: Sun, 8 Feb 2026 17:43:25 -0500 Subject: [PATCH 69/97] updating direct_fl_int variables and initialisations... this flux surface integrator will now stop integrating if a number of x-point tolerances are violated --- equil/direct.f | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 668f18d4..181b9f7e 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -524,17 +524,19 @@ SUBROUTINE direct_position END SUBROUTINE direct_position c----------------------------------------------------------------------- c subprogram 4. direct_fl_int. -c integrates along field line. +c integrates along field line. exits based on proximity to x-point +c if simp = false c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) - !$ min_BpOnBt,max_dy1,eval_BpOnBt,eval_dy1,probe_xpt) + SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,len_y_out, + $ eval_BpOnBt,eval_dy1,eval_xpt_tol,probe_xpt,bf,simp) - REAL(r8), INTENT(IN) :: psifac,eta1,eta2!,min_BpOnBt,max_dy1 - !REAL(r8), INTENT(OUT) :: eval_BpOnBt,eval_dy1 - !LOGICAL, INTENT(IN) :: probe_xpt + REAL(r8), INTENT(IN) :: psifac,eta1,eta2 + REAL(r8), INTENT(OUT) :: eval_BpOnBt,eval_dy1,eval_xpt_tol + LOGICAL, INTENT(IN) :: probe_xpt ! + LOGICAL, INTENT(IN) :: simp !set true to skip x-point checks INTEGER, INTENT(OUT) :: len_y_out REAL(r8), DIMENSION(0:,0:), INTENT(OUT) :: y_out TYPE(direct_bfield_type), INTENT(OUT) :: bf @@ -546,9 +548,10 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,bf,len_y_out) INTEGER, DIMENSION(liw) :: iwork REAL(r8), PARAMETER :: eps=1e-12 REAL(r8) :: atol,rtol,rfac,deta,r,z,eta,err,psi0,bp,bt,rx,zx,dy1 + REAL(r8) :: cooleta REAL(r8), DIMENSION(neq) :: y REAL(r8), DIMENSION(lrw) :: rwork - LOGICAL :: new_xpt + LOGICAL :: new_xpt,valid,cooloff=.FALSE. c----------------------------------------------------------------------- c format statements. c----------------------------------------------------------------------- From 57cbb0d027f09c370ac3c409bbbe28b984575ff6 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:44:50 -0500 Subject: [PATCH 70/97] updating formatting terms --- equil/direct.f | 2 -- 1 file changed, 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 181b9f7e..f5578039 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -558,10 +558,8 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,len_y_out, 20 FORMAT(/2x,"is",5x,"eta",8x,"deta",8x,"s",9x,"rfac",8x,"r",10x, $ "z",9x,"psi",8x,"err"/) 30 FORMAT(i4,1p,8e11.3) - 40 FORMAT(a,i4,a,es10.3,a,i3) 51 FORMAT(1x,"psifac =",f18.15) 61 FORMAT(3x,"integrator took",i6," steps of max",i6,".") - 62 FORMAT(3x,"non. div. integrator took",i6," steps of max",i6,".") 11 FORMAT(1x,"Incomplete: eta=",es10.2," of [",es10.2,",",es10.2,"]") c----------------------------------------------------------------------- c find flux surface. From 645473dc0527f9ce9d2a6ce42a062003ebff9632 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:45:35 -0500 Subject: [PATCH 71/97] adding x-point stopping logic to direct_fl_int --- equil/direct.f | 41 +++++++++++++++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 6 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index f5578039..1442b353 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -611,9 +611,9 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,len_y_out, c compute ratio of Bp to Bt, as well as divergent integrand related c to q (dy1) c----------------------------------------------------------------------- - !bp=SQRT(bf%br**2+bf%bz**2) - !bt=bf%f/r - !dy1=rfac/(bf%bz*COS(eta)-bf%br*SIN(eta)) + bp=SQRT(bf%br**2+bf%bz**2) + bt=bf%f/r + dy1=rfac/(bf%bz*COS(eta)-bf%br*SIN(eta)) c----------------------------------------------------------------------- c compute and print output for each step. c----------------------------------------------------------------------- @@ -623,11 +623,40 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,len_y_out, $ REAL(eta,4),REAL(rwork(11),4),REAL(y(1:4),4),REAL(r,4), $ REAL(z,4),REAL(psifac,4),REAL(err,4) c----------------------------------------------------------------------- -c stopping conditions. +c xpoint stopping conditions. +c----------------------------------------------------------------------- + IF((bp/bt)dqdeps_tol.AND.psifac>0.9 + $ .AND. (.NOT. simp))THEN + IF(probe_xpt)THEN + !looking for x-points, exit because you've found one + !will automatically call int_validity_check + EXIT + ELSEIF(cooloff)THEN + !cooloff active, do nothing unless you've gone far enough + !to reset it. + IF(ABS(eta-cooleta)>0.2*pi)THEN + cooloff=.FALSE. + ENDIF + ELSE + CALL int_validity_check(r,z,rfac,eta,valid,eval_xpt_tol) + IF(valid)THEN + !its a valid time to use analytic formulas, exit + !numerical integration + EXIT + ELSE!not a valid time to use formulas, power through + !and hope you don't hit one of the accuracy limits + cooloff = .TRUE. + cooleta = eta + ENDIF + ENDIF + ENDIF +c----------------------------------------------------------------------- +c regular stopping conditions. c----------------------------------------------------------------------- - IF(eta >= eta2 .OR. istep >= nstepd .OR. istate < 0 + IF((eta2 > eta1 .AND. eta >= eta2) .OR. + $ (eta2 < eta1 .AND. eta <= eta2) + $ .OR. istep >= nstepd .OR. istate < 0 $ .OR. ABS(err) >= 1)EXIT - !$ .OR. ((bp/bt)max_dy1))EXIT c----------------------------------------------------------------------- c advance differential equations. c----------------------------------------------------------------------- From f214201f317823b3a821a105556d6b78c7aaa707 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:47:07 -0500 Subject: [PATCH 72/97] updating direct_fl_int to save variables and/or print warnings after stopping on an x-point --- equil/direct.f | 51 ++++++++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 1442b353..b5c41037 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -664,38 +664,45 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,len_y_out, CALL lsode(direct_fl_der,neq,y,eta,eta2,itol,rtol,atol, $ itask,istate,iopt,rwork,lrw,iwork,liw,jac,mf) ENDDO + len_y_out = istep IF(out_fl)WRITE(out_2d_unit,20) IF(bin_fl)WRITE(bin_2d_unit) c----------------------------------------------------------------------- c abort if istep > nstepd. c----------------------------------------------------------------------- - IF(.FALSE.)THEN!(bp/bt)<=min_BpOnBt .AND. ABS(dy1)>max_dy1)THEN - !IF(probe_xpt)THEN - ! rx=r - ! zx=z - ! CALL direct_xpoint(rx,zx,num_xpts+1,new_xpt) - ! IF(new_xpt)THEN - ! num_xpts=num_xpts+1 - ! ENDIF - !ENDIF - !eval_dy1=ABS(dy1) - !eval_BpOnBt=(bp/bt) - ELSEIF(eta < eta2)THEN + IF((bp/bt)dqdeps_tol.AND.psifac>0.9 + $ .AND. (.NOT. simp))THEN + IF(probe_xpt)THEN + rx=r + zx=z + CALL direct_xpoint(rx,zx,num_xpts+1,new_xpt) + IF(new_xpt)THEN + num_xpts=num_xpts+1 + ENDIF + ENDIF +c----------------------------------------------------------------------- +c get tolerance terms. +c----------------------------------------------------------------------- + CALL int_validity_check(r,z,rfac,eta,valid,eval_xpt_tol) + eval_dy1=ABS(dy1) + eval_BpOnBt=(bp/bt) + RETURN + ELSEIF(eta < eta2 .AND. cooloff)THEN WRITE(message,61)istep,nstepd WRITE(message2,11)eta,eta1,eta2 PRINT "(A)", message - PRINT "(A)", "Increase nstepd or decrease etol." + PRINT "(3A)","Field line integrator failed before the", + $"analytic x-point formulas became valid. Increase nstepd to ", + $"keep accuracy, or decrease etol/reduce psihigh to retain speed." CALL program_stop(message2) - ELSEIF(verbose .AND. eta2==twopi .AND. eta1==zero)THEN - WRITE(message,61)istep,nstepd - IF(verbose)PRINT "(A)", message - ELSEIF(verbose)THEN - WRITE(message,62)istep,nstepd - IF(verbose)PRINT "(A)", message ENDIF - len_y_out = istep - !eval_dy1=-1.0 - !eval_BpOnBt=-1.0 +c----------------------------------------------------------------------- +c if .NOT.(eval_dy1==eval_BpOnBt==-1.0), and early exit, we know the +c separatrix integral died because of min_BpOnBt,max_dy1 criteria. +c----------------------------------------------------------------------- + eval_dy1=-1.d0 + eval_BpOnBt=-1.d0 + eval_xpt_tol=-1.d0 c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- From bc7e22e23e913bea2e738bed7da00e5b7201d30a Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:48:38 -0500 Subject: [PATCH 73/97] shifting direct_fl_der, direct_refine and direct_output to their original order in direct.f --- equil/direct.f | 169 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 167 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index b5c41037..5ba96c96 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -709,8 +709,173 @@ SUBROUTINE direct_fl_int(psifac,eta1,eta2,y_out,len_y_out, RETURN END SUBROUTINE direct_fl_int c----------------------------------------------------------------------- -c subprogram 4.5. find_fl_surface. -c finds r,z given psi, eta. +c subprogram 5. direct_fl_der. +c contains differential equations for field line averages. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_fl_der(neq,eta,y,dy) + + INTEGER, INTENT(IN) :: neq + REAL(r8), INTENT(IN) :: eta + REAL(r8), INTENT(IN) :: y(neq) + REAL(r8), INTENT(OUT) :: dy(neq) + + REAL(r8) :: cosfac,sinfac,bp,r,z,jacfac,bt,b + TYPE(direct_bfield_type) :: bf +c----------------------------------------------------------------------- +c preliminary computations. +c here magnetic coordinates are defined +c----------------------------------------------------------------------- + cosfac=COS(eta) + sinfac=SIN(eta) + r=ro+y(2)*cosfac + z=zo+y(2)*sinfac + CALL direct_get_bfield(r,z,bf,1) + bp=SQRT(bf%br**2+bf%bz**2) + bt=bf%f/r + b=SQRT(bp*bp+bt*bt) + jacfac=bp**power_bp*b**power_b/r**power_r +c----------------------------------------------------------------------- +c compute derivatives. +c----------------------------------------------------------------------- + dy(1)=y(2)/(bf%bz*cosfac-bf%br*sinfac) + dy(2)=dy(1)*(bf%br*cosfac+bf%bz*sinfac) + dy(3)=dy(1)/(r*r) + dy(4)=dy(1)*jacfac +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_fl_der +c----------------------------------------------------------------------- +c subprogram 6. direct_refine. +c moves a point orthogonally to a specified flux surface. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_refine(rfac,eta,psi0) + + REAL(r8) :: rfac,eta,psi0 + + REAL(r8) :: dpsi,cosfac,sinfac,drfac,r,z + REAL(r8), PARAMETER :: eps=1e-12 + TYPE(direct_bfield_type) :: bf + INTEGER :: ir +c----------------------------------------------------------------------- +c initialize iteration. +c----------------------------------------------------------------------- + cosfac=COS(eta) + sinfac=SIN(eta) + r=ro+rfac*cosfac + z=zo+rfac*sinfac + CALL direct_get_bfield(r,z,bf,1) + dpsi=bf%psi-psi0 +c----------------------------------------------------------------------- +c refine rfac by newton iteration. +c----------------------------------------------------------------------- + ir = 0 + DO + drfac=-dpsi/(bf%psir*cosfac+bf%psiz*sinfac) + rfac=rfac+drfac + r=ro+rfac*cosfac + z=zo+rfac*sinfac + CALL direct_get_bfield(r,z,bf,1) + dpsi=bf%psi-psi0 + IF(ABS(dpsi) <= eps*psi0 .OR. ABS(drfac) <= eps*rfac)EXIT + + ir = ir+1 + IF (ir > direct_infinite_loop_count) THEN + direct_infinite_loop_flag = .TRUE. + CALL program_stop("Took too many steps to refine rfac.") + ENDIF + ENDDO +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_refine +c----------------------------------------------------------------------- +c subprogram 7. direct_output. +c diagnoses input. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE direct_output + + INTEGER :: ix,iy + REAL(r8), DIMENSION(:,:), POINTER :: x,y +c----------------------------------------------------------------------- +c format statements. +c----------------------------------------------------------------------- + 10 FORMAT(/4x,"ix",4x,"iy",6x,"r",10x,"z",9x,"psi"/) + 20 FORMAT(2i6,1p,3e11.3) +c----------------------------------------------------------------------- +c open output files. +c----------------------------------------------------------------------- + IF(.NOT. (out_eq_1d .OR. bin_eq_1d .OR. out_eq_2d .OR. bin_eq_2d)) + $ RETURN + IF(out_eq_1d .OR. out_eq_2d) + $ CALL ascii_open(out_2d_unit,"input.out","UNKNOWN") +c----------------------------------------------------------------------- +c diagnose 1d output. +c----------------------------------------------------------------------- + IF(out_eq_1d)WRITE(out_2d_unit,'(a)')"input surface quantities:" + IF(bin_eq_1d)CALL bin_open(bin_2d_unit,"sq_in.bin","UNKNOWN", + $ "REWIND","none") + CALL spline_write1(sq_in,out_eq_1d,bin_eq_1d, + $ out_2d_unit,bin_2d_unit,interp) + IF(bin_eq_1d)CALL bin_close(bin_2d_unit) +c----------------------------------------------------------------------- +c ascii table of psi. +c----------------------------------------------------------------------- + IF(out_eq_2d)THEN + DO iy=0,psi_in%my + WRITE(out_2d_unit,10) + DO ix=0,psi_in%mx + WRITE(out_2d_unit,20) + $ ix,iy,psi_in%xs(ix),psi_in%ys(iy),psi_in%fs(ix,iy,1) + ENDDO + ENDDO + WRITE(out_2d_unit,10) + ENDIF +c----------------------------------------------------------------------- +c draw contour plot of psi. +c----------------------------------------------------------------------- + IF(bin_eq_2d)THEN + CALL bin_open(bin_2d_unit,"psi_in.bin","UNKNOWN","REWIND", + $ "none") + WRITE(bin_2d_unit)1,0 + WRITE(bin_2d_unit)psi_in%mx,psi_in%my + ALLOCATE(x(0:psi_in%mx,0:psi_in%my),y(0:psi_in%mx,0:psi_in%my)) + DO ix=0,psi_in%mx + DO iy=0,psi_in%my + x(ix,iy)=psi_in%xs(ix) + y(ix,iy)=psi_in%ys(iy) + ENDDO + ENDDO + WRITE(bin_2d_unit)REAL(x,4),REAL(y,4) + WRITE(bin_2d_unit)REAL(psi_in%fs,4) + DEALLOCATE(x,y) + CALL bin_close(bin_2d_unit) + ENDIF +c----------------------------------------------------------------------- +c close output files. +c----------------------------------------------------------------------- + IF(out_eq_1d .OR. out_eq_2d)CALL ascii_close(out_2d_unit) + IF(input_only)CALL program_stop("Termination by direct_output.") +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE direct_output +c----------------------------------------------------------------------- +c subprogram 8. find_fl_surface. +c finds r,z given psi, eta. Uses a Newton method, similar to +c direct_position. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. From cb0ee6a4a1c6752c6f03bc1d5810404d3d6dddd6 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:49:11 -0500 Subject: [PATCH 74/97] updating find_fl_surface2 description --- equil/direct.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 5ba96c96..972e1114 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -923,9 +923,10 @@ SUBROUTINE find_fl_surface(psifac,eta,r,z) RETURN END SUBROUTINE find_fl_surface c----------------------------------------------------------------------- -c subprogram 4.6. find_fl_surface2. +c subprogram 9. find_fl_surface2. c finds r,z given psi, eta. Uses a bisection method instead of the -c Newton method used in find_fl_surface, motivated by special cases. +c Newton method used in find_fl_surface, motivated by special cases +c where the Newton method fails to converge eg. near x-points. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. From f9a58a30a11d2eb72873aae444fdb031c5d46a77 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:54:42 -0500 Subject: [PATCH 75/97] adding new function direct_xpt_y_out that calls the numerical field line integrator (via direct_fl_int), and also calls the analytic field line integral function (analytic_y_out), and splices the outputs together using functions patch_two_a, patch_two_b, patch_two_c --- equil/direct.f | 290 +++++++++++++++++++++++++++---------------------- 1 file changed, 158 insertions(+), 132 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 972e1114..07286628 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1062,169 +1062,195 @@ SUBROUTINE find_fl_surface2(psifac,eta,radius1,r,z) RETURN END SUBROUTINE find_fl_surface2 c----------------------------------------------------------------------- -c subprogram 5. direct_fl_der. -c contains differential equations for field line averages. +c subprogram 10. direct_xpt_y_out. +c makes y_out, splicing in analytic integrals. +c called when the numerical integral in direct_fl_int was terminated +c due to proximity to an x-point. can account for up to 2 x-points, +c if two are present, they must occur either side of the interval +c eta = [0.9pi,pi] for this script to work... aka they can't lie too +c close to the inboard midplane. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_fl_der(neq,eta,y,dy) - - INTEGER, INTENT(IN) :: neq - REAL(r8), INTENT(IN) :: eta - REAL(r8), INTENT(IN) :: y(neq) - REAL(r8), INTENT(OUT) :: dy(neq) - - REAL(r8) :: cosfac,sinfac,bp,r,z,jacfac,bt,b + SUBROUTINE direct_xpt_y_out(y_out1,len_y_out1,psifac,y_out, + $ len_y_out,eval_BpOnBt,eval_dy1,eval_xpt_tol,ix,diffs_raw, + $ outmat2f) + + REAL(r8), DIMENSION(0:,0:), INTENT(IN) :: y_out1 + REAL(r8),DIMENSION(1:4),INTENT(OUT) :: diffs_raw + REAL(r8),DIMENSION(1:17),INTENT(OUT) :: outmat2f + INTEGER, INTENT(IN) :: len_y_out1 + INTEGER, DIMENSION(2), INTENT(OUT) :: ix + REAL(r8), DIMENSION(0:,0:),INTENT(INOUT) :: + $ y_out + REAL(r8), INTENT(IN) :: psifac + REAL(r8), INTENT(OUT) :: eval_BpOnBt,eval_dy1,eval_xpt_tol + INTEGER,INTENT(INOUT) :: len_y_out + REAL(r8), DIMENSION(0:(4*nstepd+2*nstep2+6),0:4) :: y_outf + REAL(r8), DIMENSION(0:(nstepd+2),0:4) :: y_out2,y_out3, + $ y_out4 + REAL(r8), DIMENSION(0:(nstep2+2),0:4) :: yi1!,yi2 TYPE(direct_bfield_type) :: bf -c----------------------------------------------------------------------- -c preliminary computations. -c here magnetic coordinates are defined -c----------------------------------------------------------------------- - cosfac=COS(eta) - sinfac=SIN(eta) - r=ro+y(2)*cosfac - z=zo+y(2)*sinfac - CALL direct_get_bfield(r,z,bf,1) - bp=SQRT(bf%br**2+bf%bz**2) - bt=bf%f/r - b=SQRT(bp*bp+bt*bt) - jacfac=bp**power_bp*b**power_b/r**power_r -c----------------------------------------------------------------------- -c compute derivatives. -c----------------------------------------------------------------------- - dy(1)=y(2)/(bf%bz*cosfac-bf%br*sinfac) - dy(2)=dy(1)*(bf%br*cosfac+bf%bz*sinfac) - dy(3)=dy(1)/(r*r) - dy(4)=dy(1)*jacfac -c----------------------------------------------------------------------- -c terminate. -c----------------------------------------------------------------------- - RETURN - END SUBROUTINE direct_fl_der -c----------------------------------------------------------------------- -c subprogram 6. direct_refine. -c moves a point orthogonally to a specified flux surface. -c----------------------------------------------------------------------- -c----------------------------------------------------------------------- -c declarations. -c----------------------------------------------------------------------- - SUBROUTINE direct_refine(rfac,eta,psi0) - - REAL(r8) :: rfac,eta,psi0 - REAL(r8) :: dpsi,cosfac,sinfac,drfac,r,z - REAL(r8), PARAMETER :: eps=1e-12 - TYPE(direct_bfield_type) :: bf - INTEGER :: ir + INTEGER :: len_y_out2,len_y_out3,len_y_out4,len_y_outf + INTEGER :: ix1,ix2,i + ix=-1 c----------------------------------------------------------------------- -c initialize iteration. +c setting bounardies on integration interval: c----------------------------------------------------------------------- - cosfac=COS(eta) - sinfac=SIN(eta) - r=ro+rfac*cosfac - z=zo+rfac*sinfac - CALL direct_get_bfield(r,z,bf,1) - dpsi=bf%psi-psi0 + xpt_brackets(1,1)=y_out1(len_y_out1,0) c----------------------------------------------------------------------- -c refine rfac by newton iteration. +c integrating opposite direction (clockwise). c----------------------------------------------------------------------- - ir = 0 - DO - drfac=-dpsi/(bf%psir*cosfac+bf%psiz*sinfac) - rfac=rfac+drfac - r=ro+rfac*cosfac - z=zo+rfac*sinfac - CALL direct_get_bfield(r,z,bf,1) - dpsi=bf%psi-psi0 - IF(ABS(dpsi) <= eps*psi0 .OR. ABS(drfac) <= eps*rfac)EXIT - - ir = ir+1 - IF (ir > direct_infinite_loop_count) THEN - direct_infinite_loop_flag = .TRUE. - CALL program_stop("Took too many steps to refine rfac.") - ENDIF - ENDDO + CALL direct_fl_int(psifac,twopi+0.1*pi,zero,y_out2, + $ len_y_out2,eval_BpOnBt,eval_dy1,eval_xpt_tol,.TRUE.,bf,.FALSE.) + IF(debug_xpt)WRITE(*,*)"Clockwise integral w. length:",len_y_out2 + IF(debug_xpt)WRITE(*,*)y_out2(len_y_out2-3:len_y_out2,0) + IF(debug_xpt)WRITE(*,*)y_out2(len_y_out2-3:len_y_out2,1) + IF(debug_xpt)WRITE(*,*)y_out2(len_y_out2-3:len_y_out2,2) + IF(debug_xpt)WRITE(*,*)y_out2(len_y_out2-3:len_y_out2,3) + IF(debug_xpt)WRITE(*,*)y_out2(len_y_out2-3:len_y_out2,4) c----------------------------------------------------------------------- -c terminate. +c flagging case where one integral passed x-point while other +c did not, which should not happen. c----------------------------------------------------------------------- - RETURN - END SUBROUTINE direct_refine + IF(y_out2(len_y_out2,0)y_out2(len_y_out2,0))THEN + CALL program_stop("Xpt int. err2, needs debug") + ENDIF + xpt_brackets(1,2)=y_out3(len_y_out3,0) + xpt_brackets(2,1)=y_out4(len_y_out4,0) +c----------------------------------------------------------------------- +c combining the two inboard numerical integrals into one +c anti-clockwise integral y_out +c----------------------------------------------------------------------- + IF(debug_xpt)WRITE(*,*)"y_out3 bounds:" + IF(debug_xpt)WRITE(*,*)y_out3(0,0),y_out3(len_y_out3,0) + IF(debug_xpt)WRITE(*,*)"y_out4 bounds:" + IF(debug_xpt)WRITE(*,*)y_out4(0,0),y_out4(len_y_out4,0) + CALL patch_two_a(y_out4,y_out3,len_y_out4,len_y_out3, + $ y_out,len_y_out) + IF(debug_xpt)WRITE(*,*)"y_out bounds:" + IF(debug_xpt)WRITE(*,*)y_out(0,0),y_out(len_y_out,0) + ix2=len_y_out +c----------------------------------------------------------------------- +c writing 1st analytic x-point integral and combining with inboard +c integrals. +c y_out, yi1 and y_outf all used as intermediaries in the splicing, +c but final result is in y_outf. +c----------------------------------------------------------------------- + CALL analytic_y_out(psifac,y_out4(len_y_out4,0), + $ y_out4(len_y_out4,2),y_out2(len_y_out2,0),y_out2(len_y_out2,2), + $ nstep2,yi1,diffs_raw,outmat2f) + IF(debug_xpt)WRITE(*,*)"yi1 bounds:" + IF(debug_xpt)WRITE(*,*)yi1(0,0),yi1(nstep2,0) + CALL patch_two_b(y_out,yi1,len_y_out,nstep2, + $ y_outf,len_y_outf) + + IF(debug_xpt)WRITE(*,*)"y_outf bounds:" + IF(debug_xpt)WRITE(*,*)y_outf(0,0),y_outf(len_y_outf,0) +c----------------------------------------------------------------------- +c writing 2nd analytic x-point integral and combining with y_outf. +c y_out, yi1 and y_outf all used as intermediaries in the splicing, +c but final result is in y_out. +c----------------------------------------------------------------------- + CALL analytic_y_out(psifac,y_out1(len_y_out1,0), + $ y_out1(len_y_out1,2),y_out3(len_y_out3,0),y_out3(len_y_out3,2), + $ nstep2,yi1,diffs_raw,outmat2f) + IF(debug_xpt)WRITE(*,*)"yi1 bounds: ROUND 2" + IF(debug_xpt)WRITE(*,*)yi1(0,0),yi1(nstep2,0) + CALL patch_two_b(yi1,y_outf,nstep2,len_y_outf, + $ y_out,len_y_out) + IF(debug_xpt)WRITE(*,*)"y_out bounds:" + IF(debug_xpt)WRITE(*,*)y_out(0,0),y_out(len_y_out,0) + ix2=ix2+nstep2 +c----------------------------------------------------------------------- +c reconstructing full 2pi integral, combining initial anti-clockwise +c numerical integral (y_out1) with y_out (inboard integrals plus +c both analytic x-point integrals), and then combining that with the +c second clockwise numerical integral (y_out2). +c----------------------------------------------------------------------- + IF(debug_xpt)WRITE(*,*)"y_out1 bounds:" + IF(debug_xpt)WRITE(*,*)y_out1(0,0),y_out1(len_y_out1,0) + CALL patch_two_b(y_out1,y_out,len_y_out1,len_y_out, + $ y_outf,len_y_outf) + IF(debug_xpt)WRITE(*,*)"y_outf bounds:" + IF(debug_xpt)WRITE(*,*)y_outf(0,0),y_outf(len_y_outf,0) + ix2=ix2+len_y_out+1 + CALL patch_two_c(y_outf,y_out2,len_y_outf,len_y_out2, + $ y_out,len_y_out,ix1) + ix2=ix2+nstep2+ix1+1 + ix(1)=ix1 + ix(2)=ix2 ENDIF -c----------------------------------------------------------------------- -c close output files. -c----------------------------------------------------------------------- - IF(out_eq_1d .OR. out_eq_2d)CALL ascii_close(out_2d_unit) - IF(input_only)CALL program_stop("Termination by direct_output.") + IF(debug_xpt)WRITE(*,*)y_out(1:100,0) + IF(debug_xpt)WRITE(*,*)y_out(1:4,1) + IF(debug_xpt)WRITE(*,*)y_out(1:4,2) + IF(debug_xpt)WRITE(*,*)y_out(1:4,3) + IF(debug_xpt)WRITE(*,*)y_out(1:4,4) c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN - END SUBROUTINE direct_output + END SUBROUTINE direct_xpt_y_out c----------------------------------------------------------------------- c subprogram 8. direct_local_xpoint. c finds location of nearby x-point where |Bp|=0 using Newton method. From 32b947363289a311d9f9d03889e0e87174c277e3 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:55:40 -0500 Subject: [PATCH 76/97] updating subroutine numbers --- equil/direct.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 07286628..7ff77c8e 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1252,7 +1252,7 @@ SUBROUTINE direct_xpt_y_out(y_out1,len_y_out1,psifac,y_out, RETURN END SUBROUTINE direct_xpt_y_out c----------------------------------------------------------------------- -c subprogram 8. direct_local_xpoint. +c subprogram 11. direct_local_xpoint. c finds location of nearby x-point where |Bp|=0 using Newton method. c can and will search outside separatrix. c----------------------------------------------------------------------- @@ -1448,7 +1448,7 @@ SUBROUTINE direct_saddle_angle(rx,zx,rho,nustart_in,nu_var_in,nu, RETURN END SUBROUTINE direct_saddle_angle c----------------------------------------------------------------------- -c subprogram 10. direct_psisaddle. +c subprogram 13. direct_psisaddle. c calculates the linear term of psi_in at the saddle point, as well c as gamma, and vartheta c----------------------------------------------------------------------- @@ -1541,7 +1541,7 @@ SUBROUTINE direct_psisaddle(rx,zx, RETURN END SUBROUTINE direct_psisaddle c----------------------------------------------------------------------- -c subprogram 11. direct_xpoint. +c subprogram 14. direct_xpoint. c finds location and angles of nearby x-point, checks if it's inside C separatrix. c----------------------------------------------------------------------- From e5388b025381ee72a0960d2a030a378a477d5130 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:56:21 -0500 Subject: [PATCH 77/97] removing deprecated newton method for calculating direct_saddle_angle --- equil/direct.f | 62 +++----------------------------------------------- 1 file changed, 3 insertions(+), 59 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 7ff77c8e..cda6f31b 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1295,67 +1295,11 @@ SUBROUTINE direct_local_xpoint(r,z) RETURN END SUBROUTINE direct_local_xpoint c----------------------------------------------------------------------- -c subprogram 9. direct_saddle_angle_DEPRECATED. -c finds angle location of nearby saddle-node eigenvector using -c Newton iteration. Ends up infinite looping... I suspect the -c analytic form of the zero crosssing of Bout is unfriendly to -c the Newton method (I double checked formulas etc) -c----------------------------------------------------------------------- -c----------------------------------------------------------------------- -c declarations. -c----------------------------------------------------------------------- - SUBROUTINE direct_saddle_angle_DEPRECATED(rx,zx,nu,Bnorm) - - REAL(r8), INTENT(IN) :: rx,zx,Bnorm - REAL(r8), INTENT(INOUT) :: nu - REAL(r8), PARAMETER :: r_eps1=1e-9,r_eps2=1e-10,nu_eps=1e-13 - INTEGER :: ir - REAL(r8) :: Bout,dBout_dnu,cosfac,sinfac,dnu - TYPE(direct_bfield_type) :: bf - -c----------------------------------------------------------------------- -c use newton iteration to find point where Bout = 0. -c----------------------------------------------------------------------- -c vtheta = -sin(theta)*Rhat+cos(theta)*Zhat -c B = bf%br*Rhat+bf%bz*Zhat -c CHJECK LINEARITY OF LEG? -c ONLY TWO X-pts, can check if need the good treatment for them both - ir=0 - DO - cosfac=COS(nu) - sinfac=SIN(nu) - CALL direct_get_bfield(rx+r_eps1*rx*cosfac, - $ zx+r_eps1*rx*sinfac,bf,1) - Bout = (-sinfac*bf%br+cosfac*bf%bz) - dBout_dnu = ((-cosfac*bf%br-sinfac*bf%bz) + - $ (-sinfac*bf%brr+cosfac*bf%bzr)*(-r_eps1*rx*sinfac) + - $ (-sinfac*bf%brz+cosfac*bf%bzz)*(r_eps1*rx*cosfac)) - dnu = -Bout/dBout_dnu - nu=nu+dnu - IF(ABS(dnu) <= nu_eps)EXIT - - PRINT "(e16.3)", Bout/Bnorm - - ir = ir+1 - IF (ir > 50) THEN !direct_infinite_loop_count) THEN - direct_infinite_loop_flag = .TRUE. - CALL program_stop("Took too many steps to find x-pt angle.") - ENDIF - ENDDO -c----------------------------------------------------------------------- -c make sure nu is in [0,2pi). works even if nu is negative -c----------------------------------------------------------------------- - nu = nu - twopi*floor(nu/twopi) -c----------------------------------------------------------------------- -c terminate. -c----------------------------------------------------------------------- - RETURN - END SUBROUTINE direct_saddle_angle_DEPRECATED -c----------------------------------------------------------------------- -c subprogram 9. direct_saddle_angle. +c subprogram 12. direct_saddle_angle. c finds angle location of nearby saddle-node eigenvector using c a binary search type algorithm. can find point where Bnu = 0 or -c Brho = 0. +c Brho = 0. A newton method was attempted but generally failed to +c converge. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. From 030e4e599065984d26bcdc92e6178b5b77c9e513 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:57:53 -0500 Subject: [PATCH 78/97] updating variable b11 to c11 to match notation in paper (https://doi.org/10.1088/1361-6587/add9ca) --- equil/direct.f | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index cda6f31b..ee6171b7 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -46,7 +46,7 @@ MODULE direct_mod INTEGER, PRIVATE :: istep REAL(r8) :: rmin,rmax,zmin,zmax,rs1,rs2 - REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_b11s + REAL(r8), DIMENSION(1:2) :: xpt_etas, rxs, zxs, xpt_c11s REAL(r8), DIMENSION(1:2) :: xpt_gammas, xpt_varthetas REAL(r8), DIMENSION(1:2) :: xpt_gammas2, xpt_varthetas2 LOGICAL, DIMENSION(1:2) :: outside_sep @@ -1394,17 +1394,19 @@ END SUBROUTINE direct_saddle_angle c----------------------------------------------------------------------- c subprogram 13. direct_psisaddle. c calculates the linear term of psi_in at the saddle point, as well -c as gamma, and vartheta +c as gamma, and vartheta (please refer to +c https://doi.org/10.1088/1361-6587/add9ca for definitions +c of these parameters). c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- SUBROUTINE direct_psisaddle(rx,zx, - $ nu,b11,gamma,vartheta,lincheck) + $ nu,c11,gamma,vartheta,lincheck) REAL(r8), INTENT(IN) :: rx,zx REAL(r8), DIMENSION(2), INTENT(IN) :: nu - REAL(r8), INTENT(OUT) :: b11,lincheck,gamma,vartheta + REAL(r8), INTENT(OUT) :: c11,lincheck,gamma,vartheta REAL(r8), PARAMETER :: nuh_eps=1e-13, nuh_eps2=1e-6 INTEGER :: ir @@ -1471,14 +1473,14 @@ SUBROUTINE direct_psisaddle(rx,zx, y = -sinfact*Rlocal + cosfact*Zlocal chi = -COS(gamma)*x+SIN(gamma)*y c----------------------------------------------------------------------- -c extracting linear component b11, where psi = psi(rx,zx)+b11*x*chi. +c extracting linear component c11, where psi = psi(rx,zx)+c11*x*chi. c----------------------------------------------------------------------- CALL direct_get_bfield(rx,zx,bf,1) psix = bf%psi CALL direct_get_bfield(rx+r*cosfac,zx+r*sinfac,bf,1) psinuh = bf%psi - b11 = -(psinuh-psix)/(x*chi) + c11 = -(psinuh-psix)/(x*chi) c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- @@ -1502,7 +1504,7 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) INTEGER :: i REAL(r8), PARAMETER :: psi_eps=1e-4, r_eps1=1e-9 REAL(r8) :: r,z - REAL(r8) :: b11,lincheck,gamma,vartheta + REAL(r8) :: c11,lincheck,gamma,vartheta REAL(r8), DIMENSION(1:2) :: nu REAL(r8) :: oangle,nu_var,Bnua,Bnub,Bnuc TYPE(direct_bfield_type) :: bf @@ -1626,13 +1628,13 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) PRINT "(A)", "------------------------------------------" ENDIF c----------------------------------------------------------------------- -c calculating xpoint angles gamma, vartheta, and linear term b11. +c calculating xpoint angles gamma, vartheta, and linear term c11. c----------------------------------------------------------------------- - CALL direct_psisaddle(r,z,nu,b11,gamma,vartheta,lincheck) + CALL direct_psisaddle(r,z,nu,c11,gamma,vartheta,lincheck) c----------------------------------------------------------------------- c filling out x-point module variables. c----------------------------------------------------------------------- - xpt_b11s(x_i) = b11 + xpt_c11s(x_i) = c11 xpt_gammas(x_i) = gamma xpt_varthetas(x_i) = vartheta c----------------------------------------------------------------------- From e0cc1dc52011bdbfbef37ad531bde42ae1fd341a Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:58:48 -0500 Subject: [PATCH 79/97] updating some print statements --- equil/direct.f | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index ee6171b7..c7807610 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1049,7 +1049,6 @@ SUBROUTINE find_fl_surface2(psifac,eta,radius1,r,z) direct_infinite_loop_flag = .TRUE. CALL program_stop("find_fl_surface2 failed.") ENDIF - !PRINT "(es25.14)",radii(2) ENDDO c----------------------------------------------------------------------- c calculating r, z. @@ -1525,6 +1524,8 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) PRINT "(A)", "direct_local_xpoint output =>" PRINT "(A)", "X-point number:" PRINT "(i6)", x_i + PRINT "(A)", "eta:" + PRINT "(f16.10)", ATAN2(z-zo,r-ro) CALL direct_get_bfield(ro,zo,bf,1) PRINT "(A)", "psi at origin:" PRINT "(f20.14)", bf%psi @@ -1709,22 +1710,24 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) c----------------------------------------------------------------------- c501 FORMAT(1x,i1," x-point(s) detected:") c502 FORMAT(1x,"over eta bracket (",f10.8,",",f10.8,")") -600 FORMAT(1x,"x-point detected at eta = ",f7.5,". analytic") -601 FORMAT(1x,"2nd x-point detected at eta = ",f7.5,". analytic") +600 FORMAT(1x," x-point detected at eta, r = ",f6.4,",",f6.4) +601 FORMAT(1x," 2nd x-point detected at eta, r = ",f6.4,",",f6.4) 603 FORMAT(1x,"integrals applied for eta = (", $ f7.5,",",f7.5,").") IF(verbose)THEN - PRINT "(A)", "________________________________________________" + PRINT "(A)", " _______________________________________________" IF(x_i==1)THEN - WRITE(message,600)xpt_etas(x_i) + WRITE(message,600)xpt_etas(x_i), + $ SQRT((zxs(x_i)-zo)**2+(rxs(x_i)-ro)**2) PRINT "(A)",message ELSEIF(x_i==2)THEN - WRITE(message,601)xpt_etas(x_i) + WRITE(message,601)xpt_etas(x_i), + $ SQRT((zxs(x_i)-zo)**2+(rxs(x_i)-ro)**2) PRINT "(A)",message ENDIF - WRITE(message,603)xpt_brackets(x_i,1),xpt_brackets(x_i,2) - PRINT "(A)",message - PRINT "(A)", "------------------------------------------------" + !WRITE(message,603)xpt_brackets(x_i,1),xpt_brackets(x_i,2) + !PRINT "(A)",message + PRINT "(A)", " -----------------------------------------------" ENDIF c----------------------------------------------------------------------- c terminate. From 04aebb1c3da4a788abaf80d9d52f34f049901fed Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 17:59:55 -0500 Subject: [PATCH 80/97] revmogin deprecated code from direct_xpoint --- equil/direct.f | 66 +------------------------------------------------- 1 file changed, 1 insertion(+), 65 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index c7807610..554c47a8 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1575,14 +1575,11 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) c----------------------------------------------------------------------- IF (bf%psi < -psi_eps*psio) THEN outside_sep(x_i)=.TRUE. - usevth2(x_i)=.FALSE. ELSE outside_sep(x_i)=.FALSE. - usevth2(x_i)=.TRUE. ENDIF c----------------------------------------------------------------------- -c updating xpt_etas with a more exact value than that calculated by -c direct_initialise_xpoints. +c updating xpt_etas with a more exact value. c----------------------------------------------------------------------- xpt_etas(x_i)=ATAN2(zxs(x_i)-zo,rxs(x_i)-ro) xpt_etas(x_i)=xpt_etas(x_i) - twopi*floor(xpt_etas(x_i)/twopi) @@ -1639,71 +1636,10 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) xpt_gammas(x_i) = gamma xpt_varthetas(x_i) = vartheta c----------------------------------------------------------------------- -c second vartheta to make sure x1 in direct_analytic_ints correctly -c approaches 0 as psifac goes to 1. -c----------------------------------------------------------------------- - CALL find_fl_surface(one,xpt_brackets(x_i,1),r,z) - nu(1)=ATAN2(z-zxs(x_i),r-rxs(x_i)) - CALL find_fl_surface(one,xpt_brackets(x_i,2),r,z) - nu(2)=ATAN2(z-zxs(x_i),r-rxs(x_i)) -c----------------------------------------------------------------------- -c some useful debugging statements. -c----------------------------------------------------------------------- - !IF(x_i==2)THEN - ! xpt_brackets(x_i,1)=xpt_etas(x_i)-1e-3 - ! xpt_brackets(x_i,2)=xpt_etas(x_i)+1e-3 - !ENDIF - - !CALL direct_get_bfield(rxs(x_i),zxs(x_i),bf,1) - - !IF(x_i==2)THEN - ! CALL direct_get_bfield(rxs(x_i),zxs(x_i),bf,1) - ! CALL find_fl_surface(one,xpt_brackets(x_i,1),r,z) - ! nu(1)=ATAN2(z-zxs(x_i),r-rxs(x_i)) - ! PRINT "(A)", "First x-point leg's angle nu (mthd 2):" - ! PRINT "(f17.14)", nu(1)/pi - ! CALL find_fl_surface(bf%f,xpt_brackets(x_i,2),r,z) - ! nu(2)=ATAN2(z-zxs(x_i),r-rxs(x_i)) - ! PRINT "(A)", "Second x-point leg's angle nu (mthd 2):" - ! PRINT "(f17.14)", nu(2)/pi - !ELSE - !ENDIF -c----------------------------------------------------------------------- -c defining xpt_varthetas2, xpt_gammas2. these angles are -c calculated out at the eta-location where we switch from numerical -c to analytic integrals (xpt_brackets), instead of asymptotically -c close to the x-point as is the case for xpt_varthetas, xpt_gammas. -c----------------------------------------------------------------------- - xpt_varthetas2(x_i) = nu(1)-pi/2 - xpt_gammas2(x_i) = nu(1)-nu(2) - - xpt_varthetas2(x_i) = xpt_varthetas2(x_i) - $ - twopi*floor(xpt_varthetas2(x_i)/twopi) - xpt_gammas2(x_i) = xpt_gammas2(x_i) - $ - twopi*floor(xpt_gammas2(x_i)/twopi) -c----------------------------------------------------------------------- c acknowledges new xpoint after all module variables filled c----------------------------------------------------------------------- new_xpt=.TRUE. c----------------------------------------------------------------------- -c making sure there isn't much difference between the varthetas and -c gamma angles asymptotically close to the x-point vs at the -c switch-over location. Note if the x-point is slightly outside the -c separatrix such that outside_sep(x_i)=.TRUE., xpt_varthetas2 -c amd xpt_gammas2 will have big error and should not be used. -c----------------------------------------------------------------------- - IF((ABS(xpt_varthetas(x_i)-xpt_varthetas2(x_i))>twopi/100 .OR. - $ ABS(xpt_gammas2(x_i)-xpt_gammas(x_i))>twopi/100) .AND. - $ (.NOT.outside_sep(x_i)))THEN - PRINT "(A)", "Straight x-point leg assumption bad for Xpt" - !PRINT "(i6)", x_i - !PRINT "(es16.10)", xpt_gammas(x_i)/pi - !PRINT "(es16.10)", xpt_gammas2(x_i)/pi - IF(.NOT.plot_convergence1)THEN - CALL program_stop("increase dq_eps.") - ENDIF - ENDIF -c----------------------------------------------------------------------- c regular print statements. eta bracket describes the region where c the analytic formulas will take over from the numerical c integrator. From ef0714079ff1af95b2941d2eff1b7c909ad5f4e6 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:00:12 -0500 Subject: [PATCH 81/97] updating x-point id tolerance --- equil/direct.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 554c47a8..ce81744b 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1559,8 +1559,8 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) c----------------------------------------------------------------------- IF(x_i>0)THEN DO i=1,(x_i-1),+1 - IF(ABS(r-rxs(i))<(0.001*ro) .AND. - $ ABS(z-zxs(i))<(0.001*ro))THEN + IF(ABS(r-rxs(i))<(0.0001*ro) .AND. + $ ABS(z-zxs(i))<(0.0001*ro))THEN RETURN ENDIF ENDDO From 777606701f4f8fa067f1e6214f7e0952232cdfa6 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:00:42 -0500 Subject: [PATCH 82/97] removing deprecated function direct_initialise_xpoints --- equil/direct.f | 249 +------------------------------------------------ 1 file changed, 1 insertion(+), 248 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index ce81744b..61f09687 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1671,254 +1671,7 @@ SUBROUTINE direct_xpoint(rin,zin,x_i,new_xpt) RETURN END SUBROUTINE direct_xpoint c----------------------------------------------------------------------- -c subprogram 12. direct_initialise_xpoints. -c scans the field-line integral to find likely x-point locations, -c denoted by diverging regions in the q-integral -c----------------------------------------------------------------------- -c----------------------------------------------------------------------- -c declarations. -c----------------------------------------------------------------------- - SUBROUTINE direct_initialise_xpoints(y_out,len_y_out,wrap,debug, - $ bf,dq_eps,BpBt,eta_maxes,eta_brackets,maxima_count) - - INTEGER, INTENT(IN) :: len_y_out - LOGICAL, INTENT(IN) :: wrap,debug - REAL(r8), DIMENSION(0:,0:), INTENT(IN) :: y_out - REAL(r8), INTENT(IN) :: dq_eps, BpBt - TYPE(direct_bfield_type), INTENT(IN) :: bf - - INTEGER, INTENT(OUT) :: maxima_count - REAL(r8), DIMENSION(1:), INTENT(OUT) :: eta_maxes - REAL(r8), DIMENSION(1:,1:), INTENT(OUT) :: eta_brackets - CHARACTER(64) :: message - - INTEGER :: i - LOGICAL :: prev_above_threshold,wrap_max,wrap_ - REAL(r8), DIMENSION(1:len_y_out) :: dqdeta - REAL(r8), DIMENSION(100) :: max_dqdeta,max_locations - - max_locations=0.0 - eta_maxes=0.0 - maxima_count=0 - wrap_max=.FALSE. - wrap_=wrap - prev_above_threshold=.FALSE. -c----------------------------------------------------------------------- -c sanity check that final eta is less than twopi. -c only called when wrap = .TRUE. and we are analysing the whole -c [0,2pi] interval. lsode integrator makes sure final eta is twopi -c----------------------------------------------------------------------- - IF ((y_out(len_y_out,0)-y_out(0,0)) > twopi .AND. wrap) THEN - CALL program_stop("eta wrap error... debug direct.f") - ENDIF -c----------------------------------------------------------------------- -c turn y_out into dqdeta. -c----------------------------------------------------------------------- - DO i=0,(len_y_out-1),+1 - dqdeta(i+1) = (bf%f)*(y_out(i+1,3)-y_out(i,3)) - $ /(y_out(i+1,0)-y_out(i,0))! - ENDDO -c----------------------------------------------------------------------- -c identifies all regions of eta above threshold. calculates the -c maximum value of d_q_int/d_eta as well as eta for each region. -c----------------------------------------------------------------------- - DO i=1,len_y_out-1,+1 - IF((dqdeta(i)>dq_eps).AND.(.NOT.prev_above_threshold)) THEN - IF(i==1)THEN - wrap_max=.TRUE. - ENDIF - maxima_count=maxima_count+1 - - eta_brackets(maxima_count,1)=y_out(i-1,0) - eta_brackets(maxima_count,2)=y_out(i,0) - - max_dqdeta(maxima_count)=dqdeta(i) - max_locations(maxima_count) = 0.5*(y_out(i,0)+ - $ y_out(i-1,0)) - prev_above_threshold=.TRUE. - ELSEIF ((dqdeta(i)>dq_eps) .AND. prev_above_threshold) THEN - eta_brackets(maxima_count,2)=y_out(i,0) - - IF (dqdeta(i)>max_dqdeta(maxima_count)) THEN - max_dqdeta(maxima_count)=dqdeta(i) - max_locations(maxima_count) = 0.5*(y_out(i,0)+ - $ y_out(i-1,0)) - ENDIF - prev_above_threshold=.TRUE. - ELSE - prev_above_threshold=.FALSE. - ENDIF - ENDDO -c----------------------------------------------------------------------- -c case where whole range is under threshold doesn't require wrapping -c----------------------------------------------------------------------- - IF(MINVAL(dqdeta) > dq_eps)THEN - wrap_=.FALSE. - ENDIF -c----------------------------------------------------------------------- -c final datapoint is a special case due to the possibility of the -c region wrapping around to eta=0 region. -c----------------------------------------------------------------------- - IF (dqdeta(len_y_out)>dq_eps .AND. wrap_) THEN - IF (prev_above_threshold) THEN - IF (dqdeta(len_y_out)>max_dqdeta(maxima_count)) THEN - max_dqdeta(maxima_count)=dqdeta(len_y_out) - max_locations(maxima_count) = - $ 0.5*(y_out(len_y_out-1,0)+y_out(len_y_out,0)) - ENDIF - eta_brackets(maxima_count,2)=y_out(0,0) - - IF (wrap_max) THEN - eta_brackets(1,1)=eta_brackets(maxima_count,1) - - IF (max_dqdeta(maxima_count)>=max_dqdeta(1)) THEN - max_dqdeta(1)=max_dqdeta(maxima_count) - max_locations(1)=max_locations(maxima_count) - ENDIF - - eta_brackets(maxima_count,1)=0.0 - eta_brackets(maxima_count,2)=0.0 - - max_dqdeta(maxima_count)=0.0 - max_locations(maxima_count)=0.0 - maxima_count=maxima_count-1 - ENDIF - - ELSEIF (wrap_max) THEN !.AND. !prev_above_threshold) - eta_brackets(1,1)=y_out(len_y_out-1,0) - - IF (dqdeta(len_y_out)>max_dqdeta(1)) THEN - max_dqdeta(1)=dqdeta(len_y_out) - max_locations(1)=0.5*(y_out(len_y_out-1,0) - $ +y_out(len_y_out,0)) - ENDIF - ELSE - maxima_count=maxima_count+1 - - eta_brackets(maxima_count,1)=y_out(len_y_out-1,0) - eta_brackets(maxima_count,2)=y_out(0,0) - - max_dqdeta(maxima_count)=dqdeta(len_y_out) - max_locations(maxima_count) = - $ 0.5*(y_out(len_y_out-1,0)+y_out(len_y_out,0)) - ENDIF - ELSEIF (dqdeta(len_y_out)>dq_eps) THEN -c----------------------------------------------------------------------- -c non wrap case treated same as i=1:len_y_out-1 -c----------------------------------------------------------------------- - IF(prev_above_threshold) THEN - eta_brackets(maxima_count,2)=y_out(len_y_out,0) - - IF (dqdeta(len_y_out)>max_dqdeta(maxima_count)) THEN - max_dqdeta(maxima_count)=dqdeta(len_y_out) - max_locations(maxima_count) = 0.5*(y_out(len_y_out,0)+ - $ y_out(len_y_out-1,0)) - ENDIF - prev_above_threshold=.TRUE. - ELSE - maxima_count=maxima_count+1 - - eta_brackets(maxima_count,1)=y_out(len_y_out-1,0) - eta_brackets(maxima_count,2)=y_out(len_y_out,0) - - max_dqdeta(maxima_count)=dqdeta(len_y_out) - max_locations(maxima_count) = 0.5*(y_out(len_y_out,0)+ - $ y_out(len_y_out-1,0)) - prev_above_threshold=.TRUE. - ENDIF - ENDIF -c----------------------------------------------------------------------- -c warning if theres more than 2 xpoints. -c----------------------------------------------------------------------- - IF(maxima_count>2 .AND. wrap)THEN - CALL program_stop("More than 2 x-points detected.") - ENDIF -c----------------------------------------------------------------------- -c filling out xpt_etas output. -c----------------------------------------------------------------------- - IF (maxima_count==0) THEN - xpt_etas(1)=0.0 - ELSE - DO i=1,maxima_count,+1 - eta_maxes(i)=max_locations(i) - IF(wrap)THEN - xpt_etas(i)=max_locations(i) - xpt_etas(i)=xpt_etas(i)-twopi*floor(xpt_etas(i)/twopi) - ENDIF - ENDDO - ENDIF -c----------------------------------------------------------------------- -c debug print statements. lots of information. -c----------------------------------------------------------------------- - IF(debug)PRINT "(A)", "Num X-points::::::::::::::::::::::::::::::" - IF(debug)PRINT "(i6)", maxima_count - IF(maxima_count>0 .AND. debug)THEN - DO i=1,maxima_count - PRINT "(A)", "Point " - PRINT "(i6)", i - PRINT "(f16.5)", (eta_brackets(i,1) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - PRINT "(f16.5)", (eta_maxes(i) - $ )!-twopi*floor(eta_maxes(i)/twopi)) - PRINT "(f16.5)", (eta_brackets(i,2) - $ )!-twopi*floor(eta_brackets(i,2)/twopi)) - ENDDO - ENDIF - IF (debug)THEN - PRINT "(A)", "Total theta values over interval " - PRINT "(f16.5)", y_out(0,0) - PRINT "(f16.5)", y_out(len_y_out,0) - PRINT "(A)", "Total q values over interval " - PRINT "(es16.5)", y_out(0,3) - PRINT "(es16.5)", y_out(len_y_out,3) - PRINT "(es16.5)", (y_out(len_y_out,3)/(y_out(len_y_out,0)- - $ y_out(0,0))) - PRINT "(A)", "max and min dqdeta" - PRINT "(es16.5)", MAXVAL(dqdeta) - PRINT "(es16.5)", MINVAL(dqdeta) - ENDIF - IF(debug)PRINT "(A)", "::::::::::::::::::::::::::::::::::::::::::" -c----------------------------------------------------------------------- -c regular print statements. eta bracket describes the region where -c the analytic formulas will take over from the numerical -c integrator. -c----------------------------------------------------------------------- -501 FORMAT(1x,i1," x-point(s) detected:") -c502 FORMAT(1x,"over eta bracket (",f10.8,",",f10.8,")") -503 FORMAT(4x,"1st x-point eta bracket = (",f7.5,",",f7.5,")") -504 FORMAT(4x,"2nd x-point eta bracket = (",f7.5,",",f7.5,")") -505 FORMAT(3x,"max q-gradient",e10.3," <",e10.3) -506 FORMAT(3x,"max q-gradient",e10.3," >",e10.3) - IF(verbose .AND. wrap)THEN - IF(MAXVAL(dqdeta)0 .AND. wrap .AND. .FALSE.)THEN - PRINT "(A)", "________________________________________________" - WRITE(message,501)maxima_count - PRINT "(A)",message - DO i=1,maxima_count,+1 - IF(i==1)THEN - WRITE(message,503)eta_brackets(i,1),eta_brackets(i,2) - PRINT "(A)",message - ELSEIF(i==2)THEN - WRITE(message,504)eta_brackets(i,1),eta_brackets(i,2) - PRINT "(A)",message - ENDIF - ENDDO - PRINT "(A)", "------------------------------------------------" - ENDIF -c----------------------------------------------------------------------- -c terminate. -c----------------------------------------------------------------------- - RETURN - END SUBROUTINE direct_initialise_xpoints -c----------------------------------------------------------------------- -c subprogram 13. direct_saddle_coords. +c subprogram 15. direct_saddle_coords. c transforms us into a local coordinate frame aligned with one leg c of the x-point. takes x-point data from module variables. c r1 is radius from the magnetic axis, not major radius From 85b787d0d4759db4aa64a6e5b994a9a9894ec72b Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:01:43 -0500 Subject: [PATCH 83/97] updating direct_saddle_coords to allow use of exact angle coordinates (important) --- equil/direct.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 61f09687..ffa068f3 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1679,10 +1679,10 @@ END SUBROUTINE direct_xpoint c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) + SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi,usevth2) INTEGER, INTENT(IN) :: x_i - + LOGICAL, INTENT(IN) :: usevth2 REAL(r8), INTENT(IN) :: r1,eta1 REAL(r8), INTENT(OUT) :: x,y,chi @@ -1694,7 +1694,7 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) c----------------------------------------------------------------------- cosfac=COS(eta1) sinfac=SIN(eta1) - IF(usevth2(x_i))THEN + IF(usevth2)THEN cosfact=COS(xpt_varthetas2(x_i)) sinfact=SIN(xpt_varthetas2(x_i)) ELSE @@ -1722,7 +1722,7 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi) c orthogonal to the x-point leg that leaves the c x-point when travelling anticlockwise around the separatrix. c----------------------------------------------------------------------- - IF(usevth2(x_i))THEN + IF(usevth2)THEN chi = -COS(xpt_gammas2(x_i))*x+SIN(xpt_gammas2(x_i))*y ELSE chi = -COS(xpt_gammas(x_i))*x+SIN(xpt_gammas(x_i))*y From 66913830ee2f09d10b26b29d2d308253437e92d8 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:02:06 -0500 Subject: [PATCH 84/97] updating direct_saddle_coords_inv to allow use of exact angle coordinates (important) --- equil/direct.f | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index ffa068f3..4bb76c7b 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1733,26 +1733,26 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi,usevth2) RETURN END SUBROUTINE direct_saddle_coords c----------------------------------------------------------------------- -c subprogram 14. direct_saddle_coords_inv. +c subprogram 16. direct_saddle_coords_inv. c inverse of direct_saddle_coords. takes x,y, returns R,Z,rho,eta. -c rho is minor radius +c rho is minor radius. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta) + SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta,usevth2) INTEGER, INTENT(IN) :: x_i + LOGICAL, INTENT(IN) :: usevth2 REAL(r8), INTENT(IN) :: x,y REAL(r8), INTENT(OUT) :: R,Z,rho,eta REAL(r8) :: cosfact,sinfact REAL(r8) :: Rlocal,Zlocal - c----------------------------------------------------------------------- c precalculating trig components. c----------------------------------------------------------------------- - IF(usevth2(x_i))THEN + IF(usevth2)THEN cosfact=COS(xpt_varthetas2(x_i)) sinfact=SIN(xpt_varthetas2(x_i)) ELSE @@ -1760,16 +1760,8 @@ SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta) sinfact=SIN(xpt_varthetas(x_i)) ENDIF c----------------------------------------------------------------------- -c inverse coordinate transform. commented out lines are the forwards -c transform from direct_saddle_coords. +c inverse coordinate transform. c----------------------------------------------------------------------- - !Rshft = ro + r1*cosfac - !Zshft = zo + r1*sinfac - !Rlocal = Rshft-rxs(x_i) - !Zlocal = Zshft-zxs(x_i) - !x = cosfact*Rlocal + sinfact*Zlocal - !y = -sinfact*Rlocal + cosfact*Zlocal - Rlocal = cosfact*x - sinfact*y Zlocal = sinfact*x + cosfact*y From 5262cf5d904cec2fad8368a40db94905cfab2196 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:02:49 -0500 Subject: [PATCH 85/97] missed line from previous two commits --- equil/direct.f | 1 - 1 file changed, 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 4bb76c7b..c4e37b10 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1716,7 +1716,6 @@ SUBROUTINE direct_saddle_coords(x_i,r1,eta1,x,y,chi,usevth2) c----------------------------------------------------------------------- x = cosfact*Rlocal + sinfact*Zlocal y = -sinfact*Rlocal + cosfact*Zlocal - Zlocal = Zshft-zxs(x_i) c----------------------------------------------------------------------- c calculating chi angle variable, defined such that nabla chi is c orthogonal to the x-point leg that leaves the From 9b00e78ffcf498a5de312463172dfbc7017a1f73 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:03:58 -0500 Subject: [PATCH 86/97] adding new function int_validity_check that checks the criteria given by Eq. 12 in https://doi.org/10.1088/1361-6587/add9ca . Also updates to the description of direct_analytic_ints --- equil/direct.f | 70 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 68 insertions(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index c4e37b10..5fb5258f 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1775,10 +1775,76 @@ SUBROUTINE direct_saddle_coords_inv(x_i,x,y,R,Z,rho,eta,usevth2) RETURN END SUBROUTINE direct_saddle_coords_inv c----------------------------------------------------------------------- -c subprogram 15. direct_analytic_ints. -c takes the linear term b11, angle and position data, and calculates +c subprogram 17. int_validity_check. +c checks if we are close enough to the x-point for the analytic +c formulas to be valid. This is Eq. 12 in +c https://doi.org/10.1088/1361-6587/add9ca. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE int_validity_check(r,z,r_loc,eta,valid,eval_xpt_tol) + + REAL(r8), INTENT(IN) :: r,z,r_loc + REAL(r8), INTENT(INOUT) :: eta + REAL(r8), DIMENSION(1:2) :: xpt_dists + LOGICAL, INTENT(OUT) :: valid + REAL(r8), INTENT(OUT) :: eval_xpt_tol + REAL(r8) :: x,y,chi + INTEGER :: ixpt + !x1_tol gonna +c----------------------------------------------------------------------- +c find nearest x-point. +c----------------------------------------------------------------------- + IF(num_xpts==0)CALL program_stop("X-point init missed something.") + xpt_dists(1)=SQRT((r-rxs(1))**2+(z-zxs(1))**2) + IF(num_xpts==2)THEN + xpt_dists(2)=SQRT((r-rxs(2))**2+(z-zxs(2))**2) + ELSE + xpt_dists(2)=1d99 + ENDIF + ixpt=MINLOC(xpt_dists,1) +c----------------------------------------------------------------------- +c check we are actually near this x-point in angle-space. +c----------------------------------------------------------------------- + eta=eta-twopi*floor(eta/twopi) + IF(ABS(xpt_etas(ixpt)-eta)>0.1*pi.OR.xpt_dists(ixpt)>0.1*ro)THEN + CALL program_stop("Poloidal field vanishing far from x-point") + ENDIF +c----------------------------------------------------------------------- +c if etaABS(chi))CALL program_stop("angle sanity ch. fail 1") + !^We are approaching anticlockwise, travelling down the x-axis. + !The int. point should be closer to the first leg of the sep. + !then the second + eval_xpt_tol=ABS(x/xpt_dists(ixpt)) + ELSE + IF(ABS(chi)>ABS(x))CALL program_stop("angle sanity ch. fail 2") + eval_xpt_tol=ABS(chi/xpt_dists(ixpt)) + !chi is the orthogonal distance from the second leg of the + !x-point. The second leg is the one pointing in the + !anticlockwise direction as we travel and the psi surface in + !a normal poloidal cross section image. + ENDIF + valid=eval_xpt_tol", valid +c----------------------------------------------------------------------- +c terminate. +c----------------------------------------------------------------------- + RETURN + END SUBROUTINE int_validity_check +c----------------------------------------------------------------------- +c subprogram 18. direct_analytic_ints. +c takes the linear term c11, angle and position data, and calculates c integrals y(1), y(2), y(3), y(4) replacing direct_fl_int. assumes c logarithmic trajectories near the saddle point. +c for more information see https://doi.org/10.1088/1361-6587/add9ca. c----------------------------------------------------------------------- c----------------------------------------------------------------------- c declarations. From e7d11a2124a7481ba685e29c5a18f24dcd2e9c70 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:05:02 -0500 Subject: [PATCH 87/97] updating direct_analytic_ints to allow use of exact angles --- equil/direct.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index 5fb5258f..b975732d 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1855,6 +1855,7 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, REAL(r8), INTENT(IN) :: r1,eta1,eta2 INTEGER, INTENT(IN) :: x_i LOGICAL, INTENT(IN) :: debug + LOGICAL :: usevth2 REAL(r8), INTENT(OUT) :: yi1,yi2,yi3,yi4 REAL(r8), DIMENSION(1:4,1:2,0:1),INTENT(OUT) :: outmat @@ -1887,7 +1888,7 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, c----------------------------------------------------------------------- c pre-calculationg useful terms c----------------------------------------------------------------------- - IF(usevth2(x_i))THEN + IF(usevth2)THEN vartheta=xpt_varthetas2(x_i) gamma=xpt_gammas2(x_i) ELSE @@ -1900,6 +1901,7 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, cotgam = one/TAN(gamma) singam = SIN(gamma) + cosgam = COS(gamma) singmt = SIN(gamma-vartheta) cscgam = one/singam From 491367c5388de7733f1380be3c67c30dbe52291e Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:06:09 -0500 Subject: [PATCH 88/97] big updates to direct_analytic_ints, some new expressions for yi1-yi3 --- equil/direct.f | 51 ++++++++++++++++++++------------------------------ 1 file changed, 20 insertions(+), 31 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index b975732d..70fbe688 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1850,7 +1850,7 @@ END SUBROUTINE int_validity_check c declarations. c----------------------------------------------------------------------- SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, - $ outmat,debug) + $ outmat,outmat2,debug) REAL(r8), INTENT(IN) :: r1,eta1,eta2 INTEGER, INTENT(IN) :: x_i @@ -1859,32 +1859,20 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, REAL(r8), INTENT(OUT) :: yi1,yi2,yi3,yi4 REAL(r8), DIMENSION(1:4,1:2,0:1),INTENT(OUT) :: outmat + REAL(r8), DIMENSION(1:8),INTENT(OUT) :: outmat2 - REAL(r8) :: x1,y1,x2,y2,chi,I1,I2,I3,bt,b,root,xo,yo,chio - REAL(r8) :: y3d,y3r1,y3r2,singmt,a,c,yi2b,yi3b + REAL(r8) :: x1,y1,x2,y2,chi,J1,J2,J3,bt,b,root,xo,yo,chio,d,C00 + REAL(r8) :: y3d,y3r1,y3r2,singmt,a,c,yi2b,yi3b,cosgam REAL(r8) :: cosvt,sinvt,cotgam,singam,cscgam,etax,vartheta,gamma TYPE(direct_bfield_type) :: bf outmat=0.0 -c----------------------------------------------------------------------- -c Asymptotic assumptions that are necessary for the formulas used -c in this function -c----------------------------------------------------------------------- -c chi/a<<1 must be a small number, x/a<<1 must be a small number -c ^Important for the definition of Bp as a linear term -c ^a here is minor radius. chi and x calculated by -c direct_saddle_coords -c |Bp|/|Bt|<<1 must be a small number -c ^important for ignoring |Bp| when calculating |B|. -c I don't think x1/x2 necessarily has to be small, however I'll -c still double check. -c Initial observation shows that y(2) - aka minor radius has its -c error grow the fastest as the above assumptions are relaxed + usevth2=.TRUE. c----------------------------------------------------------------------- c getting local coordinates. c----------------------------------------------------------------------- - CALL direct_saddle_coords(x_i,r1,eta1,x1,y1,chi) - CALL direct_saddle_coords(x_i,zero,zero,xo,yo,chio) + CALL direct_saddle_coords(x_i,r1,eta1,x1,y1,chi,.TRUE.) + CALL direct_saddle_coords(x_i,zero,zero,xo,yo,chio,.TRUE.) c----------------------------------------------------------------------- c pre-calculationg useful terms c----------------------------------------------------------------------- @@ -1935,40 +1923,41 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, outmat(1,2,1)=y2 CALL direct_saddle_coords_inv(x_i,x1,y1,outmat(2,1,0), - $ outmat(2,2,0),outmat(3,1,0),outmat(3,2,0)) + $ outmat(2,2,0),outmat(3,1,0),outmat(3,2,0),.TRUE.) ENDIF CALL direct_saddle_coords_inv(x_i,x2,y2,outmat(2,1,1), - $ outmat(2,2,1),outmat(3,1,1),outmat(3,2,1)) + $ outmat(2,2,1),outmat(3,1,1),outmat(3,2,1),.TRUE.) c----------------------------------------------------------------------- c evaluating y1 c----------------------------------------------------------------------- - yi1 = -(cscgam/xpt_b11s(x_i))*(rxs(x_i)*LOG(x2/x1) - $ +(cosvt-cotgam*sinvt)*(x2-x1)+sinvt*(y1-x1)*(x1/x2-one)) + yi1 = -(cscgam/xpt_c11s(x_i))*(rxs(x_i)*LOG(x2/x1) + $ +(x2-x1)*(cosvt-(one-x1/x2)*cotgam*sinvt) + $ -(one-x1/x2)*y1*sinvt) c----------------------------------------------------------------------- c evaluating y2 c----------------------------------------------------------------------- yi2=outmat(3,1,1) - !The following formula is wrong... - IF(debug)yi2b = -(cscgam/xpt_b11s(x_i))*abs(-SIN(etax+gamma + !The following formula for minor radius integral is wrong... + IF(debug)yi2b = -(cscgam/xpt_c11s(x_i))*abs(-SIN(etax+gamma $ -vartheta)*(x2-x1) $ +singam*SIN(etax-vartheta)*(y1-x1)*(one-x1/x2)) c----------------------------------------------------------------------- c evaluating y3 c----------------------------------------------------------------------- a=cscgam*singmt - c=x1*(x1-y1)*sinvt + c=x1*(x1*cotgam-y1)*sinvt - y3d=rxs(x_i)**2-4*a*c + y3d=rxs(x_i)**2.d0-4.d0*a*c y3r1=(one/(2*a))*(-rxs(x_i)+SQRT(y3d)) y3r2=(one/(2*a))*(-rxs(x_i)-SQRT(y3d)) - yi3 = -(cscgam/xpt_b11s(x_i))*(one/SQRT(y3d))* + yi3 = -(cscgam/xpt_c11s(x_i))*(one/SQRT(y3d))* $ LOG((x2-y3r1)*(x1-y3r2)/((x2-y3r2)*(x1-y3r1))) - IF(debug)yi3b = -(cscgam/(xpt_b11s(x_i)*rxs(x_i)))*(LOG(x2/x1) - $ -(cosvt-cotgam*sinvt)*(x2-x1)/rxs(x_i) - $ +sinvt*(y1-x1)*(one-x1/x2)/rxs(x_i)) + IF(debug)yi3b = -(cscgam/(xpt_c11s(x_i)*rxs(x_i)))*(LOG(x2/x1) + $ -(cosvt-(one-x1/x2)*cotgam*sinvt)*(x2-x1)/rxs(x_i) + $ +sinvt*y1*(one-x1/x2)/rxs(x_i)) IF(debug)THEN outmat(4,1,0)=yi2 From bbe28ea66fe753493cdd9c7d9b0492f0e4dc1d91 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:07:51 -0500 Subject: [PATCH 89/97] big updates to direct_analytic_ints regarding yi4. Also, outputs computed in outmat2 may be used as inputs for a future implementation of the general formula for yi4 where power_bp =/=0 --- equil/direct.f | 140 ++++++++++++++++++++++++++----------------------- 1 file changed, 73 insertions(+), 67 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 70fbe688..ccf62639 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -1969,81 +1969,87 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, c y4 special case. c----------------------------------------------------------------------- IF(abs(power_bp)>1e-13)THEN - CALL program_stop("Analytic sep. incompat. w power_bp =/= 0") + IF(.NOT. debug)THEN + CALL program_stop("Analytic int incompat. w power_bp =/= 0") + ELSE + WRITE(*,*)"Analytic integrals incompatible w power_bp != 0" + WRITE(*,*)"Printing data" + ENDIF + !Refer to https://doi.org/10.1088/1361-6587/add9ca for the + !the full writeup of the y4 formula. + !Need all ingredients for these Appellf1 functions: + !Ingredients for J1, J2, J3 in Mathematica: + !d = x1*y1-x1*x1 + C00=-cscgam*(b**power_b)*(ABS(xpt_c11s(x_i)**(power_bp-one)))* + $ (xpt_c11s(x_i)/ABS(xpt_c11s(x_i))) !keeping sign consistent + outmat2(1)=y1 + outmat2(2)=x1 + outmat2(3)=x2 + outmat2(4)=gamma + outmat2(5)=power_bp + + outmat2(6)=C00* + $ rxs(x_i)**(one-power_r-power_bp) + outmat2(7)=C00* + $ (one-power_r-power_bp)* + $ (cosvt-cotgam*sinvt)/(rxs(x_i)**(power_r+power_bp)) + outmat2(8)=C00* + $ (-one)*(one-power_r-power_bp)* + $ sinvt*(x1*y1-x1*x1*cotgam)/(rxs(x_i)**(power_r+power_bp)) + + !yi4=outmat2(6)*J1+outmat2(7)*J2+outmat2(8)*J3 + yi4=0.0 + + !Full writeup: + !yi4 = -cscgam*(b**power_b)*(xpt_c11s(x_i)**(power_bp-one))*( + !$ J1*rxs(x_i)**(one-power_r-power_bp)+ + !$ J2*(one-power_r-power_bp)* + !$ (cosvt-cotgam*sinvt)/(rxs(x_i)**(power_r+power_bp)) + !$ -J3*(one-power_r-power_bp)* + !$ sinvt*(x1*y1-x1*x1)/(rxs(x_i)**(power_r+power_bp))) + + !AppellF1 entries (Can't appel package since xf1,yf1 complex) + !a(1)=-alpha_p/2.d0 + !b1(1)=-alpha_p/2.d0 + !b2(1)=-alpha_p/2.d0 + !c(1)=1.d0-alpha_p/2.d0 + + !a(2)=1.d0/2.d0-alpha_p/2.d0 + !b1(2)=-alpha_p/2.d0 + !b2(2)=-alpha_p/2.d0 + !c(2)=3.d0/2.d0-alpha_p/2.d0 + + !a(3)=-1.d0/2.d0-alpha_p/2.d0 + !b1(3)=-alpha_p/2.d0 + !b2(3)=-alpha_p/2.d0 + !c(3)=1.d0/2.d0-alpha_p/2.d0 + + !xf1=x**2/(d*cosgam*singam - sqrt(-d**2*singam**4)) + !yf1=xf1 ELSE - I1 = LOG(x2/x1) - I2 = x2-x1 - I3 = -(one/x2)+one/x1 + outmat2(1)=0.d0 + outmat2(2)=0.d0 + outmat2(3)=0.d0 + outmat2(4)=0.d0 + outmat2(5)=0.d0 + outmat2(6)=0.d0 + outmat2(7)=0.d0 + outmat2(8)=0.d0 + + J1 = LOG(x2/x1) + J2 = x2-x1 + J3 = -(one/x2)+one/x1 + yi4 = -cscgam*(b**power_b)*(xpt_c11s(x_i)**(power_bp-one))*( + $ J1*rxs(x_i)**(one-power_r)+ + $ J2*(one-power_r)*(cosvt-cotgam*sinvt)/(rxs(x_i)**power_r) + $ -J3*(one-power_r)*sinvt*(x1*y1-x1*x1*cotgam)/(rxs(x_i)**power_r)) ENDIF - yi4 = -cscgam*(b**power_b)*(xpt_b11s(x_i)**(power_bp-one))*( - $ I1*rxs(x_i)**(one-power_r)+ - $ I2*(one-power_r)*(cosvt-cotgam*sinvt)/(rxs(x_i)**power_r) - $ -I3*(one-power_r)*sinvt*(x1*y1-x1*x1)/(rxs(x_i)**power_r)) c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- RETURN END SUBROUTINE direct_analytic_ints c----------------------------------------------------------------------- -c subprogram 16. direct_mixed_spline_builder. -c builds y_out and ff spline using a combination of analytic -c integrals over divergent x-point regions, and numerically -c integrated sections inbetween x-points. -c----------------------------------------------------------------------- -c declarations. -c----------------------------------------------------------------------- - SUBROUTINE direct_mixed_spline_builder(psifac,ff,y_out,debug_in, - $ maxBpBt,xpt_starts) - - REAL(r8), INTENT(INOUT) :: psifac - REAL(r8), INTENT(OUT) :: maxBpBt - INTEGER, DIMENSION(2), INTENT(OUT) :: xpt_starts - LOGICAL, INTENT(IN) :: debug_in - - REAL(r8) :: eta,eta1,eta2,R,Z,etat,y01,y02,y03,y04 - REAL(r8) :: bt1,bp1,bt2,bp2 - REAL(r8) :: eta3,eta4,r_loc1,r_loc2 - REAL(r8), DIMENSION(1:nstep2,0:4) :: yi1, yi2, yi_i - - REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out1,y_out2 - REAL(r8), DIMENSION(0:(nstepd+1),0:4) :: y_out2i - REAL(r8), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4), - $ INTENT(INOUT) :: y_out - REAL(r8), DIMENSION(1:4,1:2,0:1) :: outmat - INTEGER :: len_y1_out,len_y2_out,maxima_count,tot_steps,ist1,ist2 - INTEGER :: i1,i2,i,j,k,eta0i - LOGICAL :: dbg1xpt,debug,out,fakeout,new_xpt - - REAL(r8), DIMENSION(6,2) :: eta_brackets - REAL(r8), DIMENSION(6) :: eta_maxes - - TYPE(direct_bfield_type) :: bf - TYPE(spline_type) :: yi,ffi - TYPE(spline_type), INTENT(OUT) :: ff - - yi1=0.0 - yi2=0.0 - y_out1=0.0 - y_out2=0.0 - y_out=0.0 - maxBpBt=0.0 - xpt_starts=-1 - dbg1xpt=.FALSE. - debug=.FALSE. - out=.FALSE. - fakeout=.TRUE. -c----------------------------------------------------------------------- -c preparing print statements. -c----------------------------------------------------------------------- -400 FORMAT(/,"R_X",10x,"Z_X",11x,"r_x",10x,"eta_x"/) -401 FORMAT(/,"psi_fac=",f15.13/) -410 FORMAT(f12.10,",",f13.10,",",f12.10,",",f12.10) -411 FORMAT(f13.10,",",f13.10,",",f12.10,",",f13.10,",",f13.10 - $ ,",",f13.10,",",f12.10) -412 FORMAT(f16.12,",",f16.12,",",f16.12,",",f16.12,",",f16.12) -413 FORMAT(f13.10,",",f13.10,",",f13.10,",",f13.10,",",f12.10 - $ ,",",f13.10,",",f12.10,",",f13.10,",",f13.10,",",f12.10) -c----------------------------------------------------------------------- c adddressing case of only one x-point. c----------------------------------------------------------------------- IF(num_xpts==1 .AND. (.NOT.fakeout))THEN From ae21864ae38a4e938049e27422257892cc1aa309 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:08:55 -0500 Subject: [PATCH 90/97] removing deprecated code + adding the function interp_through_zero which adds a knot at eta = 2pi for field line integral outputs --- equil/direct.f | 313 +++++++++---------------------------------------- 1 file changed, 53 insertions(+), 260 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index ccf62639..798e7d2d 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2050,271 +2050,64 @@ SUBROUTINE direct_analytic_ints(x_i,r1,eta1,eta2,yi1,yi2,yi3,yi4, RETURN END SUBROUTINE direct_analytic_ints c----------------------------------------------------------------------- -c adddressing case of only one x-point. +c subprogram 19. interp_through_zero. +c adds a spline knot at zero (or twopi). c----------------------------------------------------------------------- - IF(num_xpts==1 .AND. (.NOT.fakeout))THEN -c----------------------------------------------------------------------- -c calling direct_analytic_ints on the initial x-point over full eta -c span. Note we don't need to call find_fl_surface, direct_xpoint -c since these were already called for this x-point in direct_run's -c psi loop +c declarations. c----------------------------------------------------------------------- - CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) - r_loc1 = SQRT((r-ro)**2+(z-zo)**2) - CALL direct_get_bfield(r,z,bf,1) - - IF(out)CALL ascii_open(out_xpt_unit,"yi1.csv","UNKNOWN") - - DO i=1,nstep2,+1 - eta=xpt_brackets(1,1)+(xpt_brackets(1,2)- - $ xpt_brackets(1,1))*(one*i/nstep2) - yi1(i,0)=eta - - CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1) - $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.TRUE.) - - IF(debug)CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, - $ y_out1,bf,len_y1_out) - - IF(i==nstep2)THEN - CALL direct_get_bfield(outmat(2,1,0),outmat(2,2,0),bf,1) - bp1=SQRT(bf%br**2+bf%bz**2) - bt1=bf%f/outmat(2,1,0) - CALL direct_get_bfield(outmat(2,1,1),outmat(2,2,1),bf,1) - bp2=SQRT(bf%br**2+bf%bz**2) - bt2=bf%f/outmat(2,1,1) - PRINT "(A,es10.3)"," max Bp/Bt (x-point)=", - $ MAX(bp1/bt1,bp2/bt2) - maxBpBt=MAX(bp1/bt1,bp2/bt2) - ENDIF - - IF(out)WRITE(out_xpt_unit,412) - $ eta, - $ yi1(i,1), - $ yi1(i,2), - $ yi1(i,3), - $ yi1(i,4) - ENDDO - - IF(out)CALL ascii_close(out_xpt_unit) -c----------------------------------------------------------------------- -c printing field line paths comparison between numerical and -c analytic methods. COMMENTED OUT -c----------------------------------------------------------------------- - IF(.FALSE.)THEN - PRINT "(A)", "STARTING THE PATH SHOW:::::::::::::::::::::::::" - - !xpt_brackets(1,1)=4.32562 - !xpt_brackets(1,2)=4.33276 - - CALL ascii_open(out_xpt_unit,"xpt.out","UNKNOWN") - k=1 - DO j=1,9,+3 - psifac=one-(10*one)**(-1-j) - DO k=1,4,+1 - CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) - r_loc1 = SQRT((r-ro)**2+(z-zo)**2) - CALL direct_get_bfield(r,z,bf,1) - IF (k==1 .AND. j==1)THEN - PRINT "(A)", "Ro, Zo" - !WRITE(out_2d_unit) "(A)", "Ro, Zo" - PRINT "(f12.10,A,f12.10)",ro,",",zo - PRINT "(A)", "RX, ZX, rx, etax" - WRITE(out_xpt_unit,400) - PRINT 410,rxs(1),zxs(1),SQRT((ro-rxs(1))**2+ - $ (zo-zxs(1))**2),xpt_etas(1) - WRITE(out_xpt_unit,410)rxs(1),zxs(1), - $ SQRT((ro-rxs(1))**2+(zo-zxs(1))**2),xpt_etas(1) - PRINT "(A)", "Rsep, Zsep" - ELSE - IF(K==2 .AND. j==1)PRINT "(A)", "psifac:" - IF(K==2 .AND. j==1)THEN - PRINT "(f15.13)", psifac - WRITE(out_xpt_unit,401)psifac - ENDIF - IF(K==1 .AND. j>1)PRINT "(A)", "psifac:" - IF(K==1 .AND. j>1)THEN - PRINT "(f15.13)", psifac - WRITE(out_xpt_unit,401)psifac - ENDIF - IF (k==2)THEN - PRINT "(A)", "R_Numerical, Z_Numerical,r_num,eta_num" - etat=ATAN2(z-zo,r-ro) - etat=etat-twopi*floor(etat/twopi) - PRINT 410,r,z,SQRT((ro-r)**2+(zo-z)**2),etat - WRITE(out_xpt_unit,410)r,z, - $ SQRT((ro-r)**2+(zo-z)**2),etat - ENDIF - IF (k==3)THEN - PRINT "(A)", "R_A, Z_A,r_a,eta_a, origvarthetas" - usevth2(1)=.FALSE. - ENDIF - IF (k==4)THEN - PRINT "(A)", "R_A, Z_A,r_a,eta_a, new varthetas" - usevth2(1)=.TRUE. - ENDIF - - ENDIF - DO i=1,nstep2,+1 - eta=xpt_brackets(1,1)+(xpt_brackets(1,2)- - $ xpt_brackets(1,1))*(one*i/nstep2) - yi1(i,0)=eta - - !PRINT "(es16.9)", one*i/nstep2 - CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1) - $ ,eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.TRUE.) - verbose=.FALSE. - CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, - $ y_out1,bf,len_y1_out) - - IF (k==1 .AND. j==1)THEN !Sep values - CALL find_fl_surface(one,eta,r,z) - etat=ATAN2(z-zo,r-ro) - etat=etat-twopi*floor(etat/twopi) - PRINT 410,r,z,SQRT((ro-r)**2+(zo-z)**2),etat - WRITE(out_xpt_unit,410)r,z, - $ SQRT((ro-r)**2+(zo-z)**2),etat - ELSEIF(k==2)THEN !Numerical int values - r=ro+y_out1(istep,2)*COS(y_out1(istep,0)) - z=zo+y_out1(istep,2)*SIN(y_out1(istep,0)) - etat=y_out1(istep,0) - etat=etat-twopi*floor(etat/twopi) - PRINT 410,r,z,y_out1(istep,2),etat - WRITE(out_xpt_unit,410)r,z,y_out1(istep,2),etat - ELSEIF(k==3 .OR. k==4)THEN !Analytic int values - etat=outmat(3,2,0) - etat=etat-twopi*floor(etat/twopi) - IF(i==1)THEN - PRINT 410,outmat(2,1,0),outmat(2,2,0), - $ outmat(3,1,0),etat - WRITE(out_xpt_unit,410)outmat(2,1,0), - $ outmat(2,2,0),outmat(3,1,0),etat - ENDIF - etat=outmat(3,2,1) - etat=etat-twopi*floor(etat/twopi) - PRINT 410,outmat(2,1,1),outmat(2,2,1),outmat(3,1,1) - $ ,etat - WRITE(out_xpt_unit,410)outmat(2,1,1),outmat(2,2,1) - $ ,outmat(3,1,1),etat - ENDIF - - IF (.FALSE.)THEN - PRINT "(A)", "y(1)" - PRINT "(f16.9)", y_out1(istep,1)-y_out1(0,1) - PRINT "(f16.9)", yi1(1,1) - PRINT "(A)", "y(2)" - PRINT "(f16.9)", y_out1(istep,2)-y_out1(0,2) - PRINT "(f16.9)", yi1(1,2) - PRINT "(A)", "y(3)" - PRINT "(f16.9)", y_out1(istep,3)-y_out1(0,3) - PRINT "(f16.9)", yi1(1,3) - PRINT "(A)", "y(4)" - PRINT "(f16.9)", y_out1(istep,4)-y_out1(0,4) - PRINT "(f16.9)", yi1(1,4) - ENDIF - ENDDO - ENDDO - ENDDO - - CALL ascii_close(out_xpt_unit) - CALL program_stop("numerical vs analytic integral paths print") - $ + SUBROUTINE interp_through_zero(y_out,len_y_out,i_zero) + + REAL(r8), DIMENSION(0:,0:), INTENT(INOUT) :: y_out + REAL(r8), DIMENSION(0:(4*nstepd+2*nstep2+6),0:4) :: y_cpy + INTEGER, INTENT(INOUT) :: len_y_out + INTEGER, INTENT(OUT) :: i_zero + REAL(r8), DIMENSION(0:4) :: yinterim1 + INTEGER :: i,len_y_out_tmp + LOGICAL :: interpd + !force_twopi=.TRUE. +c----------------------------------------------------------------------- +c if integrals pass through twopi, we add a point there. +c----------------------------------------------------------------------- + interpd=.FALSE. + + y_cpy(0:len_y_out,0)=y_out(0:len_y_out,0) + y_cpy(0:len_y_out,1)=y_out(0:len_y_out,1) + y_cpy(0:len_y_out,2)=y_out(0:len_y_out,2) + y_cpy(0:len_y_out,3)=y_out(0:len_y_out,3) + y_cpy(0:len_y_out,4)=y_out(0:len_y_out,4) + + len_y_out_tmp=len_y_out + DO i=0,len_y_out_tmp-1,+1 + IF(y_out(i+1,0)==twopi)THEN + WRITE(*,*)"patch_two_c no interp at 0 required, s2" + i_zero=i+1 + EXIT !no interp requied + ELSEIF(y_out(i,0)>twopi .AND. + $ y_out(i+1,0) Date: Sun, 8 Feb 2026 18:10:33 -0500 Subject: [PATCH 91/97] adding three functions, patch_two_a, patch_two_b, patch_two_c that splice two y_outs together (see their descriptions for more information) --- equil/direct.f | 673 ++++++++++++++++++++++--------------------------- 1 file changed, 301 insertions(+), 372 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 798e7d2d..44b990dd 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2109,439 +2109,368 @@ SUBROUTINE interp_through_zero(y_out,len_y_out,i_zero) RETURN END SUBROUTINE interp_through_zero c----------------------------------------------------------------------- -c ordering the two etas for numerical field line integration +c subprogram 20. patch_two_a. +c combines two y_outs together. assumes y_out1 is anticlockwise, +c from etaii to etaiv, and y_out2 is clockwise from etaiii to etai +c where etavi>etaiii>etaii>etai. Also assumes we aren't going more +c than twopi around the loop. Stitches splines together at +c 0.5*(etaii+etaiii). Returns y_out, len_y_out, which will seem +c like a single integral. c----------------------------------------------------------------------- - eta1 = xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) - eta2 = xpt_brackets(1,2) - twopi*floor(xpt_brackets(1,2)/twopi) - - IF(eta2etaiii).AND.(etaiii>etaii).AND.(etaii>etai)))THEN + WRITE(*,*)"Incorrect use of patch_two_a (s1)." + WRITE(*,*)y_out2(len_y_out2,0) + WRITE(*,*)y_out2(len_y_out2-1,0) + WRITE(*,*)y_out2(0,0) + WRITE(*,*)"Angles:" + WRITE(*,*)etaiv + WRITE(*,*)etaiii + WRITE(*,*)etaii + WRITE(*,*)etai + CALL program_stop("Incorrect use of patch_two_a. (s1)") + ELSEIF((etaiv-etai)>twopi)THEN + CALL program_stop("Incorrect use of patch_two_a. (s2)") + ENDIF c----------------------------------------------------------------------- -c calling direct_initialise_xpoints to check for a second x-point. -c----------------------------------------------------------------------- - CALL direct_initialise_xpoints(y_out1,len_y1_out,.FALSE., - $ .FALSE.,bf,dqdeps_tol,BpBt_tol, - $ eta_maxes,eta_brackets,maxima_count) - IF(dbg1xpt)PRINT "(A)", "Maxima count for numerical integral" - IF(dbg1xpt)PRINT "(i6)", maxima_count - IF(dbg1xpt .AND. maxima_count>0)THEN - PRINT "(A)", "|||||||||||||||||||||||||||||||||||||||||||" - PRINT "(i6)", maxima_count - DO i=1,maxima_count - PRINT "(i6)", i - PRINT "(f16.5)", (eta_brackets(i,1) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - PRINT "(f16.5)", (eta_maxes(i) - $ )!-twopi*floor(eta_maxes(i)/twopi)) - PRINT "(f16.5)", (eta_brackets(i,2) - $ )!-twopi*floor(eta_brackets(i,2)/twopi)) - ENDDO - ENDIF +c find main stitch point. c----------------------------------------------------------------------- -c check first and last maxima to make sure they are unique. + eta_s=0.5*(etaiii+etaii) c----------------------------------------------------------------------- - IF(maxima_count>0)THEN +c create stich points. c----------------------------------------------------------------------- -c if first maxima not unique, eliminate it -c----------------------------------------------------------------------- - IF(ABS(eta_brackets(1,1)-eta2)<1e-6 .AND. - $ ABS(eta_maxes(1)-eta2)<1e-3)THEN - maxima_count=maxima_count-1 - DO i=1,maxima_count,+1 - eta_brackets(i,1:2)=eta_brackets(i+1,1:2) - eta_maxes(i)=eta_maxes(i+1) - ENDDO - ENDIF - IF(dbg1xpt)PRINT "(A)", "Maxima count for numerical int." - IF(dbg1xpt)PRINT "(i6)", maxima_count - IF(dbg1xpt .AND. maxima_count>0)THEN - PRINT "(A)", "||||||||||||||||||||||||||||||||||||||||||" - DO i=1,maxima_count - PRINT "(i6)", i - PRINT "(f16.5)", (eta_brackets(i,1) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - PRINT "(f16.5)", (eta_maxes(i) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - PRINT "(f16.5)", (eta_brackets(i,2) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - ENDDO - ENDIF + CALL yinterim(y_out1,len_y_out1,eta_s,yinterim1) + CALL yinterim(y_out2,len_y_out2,eta_s,yinterim2) c----------------------------------------------------------------------- -c if last maxima not unique, eliminate it -c----------------------------------------------------------------------- - IF(ABS(eta_brackets(maxima_count,2)-eta1)<1e-6 .AND. - $ ABS(eta_maxes(maxima_count)-eta1)<1e-3)THEN - eta_brackets(maxima_count,1:2)=0.0 - eta_maxes(maxima_count)=0.0 - maxima_count=maxima_count-1 - ENDIF - IF(dbg1xpt .AND. maxima_count>0)THEN - PRINT "(A)", "||||||||||||||||||||||||||||||||||||||||||" - PRINT "(i6)", maxima_count - DO i=1,maxima_count - PRINT "(i6)", i - PRINT "(f16.5)", (eta_brackets(i,1) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - PRINT "(f16.5)", (eta_maxes(i) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - PRINT "(f16.5)", (eta_brackets(i,2) - $ )!-twopi*floor(eta_brackets(i,1)/twopi)) - ENDDO - ENDIF - ENDIF +c checking radii are similar. c----------------------------------------------------------------------- -c loop over new unique local maxes that flag as x-points. + IF(ABS(yinterim1(2)-yinterim2(2))/ro > r_tol)THEN + WRITE(*,*)"patch_two_a:" + WRITE(*,*)ABS(yinterim1(2)-yinterim2(2))/ro + CALL program_stop( + $ "Radial discontinuity > r_tol during field line stitching.") + ENDIF c----------------------------------------------------------------------- - DO i=1,maxima_count,+1 +c renormalising y_out1 so the integrals are zero at stitch point. c----------------------------------------------------------------------- -c making sure all angles are in [0,2pi). + DO i=0,len_y_out1,+1 + y_out1(i,1)=y_out1(i,1)-yinterim1(1) + y_out1(i,3)=y_out1(i,3)-yinterim1(3) + y_out1(i,4)=y_out1(i,4)-yinterim1(4) + ENDDO c----------------------------------------------------------------------- - eta_maxes(i)=eta_maxes(i) - twopi*floor(eta_maxes(i)/twopi) - eta_brackets(i,1)= - $ eta_brackets(i,1) - twopi*floor(eta_brackets(i,1)/twopi) - eta_brackets(i,2)= - $ eta_brackets(i,2) - twopi*floor(eta_brackets(i,2)/twopi) +c resigning those integrals of absolute values in y_out2 +c----------------------------------------------------------------------- + y_cpy(0:len_y_out2,0)=y_out2(0:len_y_out2,0) + y_cpy(0:len_y_out2,1)=y_out2(0:len_y_out2,1) + y_cpy(0:len_y_out2,2)=y_out2(0:len_y_out2,2) + y_cpy(0:len_y_out2,3)=y_out2(0:len_y_out2,3) + y_cpy(0:len_y_out2,4)=y_out2(0:len_y_out2,4) + DO i=len_y_out2,0,-1 + y_out2(i,1)=-(y_cpy(i,1)-y_cpy(len_y_out2,1)) + y_out2(i,3)=-(y_cpy(i,3)-y_cpy(len_y_out2,3)) + y_out2(i,4)=-(y_cpy(i,4)-y_cpy(len_y_out2,4)) + ENDDO c----------------------------------------------------------------------- -c updating module variables. +c writing y_out2 to y_out. c----------------------------------------------------------------------- - num_xpts=num_xpts+1 - IF(num_xpts>2) - $ CALL program_stop("More than 2 x-points detected") - - xpt_etas(num_xpts)=eta_maxes(i) - xpt_brackets(num_xpts,1)=eta_brackets(i,1) - xpt_brackets(num_xpts,2)=eta_brackets(i,2) - - CALL find_fl_surface(one,xpt_etas(num_xpts),r,z) - CALL direct_xpoint(r,z,num_xpts,new_xpt) - ENDDO - + ii=0 + DO i=len_y_out2,0,-1 + IF(y_out2(i,0)zero)THEN - eta0i=i - EXIT - ENDIF - ENDDO - - i=MAX(eta0i-5,0) - j=MIN(eta0i+5,len_y1_out) - - CALL spline_alloc(yi,j-i,4) - - DO k=i,j,+1 - yi%xs(k-i)=y_out1(k,0) - yi%fs(k-i,1)=y_out1(k,1) - yi%fs(k-i,2)=y_out1(k,2) - yi%fs(k-i,3)=y_out1(k,3) - yi%fs(k-i,4)=y_out1(k,4) - - ENDDO - - CALL spline_fit(yi,"extrap") - CALL spline_eval(yi,zero,0) - y01=yi%f(1) - y02=yi%f(2) - y03=yi%f(3) - y04=yi%f(4) - CALL spline_dealloc(yi) + y_out(ii,0)=yinterim2(0) + y_out(ii,1)=yinterim2(1) + y_out(ii,2)=yinterim2(2) + y_out(ii,3)=yinterim2(3) + y_out(ii,4)=yinterim2(4) + ii=ii+1 c----------------------------------------------------------------------- -c adding consecutive integral sections. spline length of tot_steps -c +1 is used to make space for the interpolated point at eta=0.0 +c writing y_out1 to y_out. c----------------------------------------------------------------------- - IF(istep /= len_y1_out)CALL program_stop("minor err. direct.f") - istep=len_y1_out - - tot_steps=istep+nstep2 - i1=istep+1 - i2=tot_steps + DO i=0,len_y_out1,+1 + IF(y_out1(i,0)>eta_s)THEN + !Theta and radius values just flat equals + y_out(ii,0)=y_out1(i,0) + y_out(ii,2)=y_out1(i,2) - CALL spline_alloc(yi,tot_steps+1,4) -c----------------------------------------------------------------------- -c filling out points up to eta = 0.0 -c----------------------------------------------------------------------- - yi%xs(0:(eta0i-1))=y_out1(0:(eta0i-1),0) - yi%fs(0:(eta0i-1),1)=y_out1(0:(eta0i-1),1) - yi%fs(0:(eta0i-1),2)=y_out1(0:(eta0i-1),2) - yi%fs(0:(eta0i-1),3)=y_out1(0:(eta0i-1),3) - yi%fs(0:(eta0i-1),4)=y_out1(0:(eta0i-1),4) -c----------------------------------------------------------------------- -c putting in interpolated point at eta = 0.0 -c----------------------------------------------------------------------- - yi%xs(eta0i)=zero - yi%fs(eta0i,1)=y01 - yi%fs(eta0i,2)=y02 - yi%fs(eta0i,3)=y03 - yi%fs(eta0i,4)=y04 -c----------------------------------------------------------------------- -c putting in the rest of the numerically integrated points + !Integrals need to add previous: + y_out(ii,1)=y_out1(i,1)+yinterim2(1) + y_out(ii,3)=y_out1(i,3)+yinterim2(3) + y_out(ii,4)=y_out1(i,4)+yinterim2(4) + ii=ii+1 + ENDIF + ENDDO + len_y_out=ii-1 c----------------------------------------------------------------------- - yi%xs((eta0i+1):istep+1)=y_out1(eta0i:istep,0) - yi%fs((eta0i+1):istep+1,1)=y_out1(eta0i:istep,1) - yi%fs((eta0i+1):istep+1,2)=y_out1(eta0i:istep,2) - yi%fs((eta0i+1):istep+1,3)=y_out1(eta0i:istep,3) - yi%fs((eta0i+1):istep+1,4)=y_out1(eta0i:istep,4) +c terminate. c----------------------------------------------------------------------- -c adding analytic integral sections + RETURN + END SUBROUTINE patch_two_a c----------------------------------------------------------------------- - yi%xs((i1+1):(i2+1))=yi1(1:nstep2,0) - yi%fs((i1+1):(i2+1),1)=yi1(1:nstep2,1)+yi%fs(i1,1) - yi%fs((i1+1):(i2+1),2)=yi1(1:nstep2,2) - yi%fs((i1+1):(i2+1),3)=yi1(1:nstep2,3)+yi%fs(i1,3) - yi%fs((i1+1):(i2+1),4)=yi1(1:nstep2,4)+yi%fs(i1,4) +c subprogram 21. patch_two_b. +c combines two y_outs together. assumes y_out1 and y_out2 are both +c travelling anticlockwise and start/end at the same point. +c Returns y_out, len_y_out, which will seem like a single integral. +c Assumes integral doens't travel more than twopi in eta. c----------------------------------------------------------------------- -c wrapping around to start yi at eta = 0.0 +c declarations. c----------------------------------------------------------------------- - istep=tot_steps+1 + SUBROUTINE patch_two_b(y_out1,y_out2, + $ len_y_out1,len_y_out2,y_out,len_y_out) - DO i=0,istep,+1 - j=eta0i+i - - IF(j>istep)THEN - j=j-istep-1 - y_out(i,1)=yi%fs(j,1)+yi%fs(istep,1) - y_out(i,3)=yi%fs(j,3)+yi%fs(istep,3) - y_out(i,4)=yi%fs(j,4)+yi%fs(istep,4) - ELSE - y_out(i,1)=yi%fs(j,1) - y_out(i,3)=yi%fs(j,3) - y_out(i,4)=yi%fs(j,4) - ENDIF - y_out(i,2)=yi%fs(j,2) - - IF(yi%xs(j)<0.0)THEN - y_out(i,0)=yi%xs(j)+twopi - ELSE - y_out(i,0)=yi%xs(j) - ENDIF - ENDDO - - y_out(:,1)=y_out(:,1)-yi%fs(eta0i,1) - y_out(:,3)=y_out(:,3)-yi%fs(eta0i,3) - y_out(:,4)=y_out(:,4)-yi%fs(eta0i,4) -c----------------------------------------------------------------------- -c building ff + REAL(r8), DIMENSION(0:,0:), INTENT(IN) :: y_out1,y_out2 + REAL(r8), DIMENSION(0:,0:), INTENT(INOUT) :: y_out + INTEGER, INTENT(IN) :: len_y_out1,len_y_out2 + INTEGER, INTENT(INOUT) :: len_y_out + REAL(r8) :: etai,etaii,etaiii,etaiv + INTEGER :: ii,i + y_out=0.0 + len_y_out=0 +c----------------------------------------------------------------------- +c assert angles. +c----------------------------------------------------------------------- + etai =y_out1(0,0) + etaii =y_out1(len_y_out1,0) + etaiii=y_out2(0,0) + etaiv =y_out2(len_y_out2,0) + !IF(.NOT.(((etaiv>etaiii).AND.(etaiii==etaii).AND.(etaii>etai)).OR. + !$((etaiv>etaiii).AND.(etaiii>etaii).AND.((etaiii-etaii)<0.0001*pi) + !$.AND. (etaii>etai))))THEN + IF(.NOT.((etaiv>etaiii).AND.(etaiii==etaii).AND.(etaii>etai)))THEN + WRITE(*,*)"Incorrect use of patch_two_b (s1)." + WRITE(*,*)y_out2(len_y_out2,0) + WRITE(*,*)y_out2(len_y_out2-1,0) + WRITE(*,*)y_out2(0,0) + WRITE(*,*)"Angles:" + WRITE(*,*)etaiv + WRITE(*,*)etaiii + WRITE(*,*)etaii + WRITE(*,*)etai + CALL program_stop("Incorrect use of patch_two_b (s1).") + ELSEIF((etaiv-etai)>twopi)THEN + CALL program_stop("Incorrect use of patch_two_b (s2).") + ENDIF c----------------------------------------------------------------------- - CALL spline_alloc(ff,istep,4) - ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) - ff%fs(0:istep,1)=y_out(0:istep,2)**2 - ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* - $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) - ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) - $ -ff%xs +c checking radii are similar. c----------------------------------------------------------------------- -c deallocating spline, printing important information for -c direct_spline_comparison + IF(ABS(y_out1(len_y_out1,2)-y_out2(0,2))/ro > r_tol)THEN + WRITE(*,*)"patch_two_b:" + WRITE(*,*)y_out1(0,2) + WRITE(*,*)y_out2(0,2) + WRITE(*,*)ABS(y_out1(len_y_out1,2)-y_out2(0,2))/ro + CALL program_stop( + $ "Radial discontinuity > r_tol during field line stitching.") + ENDIF c----------------------------------------------------------------------- - CALL spline_dealloc(yi) - !IF(debug_in)PRINT "(A)", "ff x-pt start point:" - !IF(debug_in)PRINT "(i6)", (istep+1-eta0i) - xpt_starts(1)=(istep+1-eta0i) +c adding y_out1 to y_out. c----------------------------------------------------------------------- -c fakeout option is used for testing integrator error/debugging. -c won't be used in normal operation + ii=0 + DO i=0,len_y_out1,+1 + y_out(ii,:)=y_out1(i,:) + ii=ii+1 + ENDDO c----------------------------------------------------------------------- - ELSEIF(num_xpts==1 .AND. fakeout)THEN +c writing y_out2 to y_out. c----------------------------------------------------------------------- -c testing script to identify mysterious error source 0_0 :3 + DO i=1,len_y_out2,+1 + y_out(ii,0)=y_out2(i,0) + y_out(ii,2)=y_out2(i,2) + + y_out(ii,1)=y_out2(i,1)+y_out1(len_y_out1,1) + y_out(ii,3)=y_out2(i,3)+y_out1(len_y_out1,3) + y_out(ii,4)=y_out2(i,4)+y_out1(len_y_out1,4) + ii=ii+1 + ENDDO + len_y_out=ii-1 c----------------------------------------------------------------------- +c terminate. c----------------------------------------------------------------------- -c calling direct_analytic_ints on the initial x-point over full eta -c span. Note we don't need to call find_fl_surface, direct_xpoint -c since these were already called for this x-point in direct_run's -c psi loop + RETURN + END SUBROUTINE patch_two_b c----------------------------------------------------------------------- - CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) - r_loc1 = SQRT((r-ro)**2+(z-zo)**2) - CALL direct_get_bfield(r,z,bf,1) +c subprogram 22. patch_two_c. +c combines two y_outs together. assumes y_out1 is anticlockwise, +c from etai>=0 to etaii, and y_out2 is clockwise from +c etaiv>twopi to etaiii=etaii. +c iswtch is the index where the output spline y_out switches from +c y_out1 to y_out2 (technically index of final y_out1 point) c----------------------------------------------------------------------- -c ordering the two etas for numerical field line integration +c declarations. c----------------------------------------------------------------------- - eta1 = xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) - eta2 = xpt_brackets(1,2) - twopi*floor(xpt_brackets(1,2)/twopi) + SUBROUTINE patch_two_c(y_out1,y_out2, + $ len_y_out1,len_y_out2,y_out,len_y_out,iswtch) - IF(eta2etaiii).AND.(etaiii==etaii).AND.(etaii>etai).AND. + $ (etai==zero).AND.(etaiv>twopi).AND.(etaiiizero)THEN - eta0i=i - EXIT - ENDIF - ENDDO - - i=MAX(eta0i-5,0) - j=MIN(eta0i+5,len_y1_out) - - CALL spline_alloc(yi,j-i,4) - - DO k=i,j,+1 - yi%xs(k-i)=y_out1(k,0) - yi%fs(k-i,1)=y_out1(k,1) - yi%fs(k-i,2)=y_out1(k,2) - yi%fs(k-i,3)=y_out1(k,3) - yi%fs(k-i,4)=y_out1(k,4) - - ENDDO - - CALL spline_fit(yi,"extrap") - CALL spline_eval(yi,zero,0) - y01=yi%f(1) - y02=yi%f(2) - y03=yi%f(3) - y04=yi%f(4) - CALL spline_dealloc(yi) + y_cpy(0:len_y_out2,0)=y_out2(0:len_y_out2,0) + y_cpy(0:len_y_out2,1)=y_out2(0:len_y_out2,1) + y_cpy(0:len_y_out2,2)=y_out2(0:len_y_out2,2) + y_cpy(0:len_y_out2,3)=y_out2(0:len_y_out2,3) + y_cpy(0:len_y_out2,4)=y_out2(0:len_y_out2,4) + DO i=len_y_out2,0,-1 + y_out2(i,1)=-(y_cpy(len_y_out2,1)-y_cpy(i,1)) + y_out2(i,3)=-(y_cpy(len_y_out2,3)-y_cpy(i,3)) + y_out2(i,4)=-(y_cpy(len_y_out2,4)-y_cpy(i,4)) + ENDDO c----------------------------------------------------------------------- -c adding consecutive integral sections. spline length of tot_steps -c +1 is used to make space for the interpolated point at eta=0.0 +c find main stitch point. c----------------------------------------------------------------------- - IF(istep /= len_y1_out)CALL program_stop("minor err. direct.f") - istep=len_y1_out - - tot_steps=istep - - CALL spline_alloc(yi,tot_steps+1,4) + eta_s=0.5*(twopi+etaiv) c----------------------------------------------------------------------- -c filling out points up to eta = 0.0 +c create stich points. c----------------------------------------------------------------------- - yi%xs(0:(eta0i-1))=y_out1(0:(eta0i-1),0) - yi%fs(0:(eta0i-1),1)=y_out1(0:(eta0i-1),1) - yi%fs(0:(eta0i-1),2)=y_out1(0:(eta0i-1),2) - yi%fs(0:(eta0i-1),3)=y_out1(0:(eta0i-1),3) - yi%fs(0:(eta0i-1),4)=y_out1(0:(eta0i-1),4) + CALL yinterim(y_out1,len_y_out1,eta_s-twopi,yinterim1) + CALL yinterim(y_out2,len_y_out2,eta_s,yinterim2) c----------------------------------------------------------------------- -c putting in interpolated point at eta = 0.0 +c checking radii are similar. c----------------------------------------------------------------------- - yi%xs(eta0i)=zero - yi%fs(eta0i,1)=y01 - yi%fs(eta0i,2)=y02 - yi%fs(eta0i,3)=y03 - yi%fs(eta0i,4)=y04 + IF(ABS(yinterim1(2)-yinterim2(2))/ro > r_tol)THEN + WRITE(*,*)"patch_two_c:" + WRITE(*,*)ABS(yinterim1(2)-yinterim2(2))/ro + CALL program_stop( + $ "Radial discontinuity > r_tol during field line stitching.") + ENDIF c----------------------------------------------------------------------- -c putting in the rest of the numerically integrated points +c renormalising y_out1 so the integrals are zero at stitch point. c----------------------------------------------------------------------- - yi%xs((eta0i+1):istep+1)=y_out1(eta0i:istep,0) - yi%fs((eta0i+1):istep+1,1)=y_out1(eta0i:istep,1) - yi%fs((eta0i+1):istep+1,2)=y_out1(eta0i:istep,2) - yi%fs((eta0i+1):istep+1,3)=y_out1(eta0i:istep,3) - yi%fs((eta0i+1):istep+1,4)=y_out1(eta0i:istep,4) + DO i=0,len_y_out1,+1 + y_out1(i,1)=y_out1(i,1)-yinterim1(1) + y_out1(i,3)=y_out1(i,3)-yinterim1(3) + y_out1(i,4)=y_out1(i,4)-yinterim1(4) + ENDDO c----------------------------------------------------------------------- -c wrapping around to start yi at eta = 0.0 +c adding start of y_out2 (eta twopi to stitch point) to y_out. c----------------------------------------------------------------------- - istep=tot_steps+1 - - DO i=0,istep,+1 - j=eta0i+i + ii=0 + DO i=len_y_out2,0,-1 + IF(y_out2(i,0)>=twopi .AND. y_out2(i,0)istep)THEN - j=j-istep-1 - y_out(i,1)=yi%fs(j,1)+yi%fs(istep,1) - y_out(i,3)=yi%fs(j,3)+yi%fs(istep,3) - y_out(i,4)=yi%fs(j,4)+yi%fs(istep,4) - ELSE - y_out(i,1)=yi%fs(j,1) - y_out(i,3)=yi%fs(j,3) - y_out(i,4)=yi%fs(j,4) - ENDIF - y_out(i,2)=yi%fs(j,2) - - IF(yi%xs(j)<0.0)THEN - y_out(i,0)=yi%xs(j)+twopi - ELSE - y_out(i,0)=yi%xs(j) - ENDIF - ENDDO - - y_out(:,1)=y_out(:,1)-yi%fs(eta0i,1) - y_out(:,3)=y_out(:,3)-yi%fs(eta0i,3) - y_out(:,4)=y_out(:,4)-yi%fs(eta0i,4) -c----------------------------------------------------------------------- -c building ff -c----------------------------------------------------------------------- - CALL spline_alloc(ff,istep,4) - ff%xs(0:istep)=y_out(0:istep,4)/y_out(istep,4) - ff%fs(0:istep,1)=y_out(0:istep,2)**2 - ff%fs(0:istep,2)=y_out(0:istep,0)/twopi-ff%xs(0:istep) - ff%fs(0:istep,3)=bf%f* - $ (y_out(0:istep,3)-ff%xs(0:istep)*y_out(istep,3)) - ff%fs(0:istep,4)=y_out(0:istep,1)/y_out(istep,1) - $ -ff%xs + y_out(ii,2)=y_out2(i,2) + + ii=ii+1 + ENDIF + ENDDO c----------------------------------------------------------------------- -c deallocating spline, printing important information for -c direct_spline_comparison +c adding stitch at eta_s. c----------------------------------------------------------------------- - CALL spline_dealloc(yi) - !IF(debug_in)PRINT "(A)", "ff x-pt start point:" - !IF(debug_in)PRINT "(i6)", (istep+1-eta0i) - xpt_starts(1)=(istep+1-eta0i) - ELSE + y_out(ii,0)=yinterim2(0)-twopi + y_out(ii,1)=yinterim2(1)-y_out2(i_zero,1) + y_out(ii,2)=yinterim2(2) + y_out(ii,3)=yinterim2(3)-y_out2(i_zero,3) + y_out(ii,4)=yinterim2(4)-y_out2(i_zero,4) + ii=ii+1 + i1=ii-1 c----------------------------------------------------------------------- -c 2 x-points: making sure all brackets are in [0,2pi) +c writing y_out1 to y_out. c----------------------------------------------------------------------- - xpt_brackets(1,1)= - $ xpt_brackets(1,1) - twopi*floor(xpt_brackets(1,1)/twopi) - xpt_brackets(1,2)= - $ xpt_brackets(1,2) - twopi*floor(xpt_brackets(1,2)/twopi) - xpt_brackets(2,1)= - $ xpt_brackets(2,1) - twopi*floor(xpt_brackets(2,1)/twopi) - xpt_brackets(2,2)= - $ xpt_brackets(2,2) - twopi*floor(xpt_brackets(2,2)/twopi) + iswtch=0 + DO i=0,len_y_out1,+1 + IF(y_out1(i,0)>(eta_s-twopi))THEN + y_out(ii,0)=y_out1(i,0) + y_out(ii,2)=y_out1(i,2) + + y_out(ii,1)=y_out1(i,1)+y_out(i1,1) + y_out(ii,3)=y_out1(i,3)+y_out(i1,3) + y_out(ii,4)=y_out1(i,4)+y_out(i1,4) + + ii=ii+1 + iswtch=iswtch+1 + ENDIF + ENDDO + i1=ii-1 + iswtch=i1 !end of y_out1 in y_out c----------------------------------------------------------------------- -c making sure there are no wrap-arounds within each set of brackets +c writing rest of y_out2s to y_out. c----------------------------------------------------------------------- - IF(xpt_brackets(1,2)=y_out(i1,0))THEN + y_out(ii,0)=y_out2(i,0) + y_out(ii,2)=y_out2(i,2) + + y_out(ii,1)=y_out2(i,1)+y_out(i1,1) + y_out(ii,3)=y_out2(i,3)+y_out(i1,3) + y_out(ii,4)=y_out2(i,4)+y_out(i1,4) + + ii=ii+1 + ELSEIF(y_out2(i,0)>twopi)THEN + EXIT ENDIF + ENDDO + len_y_out=ii-1 c----------------------------------------------------------------------- -c calculating minor radii that start each divergent analytic int. +c terminate. c----------------------------------------------------------------------- - CALL find_fl_surface(psifac,xpt_brackets(1,1),r,z) - r_loc1 = SQRT((r-ro)**2+(z-zo)**2) - CALL find_fl_surface(psifac,xpt_brackets(2,1),r,z) - r_loc2 = SQRT((r-ro)**2+(z-zo)**2) + RETURN + END SUBROUTINE patch_two_c c----------------------------------------------------------------------- c calculating divergent analytic integrals over x-point brackets c----------------------------------------------------------------------- From cecd5b51f7b6f189d5b549df5ec9ed42ab70118d Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:11:35 -0500 Subject: [PATCH 92/97] adding new function yinterim that is used by patch_two_a-c --- equil/direct.f | 329 +++++++++---------------------------------------- 1 file changed, 59 insertions(+), 270 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 44b990dd..8c1b6228 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2472,296 +2472,85 @@ SUBROUTINE patch_two_c(y_out1,y_out2, RETURN END SUBROUTINE patch_two_c c----------------------------------------------------------------------- -c calculating divergent analytic integrals over x-point brackets -c----------------------------------------------------------------------- - DO i=1,nstep2,+1 -c----------------------------------------------------------------------- -c first x-point divergent analytic integrals: -c----------------------------------------------------------------------- - eta=xpt_brackets(1,1)+ - $ (xpt_brackets(1,2)-xpt_brackets(1,1))*(one*i/nstep2) - yi1(i,0)=eta - CALL direct_analytic_ints(1,r_loc1,xpt_brackets(1,1), - $ eta,yi1(i,1),yi1(i,2),yi1(i,3),yi1(i,4),outmat,.FALSE.) - !PRINT "(f20.10)",eta -c----------------------------------------------------------------------- -c printing maximum value of Bp/Bt at first x-point -c----------------------------------------------------------------------- - IF(i==nstep2)THEN - CALL direct_get_bfield(outmat(2,1,0),outmat(2,2,0),bf,1) - bp1=SQRT(bf%br**2+bf%bz**2) - bt1=bf%f/outmat(2,1,0) - CALL direct_get_bfield(outmat(2,1,1),outmat(2,2,1),bf,1) - bp2=SQRT(bf%br**2+bf%bz**2) - bt2=bf%f/outmat(2,1,1) - PRINT "(A,es10.3)"," max Bp/Bt (1st x-point) =", - $ MAX(bp1/bt1,bp2/bt2) - maxBpBt=MAX(bp1/bt1,bp2/bt2) - ENDIF +c subprogram 23. yinterim. +c evaluates interpolated point at eta_i. assumes eta_i is within +c the eta-range of y_out c----------------------------------------------------------------------- -c second x-point divergent analytic integrals: -c----------------------------------------------------------------------- - eta=xpt_brackets(2,1) - $ +(xpt_brackets(2,2)-xpt_brackets(2,1))*(one*i/nstep2) - yi2(i,0)=eta - CALL direct_analytic_ints(2,r_loc2,xpt_brackets(2,1), - $ eta,yi2(i,1),yi2(i,2),yi2(i,3),yi2(i,4),outmat,.FALSE.) -c----------------------------------------------------------------------- -c printing maximum value of Bp/Bt at second x-point -c----------------------------------------------------------------------- - IF(i==nstep2)THEN - CALL direct_get_bfield(outmat(2,1,0),outmat(2,2,0),bf,1) - bp1=SQRT(bf%br**2+bf%bz**2) - bt1=bf%f/outmat(2,1,0) - CALL direct_get_bfield(outmat(2,1,1),outmat(2,2,1),bf,1) - bp2=SQRT(bf%br**2+bf%bz**2) - bt2=bf%f/outmat(2,1,1) - PRINT "(A,es10.3)"," max Bp/Bt (2nd x-point) =", - $ MAX(bp1/bt1,bp2/bt2) - IF(MAX(bp1/bt1,bp2/bt2)>maxBpBt)THEN - maxBpBt=MAX(bp1/bt1,bp2/bt2) - ENDIF - ENDIF - ENDDO +c declarations. c----------------------------------------------------------------------- -c ordering etas in the brackets to define two non-divergent -c intervals: [eta1,eta2] and [eta3,eta4]. x points should lie in -c [eta2,eta3] and [eta4-twopi,eta1]. twopi will be between eta3,eta4 -c----------------------------------------------------------------------- - IF(xpt_brackets(2,1)>xpt_brackets(1,1))THEN - IF(xpt_brackets(2,1)MAXVAL(y_out(0:len_y_out,0)))THEN + CALL program_stop("improper use of yinterim") + ENDIF c----------------------------------------------------------------------- -c interpolating an eta=twopi point for y_out2. +c interpolating the numerical integral around an eta=0.0 point. +c I assume eta=0.0 won't be within the xpt_brackets since most +c tokamaks wont have an xpoint at the top or bottom of the LCFS c----------------------------------------------------------------------- - DO i=0,ist2,+1 - IF(y_out2(i,0)>twopi)THEN - eta0i=i + IF(y_out(len_y_out,0)>eta_i)THEN + DO i=0,len_y_out,+1 + IF(y_out(i,0)>eta_i)THEN + eta_ii=i + EXIT + ENDIF + ENDDO + ELSEIF(y_out(len_y_out,0)tot_steps)THEN - j=j-tot_steps-1 - ff%xs(i)=ffi%xs(j)+ffi%xs(tot_steps) - y_out(i,1)=yi%fs(j,1)+yi%fs(tot_steps,1) - y_out(i,3)=yi%fs(j,3)+yi%fs(tot_steps,3) - y_out(i,4)=yi%fs(j,4)+yi%fs(tot_steps,4) - ELSE - ff%xs(i)=ffi%xs(j) - y_out(i,1)=yi%fs(j,1) - y_out(i,3)=yi%fs(j,3) - y_out(i,4)=yi%fs(j,4) - ENDIF + CALL spline_fit(yi,"extrap") + CALL spline_eval(yi,eta_i,0) + yinterim1(0)=eta_i + yinterim1(1)=yi%f(1) - ff%fs(i,1)=ffi%fs(j,1) - ff%fs(i,2)=ffi%fs(j,2) - ff%fs(i,3)=ffi%fs(j,3) - ff%fs(i,4)=ffi%fs(j,4) - y_out(i,2)=yi%fs(j,2) + yinterim1(3)=yi%f(3) + yinterim1(4)=yi%f(4) - IF(yi%xs(j)>twopi)THEN - y_out(i,0)=yi%xs(j)-twopi - ELSE - y_out(i,0)=yi%xs(j) - ENDIF - ENDDO - ff%xs(:)=ff%xs(:)-ff%xs(0) - ff%fs(:,2)=ff%fs(:,2)-ff%fs(0,2) - ff%fs(:,3)=ff%fs(:,3)-ff%fs(0,3) - ff%fs(:,4)=ff%fs(:,4)-ff%fs(0,4) - y_out(:,1)=y_out(:,1)-yi%fs(eta0i,1) - y_out(:,3)=y_out(:,3)-yi%fs(eta0i,3) - y_out(:,4)=y_out(:,4)-yi%fs(eta0i,4) - - y_out(0,0)=zero - - !IF(debug_in)PRINT "(A)", "ff 1st x-pt start point:" - !IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i) - !IF(debug_in)PRINT "(A)", "ff 2nd x-pt start point:" - !IF(debug_in)PRINT "(i6)", (tot_steps+1-eta0i+nstep2+ist1+1) - xpt_starts(1)=(tot_steps+1-eta0i) - xpt_starts(2)=(tot_steps+1-eta0i+nstep2+ist1+1) - - CALL spline_dealloc(ffi) - CALL spline_dealloc(yi) + IF(r_avg)THEN + yinterim1(2)=y_out(eta_ii-1,2)+ + $((eta_i-y_out(eta_ii-1,0))/(y_out(eta_ii,0)-y_out(eta_ii-1,0)))* + $(y_out(eta_ii,2)-y_out(eta_ii-1,2)) + ELSE + yinterim1(2)=yi%f(2) ENDIF + + CALL spline_dealloc(yi) c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- - RETURN - END SUBROUTINE direct_mixed_spline_builder + RETURN + END SUBROUTINE yinterim c----------------------------------------------------------------------- c subprogram 17. direct_spline_comparison. c print data from mixed analytic/numerical method, and solely From b231a2694cb196b674c2641ccace45cf37c7b7f3 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:12:49 -0500 Subject: [PATCH 93/97] adding function analytic_y_out that computes field line integrals using analytic formulas --- equil/direct.f | 262 ++++++++++++++++++++++++++++--------------------- 1 file changed, 152 insertions(+), 110 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 8c1b6228..cec4a542 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2552,128 +2552,170 @@ SUBROUTINE yinterim(y_out,len_y_out,eta_i,yinterim1) RETURN END SUBROUTINE yinterim c----------------------------------------------------------------------- -c subprogram 17. direct_spline_comparison. -c print data from mixed analytic/numerical method, and solely -c numerically integrated method -c----------------------------------------------------------------------- +c subprogram 24. analytic_y_out. +c computes y_out using analytic integrals. +c assume eta2>eta1 c----------------------------------------------------------------------- c declarations. c----------------------------------------------------------------------- - SUBROUTINE direct_spline_comparison(ffnum,ffa,y_outnum,len_y_out, - $ bf,y_outa,ipsi,ipri,psifac,maxBpBt,xpt_starts,dq_deps_in) - - TYPE(spline_type), INTENT(IN) :: ffnum,ffa - REAL(r8), INTENT(IN), DIMENSION(0:(2*nstepd+2*nstep2+1),0:4):: - $ y_outnum,y_outa - REAL(r8), INTENT(IN) :: psifac,dq_deps_in,maxBpBt - INTEGER, INTENT(IN) :: ipsi,ipri,len_y_out - TYPE(direct_bfield_type), INTENT(IN) :: bf - INTEGER, DIMENSION(2), INTENT(IN) :: xpt_starts + SUBROUTINE analytic_y_out(psifac,eta1,r1,eta2,r2,nstep2,yi,ydiffs, + $ outmat2f) - CHARACTER(1024) :: filename - REAL(r8), DIMENSION(1:len_y_out) :: dqdeta - REAL(r8) :: maxdqdeps - INTEGER :: i,len_ff,len_ffa + REAL(r8), INTENT(IN) :: psifac,eta1,r1,eta2,r2 + INTEGER, INTENT(IN) :: nstep2 + REAL(r8), DIMENSION(0:,0:), INTENT(INOUT) :: yi + REAL(r8), DIMENSION(1:4,1:2,0:1) :: outmat + REAL(r8), DIMENSION(1:8) :: outmat2 + REAL(r8), DIMENSION(1:17), INTENT(OUT) :: outmat2f + LOGICAL :: debugL=.FALSE.,out=.FALSE. + REAL(r8), DIMENSION(1:2):: nu, xpt_dists + REAL(r8) :: r,z,eta,eval_BpOnBt,eval_dy1,eval_xpt_tol + REAL(r8), DIMENSION(0:nstepd,0:4) :: y_out1 + REAL(r8), DIMENSION(1:4), INTENT(OUT) :: ydiffs + INTEGER :: x_i,i,len_y1_out + TYPE(direct_bfield_type) :: bf + + yi=0.0 + ydiffs=0.0 + IF(eta2twopi/100 .OR. + $ ABS(xpt_gammas2(x_i)-xpt_gammas(x_i))>twopi/100) .AND. + $ (.NOT.outside_sep(x_i)))THEN + PRINT "(A)", "Straight x-point leg assumption bad for Xpt" + !PRINT "(i6)", x_i + !PRINT "(es16.10)", xpt_gammas(x_i)/pi + !PRINT "(es16.10)", xpt_gammas2(x_i)/pi + IF(.NOT.plot_convergence)THEN + CALL program_stop("fiddle with x-point settings.") + ENDIF + ENDIF +c----------------------------------------------------------------------- +c Setting initial values of yi. +c----------------------------------------------------------------------- + yi(0,0)=eta1 + yi(0,1)=0.0 + yi(0,2)=r1 + yi(0,3)=0.0 + yi(0,4)=0.0 +c----------------------------------------------------------------------- +c Print outputs directly if onecase is True: +c----------------------------------------------------------------------- +412 FORMAT(e20.12,",",e20.12,",",e20.12,",",e20.12,",",e20.12 + $",",e20.12,",",e20.12,",",e20.12,",",e20.12) + IF(onecase)CALL ascii_open(out_xpt_unit, + $ "xpt_tests/local_comp.csv","UNKNOWN") +c----------------------------------------------------------------------- +c Loop through eta values, computing analytic integrals +c----------------------------------------------------------------------- + DO i=1,nstep2,+1 + eta=eta1+(eta2-eta1)*(one*i/nstep2) + yi(i,0)=eta + + CALL direct_analytic_ints(x_i,r1,eta1 + $ ,eta,yi(i,1),yi(i,2),yi(i,3),yi(i,4),outmat,outmat2,debugL) + IF(i==nstep2)THEN + outmat2f(1:8)=outmat2(1:8) + ENDIF + + IF(.TRUE.)CALL direct_fl_int(psifac,xpt_brackets(1,1),eta, + $y_out1,len_y1_out,eval_BpOnBt,eval_dy1,eval_xpt_tol,.FALSE.,bf, + $ .TRUE.) + + WRITE(out_xpt_unit,412) + $ eta, + $ yi(i,1), + $ yi(i,2), + $ yi(i,3), + $ yi(i,4), + $ y_out1(len_y1_out,1), + $ y_out1(len_y1_out,2), + $ y_out1(len_y1_out,3), + $ y_out1(len_y1_out,4) ENDDO - CALL ascii_close(out_xpt_unit) + ydiffs(1)=(yi(nstep2,1)-y_out1(len_y1_out,1)) + $ /y_out1(len_y1_out,1) + ydiffs(2)=(yi(nstep2,2)-y_out1(len_y1_out,2)) + $ /y_out1(len_y1_out,2) + ydiffs(3)=(yi(nstep2,3)-y_out1(len_y1_out,3)) + $ /y_out1(len_y1_out,3) + ydiffs(4)=(yi(nstep2,4)-y_out1(len_y1_out,4)) + $ /y_out1(len_y1_out,4) + + outmat2f(9)=y_out1(len_y1_out,4) + outmat2f(10)=REAL(len_y1_out,8) !Number of integration steps.... + outmat2f(11)=y_out1(len_y1_out,1) + outmat2f(12)=y_out1(len_y1_out,2) + outmat2f(13)=y_out1(len_y1_out,3) + outmat2f(14)=yi(nstep2,1) + outmat2f(15)=yi(nstep2,2) + outmat2f(16)=yi(nstep2,3) + outmat2f(17)=yi(nstep2,4) + IF(onecase)CALL ascii_close(out_xpt_unit) +c----------------------------------------------------------------------- +c check how much r has shifted. +c----------------------------------------------------------------------- + IF(ABS(yi(nstep2,2)-r2)>r_tol)THEN + IF(.NOT. plot_convergence)WRITE(*,*) + $ "Analytic ints introduce radial discontinuity:" + IF(.NOT. plot_convergence)WRITE(*,*)ABS(yi(nstep2,2)-r2) + IF(.NOT. plot_convergence)CALL program_stop( + $ "Analytic integrals introduce a radial discontinuity > r_tol.") + ENDIF c----------------------------------------------------------------------- c terminate. c----------------------------------------------------------------------- - RETURN - END SUBROUTINE direct_spline_comparison + RETURN + END SUBROUTINE analytic_y_out c----------------------------------------------------------------------- c subprogram 18. direct_Blocal. c calculates local B-field displaced from some r,z point in polar From f7bc19b8ca0f5eae79545b3e0a6beb1baeace094 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:13:07 -0500 Subject: [PATCH 94/97] updating subroutine number --- equil/direct.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equil/direct.f b/equil/direct.f index cec4a542..113ba298 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2717,7 +2717,7 @@ SUBROUTINE analytic_y_out(psifac,eta1,r1,eta2,r2,nstep2,yi,ydiffs, RETURN END SUBROUTINE analytic_y_out c----------------------------------------------------------------------- -c subprogram 18. direct_Blocal. +c subprogram 25. direct_Blocal. c calculates local B-field displaced from some r,z point in polar c coordinates. either Bnu or Brho depending on Bcase c----------------------------------------------------------------------- From 6543f4dd834aed93a7733c45d2c3ef3dbbf8c064 Mon Sep 17 00:00:00 2001 From: StuartBenjamin Date: Sun, 8 Feb 2026 18:14:09 -0500 Subject: [PATCH 95/97] adding function plot_xpt_convergence that calculates numerical vs analytic + numerical y_out integrals for a range of xpt_tol & BpBt_tol values, before printing outputs. This function was used to generate the data that is plotted in https://doi.org/10.1088/1361-6587/add9ca Figs. 7 & 9. --- equil/direct.f | 221 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) diff --git a/equil/direct.f b/equil/direct.f index 113ba298..07d08e99 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -2750,4 +2750,225 @@ SUBROUTINE direct_Blocal(r,z,nu,rho,Bcase,Bout) c----------------------------------------------------------------------- RETURN END SUBROUTINE direct_Blocal +c----------------------------------------------------------------------- +c subprogram 26. plot_xpt_convergence. +c calculates numerical vs analytic + numerical y_out integrals +c for a range of xpt_tol & BpBt_tol values, before printing outputs. +c used to generate the data that is plotted in +c https://doi.org/10.1088/1361-6587/add9ca Figs. 7 & 9. +c works on an equilibrium with 1 x-point. +c----------------------------------------------------------------------- +c----------------------------------------------------------------------- +c declarations. +c----------------------------------------------------------------------- + SUBROUTINE plot_xpt_convergence + + REAL(r8), DIMENSION(0:(4*nstepd+2*nstep2+6),0:4) :: y_outA,y_outI, + $ y_outDIFFS + REAL(r8), DIMENSION(0:(nstepd+2),0:4) :: y_out1 + REAL(r8) :: eval_BpOnBt,eval_dy1,eval_xpt_tol + TYPE(direct_bfield_type) :: bf + INTEGER :: len_y_out1,len_y_outA,len_y_outI + INTEGER :: i,j,ii + REAL(r8) :: psifac + + !Independent variables actual values + REAL(r8), DIMENSION(0:40,0:40,1:2) :: BpBt_evals,xpt_tol_evals, + $ dy1_evals + !Dependent variables + REAL(r8), DIMENSION(btsc1:btsc2,psfc1:psfc2,1:4) :: y_out_convgs + REAL(r8), DIMENSION(btsc1:btsc2,psfc1:psfc2,0:4) :: ff_convgs + REAL(r8), DIMENSION(btsc1:btsc2,psfc1:psfc2,1:17) :: outmat2big + REAL(r8), DIMENSION(1:4) :: difs + REAL(r8), DIMENSION(1:17) :: outmat2f + INTEGER, DIMENSION(2) :: x_starts + REAL(r8) :: psifacone,BpBt_tolone + REAL(r8), DIMENSION(btsc1:btsc2) :: BpBt_scan + REAL(r8), DIMENSION(psfc1:psfc2) :: psifac_vec + DO i=btsc1,btsc2,+1 !48 + BpBt_scan(i)=10.d0**(-i*0.1) + ENDDO + DO i=psfc1,psfc2,+1 !48 + !psifac_vec(i-8)=1.d0-10.d0**(-i*0.25) + psifac_vec(i)=1.d0-10.d0**(-i*0.2) + ENDDO + + psifacone=0.9987654321 + BpBt_tolone=0.012345 +c----------------------------------------------------------------------- +c initialisations: +c----------------------------------------------------------------------- + WRITE(*,*)"running convergence" + IF(num_xpts/=1)CALL program_stop("Need 1 x-point for convg. stud") + BpBt_evals=0.0 + xpt_tol_evals=0.0 + dy1_evals=0.0 + y_out_convgs=0.0 + ff_convgs=0.0 + + !xpt_tol=100 !will never be restained by angle + + DO i=btsc1,btsc2,+1 + WRITE(*,*)"BpBt_scan NEW:",BpBt_scan(i) + DO j=psfc1,psfc2,+1 + WRITE(*,*)i,j,"L0" + psifac=psifac_vec(j) + WRITE(*,*)"Psifac, BpBt:" + WRITE(*,*)psifac,BpBt_scan(i) +c----------------------------------------------------------------------- +c GENERATING THE NUMERICALLY INTEGRATED y_out:: +c----------------------------------------------------------------------- + IF(onecase)THEN + psifac=psifacone + ENDIF + etol=1.d-14 !lowest we can go? + nstepd=20000 !big KEEP UNDER 20000 + BpBt_tol=1d-99 !we will never 'snag' an x-point' + CALL direct_fl_int(psifac,zero,twopi,y_outI,len_y_outI + $ ,eval_BpOnBt,eval_dy1,eval_xpt_tol,.FALSE.,bf,.FALSE.) +c----------------------------------------------------------------------- +c GENERATING THE ANALYTICALLY INTEGRATED y_out:: +c ASSUME 1xpt equilibrium +c----------------------------------------------------------------------- + BpBt_tol=BpBt_scan(i) + IF(onecase)THEN + BpBt_tol=BpBt_tolone + ENDIF + CALL direct_fl_int(psifac,zero,twopi,y_out1,len_y_out1 + $ ,eval_BpOnBt,eval_dy1,eval_xpt_tol,.TRUE.,bf,.FALSE.) +c----------------------------------------------------------------------- +c GENERATING THE COMBINED y_out (analytic + numerical):: +c----------------------------------------------------------------------- + IF(y_out1(len_y_out1,0) Date: Sun, 8 Feb 2026 18:14:37 -0500 Subject: [PATCH 96/97] minor changes to direct_mod variables --- equil/direct.f | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/equil/direct.f b/equil/direct.f index 07d08e99..9c423387 100644 --- a/equil/direct.f +++ b/equil/direct.f @@ -52,7 +52,7 @@ MODULE direct_mod LOGICAL, DIMENSION(1:2) :: outside_sep REAL(r8), DIMENSION(2,2) :: xpt_brackets TYPE(bicube_type) :: psi_in - LOGICAL :: direct_infinite_loop_flag,plot_convergence1 + LOGICAL :: direct_infinite_loop_flag INTEGER :: direct_infinite_loop_count = 2000 INTEGER :: num_xpts @@ -72,7 +72,6 @@ MODULE direct_mod REAL(r8) :: xpt_tol=0.2 INTEGER :: nstepd=20000 INTEGER :: nstep2=2048 - REAL(r8) :: xcheck=0.99, dqdeps_tmp CONTAINS c----------------------------------------------------------------------- From a9dbb93fce77a4642ed071c2e9c4a18c0a9d9011 Mon Sep 17 00:00:00 2001 From: logan-nc <6198372+logan-nc@users.noreply.github.com> Date: Fri, 14 Jun 2024 16:16:43 -0400 Subject: [PATCH 97/97] Empty-Commit to establish new branch