From 53e658ac5cb944ce750c30015bb66fac473d7098 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 3 Dec 2018 21:01:24 -0500 Subject: [PATCH 01/72] calculate the volume enclosed by plasma boundary --- sources/globals.h | 3 ++- sources/rdsurf.h | 8 ++++++++ sources/saving.h | 1 + 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/sources/globals.h b/sources/globals.h index f625886..312dc74 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.5.03' ! version number + CHARACTER(LEN=10), parameter :: version='v0.5.04' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -225,6 +225,7 @@ module globals xt(:,:), yt(:,:), zt(:,:), xp(:,:), yp(:,:), zp(:,:), & ds(:,:), bn(:,:), pb(:,:), & Bx(:,:), By(:,:), Bz(:,:) + REAL :: vol end type toroidalsurface type arbitrarycoil diff --git a/sources/rdsurf.h b/sources/rdsurf.h index 286a94a..ef6c5df 100644 --- a/sources/rdsurf.h +++ b/sources/rdsurf.h @@ -211,6 +211,8 @@ subroutine fousurf SALLOCATE( surf(1)%xp, (0:Nteta-1,0:Nzeta-1), zero ) !dx/dzeta; SALLOCATE( surf(1)%yp, (0:Nteta-1,0:Nzeta-1), zero ) !dy/dzeta; SALLOCATE( surf(1)%zp, (0:Nteta-1,0:Nzeta-1), zero ) !dz/dzeta; + + surf(1)%vol = zero ! volume enclosed by plasma boundary ! The center point value was used to discretize grid; do ii = 0, Nteta-1; teta = ( ii + half ) * pi2 / Nteta @@ -264,10 +266,16 @@ subroutine fousurf surf(1)%ny(ii,jj) = ds(2) / dd surf(1)%nz(ii,jj) = ds(3) / dd surf(1)%ds(ii,jj) = dd + + ! using Gauss theorom; V = \int_S x \cdot n dt dz + surf(1)%vol = surf(1)%vol + surf(1)%xx(ii,jj) * ds(1) enddo ! end of do jj; 14 Apr 16; enddo ! end of do ii; 14 Apr 16; + surf(1)%vol = surf(1)%vol * discretefactor + if( myid == 0 .and. IsQuiet <= 0) write(ounit, '(8X": Enclosed volume ="ES12.5" m^3 ;" )') surf(1)%vol + !calculate target Bn with input harmonics; 05 Jan 17; if(NBnf > 0) then diff --git a/sources/saving.h b/sources/saving.h index 8a43dfd..bccbf51 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -120,6 +120,7 @@ subroutine saving HWRITEIV( 1 , save_filaments, save_filaments ) HWRITEIV( 1 , Nfp , Nfp_raw ) + HWRITERV( 1 , surf_vol , surf(1)%vol ) HWRITERA( Nteta,Nzeta , xsurf , surf(1)%xx(0:Nteta-1,0:Nzeta-1) ) HWRITERA( Nteta,Nzeta , ysurf , surf(1)%yy(0:Nteta-1,0:Nzeta-1) ) HWRITERA( Nteta,Nzeta , zsurf , surf(1)%zz(0:Nteta-1,0:Nzeta-1) ) From f86d94dd7e523f772b3f9fc2e005d248dae149b8 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 12 Dec 2018 06:47:14 -0500 Subject: [PATCH 02/72] add postproc=3 doing fieldline tracing at the boundary --- sources/Makefile | 2 +- sources/focus.h | 10 +- sources/globals.h | 8 +- sources/initial.h | 3 + sources/poinplot.h | 260 +++++++++++++++++++++++++++++++++++++++++++++ sources/saving.h | 3 + 6 files changed, 280 insertions(+), 6 deletions(-) create mode 100644 sources/poinplot.h diff --git a/sources/Makefile b/sources/Makefile index bf6602b..fc59a69 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -3,7 +3,7 @@ ############################################################################################################ ALLFILES= globals initial datalloc rdsurf rdknot rdcoils packdof bfield bnormal bmnharm fdcheck \ - torflux length surfsep solvers descent congrad lmalg saving diagnos specinp focus + torflux length surfsep solvers descent congrad lmalg saving diagnos specinp poinplot focus HFILES= $(ALLFILES:=.h) FFILES= $(ALLFILES:=.F90) PFILES= $(ALLFILES:=.pdf) diff --git a/sources/focus.h b/sources/focus.h index eaf628f..8bf8f43 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -173,15 +173,17 @@ PROGRAM focus select case( case_postproc ) - case( 0 ) ; call saving - case( 1 ) ; call diagnos ; call saving - case( 2 ) ; call diagnos ; call specinp ; call saving + case( 0 ) + case( 1 ) ; call diagnos ; + case( 2 ) ; call diagnos ; call specinp !; call saving !case( 2 ) ; call saving ; call diagnos ; call wtmgrid ! write mgrid file; - !case( 3 ) ; call saving ; call diagnos ; call poinplot ! Poincare plots; for future; + case( 3 ) ; call diagnos ; call poinplot ! Poincare plots; for future; !case( 4 ) ; call saving ; call diagnos ; call resonant ! resonant harmonics analysis; for future; end select + call saving ! save all the outputs + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) tfinish = MPI_Wtime() diff --git a/sources/globals.h b/sources/globals.h index 312dc74..e5577f9 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.5.04' ! version number + CHARACTER(LEN=10), parameter :: version='v0.6.00' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -327,6 +327,12 @@ module globals REAL, allocatable :: mincc(:,:), coil_importance(:) INTEGER :: ierr, astat +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + ! fieldline tracing + REAL, ALLOCATABLE :: XYZB(:,:) + INTEGER :: pp_maxiter, tor_num, total_num + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! end module globals diff --git a/sources/initial.h b/sources/initial.h index 22b3b7a..8b905a1 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -490,6 +490,9 @@ subroutine initial case ( 2 ) if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & & 'Coil evaluations and writing SPEC input will be performed.' + case ( 3 ) + if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & + & 'Coil evaluations and field-line tracing will be performed.' case default FATAL( initial, .true., selected case_postproc is not supported ) end select diff --git a/sources/poinplot.h b/sources/poinplot.h new file mode 100644 index 0000000..15f14ab --- /dev/null +++ b/sources/poinplot.h @@ -0,0 +1,260 @@ +SUBROUTINE poinplot + !------------------------------------------------------------------------------------------------------ + ! DATE: 12/12/2018 + ! Poincare plots of the vacuum flux surfaces + ! use Guodong Wei's snippet of Adams-Moulton method + !------------------------------------------------------------------------------------------------------ + USE globals, only : dp, zero, ounit, XYZB, pp_maxiter, total_num + USE mpi + IMPLICIT NONE + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + INTEGER :: ierr, astat + INTEGER :: tor_num + REAL :: theta, zeta, r, x, y, z +! REAL, ALLOCATABLE :: XYZB(:,:) + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + pp_maxiter = 500 ! maximum iteration number + tor_num = 360 ! toroidal planes number + total_num = pp_maxiter * tor_num + + SALLOCATE( XYZB, (1:total_num, 1:4), zero) + + ! starting point + theta = zero ; zeta = zero + call surfcoord( theta, zeta, r, z) + x = r*cos(zeta) + y = r*sin(zeta) + + write(ounit, '("poincare: starting filed line tracing at x="F5.2, ", y="F5.2, ", z="F5.2)') x, y, z + + ! filedline tracing + call fieldline_tracing(x,y,z,total_num,pp_maxiter,XYZB) + + write(ounit, '("poincare: Fieldline tracing finished")') + + return + +END SUBROUTINE poinplot + + +subroutine fieldline_tracing(x,y,z,imax,n2,H) + implicit none + integer*4 ::n2,imax,j,i + real*8 :: x,y,z,dphi,pi,dt,B,Bx,By,Bz,x0,y0,z0,g,iota + real*8 :: s(4), k1x,k2x,k3x,k4x,k5x,k6x,k7x,k8x,k9x,k10x + real*8 :: k1y,k2y,k3y,k4y,k5y,k6y,k7y,k8y,k9y,k10y,xr + real*8 :: k1z,k2z,k3z,k4z,k5z,k6z,k7z,k8z,k9z,k10z + real*8,dimension(imax,4):: H + + real*8,dimension(imax+1,4):: f + real*8,dimension(2*n2,3):: f2 + + pi=3.141592653589793239 + dphi=2*pi/(float(imax)/n2) + + do j=1,imax + H(j,1)=x + H(j,2)=y + H(j,3)=z + call coils_B(s,x,y,z) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + H(j,4)=B + dt=(y-x*tan(j*dphi))/(tan(j*dphi)*Bx/sqrt(Bx**2+By**2)-By/sqrt(Bx**2+By**2))*sqrt(B**2/(Bx**2+By**2)) + ! write(*,*)x,y,z,s,dt + + f(j,1)=Bx/B + f(j,2)=By/B + f(j,3)=Bz/B + x0=x + y0=y + z0=z + + if(j<8)then + k1x=Bx/B + k1y=By/B + k1z=Bz/B + call coils_B(s,x+dt*4/27*k1x,y+dt*4/27*k1y,z+dt*4/27*k1z) + + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k2x=Bx/B + k2y=By/B + k2z=Bz/B + call coils_B(s,x+dt/18*(k1x+3*k2x),y+dt/18*(k1y+3*k2y),z+dt/18*(k1z+3*k2z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k3x=Bx/B + k3y=By/B + k3z=Bz/B + call coils_B(s,x+dt/12*(k1x+3*k3x),y+dt/12*(k1y+3*k3y),z+dt/12*(k1z+3*k3z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k4x=Bx/B + k4y=By/B + k4z=Bz/B + + call coils_B(s,x+dt/8*(k1x+3*k4x),y+dt/8*(k1y+3*k4y),z+dt/8*(k1z+3*k4z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k5x=Bx/B + k5y=By/B + k5z=Bz/B + call coils_B(s,x+dt/54*(13*k1x-27*k3x+42*k4x+8*k5x),y+dt/54*(13*k1y-27*k3y+& + 42*k4y+8*k5y),z+dt/54*(13*k1z-27*k3z+42*k4z+8*k5z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k6x=Bx/B + k6y=By/B + k6z=Bz/B + call coils_B(s,x+dt/4320*(389*k1x-54*k3x+966*k4x-824*k5x+243*k6x),y+dt/4320*(389*k1y-& + 54*k3y+966*k4y-824*k5y+243*k6y),z+dt/4320*(389*k1z-54*k3z+966*k4z-824*k5z+243*k6z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k7x=Bx/B + k7y=By/B + k7z=Bz/B + call coils_B(s,x+dt/20*(-234*k1x+81*k3x-1164*k4x+656*k5x-122*k6x+800*k7x),y+dt/20*(-234*k1y+81*k3y-& + 1164*k4y+656*k5y-122*k6y+800*k7y),z+dt/20*(-234*k1z+81*k3z-1164*k4z+656*k5z-122*k6z+800*k7z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k8x=Bx/B + k8y=By/B + k8z=Bz/B + call coils_B(s,x+dt/288*(-127*k1x+18*k3x-678*k4x+456*k5x-9*k6x+576*k7x+4*k8x),y+& + dt/288*(-127*k1y+18*k3y-678*k4y+456*k5y-9*k6y+576*k7y+4*k8y),z+dt/288*(-127*k1z+& + 18*k3z-678*k4z+456*k5z-9*k6z+576*k7z+4*k8z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k9x=Bx/B + k9y=By/B + k9z=Bz/B + call coils_B(s,x+dt/820*(1481*k1x-81*k3x+7104*k4x-3376*k5x+& + 72*k6x-5040*k7x-60*k8x+720*k9x),y+dt/820*(1481*k1y-81*k3y+& + 7104*k4y-3376*k5y+72*k6y-5040*k7y-60*k8y+720*k9y),z+dt/820*(1481*k1z-& + 81*k3z+7104*k4z-3376*k5z+72*k6z-5040*k7z-60*k8z+720*k9z)) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + k10x=Bx/B + k10y=By/B + k10z=Bz/B + + x=x+dt/840*(41*k1x+27*k4x+272*k5x+27*k6x+216*k7x+216*k9x+41*k10x) + y=y+dt/840*(41*k1y+27*k4y+272*k5y+27*k6y+216*k7y+216*k9y+41*k10y) + z=z+dt/840*(41*k1z+27*k4z+272*k5z+27*k6z+216*k7z+216*k9z+41*k10z) + + else + x=x+dt/120960*(-36799.0*f(j-7,1)+295767.0*f(j-6,1)-1041723.0*f(j-5,1)& + +2102243.0*f(j-4,1)-2664477.0*f(j-3,1)+2183877.0*f(j-2,1)-1152169.0*f(j-1,1)+434241.0*f(j,1)) + y=y+dt/120960*(-36799.0*f(j-7,2)+295767.0*f(j-6,2)-1041723.0*f(j-5,2)& + +2102243.0*f(j-4,2)-2664477.0*f(j-3,2)+2183877.0*f(j-2,2)-1152169.0*f(j-1,2)+434241.0*f(j,2)) + z=z+dt/120960*(-36799.0*f(j-7,3)+295767.0*f(j-6,3)-1041723.0*f(j-5,3)& + +2102243.0*f(j-4,3)-2664477.0*f(j-3,3)+2183877.0*f(j-2,3)-1152169.0*f(j-1,3)+434241.0*f(j,3)) + end if + + call coils_B(s,x,y,z) + Bx=s(1) + By=s(2) + Bz=s(3) + B=s(4) + f(j+1,1)=Bx/B + f(j+1,2)=By/B + f(j+1,3)=Bz/B + if (j>7) then + + x=x0+dt/120960*(1375.0*f(j-6,1)-11351.0*f(j-5,1)+41499.0*f(j-4,1)-88547.0*f(j-3,1)& + +123133.0*f(j-2,1)-121797.0*f(j-1,1)+139849.0*f(j,1)+36799.0*f(j+1,1)) + y=y0+dt/120960*(1375.0*f(j-6,2)-11351.0*f(j-5,2)+41499.0*f(j-4,2)-88547.0*f(j-3,2)& + +123133.0*f(j-2,2)-121797.0*f(j-1,2)+139849.0*f(j,2)+36799.0*f(j+1,2)) + z=z0+dt/120960*(1375.0*f(j-6,3)-11351.0*f(j-5,3)+41499.0*f(j-4,3)-88547.0*f(j-3,3)& + +123133.0*f(j-2,3)-121797.0*f(j-1,3)+139849.0*f(j,3)+36799.0*f(j+1,3)) + end if + + end do + return + +end subroutine fieldline_tracing + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine coils_B(s, x,y,z) + use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & + zero, myid, ounit, Npc, bsconstant + use mpi + implicit none + + REAL , intent(in) :: x, y, z + real*8, dimension(4) :: s + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + INTEGER :: ierr, astat + REAL :: Bx, By, Bz + + INTEGER :: icoil, kseg + REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + s(1:4) = zero + + dlx = zero; ltx = zero; Bx = zero + dly = zero; lty = zero; By = zero + dlz = zero; ltz = zero; Bz = zero + + do icoil = 1, Ncoils*Npc + do kseg = 0, coil(icoil)%NS-1 + + dlx = x - coil(icoil)%xx(kseg) + dly = y - coil(icoil)%yy(kseg) + dlz = z - coil(icoil)%zz(kseg) + rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) + + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + + Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I + By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I + Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I + + enddo ! enddo kseg + enddo + + Bx = Bx * bsconstant + By = By * bsconstant + Bz = Bz * bsconstant + + s(1) = Bx + s(2) = By + s(3) = Bz + s(4) = sqrt(Bx*Bx+By*By+Bz*Bz) + + return + +end subroutine coils_B diff --git a/sources/saving.h b/sources/saving.h index bccbf51..31a535e 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -177,6 +177,9 @@ subroutine saving HWRITERA( LM_mfvec, Ndof , LM_fjac , LM_fjac ) endif + if (allocated(XYZB)) then + HWRITERA( total_num,4 , XYZB , XYZB(1:, 1:4) ) + endif HWRITERV( 1 , time_initialize, time_initialize ) HWRITERV( 1 , time_optimize , time_optimize ) From cc82578b971c1fc2461afc0a2fb886c2fed954a3 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 20 Dec 2018 11:34:23 -0500 Subject: [PATCH 03/72] add poincare plotting and calculate iota --- sources/Makefile | 5 +- sources/globals.h | 157 ++++++----- sources/hybrj.f | 657 +++++++++++++-------------------------------- sources/poinplot.h | 481 ++++++++++++++++++++------------- sources/saving.h | 9 +- 5 files changed, 589 insertions(+), 720 deletions(-) diff --git a/sources/Makefile b/sources/Makefile index fc59a69..8463cc0 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -9,7 +9,7 @@ PFILES= $(ALLFILES:=.pdf) ROBJS=$(ALLFILES:=_r.o) DOBJS=$(ALLFILES:=_d.o) - NUMOBJ= ode.o lmder1.o + NUMOBJ= ode.o lmder1.o hybrj.o ############################################################################################################ @@ -56,6 +56,9 @@ ode.o : ode.f90 lmder1.o : lmder1.f $(FC) -c $(RFLAGS) -o $@ $< +hybrj.o: hybrj.f + $(FC) -c $(FLAGS) $(DFLAGS) -o $@ $< + $(ROBJS): %_r.o: %.F90 $(FC) -c $(RFLAGS) -o $@ $< $(HDF5) diff --git a/sources/globals.h b/sources/globals.h index e5577f9..2522766 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.6.00' ! version number + CHARACTER(LEN=10), parameter :: version='v0.6.01' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -79,77 +79,84 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! !latex \subsection{Input namelist: \type{focusin}} - INTEGER :: IsQuiet = -1 - INTEGER :: IsSymmetric = 0 + INTEGER :: IsQuiet = -1 + INTEGER :: IsSymmetric = 0 - INTEGER :: case_surface = 0 - REAL :: knotsurf = 0.200D-00 - REAL :: ellipticity = 0.000D+00 - INTEGER :: Nteta = 64 - INTEGER :: Nzeta = 64 - - INTEGER :: case_init = 0 - INTEGER :: case_coils = 1 - INTEGER :: Ncoils = 0 - REAL :: init_current = 1.000D+06 - REAL :: init_radius = 1.000D+00 - INTEGER :: IsVaryCurrent = 1 - INTEGER :: IsVaryGeometry = 1 - INTEGER :: NFcoil = 4 - INTEGER :: Nseg = 128 + INTEGER :: case_surface = 0 + REAL :: knotsurf = 0.200D-00 + REAL :: ellipticity = 0.000D+00 + INTEGER :: Nteta = 64 + INTEGER :: Nzeta = 64 + + INTEGER :: case_init = 0 + INTEGER :: case_coils = 1 + INTEGER :: Ncoils = 0 + REAL :: init_current = 1.000D+06 + REAL :: init_radius = 1.000D+00 + INTEGER :: IsVaryCurrent = 1 + INTEGER :: IsVaryGeometry = 1 + INTEGER :: NFcoil = 4 + INTEGER :: Nseg = 128 - INTEGER :: IsNormalize = 1 - INTEGER :: IsNormWeight = 1 - INTEGER :: case_bnormal = 0 - INTEGER :: case_length = 1 - REAL :: weight_bnorm = 1.000D+00 - REAL :: weight_bharm = 0.000D+00 - REAL :: weight_tflux = 0.000D+00 - REAL :: target_tflux = 0.000D+00 - REAL :: weight_ttlen = 0.000D+00 - REAL :: target_length = 0.000D+00 - REAL :: weight_cssep = 0.000D+00 - REAL :: cssep_factor = 1.000D+00 - REAL :: weight_specw = 0.000D+00 - REAL :: weight_ccsep = 0.000D+00 - REAL :: weight_inorm = 1.000D+00 - REAL :: weight_gnorm = 1.000D+00 - - INTEGER :: case_optimize = 1 - REAL :: exit_tol = 1.000D-04 - INTEGER :: DF_maxiter = 0 - REAL :: DF_xtol = 1.000D-08 - REAL :: DF_tausta = 0.000D+00 - REAL :: DF_tauend = 1.000D+00 + INTEGER :: IsNormalize = 1 + INTEGER :: IsNormWeight = 1 + INTEGER :: case_bnormal = 0 + INTEGER :: case_length = 1 + REAL :: weight_bnorm = 1.000D+00 + REAL :: weight_bharm = 0.000D+00 + REAL :: weight_tflux = 0.000D+00 + REAL :: target_tflux = 0.000D+00 + REAL :: weight_ttlen = 0.000D+00 + REAL :: target_length = 0.000D+00 + REAL :: weight_cssep = 0.000D+00 + REAL :: cssep_factor = 1.000D+00 + REAL :: weight_specw = 0.000D+00 + REAL :: weight_ccsep = 0.000D+00 + REAL :: weight_inorm = 1.000D+00 + REAL :: weight_gnorm = 1.000D+00 + + INTEGER :: case_optimize = 1 + REAL :: exit_tol = 1.000D-04 + INTEGER :: DF_maxiter = 0 + REAL :: DF_xtol = 1.000D-08 + REAL :: DF_tausta = 0.000D+00 + REAL :: DF_tauend = 1.000D+00 - INTEGER :: CG_maxiter = 0 - REAL :: CG_xtol = 1.000D-08 - REAL :: CG_wolfe_c1 = 1.000D-04 - REAL :: CG_wolfe_c2 = 0.1 - - INTEGER :: LM_maxiter = 0 - REAL :: LM_xtol = 1.000D-08 - REAL :: LM_ftol = 1.000D-08 - REAL :: LM_factor = 1.000D+02 - - INTEGER :: HN_maxiter = 0 - REAL :: HN_xtol = 1.000D-08 - REAL :: HN_factor = 100.0 - - INTEGER :: TN_maxiter = 0 - REAL :: TN_xtol = 1.000D-08 - INTEGER :: TN_reorder = 0 - REAL :: TN_cr = 0.1 - - INTEGER :: case_postproc = 1 - INTEGER :: save_freq = 1 - INTEGER :: save_coils = 0 - INTEGER :: save_harmonics = 0 - INTEGER :: save_filaments = 0 + INTEGER :: CG_maxiter = 0 + REAL :: CG_xtol = 1.000D-08 + REAL :: CG_wolfe_c1 = 1.000D-04 + REAL :: CG_wolfe_c2 = 0.1 + + INTEGER :: LM_maxiter = 0 + REAL :: LM_xtol = 1.000D-08 + REAL :: LM_ftol = 1.000D-08 + REAL :: LM_factor = 1.000D+02 + + INTEGER :: HN_maxiter = 0 + REAL :: HN_xtol = 1.000D-08 + REAL :: HN_factor = 100.0 + + INTEGER :: TN_maxiter = 0 + REAL :: TN_xtol = 1.000D-08 + INTEGER :: TN_reorder = 0 + REAL :: TN_cr = 0.1 + + INTEGER :: case_postproc = 1 + INTEGER :: save_freq = 1 + INTEGER :: save_coils = 0 + INTEGER :: save_harmonics = 0 + INTEGER :: save_filaments = 0 + + REAL :: pp_phi = 0.000D+00 + REAL :: pp_raxis = 0.000D+00 + REAL :: pp_zaxis = 0.000D+00 + REAL :: pp_rmax = 0.000D+00 + REAL :: pp_zmax = 0.000D+00 + INTEGER :: pp_ns = 10 + INTEGER :: pp_maxiter = 1000 + REAL :: pp_xtol = 1.000D-06 - - namelist / focusin / IsQuiet , & IsSymmetric , & case_surface , & @@ -207,7 +214,17 @@ module globals save_freq , & save_coils , & save_harmonics , & - save_filaments + save_filaments , & + pp_phi , & + pp_raxis , & + pp_zaxis , & + pp_rmax , & + pp_zmax , & + pp_ns , & + pp_maxiter , & + pp_xtol + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -330,8 +347,8 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! ! fieldline tracing - REAL, ALLOCATABLE :: XYZB(:,:) - INTEGER :: pp_maxiter, tor_num, total_num + REAL, ALLOCATABLE :: XYZB(:,:), ppr(:,:), ppz(:,:), iota(:) + INTEGER :: tor_num, total_num !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/hybrj.f b/sources/hybrj.f index 094a3fb..b8ca7f9 100644 --- a/sources/hybrj.f +++ b/sources/hybrj.f @@ -175,334 +175,200 @@ subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) c last card of subroutine dogleg. c end - double precision function dpmpar(i) - integer i + subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, + * wa1,wa2) + integer n,ldfjac,iflag,ml,mu + double precision epsfcn + double precision x(n),fvec(n),fjac(ldfjac,n),wa1(n),wa2(n) c ********** c -c Function dpmpar +c subroutine fdjac1 c -c This function provides double precision machine parameters -c when the appropriate set of data statements is activated (by -c removing the c from column 1) and all other data statements are -c rendered inactive. Most of the parameter values were obtained -c from the corresponding Bell Laboratories Port Library function. +c this subroutine computes a forward-difference approximation +c to the n by n jacobian matrix associated with a specified +c problem of n functions in n variables. if the jacobian has +c a banded form, then function evaluations are saved by only +c approximating the nonzero terms. c -c The function statement is +c the subroutine statement is c -c double precision function dpmpar(i) +c subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, +c wa1,wa2) c c where c -c i is an integer input variable set to 1, 2, or 3 which -c selects the desired machine parameter. If the machine has -c t base b digits and its smallest and largest exponents are -c emin and emax, respectively, then these parameters are -c -c dpmpar(1) = b**(1 - t), the machine precision, -c -c dpmpar(2) = b**(emin - 1), the smallest magnitude, -c -c dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. -c -c Argonne National Laboratory. MINPACK Project. November 1996. -c Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' -c -c ********** - integer mcheps(4) - integer minmag(4) - integer maxmag(4) - double precision dmach(3) - equivalence (dmach(1),mcheps(1)) - equivalence (dmach(2),minmag(1)) - equivalence (dmach(3),maxmag(1)) -c -c Machine constants for the IBM 360/370 series, -c the Amdahl 470/V6, the ICL 2900, the Itel AS/6, -c the Xerox Sigma 5/7/9 and the Sel systems 85/86. -c -c data mcheps(1),mcheps(2) / z34100000, z00000000 / -c data minmag(1),minmag(2) / z00100000, z00000000 / -c data maxmag(1),maxmag(2) / z7fffffff, zffffffff / -c -c Machine constants for the Honeywell 600/6000 series. -c -c data mcheps(1),mcheps(2) / o606400000000, o000000000000 / -c data minmag(1),minmag(2) / o402400000000, o000000000000 / -c data maxmag(1),maxmag(2) / o376777777777, o777777777777 / -c -c Machine constants for the CDC 6000/7000 series. -c -c data mcheps(1) / 15614000000000000000b / -c data mcheps(2) / 15010000000000000000b / -c -c data minmag(1) / 00604000000000000000b / -c data minmag(2) / 00000000000000000000b / -c -c data maxmag(1) / 37767777777777777777b / -c data maxmag(2) / 37167777777777777777b / -c -c Machine constants for the PDP-10 (KA processor). -c -c data mcheps(1),mcheps(2) / "114400000000, "000000000000 / -c data minmag(1),minmag(2) / "033400000000, "000000000000 / -c data maxmag(1),maxmag(2) / "377777777777, "344777777777 / -c -c Machine constants for the PDP-10 (KI processor). -c -c data mcheps(1),mcheps(2) / "104400000000, "000000000000 / -c data minmag(1),minmag(2) / "000400000000, "000000000000 / -c data maxmag(1),maxmag(2) / "377777777777, "377777777777 / -c -c Machine constants for the PDP-11. -c -c data mcheps(1),mcheps(2) / 9472, 0 / -c data mcheps(3),mcheps(4) / 0, 0 / -c -c data minmag(1),minmag(2) / 128, 0 / -c data minmag(3),minmag(4) / 0, 0 / -c -c data maxmag(1),maxmag(2) / 32767, -1 / -c data maxmag(3),maxmag(4) / -1, -1 / -c -c Machine constants for the Burroughs 6700/7700 systems. -c -c data mcheps(1) / o1451000000000000 / -c data mcheps(2) / o0000000000000000 / -c -c data minmag(1) / o1771000000000000 / -c data minmag(2) / o7770000000000000 / -c -c data maxmag(1) / o0777777777777777 / -c data maxmag(2) / o7777777777777777 / -c -c Machine constants for the Burroughs 5700 system. -c -c data mcheps(1) / o1451000000000000 / -c data mcheps(2) / o0000000000000000 / -c -c data minmag(1) / o1771000000000000 / -c data minmag(2) / o0000000000000000 / -c -c data maxmag(1) / o0777777777777777 / -c data maxmag(2) / o0007777777777777 / -c -c Machine constants for the Burroughs 1700 system. -c -c data mcheps(1) / zcc6800000 / -c data mcheps(2) / z000000000 / -c -c data minmag(1) / zc00800000 / -c data minmag(2) / z000000000 / -c -c data maxmag(1) / zdffffffff / -c data maxmag(2) / zfffffffff / -c -c Machine constants for the Univac 1100 series. -c -c data mcheps(1),mcheps(2) / o170640000000, o000000000000 / -c data minmag(1),minmag(2) / o000040000000, o000000000000 / -c data maxmag(1),maxmag(2) / o377777777777, o777777777777 / -c -c Machine constants for the Data General Eclipse S/200. -c -c Note - it may be appropriate to include the following card - -c static dmach(3) -c -c data minmag/20k,3*0/,maxmag/77777k,3*177777k/ -c data mcheps/32020k,3*0/ -c -c Machine constants for the Harris 220. -c -c data mcheps(1),mcheps(2) / '20000000, '00000334 / -c data minmag(1),minmag(2) / '20000000, '00000201 / -c data maxmag(1),maxmag(2) / '37777777, '37777577 / -c -c Machine constants for the Cray-1. -c -c data mcheps(1) / 0376424000000000000000b / -c data mcheps(2) / 0000000000000000000000b / -c -c data minmag(1) / 0200034000000000000000b / -c data minmag(2) / 0000000000000000000000b / -c -c data maxmag(1) / 0577777777777777777777b / -c data maxmag(2) / 0000007777777777777776b / -c -c Machine constants for the Prime 400. -c -c data mcheps(1),mcheps(2) / :10000000000, :00000000123 / -c data minmag(1),minmag(2) / :10000000000, :00000100000 / -c data maxmag(1),maxmag(2) / :17777777777, :37777677776 / -c -c Machine constants for the VAX-11. -c -c data mcheps(1),mcheps(2) / 9472, 0 / -c data minmag(1),minmag(2) / 128, 0 / -c data maxmag(1),maxmag(2) / -32769, -1 / -c -c Machine constants for IEEE machines. +c fcn is the name of the user-supplied subroutine which +c calculates the functions. fcn must be declared +c in an external statement in the user calling +c program, and should be written as follows. c - data dmach(1) /2.22044604926d-16/ - data dmach(2) /2.22507385852d-308/ - data dmach(3) /1.79769313485d+308/ +c subroutine fcn(n,x,fvec,iflag) +c integer n,iflag +c double precision x(n),fvec(n) +c ---------- +c calculate the functions at x and +c return this vector in fvec. +c ---------- +c return +c end c - dpmpar = dmach(i) - return +c the value of iflag should not be changed by fcn unless +c the user wants to terminate execution of fdjac1. +c in this case set iflag to a negative integer. c -c Last card of function dpmpar. +c n is a positive integer input variable set to the number +c of functions and variables. c - end - double precision function enorm(n,x) - integer n - double precision x(n) -c ********** +c x is an input array of length n. c -c function enorm +c fvec is an input array of length n which must contain the +c functions evaluated at x. c -c given an n-vector x, this function calculates the -c euclidean norm of x. +c fjac is an output n by n array which contains the +c approximation to the jacobian matrix evaluated at x. c -c the euclidean norm is computed by accumulating the sum of -c squares in three different sums. the sums of squares for the -c small and large components are scaled so that no overflows -c occur. non-destructive underflows are permitted. underflows -c and overflows do not occur in the computation of the unscaled -c sum of squares for the intermediate components. -c the definitions of small, intermediate and large components -c depend on two constants, rdwarf and rgiant. the main -c restrictions on these constants are that rdwarf**2 not -c underflow and rgiant**2 not overflow. the constants -c given here are suitable for every known computer. +c ldfjac is a positive integer input variable not less than n +c which specifies the leading dimension of the array fjac. c -c the function statement is +c iflag is an integer variable which can be used to terminate +c the execution of fdjac1. see description of fcn. c -c double precision function enorm(n,x) +c ml is a nonnegative integer input variable which specifies +c the number of subdiagonals within the band of the +c jacobian matrix. if the jacobian is not banded, set +c ml to at least n - 1. c -c where +c epsfcn is an input variable used in determining a suitable +c step length for the forward-difference approximation. this +c approximation assumes that the relative errors in the +c functions are of the order of epsfcn. if epsfcn is less +c than the machine precision, it is assumed that the relative +c errors in the functions are of the order of the machine +c precision. c -c n is a positive integer input variable. +c mu is a nonnegative integer input variable which specifies +c the number of superdiagonals within the band of the +c jacobian matrix. if the jacobian is not banded, set +c mu to at least n - 1. c -c x is an input array of length n. +c wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at +c least n, then the jacobian is considered dense, and wa2 is +c not referenced. c c subprograms called c -c fortran-supplied ... dabs,dsqrt +c minpack-supplied ... dpmpar +c +c fortran-supplied ... dabs,dmax1,dsqrt c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** - integer i - double precision agiant,floatn,one,rdwarf,rgiant,s1,s2,s3,xabs, - * x1max,x3max,zero - data one,zero,rdwarf,rgiant /1.0d0,0.0d0,3.834d-20,1.304d19/ - s1 = zero - s2 = zero - s3 = zero - x1max = zero - x3max = zero - floatn = n - agiant = rgiant/floatn - do 90 i = 1, n - xabs = dabs(x(i)) - if (xabs .gt. rdwarf .and. xabs .lt. agiant) go to 70 - if (xabs .le. rdwarf) go to 30 -c -c sum for large components. -c - if (xabs .le. x1max) go to 10 - s1 = one + s1*(x1max/xabs)**2 - x1max = xabs - go to 20 - 10 continue - s1 = s1 + (xabs/x1max)**2 - 20 continue - go to 60 - 30 continue + integer i,j,k,msum + double precision eps,epsmch,h,temp,zero + double precision dpmpar + data zero /0.0d0/ c -c sum for small components. +c epsmch is the machine precision. c - if (xabs .le. x3max) go to 40 - s3 = one + s3*(x3max/xabs)**2 - x3max = xabs - go to 50 - 40 continue - if (xabs .ne. zero) s3 = s3 + (xabs/x3max)**2 - 50 continue - 60 continue - go to 80 - 70 continue + epsmch = dpmpar(1) c -c sum for intermediate components. + eps = dsqrt(dmax1(epsfcn,epsmch)) + msum = ml + mu + 1 + if (msum .lt. n) go to 40 +c +c computation of dense approximate jacobian. +c + do 20 j = 1, n + temp = x(j) + h = eps*dabs(temp) + if (h .eq. zero) h = eps + x(j) = temp + h + call fcn(n,x,wa1,iflag) + if (iflag .lt. 0) go to 30 + x(j) = temp + do 10 i = 1, n + fjac(i,j) = (wa1(i) - fvec(i))/h + 10 continue + 20 continue + 30 continue + go to 110 + 40 continue c - s2 = s2 + xabs**2 - 80 continue - 90 continue +c computation of banded approximate jacobian. c -c calculation of norm. -c - if (s1 .eq. zero) go to 100 - enorm = x1max*dsqrt(s1+(s2/x1max)/x1max) - go to 130 - 100 continue - if (s2 .eq. zero) go to 110 - if (s2 .ge. x3max) - * enorm = dsqrt(s2*(one+(x3max/s2)*(x3max*s3))) - if (s2 .lt. x3max) - * enorm = dsqrt(x3max*((s2/x3max)+(x3max*s3))) - go to 120 - 110 continue - enorm = x3max*dsqrt(s3) - 120 continue - 130 continue + do 90 k = 1, msum + do 60 j = k, n, msum + wa2(j) = x(j) + h = eps*dabs(wa2(j)) + if (h .eq. zero) h = eps + x(j) = wa2(j) + h + 60 continue + call fcn(n,x,wa1,iflag) + if (iflag .lt. 0) go to 100 + do 80 j = k, n, msum + x(j) = wa2(j) + h = eps*dabs(wa2(j)) + if (h .eq. zero) h = eps + do 70 i = 1, n + fjac(i,j) = zero + if (i .ge. j - mu .and. i .le. j + ml) + * fjac(i,j) = (wa1(i) - fvec(i))/h + 70 continue + 80 continue + 90 continue + 100 continue + 110 continue return c -c last card of function enorm. +c last card of subroutine fdjac1. c end - subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, - * factor,nprint,info,nfev,njev,r,lr,qtf,wa1,wa2, - * wa3,wa4) - integer n,ldfjac,maxfev,mode,nprint,info,nfev,njev,lr - double precision xtol,factor - double precision x(n),fvec(n),fjac(ldfjac,n),diag(n),r(lr), + + subroutine hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn,diag, + * mode,factor,nprint,info,nfev,fjac,ldfjac,r,lr, + * qtf,wa1,wa2,wa3,wa4) + integer n,maxfev,ml,mu,mode,nprint,info,nfev,ldfjac,lr + double precision xtol,epsfcn,factor + double precision x(n),fvec(n),diag(n),fjac(ldfjac,n),r(lr), * qtf(n),wa1(n),wa2(n),wa3(n),wa4(n) + external fcn c ********** c -c subroutine hybrj +c subroutine hybrd c -c the purpose of hybrj is to find a zero of a system of +c the purpose of hybrd is to find a zero of a system of c n nonlinear functions in n variables by a modification c of the powell hybrid method. the user must provide a -c subroutine which calculates the functions and the jacobian. +c subroutine which calculates the functions. the jacobian is +c then calculated by a forward-difference approximation. c c the subroutine statement is c -c subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag, -c mode,factor,nprint,info,nfev,njev,r,lr,qtf, -c wa1,wa2,wa3,wa4) +c subroutine hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn, +c diag,mode,factor,nprint,info,nfev,fjac, +c ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) c c where c c fcn is the name of the user-supplied subroutine which -c calculates the functions and the jacobian. fcn must -c be declared in an external statement in the user -c calling program, and should be written as follows. +c calculates the functions. fcn must be declared +c in an external statement in the user calling +c program, and should be written as follows. c -c subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) -c integer n,ldfjac,iflag -c double precision x(n),fvec(n),fjac(ldfjac,n) +c subroutine fcn(n,x,fvec,iflag) +c integer n,iflag +c double precision x(n),fvec(n) c ---------- -c if iflag = 1 calculate the functions at x and -c return this vector in fvec. do not alter fjac. -c if iflag = 2 calculate the jacobian at x and -c return this matrix in fjac. do not alter fvec. +c calculate the functions at x and +c return this vector in fvec. c --------- c return c end c c the value of iflag should not be changed by fcn unless -c the user wants to terminate execution of hybrj. +c the user wants to terminate execution of hybrd. c in this case set iflag to a negative integer. c c n is a positive integer input variable set to the number @@ -515,20 +381,31 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c fvec is an output array of length n which contains c the functions evaluated at the output x. c -c fjac is an output n by n array which contains the -c orthogonal matrix q produced by the qr factorization -c of the final approximate jacobian. -c -c ldfjac is a positive integer input variable not less than n -c which specifies the leading dimension of the array fjac. -c c xtol is a nonnegative input variable. termination c occurs when the relative error between two consecutive c iterates is at most xtol. c c maxfev is a positive integer input variable. termination -c occurs when the number of calls to fcn with iflag = 1 -c has reached maxfev. +c occurs when the number of calls to fcn is at least maxfev +c by the end of an iteration. +c +c ml is a nonnegative integer input variable which specifies +c the number of subdiagonals within the band of the +c jacobian matrix. if the jacobian is not banded, set +c ml to at least n - 1. +c +c mu is a nonnegative integer input variable which specifies +c the number of superdiagonals within the band of the +c jacobian matrix. if the jacobian is not banded, set +c mu to at least n - 1. +c +c epsfcn is an input variable used in determining a suitable +c step length for the forward-difference approximation. this +c approximation assumes that the relative errors in the +c functions are of the order of epsfcn. if epsfcn is less +c than the machine precision, it is assumed that the relative +c errors in the functions are of the order of the machine +c precision. c c diag is an array of length n. if mode = 1 (see c below), diag is internally set. if mode = 2, diag @@ -551,9 +428,8 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c fcn is called with iflag = 0 at the beginning of the first c iteration and every nprint iterations thereafter and c immediately prior to return, with x and fvec available -c for printing. fvec and fjac should not be altered. -c if nprint is not positive, no special calls of fcn -c with iflag = 0 are made. +c for printing. if nprint is not positive, no special calls +c of fcn with iflag = 0 are made. c c info is an integer output variable. if the user has c terminated execution, info is set to the (negative) @@ -565,8 +441,8 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c info = 1 relative error between two consecutive iterates c is at most xtol. c -c info = 2 number of calls to fcn with iflag = 1 has -c reached maxfev. +c info = 2 number of calls to fcn has reached or exceeded +c maxfev. c c info = 3 xtol is too small. no further improvement in c the approximate solution x is possible. @@ -580,10 +456,14 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c ten iterations. c c nfev is an integer output variable set to the number of -c calls to fcn with iflag = 1. +c calls to fcn. +c +c fjac is an output n by n array which contains the +c orthogonal matrix q produced by the qr factorization +c of the final approximate jacobian. c -c njev is an integer output variable set to the number of -c calls to fcn with iflag = 2. +c ldfjac is a positive integer input variable not less than n +c which specifies the leading dimension of the array fjac. c c r is an output array of length lr which contains the c upper triangular matrix produced by the qr factorization @@ -601,16 +481,16 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c c user-supplied ...... fcn c -c minpack-supplied ... dogleg,dpmpar,enorm, +c minpack-supplied ... dogleg,dpmpar,enorm,fdjac1, c qform,qrfac,r1mpyq,r1updt c -c fortran-supplied ... dabs,dmax1,dmin1,mod +c fortran-supplied ... dabs,dmax1,dmin1,min0,mod c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** - integer i,iflag,iter,j,jm1,l,ncfail,ncsuc,nslow1,nslow2 + integer i,iflag,iter,j,jm1,l,msum,ncfail,ncsuc,nslow1,nslow2 integer iwa(1) logical jeval,sing double precision actred,delta,epsmch,fnorm,fnorm1,one,pnorm, @@ -627,13 +507,12 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, info = 0 iflag = 0 nfev = 0 - njev = 0 c c check the input parameters for errors. c - if (n .le. 0 .or. ldfjac .lt. n .or. xtol .lt. zero - * .or. maxfev .le. 0 .or. factor .le. zero - * .or. lr .lt. (n*(n + 1))/2) go to 300 + if (n .le. 0 .or. xtol .lt. zero .or. maxfev .le. 0 + * .or. ml .lt. 0 .or. mu .lt. 0 .or. factor .le. zero + * .or. ldfjac .lt. n .or. lr .lt. (n*(n + 1))/2) go to 300 if (mode .ne. 2) go to 20 do 10 j = 1, n if (diag(j) .le. zero) go to 300 @@ -644,11 +523,16 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c and calculate its norm. c iflag = 1 - call fcn(n,x,fvec,fjac,ldfjac,iflag) + call fcn(n,x,fvec,iflag) nfev = 1 if (iflag .lt. 0) go to 300 fnorm = enorm(n,fvec) c +c determine the number of calls to fcn needed to compute +c the jacobian matrix. +c + msum = min0(ml+mu+1,n) +c c initialize iteration counter and monitors. c iter = 1 @@ -665,8 +549,9 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c calculate the jacobian matrix. c iflag = 2 - call fcn(n,x,fvec,fjac,ldfjac,iflag) - njev = njev + 1 + call fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn,wa1, + * wa2) + nfev = nfev + msum if (iflag .lt. 0) go to 300 c c compute the qr factorization of the jacobian. @@ -749,8 +634,7 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c if (nprint .le. 0) go to 190 iflag = 0 - if (mod(iter-1,nprint) .eq. 0) - * call fcn(n,x,fvec,fjac,ldfjac,iflag) + if (mod(iter-1,nprint) .eq. 0) call fcn(n,x,fvec,iflag) if (iflag .lt. 0) go to 300 190 continue c @@ -774,7 +658,7 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c evaluate the function at x + p and calculate its norm. c iflag = 1 - call fcn(n,wa2,wa4,fjac,ldfjac,iflag) + call fcn(n,wa2,wa4,iflag) nfev = nfev + 1 if (iflag .lt. 0) go to 300 fnorm1 = enorm(n,wa4) @@ -856,7 +740,8 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, if (nslow1 .eq. 10) info = 5 if (info .ne. 0) go to 300 c -c criterion for recalculating jacobian. +c criterion for recalculating jacobian approximation +c by forward differences. c if (ncfail .eq. 2) go to 290 c @@ -894,10 +779,10 @@ subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag,mode, c if (iflag .lt. 0) info = iflag iflag = 0 - if (nprint .gt. 0) call fcn(n,x,fvec,fjac,ldfjac,iflag) + if (nprint .gt. 0) call fcn(n,x,fvec,iflag) return c -c last card of subroutine hybrj. +c last card of subroutine hybrd. c end subroutine qform(m,n,q,ldq,wa) @@ -993,170 +878,6 @@ subroutine qform(m,n,q,ldq,wa) return c c last card of subroutine qform. -c - end - subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) - integer m,n,lda,lipvt - integer ipvt(lipvt) - logical pivot - double precision a(lda,n),rdiag(n),acnorm(n),wa(n) -c ********** -c -c subroutine qrfac -c -c this subroutine uses householder transformations with column -c pivoting (optional) to compute a qr factorization of the -c m by n matrix a. that is, qrfac determines an orthogonal -c matrix q, a permutation matrix p, and an upper trapezoidal -c matrix r with diagonal elements of nonincreasing magnitude, -c such that a*p = q*r. the householder transformation for -c column k, k = 1,2,...,min(m,n), is of the form -c -c t -c i - (1/u(k))*u*u -c -c where u has zeros in the first k-1 positions. the form of -c this transformation and the method of pivoting first -c appeared in the corresponding linpack subroutine. -c -c the subroutine statement is -c -c subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) -c -c where -c -c m is a positive integer input variable set to the number -c of rows of a. -c -c n is a positive integer input variable set to the number -c of columns of a. -c -c a is an m by n array. on input a contains the matrix for -c which the qr factorization is to be computed. on output -c the strict upper trapezoidal part of a contains the strict -c upper trapezoidal part of r, and the lower trapezoidal -c part of a contains a factored form of q (the non-trivial -c elements of the u vectors described above). -c -c lda is a positive integer input variable not less than m -c which specifies the leading dimension of the array a. -c -c pivot is a logical input variable. if pivot is set true, -c then column pivoting is enforced. if pivot is set false, -c then no column pivoting is done. -c -c ipvt is an integer output array of length lipvt. ipvt -c defines the permutation matrix p such that a*p = q*r. -c column j of p is column ipvt(j) of the identity matrix. -c if pivot is false, ipvt is not referenced. -c -c lipvt is a positive integer input variable. if pivot is false, -c then lipvt may be as small as 1. if pivot is true, then -c lipvt must be at least n. -c -c rdiag is an output array of length n which contains the -c diagonal elements of r. -c -c acnorm is an output array of length n which contains the -c norms of the corresponding columns of the input matrix a. -c if this information is not needed, then acnorm can coincide -c with rdiag. -c -c wa is a work array of length n. if pivot is false, then wa -c can coincide with rdiag. -c -c subprograms called -c -c minpack-supplied ... dpmpar,enorm -c -c fortran-supplied ... dmax1,dsqrt,min0 -c -c argonne national laboratory. minpack project. march 1980. -c burton s. garbow, kenneth e. hillstrom, jorge j. more -c -c ********** - integer i,j,jp1,k,kmax,minmn - double precision ajnorm,epsmch,one,p05,sum,temp,zero - double precision dpmpar,enorm - data one,p05,zero /1.0d0,5.0d-2,0.0d0/ -c -c epsmch is the machine precision. -c - epsmch = dpmpar(1) -c -c compute the initial column norms and initialize several arrays. -c - do 10 j = 1, n - acnorm(j) = enorm(m,a(1,j)) - rdiag(j) = acnorm(j) - wa(j) = rdiag(j) - if (pivot) ipvt(j) = j - 10 continue -c -c reduce a to r with householder transformations. -c - minmn = min0(m,n) - do 110 j = 1, minmn - if (.not.pivot) go to 40 -c -c bring the column of largest norm into the pivot position. -c - kmax = j - do 20 k = j, n - if (rdiag(k) .gt. rdiag(kmax)) kmax = k - 20 continue - if (kmax .eq. j) go to 40 - do 30 i = 1, m - temp = a(i,j) - a(i,j) = a(i,kmax) - a(i,kmax) = temp - 30 continue - rdiag(kmax) = rdiag(j) - wa(kmax) = wa(j) - k = ipvt(j) - ipvt(j) = ipvt(kmax) - ipvt(kmax) = k - 40 continue -c -c compute the householder transformation to reduce the -c j-th column of a to a multiple of the j-th unit vector. -c - ajnorm = enorm(m-j+1,a(j,j)) - if (ajnorm .eq. zero) go to 100 - if (a(j,j) .lt. zero) ajnorm = -ajnorm - do 50 i = j, m - a(i,j) = a(i,j)/ajnorm - 50 continue - a(j,j) = a(j,j) + one -c -c apply the transformation to the remaining columns -c and update the norms. -c - jp1 = j + 1 - if (n .lt. jp1) go to 100 - do 90 k = jp1, n - sum = zero - do 60 i = j, m - sum = sum + a(i,j)*a(i,k) - 60 continue - temp = sum/a(j,j) - do 70 i = j, m - a(i,k) = a(i,k) - temp*a(i,j) - 70 continue - if (.not.pivot .or. rdiag(k) .eq. zero) go to 80 - temp = a(j,k)/rdiag(k) - rdiag(k) = rdiag(k)*dsqrt(dmax1(zero,one-temp**2)) - if (p05*(rdiag(k)/wa(k))**2 .gt. epsmch) go to 80 - rdiag(k) = enorm(m-j,a(jp1,k)) - wa(k) = rdiag(k) - 80 continue - 90 continue - 100 continue - rdiag(j) = -ajnorm - 110 continue - return -c -c last card of subroutine qrfac. c end subroutine r1mpyq(m,n,a,lda,v,w) diff --git a/sources/poinplot.h b/sources/poinplot.h index 15f14ab..6dd80db 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -1,215 +1,246 @@ SUBROUTINE poinplot !------------------------------------------------------------------------------------------------------ ! DATE: 12/12/2018 - ! Poincare plots of the vacuum flux surfaces - ! use Guodong Wei's snippet of Adams-Moulton method + ! Poincare plots of the vacuum flux surfaces and calculate the rotational transform !------------------------------------------------------------------------------------------------------ - USE globals, only : dp, zero, ounit, XYZB, pp_maxiter, total_num + USE globals, only : dp, myid, ncpu, zero, half, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & + pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw USE mpi IMPLICIT NONE !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat - INTEGER :: tor_num - REAL :: theta, zeta, r, x, y, z -! REAL, ALLOCATABLE :: XYZB(:,:) + INTEGER :: ierr, astat, iflag + INTEGER :: ip, is, niter + REAL :: theta, zeta, r, x, y, z, RZ(2), r1, z1, rzrzt(5) + REAL, ALLOCATABLE :: lppr(:,:), lppz(:,:), liota(:) ! local ppr ppz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + FATAL( poinplot, pp_ns < 1 , not enough starting points ) + FATAL( poinplot, pp_maxiter<1 , not enough max. iterations ) + + ! if raxis, zaxis not provided + if ( (abs(pp_raxis) + abs(pp_zaxis)) < sqrtmachprec) then + zeta = pp_phi + theta = zero ; call surfcoord( theta, zeta, r , z ) + theta = pi ; call surfcoord( theta, zeta, r1, z1) + + pp_raxis = (r+r1)*half + pp_zaxis = (z+z1)*half + endif + + ! calculate axis + RZ(1) = pp_raxis ; RZ(2) = pp_zaxis + call find_axis(RZ, pp_maxiter, pp_xtol) + pp_raxis = RZ(1) ; pp_zaxis = RZ(2) + + ! poincare plot and calculate iota + SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( ppz , (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( lppr, (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( lppz, (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( iota, (1:pp_ns) , zero ) + SALLOCATE(liota, (1:pp_ns) , zero ) + + ! if pp_rmax and pp_zmax not provied + if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then + pp_rmax = r*1.0 + pp_zmax = z*1.0 + endif + + if(myid==0) write(ounit, '("poinplot: following fieldlines between ("ES12.5 & + ","ES12.5" ) and ("ES12.5","ES12.5" )")') pp_raxis, pp_zaxis, pp_rmax, pp_zmax + do is = 1, pp_ns ! pp_ns is the number of eavaluation surfaces + niter = 0 ! number of successful iterations + if ( myid .ne. modulo(is, ncpu) ) cycle ! MPI + + rzrzt(1:5) = (/ pp_raxis + is*(pp_rmax-pp_raxis)/pp_ns, & + pp_zaxis + is*(pp_zmax-pp_zaxis)/pp_ns, & + pp_raxis, pp_zaxis, zero /) + lppr(is, 0) = rzrzt(1) ; lppz(is, 0) = rzrzt(2) + + do ip = 1, pp_maxiter + iflag = 1 + call ppiota(rzrzt, iflag) + if (iflag >= 0) niter = niter + 1 ! counting + lppr(is, ip) = rzrzt(1) + lppz(is, ip) = rzrzt(2) + ! FATAL( poinplot, abs((rzrzt(3)-pp_raxis)/pp_raxis)>pp_xtol, magnetic axis is not coming back ) + enddo + + liota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) + + write(ounit, '(8X": order="I6" ; myid="I6" ; (R,Z)=("ES12.5","ES12.5 & + " ) ; iota="ES12.5" ; niter="I6" .")') is, myid, lppr(is,0), lppz(is,0), liota(is), niter + enddo + + call MPI_ALLREDUCE( lppr, ppr, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( lppz, ppz, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( liota, iota, pp_ns , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - pp_maxiter = 500 ! maximum iteration number - tor_num = 360 ! toroidal planes number - total_num = pp_maxiter * tor_num - - SALLOCATE( XYZB, (1:total_num, 1:4), zero) + DALLOCATE( lppz ) + DALLOCATE( lppr ) + DALLOCATE( liota ) + + return - ! starting point - theta = zero ; zeta = zero - call surfcoord( theta, zeta, r, z) - x = r*cos(zeta) - y = r*sin(zeta) +END SUBROUTINE poinplot - write(ounit, '("poincare: starting filed line tracing at x="F5.2, ", y="F5.2, ", z="F5.2)') x, y, z +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - ! filedline tracing - call fieldline_tracing(x,y,z,total_num,pp_maxiter,XYZB) +SUBROUTINE find_axis(RZ, MAXFEV, XTOL) + USE globals, only : dp, myid, ounit, zero, pp_phi, Nfp_raw + USE mpi + IMPLICIT NONE - write(ounit, '("poincare: Fieldline tracing finished")') + REAL, INTENT(INOUT) :: RZ(2) + REAL, INTENT(IN ) :: XTOL + INTEGER, INTENT(IN) :: MAXFEV + + INTEGER, parameter :: n=2 + INTEGER :: ml,mu,mode,nprint,info,nfev,ldfjac,lr + REAL :: epsfcn,factor + REAL :: fvec(n),diag(n),qtf(n),wa1(n),wa2(n),wa3(n),wa4(n) + REAL, allocatable :: fjac(:,:),r(:) + external :: axis_fcn + + LR = N*(N+1)/2 + LDFJAC = N + ml = n-1 + mu = n-1 + epsfcn = 1.0E-4 + mode = 1 + factor = 100.0 + nprint = -1 + allocate(fjac(ldfjac,n)) + allocate(r(lr)) + + call hybrd(axis_fcn,n, RZ,fvec,xtol,maxfev,ml,mu,epsfcn,diag, & + mode,factor,nprint,info,nfev,fjac,ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) + + if (myid==0) then + write(ounit,'("findaxis: updates axis at phi = "F6.2"pi is R = "ES12.5," , Z = "ES12.5)') & + pp_phi, RZ(1), RZ(2) + select case (info) + case (0) + write(ounit,'("findaxis: info=0, improper input parameters.")') + case (1) + write(ounit,'("findaxis: info=1, relative error between two consecutive iterates is at most xtol.")') + case (2) + write(ounit,'("findaxis: info=2, number of calls to fcn has reached or exceeded maxfev.")') + case (3) + write(ounit,'("findaxis: info=3, xtol is too small.")') + case (4) + write(ounit,'("findaxis: info=4, iteration is not making good progress, jacobian.")') + case (5) + write(ounit,'("findaxis: info=5, iteration is not making good progress, function.")') + end select + endif + return -END SUBROUTINE poinplot +END SUBROUTINE find_axis +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine fieldline_tracing(x,y,z,imax,n2,H) - implicit none - integer*4 ::n2,imax,j,i - real*8 :: x,y,z,dphi,pi,dt,B,Bx,By,Bz,x0,y0,z0,g,iota - real*8 :: s(4), k1x,k2x,k3x,k4x,k5x,k6x,k7x,k8x,k9x,k10x - real*8 :: k1y,k2y,k3y,k4y,k5y,k6y,k7y,k8y,k9y,k10y,xr - real*8 :: k1z,k2z,k3z,k4z,k5z,k6z,k7z,k8z,k9z,k10z - real*8,dimension(imax,4):: H - - real*8,dimension(imax+1,4):: f - real*8,dimension(2*n2,3):: f2 - - pi=3.141592653589793239 - dphi=2*pi/(float(imax)/n2) - - do j=1,imax - H(j,1)=x - H(j,2)=y - H(j,3)=z - call coils_B(s,x,y,z) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - H(j,4)=B - dt=(y-x*tan(j*dphi))/(tan(j*dphi)*Bx/sqrt(Bx**2+By**2)-By/sqrt(Bx**2+By**2))*sqrt(B**2/(Bx**2+By**2)) - ! write(*,*)x,y,z,s,dt - - f(j,1)=Bx/B - f(j,2)=By/B - f(j,3)=Bz/B - x0=x - y0=y - z0=z - - if(j<8)then - k1x=Bx/B - k1y=By/B - k1z=Bz/B - call coils_B(s,x+dt*4/27*k1x,y+dt*4/27*k1y,z+dt*4/27*k1z) - - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k2x=Bx/B - k2y=By/B - k2z=Bz/B - call coils_B(s,x+dt/18*(k1x+3*k2x),y+dt/18*(k1y+3*k2y),z+dt/18*(k1z+3*k2z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k3x=Bx/B - k3y=By/B - k3z=Bz/B - call coils_B(s,x+dt/12*(k1x+3*k3x),y+dt/12*(k1y+3*k3y),z+dt/12*(k1z+3*k3z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k4x=Bx/B - k4y=By/B - k4z=Bz/B - - call coils_B(s,x+dt/8*(k1x+3*k4x),y+dt/8*(k1y+3*k4y),z+dt/8*(k1z+3*k4z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k5x=Bx/B - k5y=By/B - k5z=Bz/B - call coils_B(s,x+dt/54*(13*k1x-27*k3x+42*k4x+8*k5x),y+dt/54*(13*k1y-27*k3y+& - 42*k4y+8*k5y),z+dt/54*(13*k1z-27*k3z+42*k4z+8*k5z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k6x=Bx/B - k6y=By/B - k6z=Bz/B - call coils_B(s,x+dt/4320*(389*k1x-54*k3x+966*k4x-824*k5x+243*k6x),y+dt/4320*(389*k1y-& - 54*k3y+966*k4y-824*k5y+243*k6y),z+dt/4320*(389*k1z-54*k3z+966*k4z-824*k5z+243*k6z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k7x=Bx/B - k7y=By/B - k7z=Bz/B - call coils_B(s,x+dt/20*(-234*k1x+81*k3x-1164*k4x+656*k5x-122*k6x+800*k7x),y+dt/20*(-234*k1y+81*k3y-& - 1164*k4y+656*k5y-122*k6y+800*k7y),z+dt/20*(-234*k1z+81*k3z-1164*k4z+656*k5z-122*k6z+800*k7z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k8x=Bx/B - k8y=By/B - k8z=Bz/B - call coils_B(s,x+dt/288*(-127*k1x+18*k3x-678*k4x+456*k5x-9*k6x+576*k7x+4*k8x),y+& - dt/288*(-127*k1y+18*k3y-678*k4y+456*k5y-9*k6y+576*k7y+4*k8y),z+dt/288*(-127*k1z+& - 18*k3z-678*k4z+456*k5z-9*k6z+576*k7z+4*k8z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k9x=Bx/B - k9y=By/B - k9z=Bz/B - call coils_B(s,x+dt/820*(1481*k1x-81*k3x+7104*k4x-3376*k5x+& - 72*k6x-5040*k7x-60*k8x+720*k9x),y+dt/820*(1481*k1y-81*k3y+& - 7104*k4y-3376*k5y+72*k6y-5040*k7y-60*k8y+720*k9y),z+dt/820*(1481*k1z-& - 81*k3z+7104*k4z-3376*k5z+72*k6z-5040*k7z-60*k8z+720*k9z)) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - k10x=Bx/B - k10y=By/B - k10z=Bz/B - - x=x+dt/840*(41*k1x+27*k4x+272*k5x+27*k6x+216*k7x+216*k9x+41*k10x) - y=y+dt/840*(41*k1y+27*k4y+272*k5y+27*k6y+216*k7y+216*k9y+41*k10y) - z=z+dt/840*(41*k1z+27*k4z+272*k5z+27*k6z+216*k7z+216*k9z+41*k10z) - - else - x=x+dt/120960*(-36799.0*f(j-7,1)+295767.0*f(j-6,1)-1041723.0*f(j-5,1)& - +2102243.0*f(j-4,1)-2664477.0*f(j-3,1)+2183877.0*f(j-2,1)-1152169.0*f(j-1,1)+434241.0*f(j,1)) - y=y+dt/120960*(-36799.0*f(j-7,2)+295767.0*f(j-6,2)-1041723.0*f(j-5,2)& - +2102243.0*f(j-4,2)-2664477.0*f(j-3,2)+2183877.0*f(j-2,2)-1152169.0*f(j-1,2)+434241.0*f(j,2)) - z=z+dt/120960*(-36799.0*f(j-7,3)+295767.0*f(j-6,3)-1041723.0*f(j-5,3)& - +2102243.0*f(j-4,3)-2664477.0*f(j-3,3)+2183877.0*f(j-2,3)-1152169.0*f(j-1,3)+434241.0*f(j,3)) - end if +SUBROUTINE axis_fcn(n,x,fvec,iflag) + USE globals, only : dp, myid, IsQuiet, ounit, zero, pi2, sqrtmachprec, pp_phi, Nfp_raw, pp_xtol + USE mpi + IMPLICIT NONE + + INTEGER :: n, iflag + REAL :: x(n), fvec(n) - call coils_B(s,x,y,z) - Bx=s(1) - By=s(2) - Bz=s(3) - B=s(4) - f(j+1,1)=Bx/B - f(j+1,2)=By/B - f(j+1,3)=Bz/B - if (j>7) then - - x=x0+dt/120960*(1375.0*f(j-6,1)-11351.0*f(j-5,1)+41499.0*f(j-4,1)-88547.0*f(j-3,1)& - +123133.0*f(j-2,1)-121797.0*f(j-1,1)+139849.0*f(j,1)+36799.0*f(j+1,1)) - y=y0+dt/120960*(1375.0*f(j-6,2)-11351.0*f(j-5,2)+41499.0*f(j-4,2)-88547.0*f(j-3,2)& - +123133.0*f(j-2,2)-121797.0*f(j-1,2)+139849.0*f(j,2)+36799.0*f(j+1,2)) - z=z0+dt/120960*(1375.0*f(j-6,3)-11351.0*f(j-5,3)+41499.0*f(j-4,3)-88547.0*f(j-3,3)& - +123133.0*f(j-2,3)-121797.0*f(j-1,3)+139849.0*f(j,3)+36799.0*f(j+1,3)) + INTEGER :: iwork(5), ierr, ifail + REAL :: rz_end(n), phi_init, phi_stop, relerr, abserr, work(100+21*N) + EXTERNAL :: BRpZ + + ifail = 1 + relerr = pp_xtol + abserr = sqrtmachprec + phi_init = pp_phi + phi_stop = pp_phi + pi2/Nfp_raw + rz_end = x + + call ode( BRpZ, n, rz_end, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) + if ( ifail /= 2 .and. myid == 0) then + if ( IsQuiet < 0 ) then + write ( ounit, '(A,I3)' ) 'axis_fcn: ODE solver ERROR; returned IFAIL = ', ifail + select case ( ifail ) + case ( 3 ) + write(ounit, '("axis_fcn: DF_xtol or abserr too small.")') + case ( 4 ) + write(ounit, '("axis_fcn: tau not reached after 500 steps.")') + case ( 5 ) + write(ounit, '("axis_fcn: tau not reached because equation to be stiff.")') + case ( 6 ) + write(ounit, '("axis_fcn: INVALID input parameters.")') + end select end if + iflag = -1 + ! call MPI_ABORT( MPI_COMM_WORLD, 1, ierr ) + end if + + fvec = rz_end - x - end do return +END SUBROUTINE axis_fcn + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +SUBROUTINE ppiota(rzrzt,iflag) + USE globals, only : dp, myid, IsQuiet, ounit, zero, pi2, sqrtmachprec, pp_phi, Nfp_raw, pp_xtol + USE mpi + IMPLICIT NONE + + INTEGER, parameter :: n = 5 + INTEGER :: iflag + REAL :: rzrzt(n) -end subroutine fieldline_tracing + INTEGER :: iwork(5), ierr, ifail + REAL :: phi_init, phi_stop, relerr, abserr, work(100+21*N) + EXTERNAL :: BRpZ_iota + + ifail = 1 + relerr = pp_xtol + abserr = sqrtmachprec + phi_init = pp_phi + phi_stop = pp_phi + pi2/Nfp_raw + + call ode( BRpZ_iota, n, rzrzt, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) + if ( ifail /= 2 .and. myid == 0) then + if ( IsQuiet < -1 ) then + write ( ounit, '(A,I3)' ) 'ppiota : ODE solver ERROR; returned IFAIL = ', ifail + select case ( ifail ) + case ( 3 ) + write(ounit, '("ppiota : DF_xtol or abserr too small.")') + case ( 4 ) + write(ounit, '("ppiota : tau not reached after 500 steps.")') + case ( 5 ) + write(ounit, '("ppiota : tau not reached because equation to be stiff.")') + case ( 6 ) + write(ounit, '("ppiota : INVALID input parameters.")') + end select + end if + iflag = -1 + ! call MPI_ABORT( MPI_COMM_WORLD, 1, ierr ) + end if + return +END SUBROUTINE ppiota -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine coils_B(s, x,y,z) +subroutine coils_bfield(s, x,y,z) use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & zero, myid, ounit, Npc, bsconstant use mpi implicit none - REAL , intent(in) :: x, y, z - real*8, dimension(4) :: s + REAL , intent( in) :: x, y, z + REAL , intent(out) :: s(4) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -244,7 +275,7 @@ subroutine coils_B(s, x,y,z) Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I enddo ! enddo kseg - enddo + enddo ! enddo icoil Bx = Bx * bsconstant By = By * bsconstant @@ -257,4 +288,94 @@ subroutine coils_B(s, x,y,z) return -end subroutine coils_B +end subroutine coils_bfield + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +SUBROUTINE BRpZ( t, x, dx ) + !---------------------- + ! dR/dphi = BR / Bphi + ! dZ/dphi = BZ / Bphi + !---------------------- + use globals, only : dp, zero, ounit, myid, ierr + implicit none + include "mpif.h" + !--------------------------------------------------------------------------------------------- + INTEGER, parameter :: n=2 + REAL, INTENT( IN) :: t, x(n) + REAL, INTENT(OUT) :: dx(n) + + REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(4) + external :: coils_bfield + !--------------------------------------------------------------------------------------------- + + RR = x(1); ZZ = x(2) ! cylindrical coordinate + XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate + B = zero + + call coils_bfield(B, XX, YY, ZZ) + + BR = B(1)*cos(t) + B(2)*sin(t) + BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR + BZ = B(3) + + dx(1) = BR/BP + dx(2) = BZ/BP + + return +END SUBROUTINE BRpZ + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +SUBROUTINE BRpZ_iota( t, x, dx ) + !---------------------- + ! dR/dphi = BR / Bphi + ! dZ/dphi = BZ / Bphi + !---------------------- + use globals, only : dp, zero, ounit, myid, ierr + implicit none + include "mpif.h" + !--------------------------------------------------------------------------------------------- + INTEGER, parameter :: n=5 + REAL, INTENT( IN) :: t, x(n) + REAL, INTENT(OUT) :: dx(n) + + REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(4), length + external :: coils_bfield + !--------------------------------------------------------------------------------------------- + + ! field line + RR = x(1); ZZ = x(2) ! cylindrical coordinate + XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate + B = zero + + call coils_bfield(B, XX, YY, ZZ) + + BR = B(1)*cos(t) + B(2)*sin(t) + BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR + BZ = B(3) + + dx(1) = BR/BP + dx(2) = BZ/BP + + ! magnetic axis + RR = x(3); ZZ = x(4) ! cylindrical coordinate + XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate + B = zero + + call coils_bfield(B, XX, YY, ZZ) + + BR = B(1)*cos(t) + B(2)*sin(t) + BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR + BZ = B(3) + + dx(3) = BR/BP + dx(4) = BZ/BP + + ! integrate theta + length = (x(1) - x(3))**2 + (x(2)-x(4))**2 ! delta R^2 + delta Z^2 + dx(5) = ( (x(1) - x(3))*(dx(2)-dx(4)) - (x(2)-x(4))*(dx(1)-dx(3)) ) / length + + return +END SUBROUTINE BRpZ_iota + diff --git a/sources/saving.h b/sources/saving.h index 31a535e..98f78b8 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -177,8 +177,15 @@ subroutine saving HWRITERA( LM_mfvec, Ndof , LM_fjac , LM_fjac ) endif + if (allocated(ppr)) then + HWRITERA( pp_ns, pp_maxiter+1, ppr , ppr(1:pp_ns, 0:pp_maxiter) ) + HWRITERA( pp_ns, pp_maxiter+1, ppz , ppz(1:pp_ns, 0:pp_maxiter) ) + HWRITEIV( 1 , pp_ns , pp_ns ) + HWRITERV( pp_ns , iota , iota(1:pp_ns) ) + endif + if (allocated(XYZB)) then - HWRITERA( total_num,4 , XYZB , XYZB(1:, 1:4) ) + HWRITERA( total_num,4 , XYZB , XYZB(1:total_num, 1:4) ) endif HWRITERV( 1 , time_initialize, time_initialize ) From 811c88c6278dac037dccde6ca4dc3eecd102aa0c Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 20 Dec 2018 19:36:03 -0500 Subject: [PATCH 04/72] update example inputs and hdf5 saving for poincare plotting --- examples/rotating_ellipse/ellipse.input | 12 +++++++++++- sources/globals.h | 2 +- sources/poinplot.h | 6 ++++-- sources/saving.h | 9 ++++++++- 4 files changed, 24 insertions(+), 5 deletions(-) diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 6d09c4a..7909bb6 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -60,9 +60,19 @@ TN_reorder = 0 TN_cr = 0.1 - case_postproc = 1 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write mgrid file (not ready) + case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots save_freq = 1 ! frequency for writing output files; should be positive save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics save_filaments = 0 ! flag for indicating whether write .example.filaments.xxxxxx + + pp_phi = 0.000D+00 ! toroidal plane for poincare plots, cylindrical angle phi = pp_phi*Pi + pp_raxis = 0.000D+00 ! pp_raxis, pp_zaxis are initial guesses for magnetic axis at the specified toroidal angle + pp_zaxis = 0.000D+00 ! If both zero, FOCUS will take the geometric center as initial guess + pp_rmax = 0.000D+00 ! pp_rmax, pp_zmax are the upper bounds for performing fieldline tracing + pp_zmax = 0.000D+00 ! FOCUS will start follow fieldlines at interpolation between (pp_raxis, pp_zaxis) and (pp_rmax, pp_zmax) + pp_ns = 10 ! number of following fieldlines + pp_maxiter = 1000 ! number of periods for each fieldline following + pp_xtol = 1.000D-06 ! tolarence of ODE solver during fieldline fowllowing + / diff --git a/sources/globals.h b/sources/globals.h index 2522766..33fd378 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.6.01' ! version number + CHARACTER(LEN=10), parameter :: version='v0.6.02' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/poinplot.h b/sources/poinplot.h index 6dd80db..7fab0f0 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -3,7 +3,7 @@ SUBROUTINE poinplot ! DATE: 12/12/2018 ! Poincare plots of the vacuum flux surfaces and calculate the rotational transform !------------------------------------------------------------------------------------------------------ - USE globals, only : dp, myid, ncpu, zero, half, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & + USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw USE mpi IMPLICIT NONE @@ -20,6 +20,8 @@ SUBROUTINE poinplot FATAL( poinplot, pp_ns < 1 , not enough starting points ) FATAL( poinplot, pp_maxiter<1 , not enough max. iterations ) + pp_phi = pp_phi * pi ! pp_phi=0.5 -> pi/2 + ! if raxis, zaxis not provided if ( (abs(pp_raxis) + abs(pp_zaxis)) < sqrtmachprec) then zeta = pp_phi @@ -121,7 +123,7 @@ SUBROUTINE find_axis(RZ, MAXFEV, XTOL) mode,factor,nprint,info,nfev,fjac,ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) if (myid==0) then - write(ounit,'("findaxis: updates axis at phi = "F6.2"pi is R = "ES12.5," , Z = "ES12.5)') & + write(ounit,'("findaxis: Finding axis at phi = "ES12.5" with (R,Z) = ( "ES12.5,","ES12.5" ).")') & pp_phi, RZ(1), RZ(2) select case (info) case (0) diff --git a/sources/saving.h b/sources/saving.h index 98f78b8..26078e4 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -118,6 +118,14 @@ subroutine saving HWRITEIV( 1 , save_coils , save_coils ) HWRITEIV( 1 , save_harmonics, save_harmonics ) HWRITEIV( 1 , save_filaments, save_filaments ) + HWRITERV( 1 , pp_phi , pp_phi ) + HWRITERV( 1 , pp_raxis , pp_raxis ) + HWRITERV( 1 , pp_zaxis , pp_zaxis ) + HWRITERV( 1 , pp_rmax , pp_rmax ) + HWRITERV( 1 , pp_zmax , pp_zmax ) + HWRITEIV( 1 , pp_ns , pp_ns ) + HWRITEIV( 1 , pp_maxiter , pp_maxiter ) + HWRITERV( 1 , pp_xtol , pp_xtol ) HWRITEIV( 1 , Nfp , Nfp_raw ) HWRITERV( 1 , surf_vol , surf(1)%vol ) @@ -180,7 +188,6 @@ subroutine saving if (allocated(ppr)) then HWRITERA( pp_ns, pp_maxiter+1, ppr , ppr(1:pp_ns, 0:pp_maxiter) ) HWRITERA( pp_ns, pp_maxiter+1, ppz , ppz(1:pp_ns, 0:pp_maxiter) ) - HWRITEIV( 1 , pp_ns , pp_ns ) HWRITERV( pp_ns , iota , iota(1:pp_ns) ) endif From 8140a4e42976ba97a5b2c7d193a968630c630856 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 2 Jan 2019 09:13:09 -0500 Subject: [PATCH 05/72] new coil types; tmp saving --- sources/bfield.h | 77 +++++++++++++----- sources/datalloc.h | 59 +++++++++++--- sources/diagnos.h | 12 ++- sources/globals.h | 4 +- sources/length.h | 5 ++ sources/packdof.h | 142 +++++++++++++++++++++++++++----- sources/rdcoils.h | 199 +++++++++++++++++++++++++++++---------------- sources/saving.h | 15 +++- sources/solvers.h | 6 +- 9 files changed, 382 insertions(+), 137 deletions(-) diff --git a/sources/bfield.h b/sources/bfield.h index 9308f1e..9f2a2db 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -28,7 +28,7 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) ! Be careful if coils have different resolutions. !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc + zero, myid, ounit, Npc, Nfp, pi2, half, two, one, bsconstant implicit none include "mpif.h" @@ -38,7 +38,7 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, kseg - REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz + REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, phi !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -46,26 +46,59 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) FATAL( bfield0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bfield0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) - dlx = zero; ltx = zero; Bx = zero - dly = zero; lty = zero; By = zero - dlz = zero; ltz = zero; Bz = zero - - do kseg = 0, coil(icoil)%NS-1 - - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) - rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) - - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) - - Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) - By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) - Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) - - enddo ! enddo kseg + select case (coil(icoil)%itype) + !--------------------------------------------------------------------------------------------- + case(1) + + dlx = zero; ltx = zero; Bx = zero + dly = zero; lty = zero; By = zero + dlz = zero; ltz = zero; Bz = zero + + do kseg = 0, coil(icoil)%NS-1 + + dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) + dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) + dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) + + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + + Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) + By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) + Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) + + enddo ! enddo kseg + + !--------------------------------------------------------------------------------------------- + case(2) + + dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%ox + dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%oy + dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%oz + r2 = dlx**2 + dly**2 + dlz**2 + rm3 = one/(sqrt(r2)*r2) + m_dot_r = coil(icoil)%mx * dlx + coil(icoil)%my * dly + coil(icoil)%mz * dlz + + Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - coil(icoil)%mx * rm3 + By = 3.0_dp * m_dot_r * rm3 / r2 * dly - coil(icoil)%my * rm3 + Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - coil(icoil)%mz * rm3 + + !--------------------------------------------------------------------------------------------- + case(3) + ! might be only valid for cylindrical coordinates + ! Bt = u0*I/(2 pi R) + phi = ( jzeta + half ) * pi2 / ( Nzeta*Nfp ) + rr = sqrt( surf(1)%xx(iteta,jzeta)**2 + surf(1)%yy(iteta,jzeta)**2 ) + coil(icoil)%Bt = two/rr * coil(icoil)%I + Bx = - coil(icoil)%Bt * sin(phi) + By = coil(icoil)%Bt * cos(phi) + Bz = coil(icoil)%Bz / bsconstant + !--------------------------------------------------------------------------------------------- + case default + FATAL(packcoil, .true., not supported coil types) + end select return diff --git a/sources/datalloc.h b/sources/datalloc.h index 59c13c7..83b1172 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -13,6 +13,7 @@ subroutine AllocData(itype) INTEGER, intent(in) :: itype INTEGER :: icoil, idof, ND, NF + REAL :: xtmp, mtmp !------------------------------------------------------------------------------------------- if (itype == -1) then ! dof related data; @@ -31,6 +32,13 @@ subroutine AllocData(itype) SALLOCATE(DoF(icoil)%xof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%yof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%zof , (0:coil(icoil)%NS-1, 1:ND), zero) + case(2) + coil(icoil)%Ic = 0 ! make sure Ic=0 + DoF(icoil)%ND = coil(icoil)%Lc * 6 ! number of DoF for permanent magnet + SALLOCATE(DoF(icoil)%xdof, (1:DoF(icoil)%ND), zero) + case(3) + DoF(icoil)%ND = coil(icoil)%Lc * 1 ! number of DoF for background Bt, Bz + SALLOCATE(DoF(icoil)%xdof, (1:DoF(icoil)%ND), zero) case default FATAL(AllocData, .true., not supported coil types) end select @@ -57,16 +65,47 @@ subroutine AllocData(itype) idof = 0 do icoil = 1, Ncoils - - if(coil(icoil)%Ic /= 0) then - dofnorm(idof+1) = Inorm - idof = idof + 1 - endif - - ND = DoF(icoil)%ND - if(coil(icoil)%Lc /= 0) then - dofnorm(idof+1:idof+ND) = Gnorm - idof = idof + ND + + if(coil(icoil)%itype == 1) then ! Fourier representation + if(coil(icoil)%Ic /= 0) then + dofnorm(idof+1) = Inorm + idof = idof + 1 + endif + + ND = DoF(icoil)%ND + if(coil(icoil)%Lc /= 0) then + dofnorm(idof+1:idof+ND) = Gnorm + idof = idof + ND + endif + else if (coil(icoil)%itype == 2) then ! permanent magnets + if(coil(icoil)%Lc /= 0) then + xtmp = sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ! origin position + mtmp = sqrt( coil(icoil)%mx**2 + coil(icoil)%my**2 + coil(icoil)%mz**2 ) ! moment strenth + dofnorm(idof+1:idof+3) = xtmp + dofnorm(idof+4:idof+6) = mtmp + idof = idof + 6 + endif + else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + if(coil(icoil)%Ic /= 0) then + if(abs(coil(icoil)%I) > sqrtmachprec) then + dofnorm(idof+1) = coil(icoil)%I + else + dofnorm(idof+1) = one + endif + idof = idof + 1 + endif + + if(coil(icoil)%Lc /= 0) then + if(abs(coil(icoil)%Bz) > sqrtmachprec) then + dofnorm(idof+1) = coil(icoil)%Bz + else + dofnorm(idof+1) = one + endif + idof = idof + 1 + endif + else + STOP " wrong coil type in rdcoils" + call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) endif enddo !end do icoil; diff --git a/sources/diagnos.h b/sources/diagnos.h index 73f8380..9cbbec2 100644 --- a/sources/diagnos.h +++ b/sources/diagnos.h @@ -43,16 +43,17 @@ SUBROUTINE diagnos coilspace(iout, idof+1:idof+NF ) = FouCoil(icoil)%ys(1:NF) ; idof = idof + NF coilspace(iout, idof+1:idof+NF+1) = FouCoil(icoil)%zc(0:NF) ; idof = idof + NF +1 coilspace(iout, idof+1:idof+NF ) = FouCoil(icoil)%zs(1:NF) ; idof = idof + NF - case default - FATAL(descent, .true., not supported coil types) +!!$ case default +!!$ FATAL(descent, .true., not supported coil types) end select enddo - FATAL( output , idof .ne. Tdof, counting error in restart ) +!!$ FATAL( output , idof .ne. Tdof, counting error in restart ) endif !-------------------------------coil maximum curvature---------------------------------------------------- MaxCurv = zero do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier call curvature(icoil) if (coil(icoil)%maxcurv .ge. MaxCurv) then MaxCurv = coil(icoil)%maxcurv @@ -71,6 +72,7 @@ SUBROUTINE diagnos if ( (case_length == 1) .and. (sum(coil(1:Ncoils)%Lo) < sqrtmachprec) ) coil(1:Ncoils)%Lo = one call length(0) do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier AvgLength = AvgLength + coil(icoil)%L enddo AvgLength = AvgLength / Ncoils @@ -81,6 +83,8 @@ SUBROUTINE diagnos minCCdist = infmax do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(Ncoils .eq. 1) exit !if only one coil itmp = icoil + 1 if(icoil .eq. Ncoils) itmp = 1 @@ -111,6 +115,8 @@ SUBROUTINE diagnos minCPdist = infmax do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + SALLOCATE(Atmp, (1:3,0:coil(icoil)%NS-1), zero) SALLOCATE(Btmp, (1:3,1:(Nteta*Nzeta)), zero) diff --git a/sources/globals.h b/sources/globals.h index 33fd378..d576ed0 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -246,8 +246,8 @@ module globals end type toroidalsurface type arbitrarycoil - INTEGER :: NS, Ic, Lc, itype - REAL :: I, L, Lo, maxcurv + INTEGER :: NS, Ic=0, Lc=0, itype + REAL :: I=zero, L=zero, Lo, maxcurv, ox, oy, oz, mx, my, mz, Bt, Bz REAL , allocatable :: xx(:), yy(:), zz(:), xt(:), yt(:), zt(:), xa(:), ya(:), za(:), & dl(:), dd(:) character(LEN=10) :: name diff --git a/sources/length.h b/sources/length.h index fff3b45..b50346a 100644 --- a/sources/length.h +++ b/sources/length.h @@ -78,6 +78,7 @@ subroutine length(ideriv) do icoil = 1, Ncoils !only care about unique coils; + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; call LenDeriv0(icoil, coil(icoil)%L) !RlBCAST( coil(icoil)%L, 1, modulo(icoil-1,ncpu) ) !broadcast each coil's length @@ -88,6 +89,7 @@ subroutine length(ideriv) if (case_length == 1) then ! quadratic; do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier if ( coil(icoil)%Lc /= 0 ) then ttlen = ttlen + half * (coil(icoil)%L - coil(icoil)%Lo)**2 / coil(icoil)%Lo**2 if (mttlen > 0) then ! L-M format of targets @@ -98,6 +100,7 @@ subroutine length(ideriv) enddo elseif (case_length == 2) then ! exponential; do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier if ( coil(icoil)%Lc /= 0 ) then ttlen = ttlen + exp(coil(icoil)%L) / exp(coil(icoil)%Lo) if (mttlen > 0) then ! L-M format of targets @@ -127,6 +130,8 @@ subroutine length(ideriv) idof = 0 ; ivec = 1 do icoil = 1, Ncoils + if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + ND = DoF(icoil)%ND if (case_length == 1) then diff --git a/sources/packdof.h b/sources/packdof.h index b6a1b16..9af8e6f 100644 --- a/sources/packdof.h +++ b/sources/packdof.h @@ -25,7 +25,7 @@ SUBROUTINE packdof(lxdof) ! DATE: 2017/03/19 !--------------------------------------------------------------------------------------------- use globals, only : dp, zero, myid, ounit, & - & case_coils, Ncoils, coil, DoF, Ndof, Inorm, Gnorm + & case_coils, Ncoils, coil, DoF, Ndof, DoFnorm implicit none include "mpif.h" @@ -41,16 +41,42 @@ SUBROUTINE packdof(lxdof) idof = 0 do icoil = 1, Ncoils - if(coil(icoil)%Ic /= 0) then - lxdof(idof+1) = coil(icoil)%I / Inorm - idof = idof + 1 - endif + select case (coil(icoil)%itype) + !--------------------------------------------------------------------------------------------- + case(1) + + if(coil(icoil)%Ic /= 0) then + lxdof(idof+1) = coil(icoil)%I + idof = idof + 1 + endif - ND = DoF(icoil)%ND - if(coil(icoil)%Lc /= 0) then - lxdof(idof+1:idof+ND) = DoF(icoil)%xdof(1:ND) / Gnorm - idof = idof + ND - endif + ND = DoF(icoil)%ND + if(coil(icoil)%Lc /= 0) then + lxdof(idof+1:idof+ND) = DoF(icoil)%xdof(1:ND) + idof = idof + ND + endif + !--------------------------------------------------------------------------------------------- + case(2) + ND = DoF(icoil)%ND + if(coil(icoil)%Lc /= 0) then + lxdof(idof+1:idof+ND) = DoF(icoil)%xdof(1:ND) + idof = idof + ND + endif + !--------------------------------------------------------------------------------------------- + case(3) + if(coil(icoil)%Ic /= 0) then + lxdof(idof+1) = coil(icoil)%I + idof = idof + 1 + endif + + if(coil(icoil)%Lc /= 0) then + lxdof(idof+1) = DoF(icoil)%xdof(idof+1) + idof = idof + 1 + endif + !--------------------------------------------------------------------------------------------- + case default + FATAL(packcoil, .true., not supported coil types) + end select enddo !end do icoil; @@ -58,6 +84,7 @@ SUBROUTINE packdof(lxdof) FATAL( packdof , idof .ne. Ndof, counting error in packing ) !write(ounit, *) "pack ", lxdof(1) + lxdof = lxdof / DoFnorm call mpi_barrier(MPI_COMM_WORLD, ierr) return @@ -71,7 +98,7 @@ SUBROUTINE unpacking(lxdof) ! DATE: 2017/04/03 !--------------------------------------------------------------------------------------------- use globals, only: dp, zero, myid, ounit, & - & case_coils, Ncoils, coil, DoF, Ndof, Inorm, Gnorm + & case_coils, Ncoils, coil, DoF, Ndof, DoFnorm implicit none include "mpif.h" @@ -83,16 +110,43 @@ SUBROUTINE unpacking(lxdof) idof = 0 ; ifirst = 0 do icoil = 1, Ncoils - if(coil(icoil)%Ic /= 0) then - coil(icoil)%I = lxdof(idof+1) * Inorm - idof = idof + 1 - endif + select case (coil(icoil)%itype) + !--------------------------------------------------------------------------------------------- + case(1) + + if(coil(icoil)%Ic /= 0) then + coil(icoil)%I = lxdof(idof+1) * dofnorm(idof+1) + idof = idof + 1 + endif + + ND = DoF(icoil)%ND + if(coil(icoil)%Lc /= 0) then + DoF(icoil)%xdof(1:ND) = lxdof(idof+1:idof+ND) * dofnorm(idof+1:idof+ND) + idof = idof + ND + endif + + !--------------------------------------------------------------------------------------------- + case(2) + ND = DoF(icoil)%ND + if(coil(icoil)%Lc /= 0) then + DoF(icoil)%xdof(1:ND) = lxdof(idof+1:idof+ND) * dofnorm(idof+1:idof+ND) + idof = idof + ND + endif + !--------------------------------------------------------------------------------------------- + case(3) + if(coil(icoil)%Ic /= 0) then + coil(icoil)%I = lxdof(idof+1) * dofnorm(idof+1) + idof = idof + 1 + endif - ND = DoF(icoil)%ND - if(coil(icoil)%Lc /= 0) then - DoF(icoil)%xdof(1:ND) = lxdof(idof+1:idof+ND) * Gnorm - idof = idof + ND - endif + if(coil(icoil)%Lc /= 0) then + DoF(icoil)%xdof(idof+1) = lxdof(idof+1) * dofnorm(idof+1) + idof = idof + 1 + endif + !--------------------------------------------------------------------------------------------- + case default + FATAL(packcoil, .true., not supported coil types) + end select enddo !end do icoil; @@ -146,6 +200,25 @@ SUBROUTINE packcoil FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- + case(2) + idof = 0 + if(coil(icoil)%Lc /= 0) then + DoF(icoil)%xdof(idof+1:idof+6) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & + coil(icoil)%mx, coil(icoil)%my, coil(icoil)%mz /) + idof = idof + 6 + endif + FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + !--------------------------------------------------------------------------------------------- + case(3) + idof = 0 +!!$ if(coil(icoil)%Ic /= 0) then +!!$ DoF(icoil)%xdof(idof+1) = coil(icoil)%I; idof = idof + 1 +!!$ endif + if(coil(icoil)%Lc /= 0) then + DoF(icoil)%xdof(idof+1) = coil(icoil)%Bz; idof = idof + 1 + endif + FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + !--------------------------------------------------------------------------------------------- case default FATAL(packcoil, .true., not supported coil types) end select @@ -174,7 +247,7 @@ SUBROUTINE unpackcoil do icoil = 1, Ncoils select case (coil(icoil)%itype) - !--------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------------------------- case(1) ! get number of DoF for each coil and allocate arrays; NF = FouCoil(icoil)%NF @@ -190,7 +263,32 @@ SUBROUTINE unpackcoil endif FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) - !--------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------------------------- + case(2) + idof = 0 + if(coil(icoil)%Lc /= 0) then + coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%mx = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%my = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%mz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + endif + FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + + !--------------------------------------------------------------------------------------------- + case(3) + idof = 0 +!!$ if(coil(icoil)%Ic /= 0) then +!!$ coil(icoil)%I = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 +!!$ endif + + if(coil(icoil)%Lc /= 0) then + coil(icoil)%Bz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + endif + FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + + !--------------------------------------------------------------------------------------------- case default FATAL(packcoil, .true., not supported coil types) end select diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 05c9298..4f73753 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -41,7 +41,16 @@ !latex 0.000000000000000E+00 -5.425716121023922E-02 -8.986316303345250E-02 -2.946386365076052E-03 -4.487052148209031E-03 !latex -4.293247278325474E-17 -1.303273952226587E-15 7.710821807870230E-16 -3.156539892466338E-16 9.395672288215928E-17 !latex 0.000000000000000E+00 9.997301975562740E-01 2.929938238054118E-02 2.436889176706748E-02 1.013941937492003E-03 -!latex #-----------2--------------------------------- +!latex #-----------2--permanent magnet--------------- +!latex #coil_type coil_name +!latex 2 dipole_01 +!latex # Lc ox oy oz mx my mz +!latex 1 1.0 0.0 0.0 0.0 1.0 0.0 +!latex #-----------3--backgound Bt Bz---------------- +!latex #coil_type coil_name +!latex 3 bg_BtBz_01 +!latex # Ic I Lc Bz (Ic control I; Lc control Bz) +!latex 1 1.0E6 0 0.0 !latex . !latex . !latex . @@ -91,12 +100,14 @@ subroutine rdcoils include "mpif.h" LOGICAL :: exist - INTEGER :: icoil, maxnseg, ifirst, NF, itmp, ip, icoef, total_coef + INTEGER :: icoil, maxnseg, ifirst, NF, itmp, ip, icoef, total_coef, num_pm, num_bg REAL :: Rmaj, zeta, totalcurrent, z0, r1, r2, z1, z2 !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! Nfixcur = 0 ! fixed coil current number Nfixgeo = 0 ! fixed coil geometry number + num_pm = 0 ! number of permanent magnets + num_bg = 0 ! number of background field if(myid == 0) write(ounit, *) "-----------INITIALIZE COILS----------------------------------" @@ -202,36 +213,45 @@ subroutine rdcoils read( runit,*) read( runit,*) read( runit,*) coil(icoil)%itype, coil(icoil)%name - if(coil(icoil)%itype /= 1) then + if(coil(icoil)%itype == 1) then ! Fourier representation + read( runit,*) + read( runit,*) coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, & + & coil(icoil)%L, coil(icoil)%Lc, coil(icoil)%Lo + FATAL( rdcoils, coil(icoil)%NS < 0 , illegal ) + FATAL( rdcoils, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) + FATAL( rdcoils, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 2, illegal ) + FATAL( rdcoils, coil(icoil)%L < zero , illegal ) + FATAL( rdcoils, coil(icoil)%Lc < zero , illegal ) + FATAL( rdcoils, coil(icoil)%Lo < zero , illegal ) + read( runit,*) + read( runit,*) FouCoil(icoil)%NF + FATAL( rdcoils, Foucoil(icoil)%NF < 0 , illegal ) + SALLOCATE( FouCoil(icoil)%xc, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%xs, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%yc, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%ys, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%zc, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%zs, (0:FouCoil(icoil)%NF), zero ) + read( runit,*) + read( runit,*) FouCoil(icoil)%xc(0:FouCoil(icoil)%NF) + read( runit,*) FouCoil(icoil)%xs(0:FouCoil(icoil)%NF) + read( runit,*) FouCoil(icoil)%yc(0:FouCoil(icoil)%NF) + read( runit,*) FouCoil(icoil)%ys(0:FouCoil(icoil)%NF) + read( runit,*) FouCoil(icoil)%zc(0:FouCoil(icoil)%NF) + read( runit,*) FouCoil(icoil)%zs(0:FouCoil(icoil)%NF) + else if (coil(icoil)%itype == 2) then ! permanent magnets + read( runit,*) + read( runit,*) coil(icoil)%Lc, coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & + coil(icoil)%mx, coil(icoil)%my, coil(icoil)%mz + write(*,*) coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz + else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + read( runit,*) + read( runit,*) coil(icoil)%Ic, coil(icoil)%I, coil(icoil)%Lc, coil(icoil)%Bz + else STOP " wrong coil type in rdcoils" call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) endif - read( runit,*) - read( runit,*) coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, & - & coil(icoil)%L, coil(icoil)%Lc, coil(icoil)%Lo - FATAL( rdcoils, coil(icoil)%NS < 0 , illegal ) - FATAL( rdcoils, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) - FATAL( rdcoils, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 2, illegal ) - FATAL( rdcoils, coil(icoil)%L < zero , illegal ) - FATAL( rdcoils, coil(icoil)%Lc < zero , illegal ) - FATAL( rdcoils, coil(icoil)%Lo < zero , illegal ) - read( runit,*) - read( runit,*) FouCoil(icoil)%NF - FATAL( rdcoils, Foucoil(icoil)%NF < 0 , illegal ) - SALLOCATE( FouCoil(icoil)%xc, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%xs, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%yc, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%ys, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%zc, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%zs, (0:FouCoil(icoil)%NF), zero ) - read( runit,*) - read( runit,*) FouCoil(icoil)%xc(0:FouCoil(icoil)%NF) - read( runit,*) FouCoil(icoil)%xs(0:FouCoil(icoil)%NF) - read( runit,*) FouCoil(icoil)%yc(0:FouCoil(icoil)%NF) - read( runit,*) FouCoil(icoil)%ys(0:FouCoil(icoil)%NF) - read( runit,*) FouCoil(icoil)%zc(0:FouCoil(icoil)%NF) - read( runit,*) FouCoil(icoil)%zs(0:FouCoil(icoil)%NF) - + enddo !end do icoil; close( runit ) @@ -241,31 +261,58 @@ subroutine rdcoils IlBCAST( coil(icoil)%itype , 1 , 0 ) ClBCAST( coil(icoil)%name , 10 , 0 ) - IlBCAST( coil(icoil)%NS , 1 , 0 ) - RlBCAST( coil(icoil)%I , 1 , 0 ) - IlBCAST( coil(icoil)%Ic , 1 , 0 ) - RlBCAST( coil(icoil)%L , 1 , 0 ) - IlBCAST( coil(icoil)%Lc , 1 , 0 ) - RlBCAST( coil(icoil)%Lo , 1 , 0 ) - IlBCAST( FouCoil(icoil)%NF , 1 , 0 ) - - if (.not. allocated(FouCoil(icoil)%xc) ) then - SALLOCATE( FouCoil(icoil)%xc, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%xs, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%yc, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%ys, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%zc, (0:FouCoil(icoil)%NF), zero ) - SALLOCATE( FouCoil(icoil)%zs, (0:FouCoil(icoil)%NF), zero ) - endif - RlBCAST( FouCoil(icoil)%xc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - RlBCAST( FouCoil(icoil)%xs(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - RlBCAST( FouCoil(icoil)%yc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - RlBCAST( FouCoil(icoil)%ys(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - RlBCAST( FouCoil(icoil)%zc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - RlBCAST( FouCoil(icoil)%zs(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 - if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + if(coil(icoil)%itype == 1) then ! Fourier representation + + IlBCAST( coil(icoil)%NS , 1 , 0 ) + RlBCAST( coil(icoil)%I , 1 , 0 ) + IlBCAST( coil(icoil)%Ic , 1 , 0 ) + RlBCAST( coil(icoil)%L , 1 , 0 ) + IlBCAST( coil(icoil)%Lc , 1 , 0 ) + RlBCAST( coil(icoil)%Lo , 1 , 0 ) + IlBCAST( FouCoil(icoil)%NF , 1 , 0 ) + + if (.not. allocated(FouCoil(icoil)%xc) ) then + SALLOCATE( FouCoil(icoil)%xc, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%xs, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%yc, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%ys, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%zc, (0:FouCoil(icoil)%NF), zero ) + SALLOCATE( FouCoil(icoil)%zs, (0:FouCoil(icoil)%NF), zero ) + endif + RlBCAST( FouCoil(icoil)%xc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) + RlBCAST( FouCoil(icoil)%xs(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) + RlBCAST( FouCoil(icoil)%yc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) + RlBCAST( FouCoil(icoil)%ys(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) + RlBCAST( FouCoil(icoil)%zc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) + RlBCAST( FouCoil(icoil)%zs(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) + + if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 + if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + + else if (coil(icoil)%itype == 2) then ! permanent magnets + + coil(icoil)%I = one + IlBCAST( coil(icoil)%Lc, 1 , 0 ) + RlBCAST( coil(icoil)%ox, 1 , 0 ) + RlBCAST( coil(icoil)%oy, 1 , 0 ) + RlBCAST( coil(icoil)%oz, 1 , 0 ) + RlBCAST( coil(icoil)%mx, 1 , 0 ) + RlBCAST( coil(icoil)%my, 1 , 0 ) + RlBCAST( coil(icoil)%mz, 1 , 0 ) + + else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + + coil(icoil)%I = one + IlBCAST( coil(icoil)%Ic, 1 , 0 ) + RlBCAST( coil(icoil)%I, 1 , 0 ) + IlBCAST( coil(icoil)%Lc, 1 , 0 ) + RlBCAST( coil(icoil)%Bz, 1 , 0 ) + + else + STOP " wrong coil type in rdcoils" + call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) + endif enddo @@ -351,6 +398,8 @@ subroutine rdcoils enddo enddo + ! when there are permanent magnets or background fields, these should be muted. + SALLOCATE( cosip, (0:Npc), one ) ! cos(ip*pi/Np) ; default one ; SALLOCATE( sinip, (0:Npc), zero ) ! sin(ip*pi/Np) ; default zero; @@ -396,14 +445,16 @@ subroutine rdcoils Inorm = 0 total_coef = 0 ! total number of coefficients do icoil = 1, Ncoils - NF = FouCoil(icoil)%NF - total_coef = total_coef + (6*NF + 3) - do icoef = 0, NF - Gnorm = Gnorm + FouCoil(icoil)%xs(icoef)**2 + FouCoil(icoil)%xc(icoef)**2 - Gnorm = Gnorm + FouCoil(icoil)%ys(icoef)**2 + FouCoil(icoil)%yc(icoef)**2 - Gnorm = Gnorm + FouCoil(icoil)%zs(icoef)**2 + FouCoil(icoil)%zc(icoef)**2 - enddo - Inorm = Inorm + coil(icoil)%I**2 + if(coil(icoil)%itype == 1) then ! Fourier representation + NF = FouCoil(icoil)%NF + total_coef = total_coef + (6*NF + 3) + do icoef = 0, NF + Gnorm = Gnorm + FouCoil(icoil)%xs(icoef)**2 + FouCoil(icoil)%xc(icoef)**2 + Gnorm = Gnorm + FouCoil(icoil)%ys(icoef)**2 + FouCoil(icoil)%yc(icoef)**2 + Gnorm = Gnorm + FouCoil(icoil)%zs(icoef)**2 + FouCoil(icoil)%zc(icoef)**2 + enddo + Inorm = Inorm + coil(icoil)%I**2 + endif enddo Gnorm = sqrt(Gnorm/total_coef) * weight_gnorm ! quadratic mean Inorm = sqrt(Inorm/Ncoils) * weight_inorm ! quadratic mean @@ -513,22 +564,22 @@ subroutine discoil(ifirst) if( (coil(icoil)%Lc + ifirst) /= 0) then !first time or if Lc/=0, then need discretize; - !reset to zero for all the coils; - coil(icoil)%xx = zero - coil(icoil)%yy = zero - coil(icoil)%zz = zero - coil(icoil)%xt = zero - coil(icoil)%yt = zero - coil(icoil)%zt = zero - coil(icoil)%xa = zero - coil(icoil)%ya = zero - coil(icoil)%za = zero - !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; select case (coil(icoil)%itype) case( 1 ) + !reset to zero for all the coils; + coil(icoil)%xx = zero + coil(icoil)%yy = zero + coil(icoil)%zz = zero + coil(icoil)%xt = zero + coil(icoil)%yt = zero + coil(icoil)%zt = zero + coil(icoil)%xa = zero + coil(icoil)%ya = zero + coil(icoil)%za = zero + NS = coil(icoil)%NS; NF = FouCoil(icoil)%NF ! allias variable for simplicity; SALLOCATE( cmt, (0:NS, 0:NF), zero ) SALLOCATE( smt, (0:NS, 0:NF), zero ) @@ -587,6 +638,10 @@ subroutine discoil(ifirst) DALLOCATE(cmt) DALLOCATE(smt) + case(2) + + case(3) + case default FATAL(discoil, .true., not supported coil types) end select diff --git a/sources/saving.h b/sources/saving.h index 26078e4..ee5c2b0 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -218,11 +218,12 @@ subroutine saving write(wunit, *) "#-----------------", icoil, "---------------------------" write(wunit, *) "#coil_type coil_name" write(wunit,'(3X,I3,4X, A10)') coil(icoil)%itype, coil(icoil)%name - write(wunit, '(3(A6, A15, 8X))') " #Nseg", "current", "Ifree", "Length", "Lfree", "target_length" - write(wunit,'(2X, I4, ES23.15, 3X, I3, ES23.15, 3X, I3, ES23.15)') & - coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, coil(icoil)%L, coil(icoil)%Lc, coil(icoil)%Lo + select case (coil(icoil)%itype) case (1) + write(wunit, '(3(A6, A15, 8X))') " #Nseg", "current", "Ifree", "Length", "Lfree", "target_length" + write(wunit,'(2X, I4, ES23.15, 3X, I3, ES23.15, 3X, I3, ES23.15)') & + coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, coil(icoil)%L, coil(icoil)%Lc, coil(icoil)%Lo NF = FouCoil(icoil)%NF ! shorthand; write(wunit, *) "#NFcoil" write(wunit, '(I3)') NF @@ -233,6 +234,14 @@ subroutine saving write(wunit, 1000) FouCoil(icoil)%ys(0:NF) write(wunit, 1000) FouCoil(icoil)%zc(0:NF) write(wunit, 1000) FouCoil(icoil)%zs(0:NF) + case (2) + write(wunit, *) "# Lc ox oy oz mx my mz" + write(wunit,'(I3, 6ES23.15)') coil(icoil)%Lc, coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & + coil(icoil)%mx, coil(icoil)%my, coil(icoil)%mz + case (3) + write(wunit, *) "# Ic I Lc Bz (Ic control I; Lc control Bz)" + write(wunit,'(I3, ES23.15, I3, ES23.15)') coil(icoil)%Ic, coil(icoil)%I, & + coil(icoil)%Lc, coil(icoil)%Bz case default FATAL(restart, .true., not supported coil types) end select diff --git a/sources/solvers.h b/sources/solvers.h index 0923c83..c9c7cb7 100644 --- a/sources/solvers.h +++ b/sources/solvers.h @@ -554,11 +554,11 @@ subroutine output (mark) coilspace(iout, idof+1:idof+NF ) = FouCoil(icoil)%ys(1:NF) ; idof = idof + NF coilspace(iout, idof+1:idof+NF+1) = FouCoil(icoil)%zc(0:NF) ; idof = idof + NF +1 coilspace(iout, idof+1:idof+NF ) = FouCoil(icoil)%zs(1:NF) ; idof = idof + NF - case default - FATAL(descent, .true., not supported coil types) +!!$ case default +!!$ FATAL(output, .true., not supported coil types) end select enddo - FATAL( output , idof .ne. Tdof, counting error in restart ) +!!$ FATAL( output , idof .ne. Tdof, counting error in restart ) endif if(mod(iout,save_freq) .eq. 0) call saving From d5ddab2d38879bece54911584c68cbe02fa4a0f8 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 7 Jan 2019 09:16:14 -0500 Subject: [PATCH 06/72] add permanent magnets and background magnetic field --- sources/bfield.h | 176 ++++++++++++++++++++++++++++++++++----------- sources/bnormal.h | 36 ++++------ sources/datalloc.h | 22 ++++-- sources/diagnos.h | 8 +-- sources/globals.h | 2 +- sources/initial.h | 6 ++ sources/packdof.h | 27 ++++--- sources/poinplot.h | 99 ++++++++++++++++++------- sources/rdcoils.h | 114 +++++++++++++++++++++++++---- sources/saving.h | 6 +- 10 files changed, 368 insertions(+), 128 deletions(-) diff --git a/sources/bfield.h b/sources/bfield.h index 9f2a2db..231ec8c 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -38,21 +38,23 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, kseg - REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, phi + REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, phi, mx, my, mz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! FATAL( bfield0, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) FATAL( bfield0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bfield0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) + + Bx = zero; By = zero; Bz = zero select case (coil(icoil)%itype) !--------------------------------------------------------------------------------------------- case(1) - dlx = zero; ltx = zero; Bx = zero - dly = zero; lty = zero; By = zero - dlz = zero; ltz = zero; Bz = zero + dlx = zero; ltx = zero + dly = zero; lty = zero + dlz = zero; ltz = zero do kseg = 0, coil(icoil)%NS-1 @@ -71,6 +73,10 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) enddo ! enddo kseg + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + !--------------------------------------------------------------------------------------------- case(2) @@ -79,11 +85,18 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%oz r2 = dlx**2 + dly**2 + dlz**2 rm3 = one/(sqrt(r2)*r2) - m_dot_r = coil(icoil)%mx * dlx + coil(icoil)%my * dly + coil(icoil)%mz * dlz + mx = sin(coil(icoil)%mt) * cos(coil(icoil)%mp) + my = sin(coil(icoil)%mt) * sin(coil(icoil)%mp) + mz = cos(coil(icoil)%mt) + m_dot_r = mx * dlx + my * dly + mz * dlz + + Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - mx * rm3 + By = 3.0_dp * m_dot_r * rm3 / r2 * dly - my * rm3 + Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - mz * rm3 - Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - coil(icoil)%mx * rm3 - By = 3.0_dp * m_dot_r * rm3 / r2 * dly - coil(icoil)%my * rm3 - Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - coil(icoil)%mz * rm3 + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant !--------------------------------------------------------------------------------------------- case(3) @@ -91,13 +104,15 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) ! Bt = u0*I/(2 pi R) phi = ( jzeta + half ) * pi2 / ( Nzeta*Nfp ) rr = sqrt( surf(1)%xx(iteta,jzeta)**2 + surf(1)%yy(iteta,jzeta)**2 ) - coil(icoil)%Bt = two/rr * coil(icoil)%I + coil(icoil)%Bt = two/rr * coil(icoil)%I * bsconstant + Bx = - coil(icoil)%Bt * sin(phi) By = coil(icoil)%Bt * cos(phi) - Bz = coil(icoil)%Bz / bsconstant - !--------------------------------------------------------------------------------------------- + Bz = coil(icoil)%Bz + + !--------------------------------------------------------------------------------------------- case default - FATAL(packcoil, .true., not supported coil types) + FATAL(bfield0, .true., not supported coil types) end select return @@ -114,7 +129,7 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc + zero, myid, ounit, Npc, one, bsconstant implicit none include "mpif.h" @@ -124,7 +139,8 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, kseg, NS - REAL :: dlx, dly, dlz, r, rm3, rm5, ltx, lty, ltz, rxp + REAL :: dlx, dly, dlz, r2, rm3, rm5, rm7, m_dot_r, ltx, lty, ltz, rxp, & + sinp, sint, cosp, cost, mx, my, mz REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dBxx, dBxy, dBxz, dByx, dByy, dByz, dBzx, dBzy, dBzz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -133,45 +149,119 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) FATAL( bfield1, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bfield1, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) FATAL( bfield1, ND <= 0, wrong inout dimension of ND ) - - NS = coil(icoil)%NS - dlx = zero; ltx = zero; Bx = zero - dly = zero; lty = zero; By = zero - dlz = zero; ltz = zero; Bz = zero + Bx = zero; By = zero; Bz = zero - do kseg = 0, NS-1 + select case (coil(icoil)%itype) + !--------------------------------------------------------------------------------------------- + case(1) - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + NS = coil(icoil)%NS - r = sqrt(dlx**2 + dly**2 + dlz**2); rm3 = r**(-3); rm5 = r**(-5) + dlx = zero; ltx = zero + dly = zero; lty = zero + dlz = zero; ltz = zero - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) + do kseg = 0, NS-1 - rxp = dlx*ltx + dly*lty + dlz*ltz !r dot x' + dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) + dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) + dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + + r2 = dlx**2 + dly**2 + dlz**2; rm3 = one/(sqrt(r2)*r2); rm5 = rm3/r2; + + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) - dBxx(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlx*rm5 ) * coil(icoil)%dd(kseg) !Bx/x - dBxy(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dly*rm5 - 3*dlz*rxp*rm5 + 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !Bx/y - dBxz(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlz*rm5 + 3*dly*rxp*rm5 - 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bx/z - - dByx(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlx*rm5 + 3*dlz*rxp*rm5 - 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !By/x - dByy(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dly*rm5 ) * coil(icoil)%dd(kseg) !By/y - dByz(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlz*rm5 - 3*dlx*rxp*rm5 + 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !By/z - - dBzx(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlx*rm5 - 3*dly*rxp*rm5 + 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bz/x - dBzy(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dly*rm5 + 3*dlx*rxp*rm5 - 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !Bz/y - dBzz(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlz*rm5 ) * coil(icoil)%dd(kseg) !Bz/z + rxp = dlx*ltx + dly*lty + dlz*ltz !r dot x' - enddo ! enddo kseg + dBxx(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlx*rm5 ) * coil(icoil)%dd(kseg) !Bx/x + dBxy(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dly*rm5 - 3*dlz*rxp*rm5 + 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !Bx/y + dBxz(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlz*rm5 + 3*dly*rxp*rm5 - 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bx/z - Bx(1:1, 1:ND) = matmul(dBxx, DoF(icoil)%xof) + matmul(dBxy, DoF(icoil)%yof) + matmul(dBxz, DoF(icoil)%zof) - By(1:1, 1:ND) = matmul(dByx, DoF(icoil)%xof) + matmul(dByy, DoF(icoil)%yof) + matmul(dByz, DoF(icoil)%zof) - Bz(1:1, 1:ND) = matmul(dBzx, DoF(icoil)%xof) + matmul(dBzy, DoF(icoil)%yof) + matmul(dBzz, DoF(icoil)%zof) + dByx(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlx*rm5 + 3*dlz*rxp*rm5 - 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !By/x + dByy(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dly*rm5 ) * coil(icoil)%dd(kseg) !By/y + dByz(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlz*rm5 - 3*dlx*rxp*rm5 + 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !By/z + dBzx(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlx*rm5 - 3*dly*rxp*rm5 + 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bz/x + dBzy(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dly*rm5 + 3*dlx*rxp*rm5 - 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !Bz/y + dBzz(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlz*rm5 ) * coil(icoil)%dd(kseg) !Bz/z + + enddo ! enddo kseg + + Bx(1:1, 1:ND) = matmul(dBxx, DoF(icoil)%xof) + matmul(dBxy, DoF(icoil)%yof) + matmul(dBxz, DoF(icoil)%zof) + By(1:1, 1:ND) = matmul(dByx, DoF(icoil)%xof) + matmul(dByy, DoF(icoil)%yof) + matmul(dByz, DoF(icoil)%zof) + Bz(1:1, 1:ND) = matmul(dBzx, DoF(icoil)%xof) + matmul(dBzy, DoF(icoil)%yof) + matmul(dBzz, DoF(icoil)%zof) + + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + !--------------------------------------------------------------------------------------------- + case(2) ! permanent dipoles + + dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%ox + dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%oy + dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%oz + r2 = dlx**2 + dly**2 + dlz**2 + rm3 = one/(sqrt(r2)*r2) + rm5 = rm3/r2 + rm7 = rm5/r2 + + cost = cos(coil(icoil)%mt) ; sint = sin(coil(icoil)%mt) + cosp = cos(coil(icoil)%mp) ; sinp = sin(coil(icoil)%mp) + mx = sint*cosp ; my = sint*sinp ; mz = cost + m_dot_r = mx*dlx + my*dly + mz*dlz + + Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 + By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 + Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 + + Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 + By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 + Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 + + Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 + By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 + Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 + + +!!$ Bx(1, 4) = 3.0_dp*dlx*dlx*rm5 - rm3 +!!$ By(1, 4) = 3.0_dp*dlx*dly*rm5 +!!$ Bz(1, 4) = 3.0_dp*dlx*dlz*rm5 +!!$ +!!$ Bx(1, 5) = 3.0_dp*dly*dlx*rm5 +!!$ By(1, 5) = 3.0_dp*dly*dly*rm5 - rm3 +!!$ Bz(1, 5) = 3.0_dp*dly*dlz*rm5 +!!$ +!!$ Bx(1, 6) = 3.0_dp*dlz*dlx*rm5 +!!$ By(1, 6) = 3.0_dp*dlz*dly*rm5 +!!$ Bz(1, 6) = 3.0_dp*dlz*dlz*rm5 - rm3 +!!$ +!!$ Bx = Bx * bsconstant +!!$ By = By * bsconstant +!!$ Bz = Bz * bsconstant + + Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 + By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 + Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + + Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 + By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 + Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + + !--------------------------------------------------------------------------------------------- + case(3) ! only for Bz + + Bx = zero + By = zero + Bz = one + + end select return diff --git a/sources/bnormal.h b/sources/bnormal.h index d9c22a3..9fdd731 100644 --- a/sources/bnormal.h +++ b/sources/bnormal.h @@ -57,15 +57,15 @@ subroutine bnormal( ideriv ) do icoil = 1, Ncoils*Npc call bfield0(icoil, iteta, jzeta, dBx(0,0), dBy(0,0), dBz(0,0)) - lbx(iteta, jzeta) = lbx(iteta, jzeta) + dBx( 0, 0) * coil(icoil)%I!* bsconstant - lby(iteta, jzeta) = lby(iteta, jzeta) + dBy( 0, 0) * coil(icoil)%I!* bsconstant - lbz(iteta, jzeta) = lbz(iteta, jzeta) + dBz( 0, 0) * coil(icoil)%I!* bsconstant + lbx(iteta, jzeta) = lbx(iteta, jzeta) + dBx( 0, 0) + lby(iteta, jzeta) = lby(iteta, jzeta) + dBy( 0, 0) + lbz(iteta, jzeta) = lbz(iteta, jzeta) + dBz( 0, 0) enddo ! end do icoil lbn(iteta, jzeta) = lbx(iteta, jzeta)*surf(1)%nx(iteta, jzeta) & & + lby(iteta, jzeta)*surf(1)%ny(iteta, jzeta) & & + lbz(iteta, jzeta)*surf(1)%nz(iteta, jzeta) & - & - surf(1)%pb(iteta, jzeta)/bsconstant + & - surf(1)%pb(iteta, jzeta) select case (case_bnormal) case (0) ! no normalization over |B|; @@ -89,19 +89,14 @@ subroutine bnormal( ideriv ) call MPI_ALLREDUCE( lbn, surf(1)%Bn, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( lbnorm, bnorm , 1 , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - surf(1)%Bx = surf(1)%Bx * bsconstant - surf(1)%By = surf(1)%By * bsconstant - surf(1)%Bz = surf(1)%Bz * bsconstant - surf(1)%Bn = surf(1)%Bn * bsconstant - bnorm = bnorm * half * discretefactor bn = surf(1)%Bn + surf(1)%pb ! bn is B.n from coils ! bn = surf(1)%Bx * surf(1)%nx + surf(1)%By * surf(1)%ny + surf(1)%Bz * surf(1)%nz - if (case_bnormal == 0) bnorm = bnorm * bsconstant * bsconstant ! take bsconst back + !! if (case_bnormal == 0) bnorm = bnorm * bsconstant * bsconstant ! take bsconst back if (case_bnormal == 1) then ! collect |B| call MPI_ALLREDUCE( lbm, bm, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - bm = bm * bsconstant * bsconstant + !! bm = bm * bsconstant * bsconstant endif ! Another type of target functions @@ -151,13 +146,14 @@ subroutine bnormal( ideriv ) ND = DoF(icoil)%ND if ( coil(icoil)%Ic /= 0 ) then !if current is free; call bfield0(icoil+(ip-1)*Ncoils, iteta, jzeta, dBx(0,0), dBy(0,0), dBz(0,0)) - dBn(idof+1) = bsconstant * ( dBx(0,0)*surf(1)%nx(iteta,jzeta) & - & + dBy(0,0)*surf(1)%ny(iteta,jzeta) & - & + dBz(0,0)*surf(1)%nz(iteta,jzeta) ) + if (coil(icoil+(ip-1)*Ncoils)%itype == 3) dBz(0,0) = zero ! Bz doesn't change in itype=3 + dBn(idof+1) = ( dBx(0,0)*surf(1)%nx(iteta,jzeta) & + & + dBy(0,0)*surf(1)%ny(iteta,jzeta) & + & + dBz(0,0)*surf(1)%nz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I if (case_bnormal == 1) then ! normalized over |B|; - dBm(idof+1) = bsconstant * ( dBx(0,0)*surf(1)%Bx(iteta,jzeta) & - & + dBy(0,0)*surf(1)%By(iteta,jzeta) & - & + dBz(0,0)*surf(1)%Bz(iteta,jzeta) ) + dBm(idof+1) = ( dBx(0,0)*surf(1)%Bx(iteta,jzeta) & + & + dBy(0,0)*surf(1)%By(iteta,jzeta) & + & + dBz(0,0)*surf(1)%Bz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I endif idof = idof +1 @@ -165,13 +161,11 @@ subroutine bnormal( ideriv ) if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; call bfield1(icoil+(ip-1)*Ncoils, iteta, jzeta, dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) - dBn(idof+1:idof+ND) = bsconstant * coil(icoil)%I & - & * ( dBx(1:ND,0)*surf(1)%nx(iteta,jzeta) & + dBn(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(1)%nx(iteta,jzeta) & & + dBy(1:ND,0)*surf(1)%ny(iteta,jzeta) & & + dBz(1:ND,0)*surf(1)%nz(iteta,jzeta) ) if (case_bnormal == 1) then ! normalized over |B|; - dBm(idof+1:idof+ND) = bsconstant * coil(icoil)%I & - & * ( dBx(1:ND,0)*surf(1)%Bx(iteta,jzeta) & + dBm(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(1)%Bx(iteta,jzeta) & & + dBy(1:ND,0)*surf(1)%By(iteta,jzeta) & & + dBz(1:ND,0)*surf(1)%Bz(iteta,jzeta) ) endif diff --git a/sources/datalloc.h b/sources/datalloc.h index 83b1172..e090ba6 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -33,8 +33,7 @@ subroutine AllocData(itype) SALLOCATE(DoF(icoil)%yof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%zof , (0:coil(icoil)%NS-1, 1:ND), zero) case(2) - coil(icoil)%Ic = 0 ! make sure Ic=0 - DoF(icoil)%ND = coil(icoil)%Lc * 6 ! number of DoF for permanent magnet + DoF(icoil)%ND = coil(icoil)%Lc * 5 ! number of DoF for permanent magnet SALLOCATE(DoF(icoil)%xdof, (1:DoF(icoil)%ND), zero) case(3) DoF(icoil)%ND = coil(icoil)%Lc * 1 ! number of DoF for background Bt, Bz @@ -48,7 +47,8 @@ subroutine AllocData(itype) do icoil = 1, Ncoils Ndof = Ndof + coil(icoil)%Ic + DoF(icoil)%ND - Tdof = Tdof + 1 + 6*(FouCoil(icoil)%NF)+3 + ! Tdof = Tdof + 1 + 6*(FouCoil(icoil)%NF)+3 + Tdof = Tdof + coil(icoil)%Ic + DoF(icoil)%ND if (DoF(icoil)%ND >= Cdof) Cdof = DoF(icoil)%ND ! find the largest ND for single coil; enddo @@ -78,12 +78,20 @@ subroutine AllocData(itype) idof = idof + ND endif else if (coil(icoil)%itype == 2) then ! permanent magnets + if(coil(icoil)%Ic /= 0) then + if(abs(coil(icoil)%I) > sqrtmachprec) then + dofnorm(idof+1) = coil(icoil)%I + else + dofnorm(idof+1) = one + endif + idof = idof + 1 + endif if(coil(icoil)%Lc /= 0) then - xtmp = sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ! origin position - mtmp = sqrt( coil(icoil)%mx**2 + coil(icoil)%my**2 + coil(icoil)%mz**2 ) ! moment strenth + xtmp = max(one, sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ) ! origin position + mtmp = max(one, sqrt( coil(icoil)%mp**2 + coil(icoil)%mt**2 ) ) ! moment orentation dofnorm(idof+1:idof+3) = xtmp - dofnorm(idof+4:idof+6) = mtmp - idof = idof + 6 + dofnorm(idof+4:idof+5) = mtmp + idof = idof + 5 endif else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field if(coil(icoil)%Ic /= 0) then diff --git a/sources/diagnos.h b/sources/diagnos.h index 9cbbec2..9e0acfe 100644 --- a/sources/diagnos.h +++ b/sources/diagnos.h @@ -12,7 +12,7 @@ SUBROUTINE diagnos implicit none include "mpif.h" - INTEGER :: icoil, itmp, astat, ierr, NF, idof, i, j + INTEGER :: icoil, itmp=0, astat, ierr, NF, idof, i, j LOGICAL :: lwbnorm = .True. , l_raw = .False.!if use raw coils data REAL :: MaxCurv, AvgLength, MinCCdist, MinCPdist, tmp_dist, ReDot, ImDot REAL, parameter :: infmax = 1.0E6 @@ -177,9 +177,9 @@ SUBROUTINE diagnos enddo if(myid .eq. 0) write(ounit, '(8X": The most and least important coils are : " & - F8.3"% at coil" I4 " ; " F8.3"% at coil "I4)') & - 100*maxval(coil_importance), maxloc(coil_importance), & - 100*minval(coil_importance), minloc(coil_importance) + ES12.5" at coil" I4 " ; " ES12.5" at coil "I4)') & + maxval(coil_importance), maxloc(coil_importance), & + minval(coil_importance), minloc(coil_importance) endif !--------------------------------------------------------------------------------------------- diff --git a/sources/globals.h b/sources/globals.h index d576ed0..c38dfa4 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -247,7 +247,7 @@ module globals type arbitrarycoil INTEGER :: NS, Ic=0, Lc=0, itype - REAL :: I=zero, L=zero, Lo, maxcurv, ox, oy, oz, mx, my, mz, Bt, Bz + REAL :: I=zero, L=zero, Lo, maxcurv, ox, oy, oz, mt, mp, Bt, Bz REAL , allocatable :: xx(:), yy(:), zz(:), xt(:), yt(:), zt(:), xa(:), ya(:), za(:), & dl(:), dd(:) character(LEN=10) :: name diff --git a/sources/initial.h b/sources/initial.h index 8b905a1..7655572 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -364,6 +364,12 @@ subroutine initial FATAL( initial, Nseg <= 0 , no enough segments ) FATAL( initial, target_length < zero, illegal ) if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Initialize circular coils.' + case( 2 ) + FATAL( initial, Ncoils < 1, should provide the No. of coils) + FATAL( initial, init_current == zero, invalid coil current) + FATAL( initial, init_radius < zero, invalid coil radius) + FATAL( initial, target_length < zero, illegal ) + if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Initialize magnetic dipoles.' case default FATAL( initial, .true., selected case_init is not supported ) end select diff --git a/sources/packdof.h b/sources/packdof.h index 9af8e6f..0c04efb 100644 --- a/sources/packdof.h +++ b/sources/packdof.h @@ -57,6 +57,10 @@ SUBROUTINE packdof(lxdof) endif !--------------------------------------------------------------------------------------------- case(2) + if(coil(icoil)%Ic /= 0) then + lxdof(idof+1) = coil(icoil)%I + idof = idof + 1 + endif ND = DoF(icoil)%ND if(coil(icoil)%Lc /= 0) then lxdof(idof+1:idof+ND) = DoF(icoil)%xdof(1:ND) @@ -70,7 +74,7 @@ SUBROUTINE packdof(lxdof) endif if(coil(icoil)%Lc /= 0) then - lxdof(idof+1) = DoF(icoil)%xdof(idof+1) + lxdof(idof+1) = DoF(icoil)%xdof(1) idof = idof + 1 endif !--------------------------------------------------------------------------------------------- @@ -127,6 +131,10 @@ SUBROUTINE unpacking(lxdof) !--------------------------------------------------------------------------------------------- case(2) + if(coil(icoil)%Ic /= 0) then + coil(icoil)%I = lxdof(idof+1) * dofnorm(idof+1) + idof = idof + 1 + endif ND = DoF(icoil)%ND if(coil(icoil)%Lc /= 0) then DoF(icoil)%xdof(1:ND) = lxdof(idof+1:idof+ND) * dofnorm(idof+1:idof+ND) @@ -140,7 +148,7 @@ SUBROUTINE unpacking(lxdof) endif if(coil(icoil)%Lc /= 0) then - DoF(icoil)%xdof(idof+1) = lxdof(idof+1) * dofnorm(idof+1) + DoF(icoil)%xdof(1) = lxdof(idof+1) * dofnorm(idof+1) idof = idof + 1 endif !--------------------------------------------------------------------------------------------- @@ -175,7 +183,7 @@ SUBROUTINE packcoil INTEGER :: icoil, idof, NF, ierr, astat FATAL( packcoil, .not. allocated(coil) , illegal ) - FATAL( packcoil, .not. allocated(FouCoil), illegal ) + ! FATAL( packcoil, .not. allocated(FouCoil), illegal ) FATAL( packcoil, .not. allocated(DoF) , illegal ) do icoil = 1, Ncoils @@ -203,9 +211,9 @@ SUBROUTINE packcoil case(2) idof = 0 if(coil(icoil)%Lc /= 0) then - DoF(icoil)%xdof(idof+1:idof+6) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & - coil(icoil)%mx, coil(icoil)%my, coil(icoil)%mz /) - idof = idof + 6 + DoF(icoil)%xdof(idof+1:idof+5) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & + coil(icoil)%mt, coil(icoil)%mp /) + idof = idof + 5 endif FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- @@ -241,7 +249,7 @@ SUBROUTINE unpackcoil INTEGER :: icoil, idof, NF, ierr, astat FATAL( unpackcoil, .not. allocated(coil) , illegal ) - FATAL( unpackcoil, .not. allocated(FouCoil), illegal ) + ! FATAL( unpackcoil, .not. allocated(FouCoil), illegal ) FATAL( unpackcoil, .not. allocated(DoF) , illegal ) do icoil = 1, Ncoils @@ -270,9 +278,8 @@ SUBROUTINE unpackcoil coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - coil(icoil)%mx = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - coil(icoil)%my = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - coil(icoil)%mz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%mt = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%mp = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 endif FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) diff --git a/sources/poinplot.h b/sources/poinplot.h index 7fab0f0..0855062 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -237,7 +237,7 @@ END SUBROUTINE ppiota subroutine coils_bfield(s, x,y,z) use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc, bsconstant + zero, myid, ounit, Npc, bsconstant, one, two use mpi implicit none @@ -250,43 +250,90 @@ subroutine coils_bfield(s, x,y,z) REAL :: Bx, By, Bz INTEGER :: icoil, kseg - REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz + REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, & + m_dot_r, mx, my, mz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! s(1:4) = zero - - dlx = zero; ltx = zero; Bx = zero - dly = zero; lty = zero; By = zero - dlz = zero; ltz = zero; Bz = zero do icoil = 1, Ncoils*Npc - do kseg = 0, coil(icoil)%NS-1 - dlx = x - coil(icoil)%xx(kseg) - dly = y - coil(icoil)%yy(kseg) - dlz = z - coil(icoil)%zz(kseg) - rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) + Bx = zero; By = zero; Bz = zero + + select case (coil(icoil)%itype) + !--------------------------------------------------------------------------------------------- + case(1) + + dlx = zero; ltx = zero + dly = zero; lty = zero + dlz = zero; ltz = zero + + do kseg = 0, coil(icoil)%NS-1 + + dlx = x - coil(icoil)%xx(kseg) + dly = y - coil(icoil)%yy(kseg) + dlz = z - coil(icoil)%zz(kseg) + rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) + + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + + Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) + By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) + Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) + + enddo ! enddo kseg - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant - Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I - By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I - Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) * coil(icoil)%I + !--------------------------------------------------------------------------------------------- + case(2) - enddo ! enddo kseg - enddo ! enddo icoil + dlx = x - coil(icoil)%ox + dly = y - coil(icoil)%oy + dlz = z - coil(icoil)%oz + r2 = dlx**2 + dly**2 + dlz**2 + rm3 = one/(sqrt(r2)*r2) + mx = sin(coil(icoil)%mt) * cos(coil(icoil)%mp) + my = sin(coil(icoil)%mt) * sin(coil(icoil)%mp) + mz = cos(coil(icoil)%mt) + m_dot_r = mx * dlx + my * dly + mz * dlz - Bx = Bx * bsconstant - By = By * bsconstant - Bz = Bz * bsconstant + Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - mx * rm3 + By = 3.0_dp * m_dot_r * rm3 / r2 * dly - my * rm3 + Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - mz * rm3 + + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + + !--------------------------------------------------------------------------------------------- + case(3) + ! might be only valid for cylindrical coordinates + ! Bt = u0*I/(2 pi R) + rr = sqrt( x**2 + y**2 ) + coil(icoil)%Bt = two/rr * coil(icoil)%I * bsconstant + + Bx = - coil(icoil)%Bt * ( y/rr ) ! sin(phi) + By = coil(icoil)%Bt * ( x/rr ) ! cos(phi) + Bz = coil(icoil)%Bz + + !--------------------------------------------------------------------------------------------- + case default + FATAL(bfield0, .true., not supported coil types) + end select + + s(1) = s(1) + Bx + s(2) = s(2) + By + s(3) = s(3) + Bz + + enddo - s(1) = Bx - s(2) = By - s(3) = Bz - s(4) = sqrt(Bx*Bx+By*By+Bz*Bz) + s(4) = sqrt( s(1)*s(1) + s(2)*s(2) + s(3)*s(3) ) return diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 4f73753..6250135 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -100,8 +100,9 @@ subroutine rdcoils include "mpif.h" LOGICAL :: exist - INTEGER :: icoil, maxnseg, ifirst, NF, itmp, ip, icoef, total_coef, num_pm, num_bg - REAL :: Rmaj, zeta, totalcurrent, z0, r1, r2, z1, z2 + INTEGER :: icoil, maxnseg, ifirst, NF, itmp, ip, icoef, total_coef, num_pm, num_bg, & + num_per_array, num_tor, ipol, itor + REAL :: Rmaj, zeta, totalcurrent, z0, r1, r2, z1, z2, rtmp, teta !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! Nfixcur = 0 ! fixed coil current number @@ -242,8 +243,7 @@ subroutine rdcoils else if (coil(icoil)%itype == 2) then ! permanent magnets read( runit,*) read( runit,*) coil(icoil)%Lc, coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & - coil(icoil)%mx, coil(icoil)%my, coil(icoil)%mz - write(*,*) coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz + coil(icoil)%Ic, coil(icoil)%I , coil(icoil)%mt, coil(icoil)%mp else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field read( runit,*) read( runit,*) coil(icoil)%Ic, coil(icoil)%I, coil(icoil)%Lc, coil(icoil)%Bz @@ -292,22 +292,21 @@ subroutine rdcoils else if (coil(icoil)%itype == 2) then ! permanent magnets - coil(icoil)%I = one + IlBCAST( coil(icoil)%Ic, 1 , 0 ) + RlBCAST( coil(icoil)%I , 1 , 0 ) IlBCAST( coil(icoil)%Lc, 1 , 0 ) RlBCAST( coil(icoil)%ox, 1 , 0 ) RlBCAST( coil(icoil)%oy, 1 , 0 ) RlBCAST( coil(icoil)%oz, 1 , 0 ) - RlBCAST( coil(icoil)%mx, 1 , 0 ) - RlBCAST( coil(icoil)%my, 1 , 0 ) - RlBCAST( coil(icoil)%mz, 1 , 0 ) + RlBCAST( coil(icoil)%mt, 1 , 0 ) + RlBCAST( coil(icoil)%mp, 1 , 0 ) else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field - - coil(icoil)%I = one + IlBCAST( coil(icoil)%Ic, 1 , 0 ) - RlBCAST( coil(icoil)%I, 1 , 0 ) + RlBCAST( coil(icoil)%I , 1 , 0 ) IlBCAST( coil(icoil)%Lc, 1 , 0 ) - RlBCAST( coil(icoil)%Bz, 1 , 0 ) + RlBCAST( coil(icoil)%Bz, 1 , 0 ) else STOP " wrong coil type in rdcoils" @@ -374,7 +373,90 @@ subroutine rdcoils enddo ! end of do icoil; - coil(1:Ncoils)%itype = case_coils + coil(1:Ncoils)%itype = 1 + + !------------- permanent dipoles and background magnetic field ---------------------------------------- + case( 2 ) ! averagely positioned permanent dipoles ; 2019/01/03 + + allocate( coil(1:Ncoils*Npc) ) + allocate( DoF(1:Ncoils*Npc) ) + + num_per_array = 5 ! number of dipoles at each toroidal cross-section + num_tor = (Ncoils-1)/num_per_array ! number of toroidal arrangements + + if (myid == 0) then + write(ounit,'("rdcoils : initializing "i3" uniformly positioned magnetic dipoles with toroidal magnetif filed")') Ncoils-1 + if (IsQuiet < 1) write(ounit, '(8X,": Initialize "I4" X "I4" dipoles on r="ES12.5"m with m="& + ES12.5" A")') num_tor, num_per_array, init_radius, init_current + if (IsQuiet < 0) write(ounit, '(8X,": IsVaryCurrent = "I1 " ; IsVaryGeometry = "I1)') & + IsVaryCurrent, IsVaryGeometry + FATAL( rdcoils, modulo(Ncoils-1, num_per_array) /= 0, Please provide a valid number ) + + endif + + ! background magnetic field Bt Bz + icoil = 1 + coil(icoil)%I = init_current + coil(icoil)%Ic = IsVaryCurrent + coil(icoil)%L = pi2*init_radius + coil(icoil)%Lc = 0 ! IsVaryGeometry ! ignore Bz first; 20190102 + coil(icoil)%Lo = target_length + coil(icoil)%Bz = zero + coil(icoil)%name = 'bg_BtBz_01' + coil(icoil)%itype = 3 + + do itor = 1, num_tor + + !initilize with circular coils; + zeta = (itor-1) * pi2 / num_tor ! put a half for a shift; + call surfcoord( zero, zeta, r1, z1) + call surfcoord( pi, zeta, r2, z2) + Rmaj = half * (r1 + r2) + z0 = half * (z1 + z2) + + do ipol = 1, num_per_array + + icoil = icoil + 1 + + !general coil parameters; + coil(icoil)%itype = 2 + coil(icoil)%Ic = IsVaryCurrent + coil(icoil)%I = init_current + coil(icoil)%L = pi2*init_radius + coil(icoil)%Lc = IsVaryGeometry + coil(icoil)%Lo = target_length + write(coil(icoil)%name,'("pm_"I6)') icoil + FATAL( rdcoils, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) + FATAL( rdcoils, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 1, illegal ) + FATAL( rdcoils, coil(icoil)%Lo < zero , illegal ) + if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 + if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + + + teta = (ipol-1) * pi2 / num_per_array + rtmp = Rmaj + init_radius * cos(teta) + coil(icoil)%ox = rtmp * cos(zeta) + coil(icoil)%oy = rtmp * sin(zeta) + coil(icoil)%oz = z0 + init_radius * sin(teta) + +!!$ ! toroidal direction +!!$ coil(icoil)%mx = - init_current * sin(zeta) +!!$ coil(icoil)%my = init_current * cos(zeta) +!!$ coil(icoil)%mz = zero +!!$ +!!$ ! poloidal direction +!!$ coil(icoil)%mx = - init_current * sin(teta) * cos(zeta) +!!$ coil(icoil)%my = - init_current * sin(teta) * sin(zeta) +!!$ coil(icoil)%mz = init_current * cos(teta) + + ! poloidal and toroidal angle; in toroidal direction + coil(icoil)%mt = -teta + coil(icoil)%mp = zeta + + enddo ! enddo ipol + enddo ! enddo itor + + FATAL( rdcoils, icoil .ne. Ncoils, counting coils wrong when initializing ) end select @@ -459,6 +541,12 @@ subroutine rdcoils Gnorm = sqrt(Gnorm/total_coef) * weight_gnorm ! quadratic mean Inorm = sqrt(Inorm/Ncoils) * weight_inorm ! quadratic mean !Inorm = Inorm * 6 ! compensate for the fact that there are so many more spatial variables + + if (abs(Gnorm) < machprec) Gnorm = one + if (abs(Inorm) < machprec) Inorm = one + + Inorm = one + Gnorm = one FATAL( rdcoils, abs(Gnorm) < machprec, cannot be zero ) FATAL( rdcoils, abs(Inorm) < machprec, cannot be zero ) diff --git a/sources/saving.h b/sources/saving.h index ee5c2b0..5862b0b 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -235,9 +235,9 @@ subroutine saving write(wunit, 1000) FouCoil(icoil)%zc(0:NF) write(wunit, 1000) FouCoil(icoil)%zs(0:NF) case (2) - write(wunit, *) "# Lc ox oy oz mx my mz" - write(wunit,'(I3, 6ES23.15)') coil(icoil)%Lc, coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & - coil(icoil)%mx, coil(icoil)%my, coil(icoil)%mz + write(wunit, *) "# Lc ox oy oz Ic I mt mp" + write(wunit,'(2(I3, 3ES23.15))') coil(icoil)%Lc, coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & + coil(icoil)%Ic, coil(icoil)%I , coil(icoil)%mt, coil(icoil)%mp case (3) write(wunit, *) "# Ic I Lc Bz (Ic control I; Lc control Bz)" write(wunit,'(I3, ES23.15, I3, ES23.15)') coil(icoil)%Ic, coil(icoil)%I, & From 966ffec90ff0fd0b08e6c354e1d40f95ccc9b9ac Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 7 Jan 2019 19:59:11 -0500 Subject: [PATCH 07/72] revise Tdof counting --- sources/datalloc.h | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/sources/datalloc.h b/sources/datalloc.h index e090ba6..bc0906f 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -47,8 +47,11 @@ subroutine AllocData(itype) do icoil = 1, Ncoils Ndof = Ndof + coil(icoil)%Ic + DoF(icoil)%ND - ! Tdof = Tdof + 1 + 6*(FouCoil(icoil)%NF)+3 - Tdof = Tdof + coil(icoil)%Ic + DoF(icoil)%ND + if (allocated(FouCoil)) then + Tdof = Tdof + 1 + 6*(FouCoil(icoil)%NF)+3 + else + Tdof = Tdof + coil(icoil)%Ic + DoF(icoil)%ND + end if if (DoF(icoil)%ND >= Cdof) Cdof = DoF(icoil)%ND ! find the largest ND for single coil; enddo From ad1cc52f6876a4ed83632b921c91882e07a67028 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 9 Jan 2019 12:24:59 -0500 Subject: [PATCH 08/72] add writing LCFS and mgrid --- sources/Makefile | 2 +- sources/boozer.h | 275 ++++++++++++++++++++++++++++++++++++++++++++++ sources/focus.h | 1 + sources/initial.h | 3 + sources/rdcoils.h | 16 ++- 5 files changed, 292 insertions(+), 5 deletions(-) create mode 100644 sources/boozer.h diff --git a/sources/Makefile b/sources/Makefile index 8463cc0..250f924 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -3,7 +3,7 @@ ############################################################################################################ ALLFILES= globals initial datalloc rdsurf rdknot rdcoils packdof bfield bnormal bmnharm fdcheck \ - torflux length surfsep solvers descent congrad lmalg saving diagnos specinp poinplot focus + torflux length surfsep solvers descent congrad lmalg saving diagnos specinp poinplot boozer focus HFILES= $(ALLFILES:=.h) FFILES= $(ALLFILES:=.F90) PFILES= $(ALLFILES:=.pdf) diff --git a/sources/boozer.h b/sources/boozer.h new file mode 100644 index 0000000..b5ef404 --- /dev/null +++ b/sources/boozer.h @@ -0,0 +1,275 @@ +subroutine last_surface + USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, total_num, pp_maxiter, XYZB + USE mpi + IMPLICIT NONE + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + INTEGER :: ierr, astat, iflag + INTEGER :: tor_num + REAL :: theta, zeta, r, x, y, z + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + call wtmgrid + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; + + tor_num = 360 ! toroidal planes number + total_num = pp_maxiter * tor_num + + SALLOCATE( XYZB, (1:total_num, 1:4), zero) + + ! starting point + theta = zero ; zeta = zero + call surfcoord( theta, zeta, r, z) + x = r*cos(zeta) + y = r*sin(zeta) + + if ( myid /= 0 ) return + + write(ounit, '("poincare: starting filed line tracing at x="F5.2, ", y="F5.2, ", z="F5.2)') x, y, z + + ! filedline tracing + call fieldline_tracing(x,y,z,total_num,pp_maxiter,XYZB) + + write(ounit, '("poincare: Fieldline tracing finished")') + + return +end subroutine last_surface + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +subroutine fieldline_tracing(x,y,z,imax,n2,H) + implicit none + integer*4 ::n2,imax,j,i + real*8 :: x,y,z,dphi,pi,dt,B,Bx,By,Bz,x0,y0,z0,g,iota + real*8 :: s(4), k1x,k2x,k3x,k4x,k5x,k6x,k7x,k8x,k9x,k10x + real*8 :: k1y,k2y,k3y,k4y,k5y,k6y,k7y,k8y,k9y,k10y,xr + real*8 :: k1z,k2z,k3z,k4z,k5z,k6z,k7z,k8z,k9z,k10z + real*8,dimension(imax,4):: H + + real*8,dimension(imax+1,4):: f + real*8,dimension(2*n2,3):: f2 + + pi=3.141592653589793239 + dphi=2*pi/(float(imax)/n2) + + do j=1,imax + H(j,1)=x ; H(j,2)=y ; H(j,3)=z + call coils_bfield(s,x,y,z) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + H(j,4)=B + dt=(y-x*tan(j*dphi))/(tan(j*dphi)*Bx/sqrt(Bx**2+By**2)-By/sqrt(Bx**2+By**2))*sqrt(B**2/(Bx**2+By**2)) + + f(j,1)=Bx/B + f(j,2)=By/B + f(j,3)=Bz/B + x0=x ; y0=y ; z0=z + + if(j<8)then + k1x=Bx/B ; k1y=By/B ; k1z=Bz/B + + call coils_bfield(s,x+dt*4/27*k1x,y+dt*4/27*k1y,z+dt*4/27*k1z) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k2x=Bx/B ; k2y=By/B ; k2z=Bz/B + + call coils_bfield(s,x+dt/18*(k1x+3*k2x),y+dt/18*(k1y+3*k2y),z+dt/18*(k1z+3*k2z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k3x=Bx/B ; k3y=By/B ; k3z=Bz/B + + call coils_bfield(s,x+dt/12*(k1x+3*k3x),y+dt/12*(k1y+3*k3y),z+dt/12*(k1z+3*k3z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k4x=Bx/B ; k4y=By/B ; k4z=Bz/B + + call coils_bfield(s,x+dt/8*(k1x+3*k4x),y+dt/8*(k1y+3*k4y),z+dt/8*(k1z+3*k4z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k5x=Bx/B ; k5y=By/B ; k5z=Bz/B + + call coils_bfield(s,x+dt/54*(13*k1x-27*k3x+42*k4x+8*k5x),y+dt/54*(13*k1y-27*k3y+& + 42*k4y+8*k5y),z+dt/54*(13*k1z-27*k3z+42*k4z+8*k5z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k6x=Bx/B ; k6y=By/B ; k6z=Bz/B + + call coils_bfield(s,x+dt/4320*(389*k1x-54*k3x+966*k4x-824*k5x+243*k6x),y+dt/4320*(389*k1y-& + 54*k3y+966*k4y-824*k5y+243*k6y),z+dt/4320*(389*k1z-54*k3z+966*k4z-824*k5z+243*k6z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k7x=Bx/B ; k7y=By/B ; k7z=Bz/B + + call coils_bfield(s,x+dt/20*(-234*k1x+81*k3x-1164*k4x+656*k5x-122*k6x+800*k7x),y+dt/20*(-234*k1y+81*k3y-& + 1164*k4y+656*k5y-122*k6y+800*k7y),z+dt/20*(-234*k1z+81*k3z-1164*k4z+656*k5z-122*k6z+800*k7z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k8x=Bx/B ; k8y=By/B ; k8z=Bz/B + + call coils_bfield(s,x+dt/288*(-127*k1x+18*k3x-678*k4x+456*k5x-9*k6x+576*k7x+4*k8x),y+& + dt/288*(-127*k1y+18*k3y-678*k4y+456*k5y-9*k6y+576*k7y+4*k8y),z+dt/288*(-127*k1z+& + 18*k3z-678*k4z+456*k5z-9*k6z+576*k7z+4*k8z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k9x=Bx/B ; k9y=By/B ; k9z=Bz/B + + call coils_bfield(s,x+dt/820*(1481*k1x-81*k3x+7104*k4x-3376*k5x+& + 72*k6x-5040*k7x-60*k8x+720*k9x),y+dt/820*(1481*k1y-81*k3y+& + 7104*k4y-3376*k5y+72*k6y-5040*k7y-60*k8y+720*k9y),z+dt/820*(1481*k1z-& + 81*k3z+7104*k4z-3376*k5z+72*k6z-5040*k7z-60*k8z+720*k9z)) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + k10x=Bx/B ; k10y=By/B ; k10z=Bz/B + + x=x+dt/840*(41*k1x+27*k4x+272*k5x+27*k6x+216*k7x+216*k9x+41*k10x) + y=y+dt/840*(41*k1y+27*k4y+272*k5y+27*k6y+216*k7y+216*k9y+41*k10y) + z=z+dt/840*(41*k1z+27*k4z+272*k5z+27*k6z+216*k7z+216*k9z+41*k10z) + + else + x=x+dt/120960*(-36799.0*f(j-7,1)+295767.0*f(j-6,1)-1041723.0*f(j-5,1)& + +2102243.0*f(j-4,1)-2664477.0*f(j-3,1)+2183877.0*f(j-2,1)-1152169.0*f(j-1,1)+434241.0*f(j,1)) + y=y+dt/120960*(-36799.0*f(j-7,2)+295767.0*f(j-6,2)-1041723.0*f(j-5,2)& + +2102243.0*f(j-4,2)-2664477.0*f(j-3,2)+2183877.0*f(j-2,2)-1152169.0*f(j-1,2)+434241.0*f(j,2)) + z=z+dt/120960*(-36799.0*f(j-7,3)+295767.0*f(j-6,3)-1041723.0*f(j-5,3)& + +2102243.0*f(j-4,3)-2664477.0*f(j-3,3)+2183877.0*f(j-2,3)-1152169.0*f(j-1,3)+434241.0*f(j,3)) + end if + + call coils_bfield(s,x,y,z) + Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) + f(j+1,1)=Bx/B + f(j+1,2)=By/B + f(j+1,3)=Bz/B + + if (j>7) then + x=x0+dt/120960*(1375.0*f(j-6,1)-11351.0*f(j-5,1)+41499.0*f(j-4,1)-88547.0*f(j-3,1)& + +123133.0*f(j-2,1)-121797.0*f(j-1,1)+139849.0*f(j,1)+36799.0*f(j+1,1)) + y=y0+dt/120960*(1375.0*f(j-6,2)-11351.0*f(j-5,2)+41499.0*f(j-4,2)-88547.0*f(j-3,2)& + +123133.0*f(j-2,2)-121797.0*f(j-1,2)+139849.0*f(j,2)+36799.0*f(j+1,2)) + z=z0+dt/120960*(1375.0*f(j-6,3)-11351.0*f(j-5,3)+41499.0*f(j-4,3)-88547.0*f(j-3,3)& + +123133.0*f(j-2,3)-121797.0*f(j-1,3)+139849.0*f(j,3)+36799.0*f(j+1,3)) + end if + + end do + return + +end subroutine fieldline_tracing + + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +subroutine wtmgrid + use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit + implicit none + + include "mpif.h" + + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + LOGICAL :: exist + INTEGER :: ierr, astat, iostat, imn, ibn00aa, ip, iz, ir, np, nz, nr, itangent, ibfield, Mfp, nextcur + REAL :: RpZ(1:3), R, P, Z, Pmin, Pmax, Zmin, Zmax, Rmin, Rmax, B(1:4), pressure, gap, & + czeta, szeta, xx, yy, zz, dx, dy, dz, dBx, dBy, dBz + REAL, allocatable :: BRZp(:,:,:,:), dBRZp(:,:,:,:), BRpZ(:,:,:,:), dBRpZ(:,:,:,:) + CHARACTER*13 :: suffix + CHARACTER*30 :: curlabel(1:1) + + np = 72 ; nz = 121 ; nr = 121 ; Mfp = 2 ! SHOULD BE USER INPUT; 04 Aug 16; + !np = 12 ; nz = 11 ; nr = 11 ; Mfp = 2 ! SHOULD BE USER INPUT; 04 Aug 16; + B = zero ; dx = 1E-4 ; dy = 1E-4 ; dz = 1E-4 + + SALLOCATE( BRZp, (1:3,1:Nr,1:Nz,1:Np), zero ) + SALLOCATE(dBRZp, (1:3,1:Nr,1:Nz,1:Np), zero ) + SALLOCATE( BRpZ, (1:2,1:Nr,1:Nz,1:Np), zero ) + SALLOCATE(dBRpZ, (1:2,1:Nr,1:Nz,1:Np), zero ) + + Pmin = zero ; Pmax = pi2 ! DO NOT CHANGE; 04 Aug 16; + + !call plasdim(Rmin, Rmax, Zmin, Zmax) !calculate plasma surface boundary ;09/11/2016 + !call coildim(Rmin, Rmax, Zmin, Zmax) + + !gap = 0.3 + !Rmin = Rmin -gap; Rmax = Rmax + gap + !Zmin = Zmin -gap; Zmax = Zmax + gap + + Rmin = 2.8 ; Rmax = 3.2 + Zmin = -0.2 ; Zmax = 0.2 + + if( myid.eq.0 ) write( ounit,'("wtmgrid : writing mgrid file at grid of [ "4(ES12.5,2X)" ]",3i6)') Rmin, Rmax, Zmin, Zmax, np, nr, nz + + do ip = 1, np ; RpZ(2) = Pmin + ( Pmax - Pmin ) * ( ip - 1 ) / ( np - 0 ) / Mfp + + if ( myid.ne.modulo(ip,ncpu) ) cycle + + do iz = 1, nz ; RpZ(3) = Zmin + ( Zmax - Zmin ) * ( iz - 1 ) / ( nz - 1 ) + + do ir = 1, nr ; RpZ(1) = Rmin + ( Rmax - Rmin ) * ( ir - 1 ) / ( nr - 1 ) + + czeta = cos(RpZ(2)) + szeta = sin(RpZ(2)) + + xx = RpZ(1) * czeta + yy = RpZ(1) * szeta + zz = RpZ(3) + + call coils_bfield(B,xx,yy,zz) + + dBRZp(1,ir,iz,ip) = ( B(1) * czeta + B(2) * szeta ) + dBRZp(3,ir,iz,ip) = ( - B(1) * szeta + B(2) * czeta ) + dBRZp(2,ir,iz,ip) = B(3) + + dBx = B(1) ; dBy = B(2) ; dBz = B(3) + dBRpZ(2,ir,iz,ip) = B(4) + + xx = xx + dx + call coils_bfield(B,xx,yy,zz) + dBx = ( B(1) - dBx ) / dx + xx = xx - dx + + yy = yy + dy + call coils_bfield(B,xx,yy,zz) + dBy = ( B(2) - dBy ) / dy + yy = yy - dy + + zz = zz + dz + call coils_bfield(B,xx,yy,zz) + dBz = ( B(3) - dBz ) / dz + zz = zz - dz + + ! write(ounit, '("(x, y, z) = "3ES12.5" ; div B = " ES12.5)') xx, yy, zz, dBx + dBy + dBz + dBRpZ(1,ir,iz,ip) = dBx + dBy + dBz + dBRpZ(2,ir,iz,ip) = dBRpZ(1,ir,iz,ip) / dBRpZ(2,ir,iz,ip) + + enddo + + enddo + + enddo + + call MPI_Reduce(dBRZp, BRZp, 3*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(dBRpZ, BRpZ, 2*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + + if( myid.eq.0 ) then + + write(ounit, '("wtmgrid : max. div B = "ES23.15 " ; max. div B / |B| = "ES23.15 )') maxval(BRpZ(1,1:Nr,1:Nz,1:Np)), maxval(BRpZ(2,1:Nr,1:Nz,1:Np)) + + nextcur = 1 ; curlabel(1) = "focus-space-curves" + + write(suffix,'(i3.3,".",i4.4,".",i4.4)') Np, Nr, Nz + + write( ounit,'("wtmgrid : writing mgrid.ext.f."i3.3"."i4.4"."i4.4" ; Mfp="i3" ;")') np, nr, nz, Mfp + + !open( wunit, file=trim(ext)//".fo.mgrid", status="unknown", form="unformatted", iostat=iostat ) + open( wunit, file="mgrid."//trim(ext)//".f."//suffix, status="unknown", form="unformatted", iostat=iostat ) + FATAL( wtmgrid, iostat.ne.0, error opening ext.fo.mgrid ) + write(wunit) Nr, Nz, Np, Mfp, nextcur + write(wunit) Rmin, Zmin, Rmax, Zmax + write(wunit) curlabel(1:nextcur) + write(wunit) BRZp(1:3,1:Nr,1:Nz,1:Np) + close(wunit) + + endif + + DEALLOCATE(dBRZp) + DEALLOCATE( BRZp) + DEALLOCATE(dBRpZ) + DEALLOCATE( BRpZ) + + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + return + +end subroutine wtmgrid diff --git a/sources/focus.h b/sources/focus.h index 8bf8f43..ff944d2 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -178,6 +178,7 @@ PROGRAM focus case( 2 ) ; call diagnos ; call specinp !; call saving !case( 2 ) ; call saving ; call diagnos ; call wtmgrid ! write mgrid file; case( 3 ) ; call diagnos ; call poinplot ! Poincare plots; for future; + case( 4 ) ; call diagnos ; call last_surface ! Last closed surface !case( 4 ) ; call saving ; call diagnos ; call resonant ! resonant harmonics analysis; for future; end select diff --git a/sources/initial.h b/sources/initial.h index 7655572..f9361f1 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -499,6 +499,9 @@ subroutine initial case ( 3 ) if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & & 'Coil evaluations and field-line tracing will be performed.' + case ( 4 ) + if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & + & 'Coil evaluations and writing last surface will be performed.' case default FATAL( initial, .true., selected case_postproc is not supported ) end select diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 6250135..26e08a3 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -44,8 +44,8 @@ !latex #-----------2--permanent magnet--------------- !latex #coil_type coil_name !latex 2 dipole_01 -!latex # Lc ox oy oz mx my mz -!latex 1 1.0 0.0 0.0 0.0 1.0 0.0 +!latex # Lc ox oy oz Ic I mt mp +!latex 1 0.0 0.0 0.0 1 1.0E6 0.0 0.0 !latex #-----------3--backgound Bt Bz---------------- !latex #coil_type coil_name !latex 3 bg_BtBz_01 @@ -381,7 +381,7 @@ subroutine rdcoils allocate( coil(1:Ncoils*Npc) ) allocate( DoF(1:Ncoils*Npc) ) - num_per_array = 5 ! number of dipoles at each toroidal cross-section + num_per_array = 16 ! number of dipoles at each toroidal cross-section num_tor = (Ncoils-1)/num_per_array ! number of toroidal arrangements if (myid == 0) then @@ -449,9 +449,17 @@ subroutine rdcoils !!$ coil(icoil)%my = - init_current * sin(teta) * sin(zeta) !!$ coil(icoil)%mz = init_current * cos(teta) - ! poloidal and toroidal angle; in toroidal direction + ! poloidal and toroidal angle; in poloidal direction coil(icoil)%mt = -teta coil(icoil)%mp = zeta +!!$ +!!$ ! inward direction +!!$ coil(icoil)%mt = teta + half * pi +!!$ coil(icoil)%mp = zeta + pi +!!$ +!!$ ! toroidal direction +!!$ coil(icoil)%mt = half * pi +!!$ coil(icoil)%mp = zeta + half * pi enddo ! enddo ipol enddo ! enddo itor From f00631a56298a5a0963705b7c4f0835dd1251d1f Mon Sep 17 00:00:00 2001 From: Samuel Lazerson Date: Thu, 17 Jan 2019 08:36:40 -0500 Subject: [PATCH 09/72] Fixed bug in mapcoil where itype 2 and 3 would bomb. --- sources/rdcoils.h | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 6250135..ce24eff 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -615,8 +615,10 @@ subroutine mapcoil Foucoil(icoil+ip*Ncoils)%ys = Foucoil(icoil)%ys * cosip(ip) + Foucoil(icoil)%xs * sinip(ip) Foucoil(icoil+ip*Ncoils)%zc = Foucoil(icoil)%zc Foucoil(icoil+ip*Ncoils)%zs = Foucoil(icoil)%zs + case( 2 ) + case( 3 ) case default - FATAL(discoil, .true., not supported coil types) + FATAL(mapcoil, .true., not supported coil types) end select enddo From 25be932404fa120c0bd616e738d605088f289825 Mon Sep 17 00:00:00 2001 From: Samuel Lazerson Date: Thu, 17 Jan 2019 09:31:56 -0500 Subject: [PATCH 10/72] Additional bugfix for NFP/=1 --- sources/rdcoils.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sources/rdcoils.h b/sources/rdcoils.h index ce24eff..a3612fb 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -498,6 +498,8 @@ subroutine rdcoils SALLOCATE( FouCoil(icoil+ip*Ncoils)%ys, (0:NF), zero ) SALLOCATE( FouCoil(icoil+ip*Ncoils)%zc, (0:NF), zero ) SALLOCATE( FouCoil(icoil+ip*Ncoils)%zs, (0:NF), zero ) + case( 2 ) + case( 3 ) case default FATAL(discoil, .true., not supported coil types) end select From bd86c6758d09bbcfe202e681896650a26746be1b Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 22 Jan 2019 10:37:20 -0500 Subject: [PATCH 11/72] dipoles only change direction --- sources/bfield.h | 53 +++++++++------------ sources/bmnharm.h | 34 +++++++------- sources/boozer.h | 2 +- sources/datalloc.h | 13 +++-- sources/diagnos.h | 4 +- sources/globals.h | 6 ++- sources/packdof.h | 15 +++--- sources/poinplot.h | 66 ++++++++++++++------------ sources/saving.h | 115 +++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 216 insertions(+), 92 deletions(-) diff --git a/sources/bfield.h b/sources/bfield.h index 231ec8c..5d9967e 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -213,42 +213,33 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) mx = sint*cosp ; my = sint*sinp ; mz = cost m_dot_r = mx*dlx + my*dly + mz*dlz - Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 - By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 - Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 - - Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 - By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 - Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 - - Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 - By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 - Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 - - -!!$ Bx(1, 4) = 3.0_dp*dlx*dlx*rm5 - rm3 -!!$ By(1, 4) = 3.0_dp*dlx*dly*rm5 -!!$ Bz(1, 4) = 3.0_dp*dlx*dlz*rm5 +!!$ Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 +!!$ By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 +!!$ Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 +!!$ +!!$ Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 +!!$ By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 +!!$ Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 !!$ -!!$ Bx(1, 5) = 3.0_dp*dly*dlx*rm5 -!!$ By(1, 5) = 3.0_dp*dly*dly*rm5 - rm3 -!!$ Bz(1, 5) = 3.0_dp*dly*dlz*rm5 +!!$ Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 +!!$ By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 +!!$ Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 !!$ -!!$ Bx(1, 6) = 3.0_dp*dlz*dlx*rm5 -!!$ By(1, 6) = 3.0_dp*dlz*dly*rm5 -!!$ Bz(1, 6) = 3.0_dp*dlz*dlz*rm5 - rm3 +!!$ Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 +!!$ By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 +!!$ Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 !!$ -!!$ Bx = Bx * bsconstant -!!$ By = By * bsconstant -!!$ Bz = Bz * bsconstant +!!$ Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 +!!$ By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 +!!$ Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 - By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 - Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 + By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 + Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 - Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 - By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 - Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 + By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 + Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 Bx = Bx * coil(icoil)%I * bsconstant By = By * coil(icoil)%I * bsconstant diff --git a/sources/bmnharm.h b/sources/bmnharm.h index 4f84c9a..48612d8 100644 --- a/sources/bmnharm.h +++ b/sources/bmnharm.h @@ -165,23 +165,23 @@ SUBROUTINE readBmn endif case_bnormal = 0 - !-------------------------store trig functions------------------------------------------- - SALLOCATE( carg, (1:Nteta*Nzeta, 1:NBmn), zero ) - SALLOCATE( sarg, (1:Nteta*Nzeta, 1:NBmn), zero ) - - Bmnin(1:NBmn) = Bmnin(1:NBmn) * Nfp_raw - - ij = 0 - do jj = 0, Nzeta-1 ; zeta = ( jj + half ) * pi2 / (Nzeta*Nfp) ! the same as in rdsurf.h - do ii = 0, Nteta-1 ; teta = ( ii + half ) * pi2 / Nteta - ij = ij + 1 - do imn = 1, NBmn - arg = Bmnim(imn) * teta - Bmnin(imn) * zeta - carg(ij, imn) = cos(arg) - sarg(ij, imn) = sin(arg) - enddo - enddo - enddo + !-------------------------store trig functions------------------------------------------- + SALLOCATE( carg, (1:Nteta*Nzeta, 1:NBmn), zero ) + SALLOCATE( sarg, (1:Nteta*Nzeta, 1:NBmn), zero ) + + Bmnin(1:NBmn) = Bmnin(1:NBmn) * Nfp_raw + + ij = 0 + do jj = 0, Nzeta-1 ; zeta = ( jj + half ) * pi2 / (Nzeta*Nfp) ! the same as in rdsurf.h + do ii = 0, Nteta-1 ; teta = ( ii + half ) * pi2 / Nteta + ij = ij + 1 + do imn = 1, NBmn + arg = Bmnim(imn) * teta - Bmnin(imn) * zeta + carg(ij, imn) = cos(arg) + sarg(ij, imn) = sin(arg) + enddo + enddo + enddo return END SUBROUTINE readBmn diff --git a/sources/boozer.h b/sources/boozer.h index b5ef404..3f3c639 100644 --- a/sources/boozer.h +++ b/sources/boozer.h @@ -11,7 +11,7 @@ subroutine last_surface !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - call wtmgrid + ! call wtmgrid call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; tor_num = 360 ! toroidal planes number diff --git a/sources/datalloc.h b/sources/datalloc.h index bc0906f..24dd3ec 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -33,7 +33,7 @@ subroutine AllocData(itype) SALLOCATE(DoF(icoil)%yof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%zof , (0:coil(icoil)%NS-1, 1:ND), zero) case(2) - DoF(icoil)%ND = coil(icoil)%Lc * 5 ! number of DoF for permanent magnet + DoF(icoil)%ND = coil(icoil)%Lc * 2 ! 5 ! number of DoF for permanent magnet SALLOCATE(DoF(icoil)%xdof, (1:DoF(icoil)%ND), zero) case(3) DoF(icoil)%ND = coil(icoil)%Lc * 1 ! number of DoF for background Bt, Bz @@ -92,9 +92,12 @@ subroutine AllocData(itype) if(coil(icoil)%Lc /= 0) then xtmp = max(one, sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ) ! origin position mtmp = max(one, sqrt( coil(icoil)%mp**2 + coil(icoil)%mt**2 ) ) ! moment orentation - dofnorm(idof+1:idof+3) = xtmp - dofnorm(idof+4:idof+5) = mtmp - idof = idof + 5 +!!$ dofnorm(idof+1:idof+3) = xtmp +!!$ dofnorm(idof+4:idof+5) = mtmp +!!$ idof = idof + 5 + + dofnorm(idof+1:idof+2) = mtmp + idof = idof + 2 endif else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field if(coil(icoil)%Ic /= 0) then @@ -122,6 +125,8 @@ subroutine AllocData(itype) enddo !end do icoil; FATAL( AllocData , idof .ne. Ndof, counting error in unpacking ) + dofnorm = one + endif !--------------------------------------------------------------------------------------------- diff --git a/sources/diagnos.h b/sources/diagnos.h index 9e0acfe..74f8f47 100644 --- a/sources/diagnos.h +++ b/sources/diagnos.h @@ -163,9 +163,11 @@ SUBROUTINE diagnos if (allocated(surf(1)%bn)) then ! \sum{ |Bn| / |B| }/ (Nt*Nz) if(myid .eq. 0) write(ounit, '(8X": Average relative absolute Bn error is :" ES23.15)') & - sum(abs(surf(1)%bn/sqrt(surf(1)%Bx**2 + surf(1)%By**2 + surf(1)%Bz**2))) / (Nzeta*Nzeta) + sum(abs(surf(1)%bn/sqrt(surf(1)%Bx**2 + surf(1)%By**2 + surf(1)%Bz**2))) / (Nteta*Nzeta) endif + return + !--------------------------------calculate coil importance------------------------------------ if (.not. allocated(coil_importance)) then SALLOCATE( coil_importance, (1:Ncoils*Npc), zero ) diff --git a/sources/globals.h b/sources/globals.h index c38dfa4..9210497 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.6.02' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.01' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -145,7 +145,8 @@ module globals INTEGER :: save_freq = 1 INTEGER :: save_coils = 0 INTEGER :: save_harmonics = 0 - INTEGER :: save_filaments = 0 + INTEGER :: save_filaments = 0 + INTEGER :: update_plasma = 0 REAL :: pp_phi = 0.000D+00 REAL :: pp_raxis = 0.000D+00 @@ -215,6 +216,7 @@ module globals save_coils , & save_harmonics , & save_filaments , & + update_plasma , & pp_phi , & pp_raxis , & pp_zaxis , & diff --git a/sources/packdof.h b/sources/packdof.h index 0c04efb..5df44b5 100644 --- a/sources/packdof.h +++ b/sources/packdof.h @@ -211,9 +211,12 @@ SUBROUTINE packcoil case(2) idof = 0 if(coil(icoil)%Lc /= 0) then - DoF(icoil)%xdof(idof+1:idof+5) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & - coil(icoil)%mt, coil(icoil)%mp /) - idof = idof + 5 +!!$ DoF(icoil)%xdof(idof+1:idof+5) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & +!!$ coil(icoil)%mt, coil(icoil)%mp /) +!!$ idof = idof + 5 + + DoF(icoil)%xdof(idof+1:idof+2) = (/ coil(icoil)%mt, coil(icoil)%mp /) + idof = idof + 2 endif FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- @@ -275,9 +278,9 @@ SUBROUTINE unpackcoil case(2) idof = 0 if(coil(icoil)%Lc /= 0) then - coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + !coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + !coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + !coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%mt = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%mp = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 endif diff --git a/sources/poinplot.h b/sources/poinplot.h index 0855062..c460e1b 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -12,7 +12,7 @@ SUBROUTINE poinplot INTEGER :: ierr, astat, iflag INTEGER :: ip, is, niter - REAL :: theta, zeta, r, x, y, z, RZ(2), r1, z1, rzrzt(5) + REAL :: theta, zeta, r, RZ(2), r1, z1, rzrzt(5), x, y, z, tmpB(4) REAL, ALLOCATABLE :: lppr(:,:), lppz(:,:), liota(:) ! local ppr ppz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -30,12 +30,17 @@ SUBROUTINE poinplot pp_raxis = (r+r1)*half pp_zaxis = (z+z1)*half + + if (myid == 0) then + RZ(1) = pp_raxis ; RZ(2) = pp_zaxis + call find_axis(RZ, pp_maxiter, pp_xtol) + pp_raxis = RZ(1) ; pp_zaxis = RZ(2) + + RlBCAST( pp_raxis, 1, 0 ) + RlBCAST( pp_zaxis, 1, 0 ) + endif endif - - ! calculate axis - RZ(1) = pp_raxis ; RZ(2) = pp_zaxis - call find_axis(RZ, pp_maxiter, pp_xtol) - pp_raxis = RZ(1) ; pp_zaxis = RZ(2) + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; ! poincare plot and calculate iota SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) @@ -47,8 +52,9 @@ SUBROUTINE poinplot ! if pp_rmax and pp_zmax not provied if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then - pp_rmax = r*1.0 - pp_zmax = z*1.0 + zeta = pp_phi + theta = zero ; call surfcoord( theta, zeta, r , z ) + pp_rmax = r*1.0 ; pp_zmax = z*1.0 endif if(myid==0) write(ounit, '("poinplot: following fieldlines between ("ES12.5 & @@ -119,27 +125,27 @@ SUBROUTINE find_axis(RZ, MAXFEV, XTOL) allocate(fjac(ldfjac,n)) allocate(r(lr)) - call hybrd(axis_fcn,n, RZ,fvec,xtol,maxfev,ml,mu,epsfcn,diag, & + call hybrd(axis_fcn,n,RZ,fvec,xtol,maxfev,ml,mu,epsfcn,diag, & mode,factor,nprint,info,nfev,fjac,ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) - if (myid==0) then - write(ounit,'("findaxis: Finding axis at phi = "ES12.5" with (R,Z) = ( "ES12.5,","ES12.5" ).")') & - pp_phi, RZ(1), RZ(2) - select case (info) - case (0) - write(ounit,'("findaxis: info=0, improper input parameters.")') - case (1) - write(ounit,'("findaxis: info=1, relative error between two consecutive iterates is at most xtol.")') - case (2) - write(ounit,'("findaxis: info=2, number of calls to fcn has reached or exceeded maxfev.")') - case (3) - write(ounit,'("findaxis: info=3, xtol is too small.")') - case (4) - write(ounit,'("findaxis: info=4, iteration is not making good progress, jacobian.")') - case (5) - write(ounit,'("findaxis: info=5, iteration is not making good progress, function.")') - end select - endif + write(ounit,'("findaxis: Finding axis at phi = "ES12.5" with (R,Z) = ( "ES12.5,","ES12.5" ).")') & + pp_phi, RZ(1), RZ(2) + select case (info) + case (0) + write(ounit,'("findaxis: info=0, improper input parameters.")') + case (1) + write(ounit,'("findaxis: info=1, relative error between two consecutive iterates is at most xtol.")') + case (2) + write(ounit,'("findaxis: info=2, number of calls to fcn has reached or exceeded maxfev.")') + case (3) + write(ounit,'("findaxis: info=3, xtol is too small.")') + case (4) + write(ounit,'("findaxis: info=4, iteration is not making good progress, jacobian.")') + case (5) + write(ounit,'("findaxis: info=5, iteration is not making good progress, function.")') + case default + write(ounit,'("findaxis: info="I2", something wrong with the axis finding subroutine.")') info + end select return @@ -167,7 +173,7 @@ SUBROUTINE axis_fcn(n,x,fvec,iflag) rz_end = x call ode( BRpZ, n, rz_end, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) - if ( ifail /= 2 .and. myid == 0) then + if ( ifail /= 2 ) then if ( IsQuiet < 0 ) then write ( ounit, '(A,I3)' ) 'axis_fcn: ODE solver ERROR; returned IFAIL = ', ifail select case ( ifail ) @@ -212,7 +218,7 @@ SUBROUTINE ppiota(rzrzt,iflag) phi_stop = pp_phi + pi2/Nfp_raw call ode( BRpZ_iota, n, rzrzt, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) - if ( ifail /= 2 .and. myid == 0) then + if ( ifail /= 2 ) then if ( IsQuiet < -1 ) then write ( ounit, '(A,I3)' ) 'ppiota : ODE solver ERROR; returned IFAIL = ', ifail select case ( ifail ) @@ -324,7 +330,7 @@ subroutine coils_bfield(s, x,y,z) !--------------------------------------------------------------------------------------------- case default - FATAL(bfield0, .true., not supported coil types) + FATAL(coils_bfield, .true., not supported coil types) end select s(1) = s(1) + Bx diff --git a/sources/saving.h b/sources/saving.h index 5862b0b..5b18e54 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -135,6 +135,7 @@ subroutine saving HWRITERA( Nteta,Nzeta , nx , surf(1)%nx(0:Nteta-1,0:Nzeta-1) ) HWRITERA( Nteta,Nzeta , ny , surf(1)%ny(0:Nteta-1,0:Nzeta-1) ) HWRITERA( Nteta,Nzeta , nz , surf(1)%nz(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , nn , surf(1)%ds(0:Nteta-1,0:Nzeta-1) ) if (allocated(bn)) then HWRITERA( Nteta,Nzeta , plas_Bn , surf(1)%pb(0:Nteta-1,0:Nzeta-1) ) @@ -308,7 +309,121 @@ subroutine saving !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + if (Update_plasma == 1 ) call write_plasma + return end subroutine saving + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +SUBROUTINE write_plasma +!-------------------------------------------------------------------------------! +! write down the unpdated plasma boundary information; ! +! CZHU; first version: 2017/01/11; last revised: 2017/01/11 ! +!-------------------------------------------------------------------------------! + use globals, only : dp, zero, half, two, pi2, myid, ncpu, ounit, wunit, ext, & + Nfou, Nfp, NBnf, bim, bin, Bnim, Bnin, Rbc, Rbs, Zbc, Zbs, Bnc, Bns, & + Nteta, Nzeta, surf, Nfp_raw, bnorm, sqrtmachprec + + implicit none + include "mpif.h" + + !------------------------------------------------------------------------------- + INTEGER :: mf, nf ! predefined Fourier modes size + INTEGER :: imn=0, ii, jj, im, in, astat, ierr, maxN, maxM + REAL :: teta, zeta, arg, tol, tmpc, tmps + !------------------------------------------------------------------------------- + + mf = 24 ; nf = 24 + FATAL(bnftran, mf .le. 0 .and. nf .le. 0, INVALID size for Fourier harmonics) + + tmpc = zero ; tmps = zero + + if (bnorm .gt. sqrtmachprec ) then + tol = 1.0E-8 * bnorm + else + tol = 1.0E-8 + endif + + if(myid .ne. 0) return + + if(Nbnf .gt. 0) then ! if there is input Bn target + DALLOCATE(bnim) + DALLOCATE(bnin) + DALLOCATE(bnc ) + DALLOCATE(bns ) + endif + + Nbnf = (mf+1)*(2*nf+1) ! (0:mf)*(-nf:nf) + + SALLOCATE( bnim, (1:Nbnf), 0 ) + SALLOCATE( bnin, (1:Nbnf), 0 ) + SALLOCATE( bnc , (1:Nbnf), zero ) + SALLOCATE( bns , (1:Nbnf), zero ) + + imn = 0 + do in = -nf, nf + do im = 0, mf + + tmpc = zero ; tmps = zero + do ii = 0, Nteta-1 + teta = ( ii + half ) * pi2 / Nteta + do jj = 0, Nzeta-1 + zeta = ( jj + half ) * pi2 / Nzeta + + arg = im*teta - in*Nfp_raw*zeta + tmpc = tmpc + surf(1)%bn(ii,jj)*cos(arg) + tmps = tmps + surf(1)%bn(ii,jj)*sin(arg) + + enddo ! end jj + enddo ! end ii + + if ( (abs(tmpc) + abs(tmps)) .lt. tol ) cycle + + imn = imn + 1 + bnin(imn) = in * Nfp_raw ; bnim(imn) = im + + if (im .eq. 0 ) then + tmpc = tmpc*half + tmps = tmps*half + endif + bnc(imn) = tmpc + bns(imn) = tmps + + enddo ! end im + enddo ! end in + + Nbnf = imn + + bnc = bnc * two / (Nteta*Nzeta) + bns = bns * two / (Nteta*Nzeta) + !---------------------------------------------- + + + open(wunit, file=trim(ext)//".plasma", status='unknown', action='write') + + write(wunit,* ) "#Nfou Nfp Nbnf" + write(wunit,'(3I)' ) Nfou, Nfp_raw, Nbnf + + write(wunit,* ) "#------- plasma boundary------" + write(wunit,* ) "# n m Rbc Rbs Zbc Zbs" + do imn = 1, Nfou + write(wunit,'(2I, 4ES15.6)') bin(imn)/Nfp_raw, bim(imn), Rbc(imn), Rbs(imn), Zbc(imn), Zbs(imn) + enddo + + write(wunit,* ) "#-------Bn harmonics----------" + write(wunit,* ) "# n m bnc bns" + if (Nbnf .gt. 0) then + do imn = 1, Nbnf + write(wunit,'(2I, 2ES15.6)') bnin(imn)/Nfp_raw, bnim(imn), bnc(imn), bns(imn) + enddo + else + write(wunit,'(2I, 2ES15.6)') 0, 0, 0.0, 0.0 + endif + + close(wunit) +END SUBROUTINE write_plasma + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!- From 24014723714e84d98b168d3ddaeda3a591723593 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Fri, 8 Feb 2019 11:53:41 -0500 Subject: [PATCH 12/72] allow dipole position to vary --- sources/bfield.h | 50 +++++++++++++++++++++++----------------------- sources/datalloc.h | 14 ++++++------- sources/packdof.h | 18 ++++++++--------- 3 files changed, 41 insertions(+), 41 deletions(-) diff --git a/sources/bfield.h b/sources/bfield.h index 5d9967e..f6aa570 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -213,33 +213,33 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) mx = sint*cosp ; my = sint*sinp ; mz = cost m_dot_r = mx*dlx + my*dly + mz*dlz -!!$ Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 -!!$ By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 -!!$ Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 -!!$ -!!$ Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 -!!$ By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 -!!$ Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 -!!$ -!!$ Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 -!!$ By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 -!!$ Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 -!!$ -!!$ Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 -!!$ By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 -!!$ Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 -!!$ -!!$ Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 -!!$ By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 -!!$ Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 + By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 + Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 - Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 - By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 - Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 + By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 + Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 - Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 - By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 - Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 + By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 + Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 + + Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 + By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 + Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + + Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 + By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 + Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 +!!$ +!!$ Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 +!!$ By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 +!!$ Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 +!!$ +!!$ Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 +!!$ By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 +!!$ Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 Bx = Bx * coil(icoil)%I * bsconstant By = By * coil(icoil)%I * bsconstant diff --git a/sources/datalloc.h b/sources/datalloc.h index 24dd3ec..7f927ef 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -33,7 +33,7 @@ subroutine AllocData(itype) SALLOCATE(DoF(icoil)%yof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%zof , (0:coil(icoil)%NS-1, 1:ND), zero) case(2) - DoF(icoil)%ND = coil(icoil)%Lc * 2 ! 5 ! number of DoF for permanent magnet + DoF(icoil)%ND = coil(icoil)%Lc * 5 ! number of DoF for permanent magnet SALLOCATE(DoF(icoil)%xdof, (1:DoF(icoil)%ND), zero) case(3) DoF(icoil)%ND = coil(icoil)%Lc * 1 ! number of DoF for background Bt, Bz @@ -92,12 +92,12 @@ subroutine AllocData(itype) if(coil(icoil)%Lc /= 0) then xtmp = max(one, sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ) ! origin position mtmp = max(one, sqrt( coil(icoil)%mp**2 + coil(icoil)%mt**2 ) ) ! moment orentation -!!$ dofnorm(idof+1:idof+3) = xtmp -!!$ dofnorm(idof+4:idof+5) = mtmp -!!$ idof = idof + 5 - - dofnorm(idof+1:idof+2) = mtmp - idof = idof + 2 + dofnorm(idof+1:idof+3) = xtmp + dofnorm(idof+4:idof+5) = mtmp + idof = idof + 5 +!!$ +!!$ dofnorm(idof+1:idof+2) = mtmp +!!$ idof = idof + 2 endif else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field if(coil(icoil)%Ic /= 0) then diff --git a/sources/packdof.h b/sources/packdof.h index 5df44b5..aa7eedd 100644 --- a/sources/packdof.h +++ b/sources/packdof.h @@ -211,12 +211,12 @@ SUBROUTINE packcoil case(2) idof = 0 if(coil(icoil)%Lc /= 0) then -!!$ DoF(icoil)%xdof(idof+1:idof+5) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & -!!$ coil(icoil)%mt, coil(icoil)%mp /) -!!$ idof = idof + 5 - - DoF(icoil)%xdof(idof+1:idof+2) = (/ coil(icoil)%mt, coil(icoil)%mp /) - idof = idof + 2 + DoF(icoil)%xdof(idof+1:idof+5) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & + coil(icoil)%mt, coil(icoil)%mp /) + idof = idof + 5 +!!$ +!!$ DoF(icoil)%xdof(idof+1:idof+2) = (/ coil(icoil)%mt, coil(icoil)%mp /) +!!$ idof = idof + 2 endif FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- @@ -278,9 +278,9 @@ SUBROUTINE unpackcoil case(2) idof = 0 if(coil(icoil)%Lc /= 0) then - !coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - !coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 - !coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 + coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%mt = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%mp = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 endif From 4d4964be1da7d91e850162c8bab6c1044165da7f Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 20 Mar 2019 16:13:33 -0400 Subject: [PATCH 13/72] Add B Fourier coefficients calculation in Boozer coordinates; some minor fixes. --- sources/boozer.h | 277 +++++++++++++++++++++++++++++++++++++++++---- sources/focus.h | 2 +- sources/globals.h | 9 +- sources/poinplot.h | 30 +++-- sources/rdcoils.h | 2 +- sources/saving.h | 7 +- 6 files changed, 293 insertions(+), 34 deletions(-) diff --git a/sources/boozer.h b/sources/boozer.h index 3f3c639..db22dbb 100644 --- a/sources/boozer.h +++ b/sources/boozer.h @@ -1,44 +1,281 @@ -subroutine last_surface - USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, total_num, pp_maxiter, XYZB +subroutine boozmn + USE globals, only : dp, myid, ncpu, zero, ounit, total_num, pp_maxiter, pp_ns, & + XYZB, lboozmn, bmin, bmim, booz_mnc, booz_mns, booz_mpol, booz_ntor, booz_mn, nfp_raw USE mpi IMPLICIT NONE - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + ! allocate data for following calculations + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, iflag - INTEGER :: tor_num - REAL :: theta, zeta, r, x, y, z - + INTEGER :: tor_num, in, im, imn !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - ! call wtmgrid call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; + FATAL( boozmn_01, booz_mpol < 0, invalid poloidal mode resolution ) + FATAL( boozmn_02, booz_ntor < 0, invalid toroidal mode resolution ) + + lboozmn = .true. ! turn on boozmn tor_num = 360 ! toroidal planes number - total_num = pp_maxiter * tor_num + total_num = pp_maxiter * tor_num ! total data points per line + + booz_mpol = 16 ; booz_ntor = 32 + booz_mn = booz_mpol*(2*booz_ntor+1) + (booz_ntor+1) ! (1:M, -N:N) + (0, 0:N) + SALLOCATE( bmin, (1:booz_mn), 0) + SALLOCATE( bmim, (1:booz_mn), 0) + SALLOCATE( booz_mnc, (1:booz_mn, 1:pp_ns), zero) + SALLOCATE( booz_mns, (1:booz_mn, 1:pp_ns), zero) + SALLOCATE( XYZB, (1:total_num, 1:4, 1:pp_ns), zero) + + ! prepare bmin & bmim + imn = 0 + do im = 0, booz_mpol + do in = -booz_ntor, booz_ntor + if ( im==0 .and. in<0 ) cycle + imn = imn + 1 + bmim(imn) = im + bmin(imn) = in !*Nfp_raw + enddo + enddo + + FATAL( boozmn_03, imn .ne. booz_mn, packing error ) - SALLOCATE( XYZB, (1:total_num, 1:4), zero) +end subroutine boozmn - ! starting point - theta = zero ; zeta = zero - call surfcoord( theta, zeta, r, z) - x = r*cos(zeta) - y = r*sin(zeta) - - if ( myid /= 0 ) return +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - write(ounit, '("poincare: starting filed line tracing at x="F5.2, ", y="F5.2, ", z="F5.2)') x, y, z +subroutine boozsurf(XYZB, x, y, z, iota, isurf) + USE globals, only : dp, myid, ncpu, zero, half, two, pi, pi2, ounit, total_num, pp_maxiter, & + bmin, bmim, booz_mnc, booz_mns, booz_mn, machprec + USE mpi + IMPLICIT NONE + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + REAL, dimension(total_num, 4) :: XYZB ! XYZB on one surface + REAL , intent( in) :: x, y, z ! starting point + REAL , intent( in) :: iota ! calculated iota + INTEGER, intent( in) :: isurf ! fieldline ordering + + INTEGER :: ierr, astat, iflag + INTEGER :: i, imn, tor_num, pol_num, iteta, jzeta + REAL,dimension(total_num) :: chi, zeta, teta + REAL :: Gpol, ang, dteta, dzeta + INTEGER, allocatable :: weight(:,:) + REAL, allocatable :: Btz(:,:) + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + ! write(ounit, '("poincare: starting filed line tracing at x="F5.2, ", y="F5.2, ", z="F5.2)') x, y, z ! filedline tracing - call fieldline_tracing(x,y,z,total_num,pp_maxiter,XYZB) + call fieldline_tracing(x, y, z, total_num, pp_maxiter, XYZB(1:total_num, 1:4)) + + ! calculate chi = \int B dl + chi = zero + do i = 2, total_num + chi(i) = chi(i-1) + (XYZB(i, 4) + XYZB(i-1, 4))*half & + * sqrt( (XYZB(i, 1) - XYZB(i-1, 1))**2 & + + (XYZB(i, 2) - XYZB(i-1, 2))**2 & + + (XYZB(i, 3) - XYZB(i-1, 3))**2 ) + enddo + + ! calculate poloidal current Gpol = \int \vetc{B} \cdot d \zeta + ! Gpol = 2.0E-7 * total_current + Gpol = chi(total_num) / (pi2*pp_maxiter) + FATAL(booz_04 , abs(Gpol) < machprec, zero external poloidal currents) + +!!$ ! Fourier decomposition +!!$ do imn = 1, booz_mn +!!$ +!!$ do i = 1, total_num +!!$ ang = (bmin(imn) - bmim(imn)*abs(iota))/Gpol * chi(i) +!!$ booz_mnc(imn, isurf) = booz_mnc(imn, isurf) + XYZB(i, 4) * cos(ang) +!!$ booz_mns(imn, isurf) = booz_mns(imn, isurf) + XYZB(i, 4) * sin(ang) +!!$ enddo +!!$ +!!$ if ( bmim(imn) == 0 .and. bmin(imn) == 0 ) then +!!$ booz_mnc(imn, isurf) = booz_mnc(imn, isurf) * half +!!$ booz_mns(imn, isurf) = booz_mns(imn, isurf) * half +!!$ endif +!!$ enddo +!!$ +!!$ booz_mnc(1:booz_mn, isurf) = booz_mnc(1:booz_mn, isurf) * two / total_num +!!$ booz_mns(1:booz_mn, isurf) = booz_mns(1:booz_mn, isurf) * two / total_num + + + ! Boozer angles + zeta = mod(chi/Gpol , pi2) + teta = mod(chi/Gpol*abs(iota), pi2) + + ! map back to two dimensional grid + ! tor_num = total_num/pp_maxiter + ! pol_num = pp_maxiter + tor_num = 256 + pol_num = 128 + SALLOCATE( Btz , (0:pol_num, 0:tor_num), zero ) + SALLOCATE( weight, (0:pol_num, 0:tor_num), 0 ) + dzeta = pi2/tor_num + dteta = pi2/pol_num + do i = 1, total_num + iteta = int(teta(i)/dteta) + jzeta = int(zeta(i)/dzeta) + Btz(iteta, jzeta) = Btz(iteta, jzeta) + XYZB(i, 4) + weight(iteta, jzeta) = weight(iteta, jzeta) + 1 + enddo + + ! Fourier decomposition + do jzeta = 0, tor_num-1 + do iteta = 0, pol_num-1 + ! weight(iteta, jzeta) = max(weight(iteta, jzeta), 1) ! avoida dividing zero + if ( weight(iteta,jzeta) /= 0) Btz(iteta,jzeta) = Btz(iteta,jzeta) / weight(iteta,jzeta) + do imn = 1, booz_mn + ang = bmim(imn) * iteta*dteta - bmin(imn) * jzeta*dzeta + booz_mnc(imn, isurf) = booz_mnc(imn, isurf) + Btz(iteta,jzeta) * cos(ang) + booz_mns(imn, isurf) = booz_mns(imn, isurf) + Btz(iteta,jzeta) * sin(ang) + enddo + enddo + enddo - write(ounit, '("poincare: Fieldline tracing finished")') + booz_mnc(1:booz_mn, isurf) = booz_mnc(1:booz_mn, isurf) * two / (tor_num*pol_num) + booz_mns(1:booz_mn, isurf) = booz_mns(1:booz_mn, isurf) * two / (tor_num*pol_num) + + imn = 1 + FATAL( boozer_05, bmim(imn) /= 0 .or. bmin(imn) /= 0, wrong mn initialization ) + booz_mnc(imn, isurf) = booz_mnc(imn, isurf) * half + booz_mns(imn, isurf) = booz_mns(imn, isurf) * half + + DALLOCATE( Btz ) + DALLOCATE( weight ) +!!$ +!!$ ! Fourier decomposition +!!$ do imn = 1, booz_mn +!!$ +!!$ booz_mnc(imn, isurf) = zero ; booz_mns(imn, isurf) = zero +!!$ +!!$ do i = 1, total_num +!!$ ang = bmim(imn) * teta(i) - bmin(imn) * zeta(i) +!!$ booz_mnc(imn, isurf) = booz_mnc(imn, isurf) + XYZB(i, 4) * cos(ang) +!!$ booz_mns(imn, isurf) = booz_mns(imn, isurf) + XYZB(i, 4) * sin(ang) +!!$ enddo +!!$ +!!$ if ( bmim(imn) == 0 .and. bmin(imn) == 0 ) then +!!$ booz_mnc(imn, isurf) = booz_mnc(imn, isurf) * half +!!$ booz_mns(imn, isurf) = booz_mns(imn, isurf) * half +!!$ endif +!!$ enddo +!!$ +!!$ booz_mnc(1:booz_mn, isurf) = booz_mnc(1:booz_mn, isurf) * two / total_num +!!$ booz_mns(1:booz_mn, isurf) = booz_mns(1:booz_mn, isurf) * two / total_num + + ! finish decomposition + + write(ounit, '("boozmn : myid="I6" ; Gpol="ES12.5" ; iota="ES12.5" ; Booz_mnc(1)="ES12.5 & + " ; Booz_mns(1)="ES12.5)') myid, Gpol, iota, booz_mnc(1, isurf), booz_mns(1, isurf) return -end subroutine last_surface +end subroutine boozsurf !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +SUBROUTINE Bmn_clt(phi_B,theta_B,B0,Bf) +implicit none + +real*8,dimension(300000,1):: B0,phi_B,theta_B +real*8,dimension(30,30)::Bf +real*8,dimension(60,60)::Bmn +real*8,dimension(30,60)::theta,phi,ang,Bf1 +real*8,dimension(61,61)::B1,n_B,B2 +real*8,dimension(30,1)::phi1 +real*8,dimension(1,60)::theta1 +integer*4 m,n,i,j,k,l +real*8 pi,s1,s2,s3,s4,B_mn,B_c,B_s, dteta, dzeta + +pi=3.141592653589793239 +m=60 +n=60 +dzeta = 2*pi/n +dteta = 2*pi/m + +do k=2,300000 + j=floor(theta_B(k,1)/(dzeta)) + i=floor(phi_B(k,1)/(dteta)) + + + s1=sqrt((theta_B(k,1)-dzeta* j )**2+(phi_B(k,1)-dteta* i )**2) + s2=sqrt((theta_B(k,1)-dzeta* j )**2+(phi_B(k,1)-dteta*(i+1))**2) + s3=sqrt((theta_B(k,1)-dzeta*(j+1))**2+(phi_B(k,1)-dteta*(i+1))**2) + s4=sqrt((theta_B(k,1)-dzeta*(j+1))**2+(phi_B(k,1)-dteta* i )**2) + i=i+1 + j=j+1 + + B1(i,j)=B1(i,j)+B0(k,1)/s1 + n_B(i,j)=n_B(i,j)+1/s1 + B1(i+1,j)=B1(i+1,j)+B0(k,1)/s2 + n_B(i+1,j)=n_B(i+1,j)+1/s2 + B1(i+1,j+1)=B1(i+1,j+1)+B0(k,1)/s3 + n_B(i+1,j+1)=n_B(i+1,j+1)+1/s3 + B1(i,j+1)=B1(i,j+1)+B0(k,1)/s4 + n_B(i,j+1)=n_B(i,j+1)+1/s4 +enddo +B1(1:m,1)=B1(1:m,1)+B1(1:m,n+1) +n_B(1:m,1)=n_B(1:m,1)+n_B(1:m,n+1) +B1(1,1:n)=B1(1,1:n)+B1(m+1,1:n) +n_B(1,1:n)=n_B(1,1:n)+n_B(m+1,1:n) +do i=1,m+1 +do j=1,n+1 + B2(i,j)=B1(i,j)/n_B(i,j) +enddo +enddo + +Bmn=B2(1:m,1:n) + + +do i=1,m/2 +phi1(i,1)=dteta*2*(i-1) +enddo + +do i=1,n +theta1(1,i)=dzeta*(i-1) +enddo + +do i=1,n +phi(:,i)=phi1(:,1) +enddo + +do i=1,m/2 +theta(i,:)=theta1(1,:) +enddo + + +do i=0,m/2-1 + do j=0,n-1 + ang=-i*Phi+j*Theta + B_mn=0 + B_c=0 + B_s=0 + do k=1,m/2 + do l=1,n + B_c=B_c+Bmn(k,l)*cos(ang(k,l)) + B_s=B_s+Bmn(k,l)*sin(ang(k,l)) + B_mn=sqrt(B_c**2+B_s**2)/float(n*m/2) + enddo + enddo + Bf1(i+1,j+1)=B_mn + ! write(*,*)B_mn + enddo +enddo + +Bf=Bf1(:,1:n/2)*2.0 +Bf(1,1)=Bf1(1,1) +return +end SUBROUTINE Bmn_clt + subroutine fieldline_tracing(x,y,z,imax,n2,H) implicit none integer*4 ::n2,imax,j,i diff --git a/sources/focus.h b/sources/focus.h index ff944d2..6b78ff4 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -178,7 +178,7 @@ PROGRAM focus case( 2 ) ; call diagnos ; call specinp !; call saving !case( 2 ) ; call saving ; call diagnos ; call wtmgrid ! write mgrid file; case( 3 ) ; call diagnos ; call poinplot ! Poincare plots; for future; - case( 4 ) ; call diagnos ; call last_surface ! Last closed surface + case( 4 ) ; call diagnos ; call boozmn ; call poinplot ! Last closed surface !case( 4 ) ; call saving ; call diagnos ; call resonant ! resonant harmonics analysis; for future; end select diff --git a/sources/globals.h b/sources/globals.h index 9210497..ebfad58 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.01' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.03' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -349,8 +349,11 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! ! fieldline tracing - REAL, ALLOCATABLE :: XYZB(:,:), ppr(:,:), ppz(:,:), iota(:) - INTEGER :: tor_num, total_num + REAL, ALLOCATABLE :: XYZB(:,:,:), ppr(:,:), ppz(:,:), iota(:) + INTEGER :: tor_num, total_num, booz_mpol, booz_ntor, booz_mn + LOGICAL :: lboozmn = .false. + INTEGER, ALLOCATABLE :: bmim(:), bmin(:) + REAL, ALLOCATABLE :: booz_mnc(:,:), booz_mns(:,:) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/poinplot.h b/sources/poinplot.h index c460e1b..3cd3bfd 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -4,14 +4,15 @@ SUBROUTINE poinplot ! Poincare plots of the vacuum flux surfaces and calculate the rotational transform !------------------------------------------------------------------------------------------------------ USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & - pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw + pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw, & + XYZB, lboozmn, booz_mnc, booz_mns, booz_mn, total_num USE mpi IMPLICIT NONE !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, iflag - INTEGER :: ip, is, niter + INTEGER :: ip, is, niter REAL :: theta, zeta, r, RZ(2), r1, z1, rzrzt(5), x, y, z, tmpB(4) REAL, ALLOCATABLE :: lppr(:,:), lppz(:,:), liota(:) ! local ppr ppz @@ -30,17 +31,17 @@ SUBROUTINE poinplot pp_raxis = (r+r1)*half pp_zaxis = (z+z1)*half + endif if (myid == 0) then RZ(1) = pp_raxis ; RZ(2) = pp_zaxis call find_axis(RZ, pp_maxiter, pp_xtol) pp_raxis = RZ(1) ; pp_zaxis = RZ(2) - - RlBCAST( pp_raxis, 1, 0 ) - RlBCAST( pp_zaxis, 1, 0 ) endif - endif + !endif call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; + RlBCAST( pp_raxis, 1, 0 ) + RlBCAST( pp_zaxis, 1, 0 ) ! poincare plot and calculate iota SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) @@ -77,16 +78,31 @@ SUBROUTINE poinplot ! FATAL( poinplot, abs((rzrzt(3)-pp_raxis)/pp_raxis)>pp_xtol, magnetic axis is not coming back ) enddo - liota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) + if (niter==0) then + liota(is) = zero + else + liota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) + endif write(ounit, '(8X": order="I6" ; myid="I6" ; (R,Z)=("ES12.5","ES12.5 & " ) ; iota="ES12.5" ; niter="I6" .")') is, myid, lppr(is,0), lppz(is,0), liota(is), niter + + if(lboozmn .and. abs(liota(is))>sqrtmachprec) then + x = lppr(is, 0) * cos(pp_phi) ; y = lppr(is, 0) * sin(pp_phi) ; z = lppz(is, 0) + call boozsurf( XYZB(1:total_num, 1:4, is), x, y, z, liota(is), is) + endif enddo call MPI_ALLREDUCE( lppr, ppr, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( lppz, ppz, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( liota, iota, pp_ns , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + if(lboozmn) then + call MPI_ALLREDUCE(MPI_IN_PLACE, XYZB, 4*pp_ns*total_num, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE(MPI_IN_PLACE, booz_mnc, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE(MPI_IN_PLACE, booz_mns, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + endif + DALLOCATE( lppz ) DALLOCATE( lppr ) DALLOCATE( liota ) diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 1a44ccf..4137ac5 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -201,7 +201,7 @@ subroutine rdcoils open( runit, file=trim(coilfile), status="old", action='read') read( runit,*) read( runit,*) Ncoils - write(ounit,'("rdcoils : identified "i3" unique coils in "A" ;")') Ncoils, coilfile + write(ounit,'("rdcoils : identified "i3" unique coils in "A" ;")') Ncoils, trim(coilfile) endif IlBCAST( Ncoils , 1, 0 ) diff --git a/sources/saving.h b/sources/saving.h index 5b18e54..a4e6b56 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -193,14 +193,17 @@ subroutine saving endif if (allocated(XYZB)) then - HWRITERA( total_num,4 , XYZB , XYZB(1:total_num, 1:4) ) + HWRITERC( total_num,4, pp_ns , XYZB , XYZB(1:total_num, 1:4, 1:pp_ns) ) + HWRITERA( booz_mn, pp_ns, booz_mnc , booz_mnc(1:booz_mn, 1:pp_ns) ) + HWRITERA( booz_mn, pp_ns, booz_mns , booz_mns(1:booz_mn, 1:pp_ns) ) + HWRITEIV( booz_mn, bmim , bmim(1:booz_mn) ) + HWRITEIV( booz_mn, bmin , bmin(1:booz_mn) ) endif HWRITERV( 1 , time_initialize, time_initialize ) HWRITERV( 1 , time_optimize , time_optimize ) HWRITERV( 1 , time_postproc , time_postproc ) - call h5fclose_f( file_id, hdfier ) ! terminate access; FATAL( restart, hdfier.ne.0, error calling h5fclose_f ) From 07eaa71d89d8a055e3ca22033e6cadcd3458e28a Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 26 Mar 2019 12:24:31 -0400 Subject: [PATCH 14/72] Fix optimization timing error --- sources/lmalg.h | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sources/lmalg.h b/sources/lmalg.h index f7ad6c4..adb5686 100644 --- a/sources/lmalg.h +++ b/sources/lmalg.h @@ -294,7 +294,7 @@ end subroutine lmalg !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! subroutine focus_fcn(m,n,x,fvec,fjac,ldfjac,iflag) - use globals, only: dp, zero, myid, ounit, tstart, tfinish, LM_iter, LM_maxiter, & + use globals, only: dp, zero, myid, ounit, LM_iter, LM_maxiter, & & exit_signal, LM_fvec, LM_fjac use mpi implicit none @@ -303,6 +303,7 @@ subroutine focus_fcn(m,n,x,fvec,fjac,ldfjac,iflag) INTEGER, INTENT(inout) :: iflag DOUBLE PRECISION, INTENT(in) :: x(n) DOUBLE PRECISION, INTENT(out) :: fvec(m),fjac(ldfjac,n) + REAL :: tstart, tfinish ! local variables INTEGER :: idof, ierr, astat call unpacking(x(1:n)) From 5703d551dc4e1d965346e83b48b18060443f92bf Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 27 Mar 2019 14:00:55 -0400 Subject: [PATCH 15/72] Add pre-processing flags to determine if varying dipole position; revise parameter normalization; minor fixes --- sources/Makefile | 6 +- sources/bfield.h | 20 ++++--- sources/congrad.h | 1 + sources/datalloc.h | 139 ++++++++++++++++++++++++++++----------------- sources/focus.h | 3 +- sources/globals.h | 6 +- sources/lmalg.h | 3 +- sources/packdof.h | 50 ++++++++-------- sources/rdcoils.h | 39 ------------- sources/rdsurf.h | 2 +- sources/saving.h | 2 + 11 files changed, 138 insertions(+), 133 deletions(-) diff --git a/sources/Makefile b/sources/Makefile index 250f924..e22e780 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -16,19 +16,19 @@ MACROS=macros CC=intel # if want to use gfortran; make CC=gfortran xfocus; otherwise using Intel FC=mpif90 + PFLAGS= # for pre-processing compiler flags, like -D dposition ifeq ($(CC),gfortran) # RFLAGS=-O3 -w -fdefault-real-8 -ffree-line-length-none -march=native -ffast-math - RFLAGS=-O3 -w -ffree-line-length-none -march=native -ffast-math + RFLAGS=-O3 -w -ffree-line-length-none -march=native -ffast-math $(PFLAGS) DFLAGS=-g3 -Wextra -Wtarget-lifetime -fbacktrace -fbounds-check -ffpe-trap=zero -fcheck=all -DDEBUG else # RFLAGS=-r8 -mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback #-vec_report0 #-ipo -xhost - RFLAGS=-mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback #-vec_report0 #-ipo -xhost + RFLAGS=-mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback $(PFLAGS) #-vec_report0 #-ipo -xhost DFLAGS=-check all -check noarg_temp_created -debug full -D DEBUG endif ############################################################################################################ - HDF5=-I$(HDF5_HOME)/include -L$(HDF5_HOME)/lib -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran \ -lhdf5 -lpthread -lz -lm diff --git a/sources/bfield.h b/sources/bfield.h index f6aa570..0bdd655 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -213,6 +213,8 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) mx = sint*cosp ; my = sint*sinp ; mz = cost m_dot_r = mx*dlx + my*dly + mz*dlz +#ifdef dposition + ! dipole position is variable Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 @@ -232,14 +234,16 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 -!!$ -!!$ Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 -!!$ By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 -!!$ Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 -!!$ -!!$ Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 -!!$ By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 -!!$ Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 +#else + ! dipole origins are fixed + Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 + By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 + Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + + Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 + By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 + Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 +#endif Bx = Bx * coil(icoil)%I * bsconstant By = By * coil(icoil)%I * bsconstant diff --git a/sources/congrad.h b/sources/congrad.h index 0ae0843..0195a2b 100644 --- a/sources/congrad.h +++ b/sources/congrad.h @@ -42,6 +42,7 @@ SUBROUTINE congrad REAL :: alpha, beta, f REAL, dimension(1:Ndof) :: lxdof, p, gradk, gradf + tfinish = MPI_Wtime() iter = 0 call packdof(lxdof(1:Ndof)) ! initial xdof; call getdf(lxdof, f, gradk) diff --git a/sources/datalloc.h b/sources/datalloc.h index 7f927ef..32d989b 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -12,7 +12,7 @@ subroutine AllocData(itype) INTEGER, intent(in) :: itype - INTEGER :: icoil, idof, ND, NF + INTEGER :: icoil, idof, ND, NF, icur, imag REAL :: xtmp, mtmp !------------------------------------------------------------------------------------------- @@ -33,7 +33,11 @@ subroutine AllocData(itype) SALLOCATE(DoF(icoil)%yof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%zof , (0:coil(icoil)%NS-1, 1:ND), zero) case(2) +#ifdef dposition DoF(icoil)%ND = coil(icoil)%Lc * 5 ! number of DoF for permanent magnet +#else + DoF(icoil)%ND = coil(icoil)%Lc * 2 ! number of DoF for permanent magnet +#endif SALLOCATE(DoF(icoil)%xdof, (1:DoF(icoil)%ND), zero) case(3) DoF(icoil)%ND = coil(icoil)%Lc * 1 ! number of DoF for background Bt, Bz @@ -62,70 +66,101 @@ subroutine AllocData(itype) endif SALLOCATE( xdof, (1:Ndof), zero ) ! dof vector; - SALLOCATE( dofnorm, (1:Ndof), zero ) ! dof normalized value vector; + SALLOCATE( dofnorm, (1:Ndof), one ) ! dof normalized value vector; SALLOCATE( evolution, (1:Nouts+1, 0:7), zero ) !evolution array; SALLOCATE( coilspace, (1:Nouts+1, 1:Tdof), zero ) ! all the coil parameters; - idof = 0 - do icoil = 1, Ncoils - - if(coil(icoil)%itype == 1) then ! Fourier representation - if(coil(icoil)%Ic /= 0) then - dofnorm(idof+1) = Inorm - idof = idof + 1 + ! determine dofnorm + if ( IsNormalize > 0 ) then + ! calculate Inorm and Gnorm + Inorm = zero ; Mnorm = zero + icur = 0 ; imag = 0 ! icur for coil current count, imag for dipole count + do icoil = 1, Ncoils + if(coil(icoil)%itype == 1 .or. coil(icoil)%itype == 3 ) then + ! Fourier representation or central currents + Inorm = Inorm + coil(icoil)%I**2 + icur = icur + 1 + else if (coil(icoil)%itype == 2) then + ! permanent dipole + Mnorm = Mnorm + coil(icoil)%I**2 + imag = imag + 1 endif + enddo + Gnorm = (surf(1)%vol/(pi*pi2))**(one/three) ! Gnorm is a hybrid of major and minor radius + Gnorm = Gnorm * weight_gnorm + + icur = max(1, icur) ; imag = max(1, imag) ! avoid dividing zero + Inorm = sqrt(Inorm/icur) * weight_inorm ! quadratic mean + Mnorm = sqrt(Mnorm/imag) * weight_mnorm ! quadratic mean + + if (abs(Gnorm) < machprec) Gnorm = one + if (abs(Inorm) < machprec) Inorm = one + if (abs(Mnorm) < machprec) Mnorm = one - ND = DoF(icoil)%ND - if(coil(icoil)%Lc /= 0) then - dofnorm(idof+1:idof+ND) = Gnorm - idof = idof + ND + if (IsQuiet<1) then + if (myid==0) then + write(ounit, '(8X": Parameter normalizations : "3(A6, ES12.5, 2X))') & + 'Inorm=', Inorm, 'Gnorm=', Gnorm, 'Mnorm=', Mnorm endif - else if (coil(icoil)%itype == 2) then ! permanent magnets - if(coil(icoil)%Ic /= 0) then - if(abs(coil(icoil)%I) > sqrtmachprec) then - dofnorm(idof+1) = coil(icoil)%I - else - dofnorm(idof+1) = one + endif + + ! construct dofnorm + idof = 0 + do icoil = 1, Ncoils + + if(coil(icoil)%itype == 1) then ! Fourier representation + if(coil(icoil)%Ic /= 0) then + dofnorm(idof+1) = Inorm + idof = idof + 1 endif - idof = idof + 1 - endif - if(coil(icoil)%Lc /= 0) then - xtmp = max(one, sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ) ! origin position - mtmp = max(one, sqrt( coil(icoil)%mp**2 + coil(icoil)%mt**2 ) ) ! moment orentation - dofnorm(idof+1:idof+3) = xtmp - dofnorm(idof+4:idof+5) = mtmp - idof = idof + 5 -!!$ -!!$ dofnorm(idof+1:idof+2) = mtmp -!!$ idof = idof + 2 - endif - else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field - if(coil(icoil)%Ic /= 0) then - if(abs(coil(icoil)%I) > sqrtmachprec) then - dofnorm(idof+1) = coil(icoil)%I - else - dofnorm(idof+1) = one + + ND = DoF(icoil)%ND + if(coil(icoil)%Lc /= 0) then + dofnorm(idof+1:idof+ND) = Gnorm + idof = idof + ND + endif + else if (coil(icoil)%itype == 2) then ! permanent magnets + if(coil(icoil)%Ic /= 0) then + dofnorm(idof+1) = Mnorm + idof = idof + 1 + endif + if(coil(icoil)%Lc /= 0) then + !xtmp = max(one, sqrt( coil(icoil)%ox**2 + coil(icoil)%oy**2 + coil(icoil)%oz**2 ) ) ! origin position + !mtmp = max(one, sqrt( coil(icoil)%mp**2 + coil(icoil)%mt**2 ) ) ! moment orentation + xtmp = Gnorm ! position normalized to Gnorm + mtmp = pi ! orentation normalized to pi +#ifdef dposition + dofnorm(idof+1:idof+3) = xtmp + dofnorm(idof+4:idof+5) = mtmp + idof = idof + 5 +#else + dofnorm(idof+1:idof+2) = mtmp + idof = idof + 2 +#endif + endif + else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + if(coil(icoil)%Ic /= 0) then + dofnorm(idof+1) = Inorm + idof = idof + 1 endif - idof = idof + 1 - endif - if(coil(icoil)%Lc /= 0) then - if(abs(coil(icoil)%Bz) > sqrtmachprec) then - dofnorm(idof+1) = coil(icoil)%Bz - else - dofnorm(idof+1) = one + if(coil(icoil)%Lc /= 0) then + if(abs(coil(icoil)%Bz) > sqrtmachprec) then + dofnorm(idof+1) = coil(icoil)%Bz + else + dofnorm(idof+1) = one + endif + idof = idof + 1 endif - idof = idof + 1 + else + STOP " wrong coil type in rdcoils" + call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) endif - else - STOP " wrong coil type in rdcoils" - call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) - endif - enddo !end do icoil; - FATAL( AllocData , idof .ne. Ndof, counting error in unpacking ) + enddo !end do icoil; + FATAL( AllocData , idof .ne. Ndof, counting error in unpacking ) - dofnorm = one + endif endif diff --git a/sources/focus.h b/sources/focus.h index 6b78ff4..bcde85c 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -89,7 +89,7 @@ PROGRAM focus use globals, only: dp, ncpu, myid, ounit, ierr, astat, eunit, case_surface, case_coils, case_optimize, & - case_postproc, xdof, tstart, tfinish, time_initialize, time_optimize, time_postproc, & + case_postproc, xdof, time_initialize, time_optimize, time_postproc, & version use mpi !to enable gfortran mpi_wtime bugs; 07/20/2017 @@ -101,6 +101,7 @@ PROGRAM focus !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: secs, mins, hrs + REAL :: tstart, tfinish ! local variables !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/globals.h b/sources/globals.h index ebfad58..857b397 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.03' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.04' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -114,6 +114,7 @@ module globals REAL :: weight_ccsep = 0.000D+00 REAL :: weight_inorm = 1.000D+00 REAL :: weight_gnorm = 1.000D+00 + REAL :: weight_mnorm = 1.000D+00 INTEGER :: case_optimize = 1 REAL :: exit_tol = 1.000D-04 @@ -190,6 +191,7 @@ module globals weight_ccsep , & weight_inorm , & weight_gnorm , & + weight_mnorm , & case_optimize , & exit_tol , & DF_maxiter , & @@ -278,7 +280,7 @@ module globals !latex \subsection{Packing and unpacking} INTEGER :: Cdof, Ndof, nfixcur, nfixgeo, Tdof - REAL :: Inorm = one, Gnorm = one !current and geometry normalizations; + REAL :: Inorm = one, Gnorm = one, Mnorm = one !current, geometry, and moment normalizations; REAL , allocatable :: xdof(:), dofnorm(:) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/lmalg.h b/sources/lmalg.h index adb5686..56ffe91 100644 --- a/sources/lmalg.h +++ b/sources/lmalg.h @@ -295,7 +295,7 @@ end subroutine lmalg subroutine focus_fcn(m,n,x,fvec,fjac,ldfjac,iflag) use globals, only: dp, zero, myid, ounit, LM_iter, LM_maxiter, & - & exit_signal, LM_fvec, LM_fjac + & exit_signal, LM_fvec, LM_fjac, tstart, tfinish use mpi implicit none @@ -303,7 +303,6 @@ subroutine focus_fcn(m,n,x,fvec,fjac,ldfjac,iflag) INTEGER, INTENT(inout) :: iflag DOUBLE PRECISION, INTENT(in) :: x(n) DOUBLE PRECISION, INTENT(out) :: fvec(m),fjac(ldfjac,n) - REAL :: tstart, tfinish ! local variables INTEGER :: idof, ierr, astat call unpacking(x(1:n)) diff --git a/sources/packdof.h b/sources/packdof.h index aa7eedd..16110de 100644 --- a/sources/packdof.h +++ b/sources/packdof.h @@ -79,13 +79,13 @@ SUBROUTINE packdof(lxdof) endif !--------------------------------------------------------------------------------------------- case default - FATAL(packcoil, .true., not supported coil types) + FATAL(packdof01, .true., not supported coil types) end select enddo !end do icoil; !--------------------------------------------------------------------------------------------- - FATAL( packdof , idof .ne. Ndof, counting error in packing ) + FATAL( packdof02 , idof .ne. Ndof, counting error in packing ) !write(ounit, *) "pack ", lxdof(1) lxdof = lxdof / DoFnorm @@ -153,13 +153,13 @@ SUBROUTINE unpacking(lxdof) endif !--------------------------------------------------------------------------------------------- case default - FATAL(packcoil, .true., not supported coil types) + FATAL(unpacking01, .true., not supported coil types) end select enddo !end do icoil; !--------------------------------------------------------------------------------------------- - FATAL( unpacking , idof .ne. Ndof, counting error in unpacking ) + FATAL( unpacking02 , idof .ne. Ndof, counting error in unpacking ) call unpackcoil !unpack DoF to coil parameters; call discoil(ifirst) @@ -182,9 +182,9 @@ SUBROUTINE packcoil INTEGER :: icoil, idof, NF, ierr, astat - FATAL( packcoil, .not. allocated(coil) , illegal ) + FATAL( packcoil01, .not. allocated(coil) , illegal ) ! FATAL( packcoil, .not. allocated(FouCoil), illegal ) - FATAL( packcoil, .not. allocated(DoF) , illegal ) + FATAL( packcoil02, .not. allocated(DoF) , illegal ) do icoil = 1, Ncoils @@ -205,33 +205,33 @@ SUBROUTINE packcoil DoF(icoil)%xdof(idof+1 : idof+NF+1) = FouCoil(icoil)%zc(0:NF); idof = idof + NF + 1 DoF(icoil)%xdof(idof+1 : idof+NF ) = FouCoil(icoil)%zs(1:NF); idof = idof + NF endif - FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + FATAL( packcoil03 , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- case(2) idof = 0 if(coil(icoil)%Lc /= 0) then +#ifdef dposition + ! dipole position is variable DoF(icoil)%xdof(idof+1:idof+5) = (/ coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & coil(icoil)%mt, coil(icoil)%mp /) idof = idof + 5 -!!$ -!!$ DoF(icoil)%xdof(idof+1:idof+2) = (/ coil(icoil)%mt, coil(icoil)%mp /) -!!$ idof = idof + 2 +#else + DoF(icoil)%xdof(idof+1:idof+2) = (/ coil(icoil)%mt, coil(icoil)%mp /) + idof = idof + 2 +#endif endif - FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + FATAL( packcoil04 , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- case(3) idof = 0 -!!$ if(coil(icoil)%Ic /= 0) then -!!$ DoF(icoil)%xdof(idof+1) = coil(icoil)%I; idof = idof + 1 -!!$ endif if(coil(icoil)%Lc /= 0) then DoF(icoil)%xdof(idof+1) = coil(icoil)%Bz; idof = idof + 1 endif - FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + FATAL( packcoil05 , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- case default - FATAL(packcoil, .true., not supported coil types) + FATAL(packcoil06, .true., not supported coil types) end select enddo ! end do icoil; @@ -251,9 +251,9 @@ SUBROUTINE unpackcoil INTEGER :: icoil, idof, NF, ierr, astat - FATAL( unpackcoil, .not. allocated(coil) , illegal ) + FATAL( unpackcoil01, .not. allocated(coil) , illegal ) ! FATAL( unpackcoil, .not. allocated(FouCoil), illegal ) - FATAL( unpackcoil, .not. allocated(DoF) , illegal ) + FATAL( unpackcoil02, .not. allocated(DoF) , illegal ) do icoil = 1, Ncoils @@ -272,35 +272,35 @@ SUBROUTINE unpackcoil FouCoil(icoil)%zc(0:NF) = DoF(icoil)%xdof(idof+1 : idof+NF+1) ; idof = idof + NF + 1 FouCoil(icoil)%zs(1:NF) = DoF(icoil)%xdof(idof+1 : idof+NF ) ; idof = idof + NF endif - FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + FATAL( unpackcoil03 , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- case(2) idof = 0 if(coil(icoil)%Lc /= 0) then +#ifdef dposition + ! dipole position is variable coil(icoil)%ox = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%oy = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%oz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 +#endif coil(icoil)%mt = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 coil(icoil)%mp = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 endif - FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + FATAL( unpackcoil04 , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- case(3) idof = 0 -!!$ if(coil(icoil)%Ic /= 0) then -!!$ coil(icoil)%I = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 -!!$ endif if(coil(icoil)%Lc /= 0) then coil(icoil)%Bz = DoF(icoil)%xdof(idof+1) ; idof = idof + 1 endif - FATAL( packcoil , idof .ne. DoF(icoil)%ND, counting error in packing ) + FATAL( unpackcoil05 , idof .ne. DoF(icoil)%ND, counting error in packing ) !--------------------------------------------------------------------------------------------- case default - FATAL(packcoil, .true., not supported coil types) + FATAL( unpackcoil06 , .true., not supported coil types) end select enddo ! end do icoil; diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 4137ac5..1f34f68 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -532,45 +532,6 @@ subroutine rdcoils ! & totalcurrent, totalcurrent * pi2 * two endif - if (IsNormalize > 0) then - Gnorm = 0 - Inorm = 0 - total_coef = 0 ! total number of coefficients - do icoil = 1, Ncoils - if(coil(icoil)%itype == 1) then ! Fourier representation - NF = FouCoil(icoil)%NF - total_coef = total_coef + (6*NF + 3) - do icoef = 0, NF - Gnorm = Gnorm + FouCoil(icoil)%xs(icoef)**2 + FouCoil(icoil)%xc(icoef)**2 - Gnorm = Gnorm + FouCoil(icoil)%ys(icoef)**2 + FouCoil(icoil)%yc(icoef)**2 - Gnorm = Gnorm + FouCoil(icoil)%zs(icoef)**2 + FouCoil(icoil)%zc(icoef)**2 - enddo - Inorm = Inorm + coil(icoil)%I**2 - endif - enddo - Gnorm = sqrt(Gnorm/total_coef) * weight_gnorm ! quadratic mean - Inorm = sqrt(Inorm/Ncoils) * weight_inorm ! quadratic mean - !Inorm = Inorm * 6 ! compensate for the fact that there are so many more spatial variables - - if (abs(Gnorm) < machprec) Gnorm = one - if (abs(Inorm) < machprec) Inorm = one - - Inorm = one - Gnorm = one - - FATAL( rdcoils, abs(Gnorm) < machprec, cannot be zero ) - FATAL( rdcoils, abs(Inorm) < machprec, cannot be zero ) - - if (myid == 0) then - write(ounit, '(" : Currents are normalized by " ES23.15)') Inorm - write(ounit, '(" : Geometries are normalized by " ES23.15)') Gnorm - endif - - else - Inorm = one - Gnorm = one - endif - !-----------------------allocate DoF arrays -------------------------------------------------- itmp = -1 diff --git a/sources/rdsurf.h b/sources/rdsurf.h index ef6c5df..0b3229c 100644 --- a/sources/rdsurf.h +++ b/sources/rdsurf.h @@ -273,7 +273,7 @@ subroutine fousurf enddo ! end of do jj; 14 Apr 16; enddo ! end of do ii; 14 Apr 16; - surf(1)%vol = surf(1)%vol * discretefactor + surf(1)%vol = abs(surf(1)%vol) * discretefactor if( myid == 0 .and. IsQuiet <= 0) write(ounit, '(8X": Enclosed volume ="ES12.5" m^3 ;" )') surf(1)%vol !calculate target Bn with input harmonics; 05 Jan 17; diff --git a/sources/saving.h b/sources/saving.h index a4e6b56..b57d41b 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -98,6 +98,7 @@ subroutine saving HWRITERV( 1 , weight_ccsep , weight_ccsep ) HWRITERV( 1 , weight_gnorm , weight_gnorm ) HWRITERV( 1 , weight_inorm , weight_inorm ) + HWRITERV( 1 , weight_mnorm , weight_mnorm ) HWRITERV( 1 , DF_tausta , DF_tausta ) HWRITERV( 1 , DF_tauend , DF_tauend ) HWRITERV( 1 , DF_xtol , DF_xtol ) @@ -148,6 +149,7 @@ subroutine saving HWRITEIV( 1 , iout , iout ) HWRITERV( 1 , Inorm , Inorm ) HWRITERV( 1 , Gnorm , Gnorm ) + HWRITERV( 1 , Mnorm , Mnorm ) HWRITERV( 1 , overlap , overlap ) HWRITERA( iout, 8 , evolution , evolution(1:iout, 0:7) ) HWRITERA( iout, Tdof , coilspace , coilspace(1:iout, 1:Tdof) ) From 3080397643694f1d82b581ed7dd605f97020c328 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sun, 31 Mar 2019 17:22:29 -0400 Subject: [PATCH 16/72] Revise memory allocation; Update documentation; Some cleanings; Minor fixes --- .gitignore | 4 +- examples/rotating_ellipse/ellipse.focus | 256 ++++++++++++------------ examples/rotating_ellipse/ellipse.input | 24 +-- sources/Makefile | 8 +- sources/bfield.h | 47 ++--- sources/bmnharm.h | 17 ++ sources/bnormal.h | 115 ++++++----- sources/datalloc.h | 20 +- sources/diagnos.h | 19 +- sources/globals.h | 2 +- sources/initial.h | 37 +++- sources/packdof.h | 6 +- sources/poinplot.h | 74 +------ sources/rdcoils.h | 4 +- sources/saving.h | 2 +- sources/solvers.h | 4 +- sources/torflux.h | 1 - 17 files changed, 305 insertions(+), 335 deletions(-) diff --git a/.gitignore b/.gitignore index 578e4cd..8596e99 100644 --- a/.gitignore +++ b/.gitignore @@ -20,6 +20,4 @@ .project bin/ -Old/ -docs/ -pyfocus/ +docs/ \ No newline at end of file diff --git a/examples/rotating_ellipse/ellipse.focus b/examples/rotating_ellipse/ellipse.focus index 7066c89..6e3f968 100644 --- a/examples/rotating_ellipse/ellipse.focus +++ b/examples/rotating_ellipse/ellipse.focus @@ -1,226 +1,226 @@ # Total number of coils 16 - #-------------------------------------------- + #----------------- 1 --------------------------- #coil_type coil_name 1 Mod_001 #Nseg current Ifree Length Lfree target_length - 128 9.844910899889484E+05 1 5.889288927667147E+00 1 1.000000000000000E+00 + 128 7.520728588581042E+05 1 5.395655237318014E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 3.044612087666170E+00 8.531153655332238E-01 4.194525679767678E-02 2.139790853335835E-02 3.243811555342430E-03 - 0.000000000000000E+00 3.542408058492299E-16 -9.108712738922674E-16 1.841880477639364E-16 -1.172175996642087E-16 - -4.456021385977147E-15 8.545613874434043E-16 -3.133154295448265E-16 1.764367073160815E-16 -1.187904023667544E-16 - 0.000000000000000E+00 -5.425716121023922E-02 -8.986316303345250E-02 -2.946386365076052E-03 -4.487052148209031E-03 - -4.293247278325474E-17 -1.303273952226587E-15 7.710821807870230E-16 -3.156539892466338E-16 9.395672288215928E-17 - 0.000000000000000E+00 9.997301975562740E-01 2.929938238054118E-02 2.436889176706748E-02 1.013941937492003E-03 - #-------------------------------------------- + 2.988539929211658E+00 8.327106971885980E-01 3.168435563359925E-02 -4.729634749879686E-02 -3.926657715126965E-03 + 0.000000000000000E+00 5.590164418932656E-03 1.319184024220209E-02 1.523370015443930E-02 -3.497821632866293E-04 + 5.953679010924422E-01 1.619405017805486E-01 -1.909577558230045E-02 -8.878033538448384E-03 4.024800198801999E-03 + 0.000000000000000E+00 -3.892516509673482E-02 -5.912037464741764E-02 6.147106771863072E-03 4.944614114398699E-03 + 2.275902141112232E-02 -1.924294535824474E-03 -3.840214356197926E-03 -2.782417462171475E-02 -8.378734084698013E-04 + 0.000000000000000E+00 8.394507087523904E-01 2.150443980874104E-02 -5.950975483787359E-02 -3.741052453256639E-03 + #----------------- 2 --------------------------- #coil_type coil_name 1 Mod_002 #Nseg current Ifree Length Lfree target_length - 128 9.825939193150387E+05 1 5.885523786092040E+00 1 1.000000000000000E+00 + 128 7.503347345220045E+05 1 5.393039812576576E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.782723530238699E+00 8.188524402610835E-01 1.015627966887937E-01 3.423108106958181E-03 1.043676727968852E-03 - 0.000000000000000E+00 7.247174059689016E-02 5.189148393383358E-02 -2.786138051989135E-02 -3.138947714342256E-03 - 1.142844202833405E+00 3.343456505400222E-01 -2.370606586536125E-02 -3.077659528299475E-03 -4.929958141009566E-03 - 0.000000000000000E+00 -6.889974421415429E-03 -4.627570410582279E-02 -2.386049487393956E-02 4.454871233820858E-03 - 1.080877113054363E-02 9.397062545279147E-02 -5.113628370077195E-02 4.019968101031725E-02 -2.123260904719736E-04 - 0.000000000000000E+00 9.531696397783556E-01 7.516427937127484E-02 2.299214621026078E-03 -4.621870077987078E-04 - #-------------------------------------------- + 2.531203271089469E+00 7.076750756389344E-01 5.550873235716919E-02 -2.482647602533806E-02 -5.359706355007858E-03 + 0.000000000000000E+00 3.856525906851818E-03 1.628510942838650E-02 3.808788657393867E-02 4.826352774127734E-03 + 1.693213150342830E+00 4.631603939687156E-01 -3.287039804374595E-02 -1.451295457423486E-02 2.253117094687433E-03 + 0.000000000000000E+00 -1.547210717512680E-02 -1.777000619275685E-02 2.780702588161363E-02 -2.159867575328454E-03 + 5.443183710589018E-02 -4.858864588544106E-03 -8.437113643959614E-03 -5.855321710369821E-02 -4.169363793928258E-03 + 0.000000000000000E+00 8.428661276609882E-01 2.579319073444275E-02 -1.673066018368582E-02 -2.854239318502315E-03 + #----------------- 3 --------------------------- #coil_type coil_name 1 Mod_003 #Nseg current Ifree Length Lfree target_length - 128 9.832393043417728E+05 1 5.887953196305714E+00 1 1.000000000000000E+00 + 128 7.501552633715026E+05 1 5.391841305583704E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.115314961365337E+00 6.734656308267452E-01 1.383637868936977E-01 -7.327077556181946E-03 -4.088839817924770E-03 - 0.000000000000000E+00 6.425694895304412E-02 1.823876577199216E-02 -2.350240267797100E-02 -5.666387840646102E-03 - 2.095397239139587E+00 6.715823169694797E-01 2.089283517905467E-02 -3.057002908374958E-02 4.349043278845081E-03 - 0.000000000000000E+00 6.260467088085638E-02 1.612881812435624E-02 -2.985521462129145E-02 4.858279502820251E-03 - 3.504795100694917E-02 1.028222095882263E-01 -5.127102410497052E-02 4.392232934098032E-02 -1.170055177359795E-03 - 0.000000000000000E+00 8.723420859147240E-01 1.288319700628106E-01 -3.272037185914849E-02 7.444587061583237E-04 - #-------------------------------------------- + 1.689228855099178E+00 4.738785866764856E-01 6.298817143237868E-02 7.213526054562644E-03 3.651146060318638E-03 + 0.000000000000000E+00 -1.777792324510675E-02 -1.797643715930334E-02 3.245272161458984E-02 7.284468990029826E-03 + 2.529661048475419E+00 6.956997282618042E-01 -7.243582300751192E-03 1.337336831683070E-02 -2.455035203155118E-03 + 0.000000000000000E+00 5.225975833879028E-03 1.664719622834951E-02 4.861370192110288E-02 2.451724157622647E-03 + 5.390500309620747E-02 -5.243817138709730E-03 -7.417647548054200E-03 -4.640069989535257E-02 -5.180187411528112E-03 + 0.000000000000000E+00 8.474816641335547E-01 3.016822178480444E-02 2.672427259502096E-02 1.747583740935530E-03 + #----------------- 4 --------------------------- #coil_type coil_name 1 Mod_004 #Nseg current Ifree Length Lfree target_length - 128 9.893062047381703E+05 1 5.902044412599992E+00 1 1.000000000000000E+00 + 128 7.514987079186337E+05 1 5.392712258582278E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.153279341210233E+00 3.839351000912973E-01 9.370469672963777E-02 -1.073976140939980E-02 -9.705191390130589E-03 - 0.000000000000000E+00 1.799347255173012E-03 -5.372521021132499E-02 -1.857749572754666E-02 1.603175426999459E-03 - 2.758561057693074E+00 9.320556574942391E-01 6.636284254294306E-02 -4.432294103114913E-02 3.053930340673586E-03 - 0.000000000000000E+00 7.986633593798817E-02 2.024479545845153E-02 -2.213912000632457E-02 -3.382339718066103E-03 - 5.630821079228619E-02 4.024688208981179E-02 -4.096234633987603E-04 2.562130898418030E-02 3.257616268484508E-03 - 0.000000000000000E+00 8.280561324748386E-01 1.199133101065296E-01 -5.093996632871012E-02 8.798511090517195E-04 - #-------------------------------------------- + 5.927116272391375E-01 1.665859083524461E-01 2.846186262771908E-02 1.095638507800185E-02 5.684160922621262E-03 + 0.000000000000000E+00 -3.990274142492009E-02 -5.528907872114740E-02 5.774581002427468E-03 -3.623545496412463E-03 + 2.980538548240107E+00 8.219189960221159E-01 2.471745954728169E-02 5.652321883799034E-02 5.231711055756799E-03 + 0.000000000000000E+00 5.566365666221656E-03 1.266551771211142E-02 2.693263073650251E-02 4.516495680440038E-03 + 2.219784783741740E-02 -2.370949305931477E-03 -2.788313950576048E-03 -1.571469478999142E-02 -1.979049754381353E-03 + 0.000000000000000E+00 8.506574163180366E-01 3.226378283491264E-02 4.555947349958186E-02 4.805096429505946E-03 + #----------------- 5 --------------------------- #coil_type coil_name 1 Mod_005 #Nseg current Ifree Length Lfree target_length - 128 9.936998575666990E+05 1 5.912220619716821E+00 1 1.000000000000000E+00 + 128 7.514987039984880E+05 1 5.392712253773238E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.095542685246406E-15 5.296264044184343E-16 2.064659971500610E-16 6.703968997180234E-16 7.881284697760508E-18 - 0.000000000000000E+00 -3.960999097417946E-02 -8.463524634129940E-02 -5.143673327580391E-03 1.043151915207185E-02 - 3.012320674611275E+00 1.032185815346890E+00 7.725640730606291E-02 -5.448359725908782E-02 -3.213601062953441E-03 - 0.000000000000000E+00 4.806554284756180E-16 1.559408741530255E-15 -1.316515174208468E-16 7.788579477338355E-17 - -1.240953916913024E-15 2.876517992094798E-16 -2.272599276151899E-15 3.627556814089238E-16 -8.946051894087629E-17 - 0.000000000000000E+00 8.174762102110396E-01 9.004542320601831E-02 -5.566721593859935E-02 -3.801301882686477E-03 - #-------------------------------------------- + -5.927118854027963E-01 -1.665859861030158E-01 -2.846187562066620E-02 -1.095638974367992E-02 -5.684162360619094E-03 + 0.000000000000000E+00 -3.990273749932960E-02 -5.528907074679813E-02 5.774588448374391E-03 -3.623541019957985E-03 + 2.980538496319568E+00 8.219189800607887E-01 2.471745451242281E-02 5.652321110817888E-02 5.231706271137767E-03 + 0.000000000000000E+00 -5.566367754216763E-03 -1.266553178467203E-02 -2.693264686120796E-02 -4.516506464882769E-03 + -2.219784448219590E-02 2.370951742061149E-03 2.788335531513377E-03 1.571470351395375E-02 1.979056866073121E-03 + 0.000000000000000E+00 8.506574142229435E-01 3.226378077005936E-02 4.555947206753809E-02 4.805095113162215E-03 + #----------------- 6 --------------------------- #coil_type coil_name 1 Mod_006 #Nseg current Ifree Length Lfree target_length - 128 9.893062047381705E+05 1 5.902044412599991E+00 1 1.000000000000000E+00 + 128 7.501552440090403E+05 1 5.391841292119622E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.153279341210230E+00 -3.839351000912948E-01 -9.370469672963856E-02 1.073976140939876E-02 9.705191390130156E-03 - 0.000000000000000E+00 1.799347255172598E-03 -5.372521021132557E-02 -1.857749572754719E-02 1.603175426999149E-03 - 2.758561057693074E+00 9.320556574942380E-01 6.636284254294574E-02 -4.432294103114796E-02 3.053930340673876E-03 - 0.000000000000000E+00 -7.986633593798621E-02 -2.024479545845140E-02 2.213912000632409E-02 3.382339718066167E-03 - -5.630821079228826E-02 -4.024688208981221E-02 4.096234633984780E-04 -2.562130898417996E-02 -3.257616268484675E-03 - 0.000000000000000E+00 8.280561324748393E-01 1.199133101065324E-01 -5.093996632870837E-02 8.798511090521912E-04 - #-------------------------------------------- + -1.689229067001008E+00 -4.738786498530534E-01 -6.298817514522354E-02 -7.213516650333737E-03 -3.651137935167777E-03 + 0.000000000000000E+00 -1.777791451826354E-02 -1.797642028022032E-02 3.245273115829594E-02 7.284472965483719E-03 + 2.529660905692762E+00 6.956996842573536E-01 -7.243588429642245E-03 1.337335562808325E-02 -2.455043212983806E-03 + 0.000000000000000E+00 -5.225973527492090E-03 -1.664719981685729E-02 -4.861370434315991E-02 -2.451725812532419E-03 + -5.390499401976419E-02 5.243817656993991E-03 7.417665985655394E-03 4.640070789057397E-02 5.180193539368011E-03 + 0.000000000000000E+00 8.474816580121304E-01 3.016821483159271E-02 2.672426608039910E-02 1.747579394926129E-03 + #----------------- 7 --------------------------- #coil_type coil_name 1 Mod_007 #Nseg current Ifree Length Lfree target_length - 128 9.832393043417730E+05 1 5.887953196305707E+00 1 1.000000000000000E+00 + 128 7.503346931259049E+05 1 5.393039802229614E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.115314961365334E+00 -6.734656308267433E-01 -1.383637868936977E-01 7.327077556180765E-03 4.088839817924469E-03 - 0.000000000000000E+00 6.425694895304439E-02 1.823876577199323E-02 -2.350240267797037E-02 -5.666387840645857E-03 - 2.095397239139590E+00 6.715823169694786E-01 2.089283517905522E-02 -3.057002908374837E-02 4.349043278844838E-03 - 0.000000000000000E+00 -6.260467088085681E-02 -1.612881812435750E-02 2.985521462129117E-02 -4.858279502820373E-03 - -3.504795100694644E-02 -1.028222095882256E-01 5.127102410497195E-02 -4.392232934097949E-02 1.170055177359796E-03 - 0.000000000000000E+00 8.723420859147251E-01 1.288319700628102E-01 -3.272037185914656E-02 7.444587061582115E-04 - #-------------------------------------------- + -2.531203410582876E+00 -7.076751153688536E-01 -5.550872998575305E-02 2.482648889925295E-02 5.359713238726924E-03 + 0.000000000000000E+00 3.856532474150872E-03 1.628512551174907E-02 3.808788384771047E-02 4.826346744368282E-03 + 1.693212938291873E+00 4.631603324885413E-01 -3.287039552315528E-02 -1.451295840805110E-02 2.253114585091834E-03 + 0.000000000000000E+00 1.547211270233631E-02 1.777001026074418E-02 -2.780702054725927E-02 2.159869161811173E-03 + -5.443181852279336E-02 4.858864977817301E-03 8.437125114458726E-03 5.855321839827211E-02 4.169365626426363E-03 + 0.000000000000000E+00 8.428661214608650E-01 2.579318055688882E-02 -1.673067211105703E-02 -2.854250261633925E-03 + #----------------- 8 --------------------------- #coil_type coil_name 1 Mod_008 #Nseg current Ifree Length Lfree target_length - 128 9.825939193150393E+05 1 5.885523786092041E+00 1 1.000000000000000E+00 + 128 7.520728717143674E+05 1 5.395655368723608E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.782723530238698E+00 -8.188524402610826E-01 -1.015627966887925E-01 -3.423108106959205E-03 -1.043676727969051E-03 - 0.000000000000000E+00 7.247174059689121E-02 5.189148393383459E-02 -2.786138051989096E-02 -3.138947714342247E-03 - 1.142844202833409E+00 3.343456505400238E-01 -2.370606586536158E-02 -3.077659528298735E-03 -4.929958141009641E-03 - 0.000000000000000E+00 6.889974421415525E-03 4.627570410582223E-02 2.386049487393978E-02 -4.454871233820674E-03 - -1.080877113054374E-02 -9.397062545278986E-02 5.113628370077263E-02 -4.019968101031668E-02 2.123260904719445E-04 - 0.000000000000000E+00 9.531696397783573E-01 7.516427937127285E-02 2.299214621027461E-03 -4.621870077985499E-04 - #-------------------------------------------- + -2.988540004263966E+00 -8.327107428043068E-01 -3.168435488524857E-02 4.729635190657960E-02 3.926657066712609E-03 + 0.000000000000000E+00 5.590155607965869E-03 1.319185195362873E-02 1.523368992492643E-02 -3.497862507550716E-04 + 5.953675303689776E-01 1.619404067055139E-01 -1.909575750387827E-02 -8.878027067865540E-03 4.024799004182142E-03 + 0.000000000000000E+00 3.892517314887458E-02 5.912037794862443E-02 -6.147102568629680E-03 -4.944614340579445E-03 + -2.275898666929556E-02 1.924306339749633E-03 3.840217759945165E-03 2.782416045019162E-02 8.378632429727306E-04 + 0.000000000000000E+00 8.394507264533018E-01 2.150443607028891E-02 -5.950976004534383E-02 -3.741058951554954E-03 + #----------------- 9 --------------------------- #coil_type coil_name 1 Mod_009 #Nseg current Ifree Length Lfree target_length - 128 9.844910899889485E+05 1 5.889288927667151E+00 1 1.000000000000000E+00 + 128 7.520728720708593E+05 1 5.395655371276433E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -3.044612087666165E+00 -8.531153655332240E-01 -4.194525679768322E-02 -2.139790853335865E-02 -3.243811555342124E-03 - 0.000000000000000E+00 -1.280601996834128E-16 -2.568013130264053E-15 1.118452007203463E-15 1.761157189862816E-17 - -6.297289382605896E-16 8.887143243094215E-16 -9.207699102326174E-18 -2.359162160823750E-16 2.254791239505026E-16 - 0.000000000000000E+00 5.425716121023926E-02 8.986316303345229E-02 2.946386365077663E-03 4.487052148208801E-03 - -2.233522643815287E-15 2.369496290216599E-15 -2.459156968972293E-15 1.111210286913772E-15 -7.587966730862343E-17 - 0.000000000000000E+00 9.997301975562742E-01 2.929938238054714E-02 2.436889176706779E-02 1.013941937491709E-03 - #-------------------------------------------- + -2.988539902262396E+00 -8.327107158986544E-01 -3.168435968273983E-02 4.729634463812559E-02 3.926657957891286E-03 + 0.000000000000000E+00 -5.590155875632664E-03 -1.319184381121468E-02 -1.523370723433056E-02 3.497807060728984E-04 + -5.953680465221158E-01 -1.619405474195902E-01 1.909577291793969E-02 8.878032322442823E-03 -4.024802251256982E-03 + 0.000000000000000E+00 3.892516635190360E-02 5.912036989029839E-02 -6.147107682585245E-03 -4.944611868753231E-03 + 2.275902202931194E-02 -1.924306982936721E-03 -3.840215576219863E-03 -2.782418314092672E-02 -8.378750767367861E-04 + 0.000000000000000E+00 8.394507288719744E-01 2.150444172282285E-02 -5.950974663360842E-02 -3.741051284132857E-03 + #----------------- 10 --------------------------- #coil_type coil_name 1 Mod_010 #Nseg current Ifree Length Lfree target_length - 128 9.825939193150395E+05 1 5.885523786092045E+00 1 1.000000000000000E+00 + 128 7.503346938302639E+05 1 5.393039807760921E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.782723530238696E+00 -8.188524402610817E-01 -1.015627966887938E-01 -3.423108106959047E-03 -1.043676727969315E-03 - 0.000000000000000E+00 -7.247174059689021E-02 -5.189148393383772E-02 2.786138051989222E-02 3.138947714342107E-03 - -1.142844202833410E+00 -3.343456505400210E-01 2.370606586536093E-02 3.077659528298494E-03 4.929958141009796E-03 - 0.000000000000000E+00 6.889974421415193E-03 4.627570410582079E-02 2.386049487394025E-02 -4.454871233820705E-03 - 1.080877113054069E-02 9.397062545279444E-02 -5.113628370077713E-02 4.019968101031814E-02 -2.123260904720409E-04 - 0.000000000000000E+00 9.531696397783578E-01 7.516427937127323E-02 2.299214621028059E-03 -4.621870077984231E-04 - #-------------------------------------------- + -2.531203117426858E+00 -7.076750350135308E-01 -5.550873632846930E-02 2.482646871060215E-02 5.359705517378937E-03 + 0.000000000000000E+00 -3.856522974826531E-03 -1.628510607829157E-02 -3.808788934321725E-02 -4.826354462952137E-03 + -1.693213378675361E+00 -4.631604553693177E-01 3.287039497567841E-02 1.451295185857816E-02 -2.253115235461406E-03 + 0.000000000000000E+00 1.547210064881719E-02 1.776999665485185E-02 -2.780703199445574E-02 2.159867808951845E-03 + 5.443184093957966E-02 -4.858864957360692E-03 -8.437113751462985E-03 -5.855321907923008E-02 -4.169364706619052E-03 + 0.000000000000000E+00 8.428661273028158E-01 2.579319177244149E-02 -1.673064832391811E-02 -2.854238539554325E-03 + #----------------- 11 --------------------------- #coil_type coil_name 1 Mod_011 #Nseg current Ifree Length Lfree target_length - 128 9.832393043417722E+05 1 5.887953196305711E+00 1 1.000000000000000E+00 + 128 7.501552442771002E+05 1 5.391841297188859E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.115314961365331E+00 -6.734656308267459E-01 -1.383637868937001E-01 7.327077556182286E-03 4.088839817924299E-03 - 0.000000000000000E+00 -6.425694895303902E-02 -1.823876577199207E-02 2.350240267797015E-02 5.666387840645909E-03 - -2.095397239139590E+00 -6.715823169694792E-01 -2.089283517905783E-02 3.057002908374946E-02 -4.349043278844712E-03 - 0.000000000000000E+00 -6.260467088085671E-02 -1.612881812435606E-02 2.985521462128991E-02 -4.858279502819658E-03 - 3.504795100694819E-02 1.028222095882271E-01 -5.127102410497007E-02 4.392232934097846E-02 -1.170055177359519E-03 - 0.000000000000000E+00 8.723420859147217E-01 1.288319700628161E-01 -3.272037185914903E-02 7.444587061582879E-04 - #-------------------------------------------- + -1.689228624917182E+00 -4.738785252663106E-01 -6.298816823302125E-02 -7.213531089815727E-03 -3.651148197198661E-03 + 0.000000000000000E+00 1.777792885563811E-02 1.797644626465408E-02 -3.245271676404942E-02 -7.284467827929833E-03 + -2.529661201393905E+00 -6.956997680692878E-01 7.243573978656596E-03 -1.337337789546080E-02 2.455034396127163E-03 + 0.000000000000000E+00 -5.225978344874689E-03 -1.664719955824522E-02 -4.861370320989225E-02 -2.451725935001864E-03 + 5.390499895719188E-02 -5.243816480907436E-03 -7.417646806010670E-03 -4.640069406005268E-02 -5.180187026541793E-03 + 0.000000000000000E+00 8.474816632291637E-01 3.016822256421065E-02 2.672427955485484E-02 1.747584881525684E-03 + #----------------- 12 --------------------------- #coil_type coil_name 1 Mod_012 #Nseg current Ifree Length Lfree target_length - 128 9.893062047381682E+05 1 5.902044412599986E+00 1 1.000000000000000E+00 + 128 7.514987039050099E+05 1 5.392712256492853E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.153279341210230E+00 -3.839351000912945E-01 -9.370469672963888E-02 1.073976140940020E-02 9.705191390130367E-03 - 0.000000000000000E+00 -1.799347255169292E-03 5.372521021132674E-02 1.857749572754733E-02 -1.603175426998955E-03 - -2.758561057693072E+00 -9.320556574942380E-01 -6.636284254294618E-02 4.432294103114773E-02 -3.053930340673634E-03 - 0.000000000000000E+00 -7.986633593798875E-02 -2.024479545844690E-02 2.213912000632430E-02 3.382339718066735E-03 - 5.630821079229477E-02 4.024688208980893E-02 -4.096234633916836E-04 2.562130898417977E-02 3.257616268485354E-03 - 0.000000000000000E+00 8.280561324748366E-01 1.199133101065342E-01 -5.093996632870944E-02 8.798511090521916E-04 - #-------------------------------------------- + -5.927113626118808E-01 -1.665858371437778E-01 -2.846185098301391E-02 -1.095638151488814E-02 -5.684159191711036E-03 + 0.000000000000000E+00 3.990274436203740E-02 5.528908359921008E-02 -5.774576514687100E-03 3.623547651385761E-03 + -2.980538600429006E+00 -8.219190098205458E-01 -2.471746400498083E-02 -5.652322541696598E-02 -5.231712897147735E-03 + 0.000000000000000E+00 -5.566363574429256E-03 -1.266551294252646E-02 -2.693262048426263E-02 -4.516494151956416E-03 + 2.219783830678712E-02 -2.370948189480474E-03 -2.788312669518343E-03 -1.571468787189318E-02 -1.979048802249423E-03 + 0.000000000000000E+00 8.506574162324855E-01 3.226378305621138E-02 4.555947516034409E-02 4.805096758450513E-03 + #----------------- 13 --------------------------- #coil_type coil_name 1 Mod_013 #Nseg current Ifree Length Lfree target_length - 128 9.936998575666993E+05 1 5.912220619716824E+00 1 1.000000000000000E+00 + 128 7.514987080121123E+05 1 5.392712255862662E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.309642721785852E-15 -6.123934419616835E-16 -2.417365220342541E-16 -5.726911113200828E-17 -2.263645524067550E-16 - 0.000000000000000E+00 3.960999097418352E-02 8.463524634129878E-02 5.143673327579279E-03 -1.043151915207169E-02 - -3.012320674611273E+00 -1.032185815346892E+00 -7.725640730606369E-02 5.448359725908920E-02 3.213601062954197E-03 - 0.000000000000000E+00 3.234979803000865E-17 -7.798991548073831E-16 -2.382747473076669E-16 -5.086374324456303E-17 - -1.493956648761240E-15 -4.034487358009764E-17 -1.010069378053523E-15 -2.126433020881394E-16 -1.264976776682364E-16 - 0.000000000000000E+00 8.174762102110380E-01 9.004542320601913E-02 -5.566721593860124E-02 -3.801301882687245E-03 - #-------------------------------------------- + 5.927121500300441E-01 1.665860573116816E-01 2.846188726536878E-02 1.095639330678970E-02 5.684164091526844E-03 + 0.000000000000000E+00 3.990273456220943E-02 5.528906586873038E-02 -5.774592936118736E-03 3.623538864982569E-03 + -2.980538444130621E+00 -8.219189662623464E-01 -2.471745005472040E-02 -5.652320452919800E-02 -5.231704429744331E-03 + 0.000000000000000E+00 5.566369846007909E-03 1.266553655425424E-02 2.693265711344370E-02 4.516507993364239E-03 + -2.219785401282495E-02 2.370952858511593E-03 2.788336812570616E-03 1.571471043205211E-02 1.979057818204685E-03 + 0.000000000000000E+00 8.506574143084941E-01 3.226378054875979E-02 4.555947040677443E-02 4.805094784216935E-03 + #----------------- 14 --------------------------- #coil_type coil_name 1 Mod_014 #Nseg current Ifree Length Lfree target_length - 128 9.893062047381685E+05 1 5.902044412599988E+00 1 1.000000000000000E+00 + 128 7.501552631034428E+05 1 5.391841300514464E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.153279341210230E+00 3.839351000912936E-01 9.370469672964007E-02 -1.073976140939872E-02 -9.705191390129882E-03 - 0.000000000000000E+00 -1.799347255168639E-03 5.372521021132683E-02 1.857749572754740E-02 -1.603175426998636E-03 - -2.758561057693070E+00 -9.320556574942356E-01 -6.636284254294939E-02 4.432294103114542E-02 -3.053930340673473E-03 - 0.000000000000000E+00 7.986633593798745E-02 2.024479545844683E-02 -2.213912000632334E-02 -3.382339718066471E-03 - -5.630821079229358E-02 -4.024688208980905E-02 4.096234633916470E-04 -2.562130898417867E-02 -3.257616268485252E-03 - 0.000000000000000E+00 8.280561324748386E-01 1.199133101065380E-01 -5.093996632870672E-02 8.798511090523702E-04 - #-------------------------------------------- + 1.689229297182977E+00 4.738787112632208E-01 6.298817834457687E-02 7.213511615076581E-03 3.651135798285880E-03 + 0.000000000000000E+00 1.777790890773168E-02 1.797641117486880E-02 -3.245273600883360E-02 -7.284474127581214E-03 + -2.529660752774237E+00 -6.956996444498592E-01 7.243596751735662E-03 -1.337334604945491E-02 2.455044020010202E-03 + 0.000000000000000E+00 5.225971016493626E-03 1.664719648695688E-02 4.861370305436504E-02 2.451724035150668E-03 + -5.390499815877593E-02 5.243818314796265E-03 7.417666727698075E-03 4.640071372587241E-02 5.180193924353800E-03 + 0.000000000000000E+00 8.474816589165207E-01 3.016821405218489E-02 2.672425912056227E-02 1.747578254334600E-03 + #----------------- 15 --------------------------- #coil_type coil_name 1 Mod_015 #Nseg current Ifree Length Lfree target_length - 128 9.832393043417709E+05 1 5.887953196305702E+00 1 1.000000000000000E+00 + 128 7.503347338176459E+05 1 5.393039807045271E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.115314961365332E+00 6.734656308267456E-01 1.383637868936978E-01 -7.327077556182388E-03 -4.088839817923967E-03 - 0.000000000000000E+00 -6.425694895303813E-02 -1.823876577199151E-02 2.350240267796986E-02 5.666387840645846E-03 - -2.095397239139589E+00 -6.715823169694777E-01 -2.089283517905502E-02 3.057002908374827E-02 -4.349043278844982E-03 - 0.000000000000000E+00 6.260467088085564E-02 1.612881812435527E-02 -2.985521462128889E-02 4.858279502819705E-03 - -3.504795100695098E-02 -1.028222095882245E-01 5.127102410496724E-02 -4.392232934097696E-02 1.170055177359472E-03 - 0.000000000000000E+00 8.723420859147224E-01 1.288319700628125E-01 -3.272037185914852E-02 7.444587061588428E-04 - #-------------------------------------------- + 2.531203564245448E+00 7.076751559942464E-01 5.550872601445132E-02 -2.482649621398703E-02 -5.359714076353015E-03 + 0.000000000000000E+00 -3.856535406174458E-03 -1.628512886184260E-02 -3.808788107842729E-02 -4.826345055542259E-03 + -1.693212709959316E+00 -4.631602710879332E-01 3.287039859121983E-02 1.451296112370399E-02 -2.253116444319106E-03 + 0.000000000000000E+00 -1.547211922864832E-02 -1.777001979865050E-02 2.780701443441668E-02 -2.159868928186500E-03 + -5.443181468910067E-02 4.858864609000908E-03 8.437125006953651E-03 5.855321642273492E-02 4.169364713732138E-03 + 0.000000000000000E+00 8.428661218190376E-01 2.579317951888924E-02 -1.673068397082541E-02 -2.854251040582261E-03 + #----------------- 16 --------------------------- #coil_type coil_name 1 Mod_016 #Nseg current Ifree Length Lfree target_length - 128 9.825939193150366E+05 1 5.885523786092033E+00 1 1.000000000000000E+00 + 128 7.520728585016159E+05 1 5.395655234765190E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.782723530238699E+00 8.188524402610796E-01 1.015627966887923E-01 3.423108106960044E-03 1.043676727969364E-03 - 0.000000000000000E+00 -7.247174059689200E-02 -5.189148393383933E-02 2.786138051989332E-02 3.138947714342312E-03 - -1.142844202833413E+00 -3.343456505400205E-01 2.370606586536152E-02 3.077659528297522E-03 4.929958141010002E-03 - 0.000000000000000E+00 -6.889974421415149E-03 -4.627570410581994E-02 -2.386049487394103E-02 4.454871233820804E-03 - -1.080877113053806E-02 -9.397062545279594E-02 5.113628370077884E-02 -4.019968101031930E-02 2.123260904718878E-04 - 0.000000000000000E+00 9.531696397783578E-01 7.516427937127053E-02 2.299214621029528E-03 -4.621870077984291E-04 + 2.988540031213204E+00 8.327107240942389E-01 3.168435083610435E-02 -4.729635476724804E-02 -3.926656823945956E-03 + 0.000000000000000E+00 -5.590164151263538E-03 -1.319184838461032E-02 -1.523368284503427E-02 3.497877079669447E-04 + -5.953673849392954E-01 -1.619403610664742E-01 1.909576016823804E-02 8.878028283871835E-03 -4.024796951726851E-03 + 0.000000000000000E+00 -3.892517189370693E-02 -5.912038270574568E-02 6.147101657908195E-03 4.944616586224016E-03 + -2.275898605110795E-02 1.924293892638741E-03 3.840216539925661E-03 2.782415193097603E-02 8.378615746983008E-04 + 0.000000000000000E+00 8.394507063337221E-01 2.150443415621218E-02 -5.950976824960581E-02 -3.741060120678750E-03 diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 7909bb6..fa27eba 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -8,7 +8,7 @@ Nteta = 128 ! poloidal number for discretizing the surface Nzeta = 128 ! toroidal number for discretizing the surface - case_init = 1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils + case_init = 1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation Ncoils = 16 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 @@ -27,13 +27,13 @@ weight_tflux = 0.010D+00 ! weight for toroidal flux error target_tflux = 0.000D+00 ! target for the toroidal flux weight_ttlen = 0.100D+00 ! weight for coil length error - target_length = 0.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length + target_length = 5.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length weight_specw = 0.000D+00 ! weight for spectral condensation error weight_cssep = 0.010D+00 ! weight for coil-surface separation constraint weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. - case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing with algorithms using the gradient (DF and/or CG); 2: optimizing with algorithms using the Hessian (HT and/or NT) + case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing with algorithms using the gradient (DF and/or CG); exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold DF_maxiter = 0 ! maximum iterations allowed for using Differential Flow (DF) @@ -41,33 +41,25 @@ DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea DF_tauend = 1.000D-00 ! ending value of τ. The larger value of τend − τsta, the more optimized - CG_maxiter = 50 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_maxiter = 20 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization CG_wolfe_c1 = 1.000D-04 ! c1 value in the strong wolfe condition for line search; CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; if one CG step takes too long, try to increase c2, but remember 0 < c1 < c2 < 1 - LM_maxiter = 20 ! maximum iterations allowed for using Levenberg-Marquard (LM) + LM_maxiter = 0 ! maximum iterations allowed for using Levenberg-Marquard (LM) LM_xtol = 1.000D-08 ! if the relative error between two consecutivec iterates is at most xtol, the optimization terminates LM_ftol = 1.000D-08 ! if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; LM_factor = 100.0 ! the initial step bound, which is set to the product of factor and the euclidean norm of diag*x if nonzero - HN_maxiter = 0 - HN_xtol = 1.000D-08 - HN_factor = 100.0 - - TN_maxiter = 0 - TN_xtol = 1.000D-08 - TN_reorder = 0 - TN_cr = 0.1 - - case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots + case_postproc = 4 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates save_freq = 1 ! frequency for writing output files; should be positive save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics save_filaments = 0 ! flag for indicating whether write .example.filaments.xxxxxx + update_plasma = 0 ! if == 1, write new example.plasma file with updated Bn harmonics. pp_phi = 0.000D+00 ! toroidal plane for poincare plots, cylindrical angle phi = pp_phi*Pi - pp_raxis = 0.000D+00 ! pp_raxis, pp_zaxis are initial guesses for magnetic axis at the specified toroidal angle + pp_raxis = 3.000D+00 ! pp_raxis, pp_zaxis are initial guesses for magnetic axis at the specified toroidal angle pp_zaxis = 0.000D+00 ! If both zero, FOCUS will take the geometric center as initial guess pp_rmax = 0.000D+00 ! pp_rmax, pp_zmax are the upper bounds for performing fieldline tracing pp_zmax = 0.000D+00 ! FOCUS will start follow fieldlines at interpolation between (pp_raxis, pp_zaxis) and (pp_rmax, pp_zmax) diff --git a/sources/Makefile b/sources/Makefile index e22e780..b463e48 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -2,8 +2,9 @@ ############################################################################################################ - ALLFILES= globals initial datalloc rdsurf rdknot rdcoils packdof bfield bnormal bmnharm fdcheck \ - torflux length surfsep solvers descent congrad lmalg saving diagnos specinp poinplot boozer focus + ALLFILES= globals initial rdsurf rdknot rdcoils packdof bfield bmnharm bnormal fdcheck \ + torflux length surfsep datalloc solvers descent congrad lmalg saving diagnos \ + specinp poinplot boozer focus HFILES= $(ALLFILES:=.h) FFILES= $(ALLFILES:=.F90) PFILES= $(ALLFILES:=.pdf) @@ -85,12 +86,11 @@ $(PFILES): %.pdf: %.h head.tex end.tex @pdflatex -shell-escape -interaction=nonstopmode -file-line-error $*.tex | grep ".*:[0-9]*:.*" ||: @pdflatex -shell-escape -interaction=nonstopmode -file-line-error $*.tex | grep ".*:[0-9]*:.*" ||: @pdflatex -shell-escape -interaction=nonstopmode -file-line-error $*.tex | grep ".*:[0-9]*:.*" ||: + @rm -f $*.tex $*.aux $*.blg $*.log $*.ps .$*.date $*.toc $*.out - ############################################################################################################ pdfs: $(PFILES) @echo "Please read pdfs in this directory!" - @rm -f $*.tex $*.aux $*.blg $*.log $*.ps .$*.date $*.toc $*.out ############################################################################################################ diff --git a/sources/bfield.h b/sources/bfield.h index 0bdd655..781f8f1 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -20,7 +20,7 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) +subroutine bfield0(icoil, xx, yy, zz, Bx, By, Bz) !------------------------------------------------------------------------------------------------------ ! DATE: 06/15/2016; 03/26/2017 ! calculate the magnetic field of icoil using manually discretized coils. @@ -32,19 +32,18 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) implicit none include "mpif.h" - INTEGER, intent(in ) :: icoil, iteta, jzeta + INTEGER, intent(in ) :: icoil + REAL, intent(in ) :: xx, yy, zz REAL , intent(out) :: Bx, By, Bz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, kseg - REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, phi, mx, my, mz + REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, mx, my, mz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! FATAL( bfield0, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) - FATAL( bfield0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) - FATAL( bfield0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) Bx = zero; By = zero; Bz = zero @@ -58,9 +57,9 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) do kseg = 0, coil(icoil)%NS-1 - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + dlx = xx - coil(icoil)%xx(kseg) + dly = yy - coil(icoil)%yy(kseg) + dlz = zz - coil(icoil)%zz(kseg) rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) ltx = coil(icoil)%xt(kseg) @@ -80,9 +79,9 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) !--------------------------------------------------------------------------------------------- case(2) - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%ox - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%oy - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%oz + dlx = xx - coil(icoil)%ox + dly = yy - coil(icoil)%oy + dlz = zz - coil(icoil)%oz r2 = dlx**2 + dly**2 + dlz**2 rm3 = one/(sqrt(r2)*r2) mx = sin(coil(icoil)%mt) * cos(coil(icoil)%mp) @@ -102,12 +101,11 @@ subroutine bfield0(icoil, iteta, jzeta, Bx, By, Bz) case(3) ! might be only valid for cylindrical coordinates ! Bt = u0*I/(2 pi R) - phi = ( jzeta + half ) * pi2 / ( Nzeta*Nfp ) - rr = sqrt( surf(1)%xx(iteta,jzeta)**2 + surf(1)%yy(iteta,jzeta)**2 ) + rr = sqrt( xx**2 + yy**2 ) coil(icoil)%Bt = two/rr * coil(icoil)%I * bsconstant - Bx = - coil(icoil)%Bt * sin(phi) - By = coil(icoil)%Bt * cos(phi) + Bx = - coil(icoil)%Bt * yy/rr + By = coil(icoil)%Bt * xx/rr Bz = coil(icoil)%Bz !--------------------------------------------------------------------------------------------- @@ -121,7 +119,7 @@ end subroutine bfield0 !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) +subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) !------------------------------------------------------------------------------------------------------ ! DATE: 06/15/2016; 03/26/2017 ! calculate the magnetic field and the first dirivatives of icoil using manually discretized coils; @@ -133,7 +131,8 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) implicit none include "mpif.h" - INTEGER, intent(in ) :: icoil, iteta, jzeta, ND + INTEGER, intent(in ) :: icoil, ND + REAL, intent(in ) :: xx, yy, zz REAL, dimension(1:1, 1:ND), intent(inout) :: Bx, By, Bz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -146,8 +145,6 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! FATAL( bfield1, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) - FATAL( bfield1, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) - FATAL( bfield1, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) FATAL( bfield1, ND <= 0, wrong inout dimension of ND ) Bx = zero; By = zero; Bz = zero @@ -164,9 +161,9 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) do kseg = 0, NS-1 - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + dlx = xx - coil(icoil)%xx(kseg) + dly = yy - coil(icoil)%yy(kseg) + dlz = zz - coil(icoil)%zz(kseg) r2 = dlx**2 + dly**2 + dlz**2; rm3 = one/(sqrt(r2)*r2); rm5 = rm3/r2; @@ -200,9 +197,9 @@ subroutine bfield1(icoil, iteta, jzeta, Bx, By, Bz, ND) !--------------------------------------------------------------------------------------------- case(2) ! permanent dipoles - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%ox - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%oy - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%oz + dlx = xx - coil(icoil)%ox + dly = yy - coil(icoil)%oy + dlz = zz - coil(icoil)%oz r2 = dlx**2 + dly**2 + dlz**2 rm3 = one/(sqrt(r2)*r2) rm5 = rm3/r2 diff --git a/sources/bmnharm.h b/sources/bmnharm.h index 48612d8..9940e70 100644 --- a/sources/bmnharm.h +++ b/sources/bmnharm.h @@ -105,6 +105,19 @@ !!$END SUBROUTINE bmnharm !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! +module bharm_mod + ! contains some common variables used in subroutine bnormal + ! allocating once and re-using them will save allocation time + use globals, only : dp + implicit none + + ! 0-order + ! none for now; in future, others should be moved to here. 03/30/2019 + ! 1st-order + REAL, allocatable :: dBc(:), dBs(:) + +end module bharm_mod +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! SUBROUTINE readBmn !---------------------------------------------------------------------------------------- @@ -113,6 +126,7 @@ SUBROUTINE readBmn !---------------------------------------------------------------------------------------- use globals, only: dp, zero, half, pi2, myid, ounit, runit, ext, IsQuiet, Nteta, Nzeta, Nfp, & NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, Nfp_raw, case_bnormal + use bharm_mod implicit none include "mpif.h" @@ -183,6 +197,9 @@ SUBROUTINE readBmn enddo enddo + SALLOCATE( dBc, (1:NBmn), zero ) ! dB_mn_cos + SALLOCATE( dBs, (1:NBmn), zero ) ! dB_mn_sin + return END SUBROUTINE readBmn diff --git a/sources/bnormal.h b/sources/bnormal.h index 9fdd731..b9ad4ef 100644 --- a/sources/bnormal.h +++ b/sources/bnormal.h @@ -8,7 +8,23 @@ !latex \calls{\link{bfield}} !latex \tableofcontents + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +module bnorm_mod + ! contains some common variables used in subroutine bnormal + ! allocating once and re-using them will save allocation time + use globals, only : dp + implicit none + + ! 0-order + REAL, allocatable :: dBx(:,:), dBy(:,:), dBz(:,:), Bm(:,:) + ! 1st-order + REAL, allocatable :: dBn(:), dBm(:), d1B(:,:,:) + +end module bnorm_mod !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + subroutine bnormal( ideriv ) !------------------------------------------------------------------------------------------------------ ! DATE: 04/02/2017; @@ -22,7 +38,8 @@ subroutine bnormal( ideriv ) bnorm, t1B, t2B, bn, Ndof, Npc, Cdof, weight_bharm, case_bnormal, & weight_bnorm, ibnorm, mbnorm, ibharm, mbharm, LM_fvec, LM_fjac, & bharm, t1H, Bmnc, Bmns, wBmn, tBmnc, tBmns, Bmnim, Bmnin, NBmn - + use bnorm_mod + use bharm_mod implicit none include "mpif.h" @@ -30,51 +47,46 @@ subroutine bnormal( ideriv ) !-------------------------------------------------------------------------------------------- INTEGER :: astat, ierr INTEGER :: icoil, iteta, jzeta, idof, ND, NumGrid, ip - REAL :: lbnorm ! local bnorm - REAL, dimension(0:Nteta-1, 0:Nzeta-1) :: lbx, lby, lbz, lbn, lbm, Bm ! local Bx, By and Bz - REAL, dimension(0:Cdof, 0:Cdof) :: dBx, dBy, dBz ! dB of each coil; - REAL, dimension(1:Ndof) :: l1B, dBn, dBm - REAL, allocatable :: ldB(:,:,:), dB(:,:,:) - REAL, allocatable :: dBc(:), dBs(:) !--------------------------initialize and allocate arrays------------------------------------- NumGrid = Nteta*Nzeta - lbnorm = zero; bnorm = zero ; lbm = zero - lbx = zero; lby = zero; lbz = zero; lbn = zero !already allocted; reset to zero; - dBx = zero; dBy = zero; dBz = zero + ! reset to zero; + bnorm = zero + surf(1)%Bx = zero; surf(1)%By = zero; surf(1)%Bz = zero; surf(1)%Bn = zero + dBx = zero; dBy = zero; dBz = zero; Bm = zero bn = zero - surf(1)%bn = zero; surf(1)%Bx = zero; surf(1)%By = zero; surf(1)%Bz = zero !-------------------------------calculate Bn-------------------------------------------------- if( ideriv >= 0 ) then - do jzeta = 0, Nzeta - 1 do iteta = 0, Nteta - 1 if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; do icoil = 1, Ncoils*Npc - call bfield0(icoil, iteta, jzeta, dBx(0,0), dBy(0,0), dBz(0,0)) - lbx(iteta, jzeta) = lbx(iteta, jzeta) + dBx( 0, 0) - lby(iteta, jzeta) = lby(iteta, jzeta) + dBy( 0, 0) - lbz(iteta, jzeta) = lbz(iteta, jzeta) + dBz( 0, 0) + call bfield0(icoil, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & + & surf(1)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) + surf(1)%Bx(iteta, jzeta) = surf(1)%Bx(iteta, jzeta) + dBx( 0, 0) + surf(1)%By(iteta, jzeta) = surf(1)%By(iteta, jzeta) + dBy( 0, 0) + surf(1)%Bz(iteta, jzeta) = surf(1)%Bz(iteta, jzeta) + dBz( 0, 0) enddo ! end do icoil - lbn(iteta, jzeta) = lbx(iteta, jzeta)*surf(1)%nx(iteta, jzeta) & - & + lby(iteta, jzeta)*surf(1)%ny(iteta, jzeta) & - & + lbz(iteta, jzeta)*surf(1)%nz(iteta, jzeta) & + surf(1)%Bn(iteta, jzeta) = surf(1)%Bx(iteta, jzeta)*surf(1)%nx(iteta, jzeta) & + & + surf(1)%By(iteta, jzeta)*surf(1)%ny(iteta, jzeta) & + & + surf(1)%Bz(iteta, jzeta)*surf(1)%nz(iteta, jzeta) & & - surf(1)%pb(iteta, jzeta) select case (case_bnormal) case (0) ! no normalization over |B|; - lbnorm = lbnorm + lbn(iteta, jzeta) * lbn(iteta, jzeta) * surf(1)%ds(iteta, jzeta) + bnorm = bnorm + surf(1)%Bn(iteta, jzeta) * surf(1)%Bn(iteta, jzeta) * surf(1)%ds(iteta, jzeta) case (1) ! normalized over |B|; - lbm(iteta, jzeta) = lbx(iteta, jzeta)*lbx(iteta, jzeta) + lby(iteta, jzeta)*lby(iteta, jzeta) & - & + lbz(iteta, jzeta)*lbz(iteta, jzeta) - lbnorm = lbnorm + lbn(iteta, jzeta) * lbn(iteta, jzeta) & - & / lbm(iteta, jzeta) * surf(1)%ds(iteta, jzeta) + Bm(iteta, jzeta) = surf(1)%Bx(iteta, jzeta)*surf(1)%Bx(iteta, jzeta) & + & + surf(1)%By(iteta, jzeta)*surf(1)%By(iteta, jzeta) & + & + surf(1)%Bz(iteta, jzeta)*surf(1)%Bz(iteta, jzeta) + bnorm = bnorm + surf(1)%Bn(iteta, jzeta) * surf(1)%Bn(iteta, jzeta) & + & / Bm(iteta, jzeta) * surf(1)%ds(iteta, jzeta) case default FATAL( bnorm, .true., case_bnormal can only be 0/1 ) end select @@ -83,19 +95,19 @@ subroutine bnormal( ideriv ) enddo ! end do jzeta call MPI_BARRIER( MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( lbx, surf(1)%Bx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( lby, surf(1)%By, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( lbz, surf(1)%Bz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( lbn, surf(1)%Bn, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( lbnorm, bnorm , 1 , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%Bx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%By, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%Bz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%Bn, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, bnorm, 1 , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - bnorm = bnorm * half * discretefactor + bnorm = bnorm * half * discretefactor bn = surf(1)%Bn + surf(1)%pb ! bn is B.n from coils ! bn = surf(1)%Bx * surf(1)%nx + surf(1)%By * surf(1)%ny + surf(1)%Bz * surf(1)%nz !! if (case_bnormal == 0) bnorm = bnorm * bsconstant * bsconstant ! take bsconst back if (case_bnormal == 1) then ! collect |B| - call MPI_ALLREDUCE( lbm, bm, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, Bm, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) !! bm = bm * bsconstant * bsconstant endif @@ -116,7 +128,7 @@ subroutine bnormal( ideriv ) ! Bn harmonics related if (weight_bharm > sqrtmachprec) then - call twodft( bn, Bmns, Bmnc, Bmnim, Bmnin, NBmn ) ! Bn from coils + call twodft( bn, Bmns, Bmnc, Bmnim, Bmnin, NBmn ) ! Bn from coils bharm = half * sum( wBmn * ((Bmnc - tBmnc)**2 + (Bmns - tBmns)**2) ) if (mbharm > 0) then @@ -130,9 +142,8 @@ subroutine bnormal( ideriv ) !-------------------------------calculate Bn/x------------------------------------------------ if ( ideriv >= 1 ) then - t1B = zero ; l1B = zero - SALLOCATE( ldB, (1:Ndof, 0:Nteta-1, 0:Nzeta-1), zero) - SALLOCATE( dB, (1:Ndof, 0:Nteta-1, 0:Nzeta-1), zero) + t1B = zero ; d1B = zero + dBn = zero ; dBm = zero do jzeta = 0, Nzeta - 1 do iteta = 0, Nteta - 1 @@ -145,7 +156,8 @@ subroutine bnormal( ideriv ) do icoil = 1, Ncoils ND = DoF(icoil)%ND if ( coil(icoil)%Ic /= 0 ) then !if current is free; - call bfield0(icoil+(ip-1)*Ncoils, iteta, jzeta, dBx(0,0), dBy(0,0), dBz(0,0)) + call bfield0(icoil+(ip-1)*Ncoils, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & + & surf(1)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) if (coil(icoil+(ip-1)*Ncoils)%itype == 3) dBz(0,0) = zero ! Bz doesn't change in itype=3 dBn(idof+1) = ( dBx(0,0)*surf(1)%nx(iteta,jzeta) & & + dBy(0,0)*surf(1)%ny(iteta,jzeta) & @@ -160,7 +172,8 @@ subroutine bnormal( ideriv ) endif if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; - call bfield1(icoil+(ip-1)*Ncoils, iteta, jzeta, dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) + call bfield1(icoil+(ip-1)*Ncoils, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & + & surf(1)%zz(iteta, jzeta), dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) dBn(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(1)%nx(iteta,jzeta) & & + dBy(1:ND,0)*surf(1)%ny(iteta,jzeta) & & + dBz(1:ND,0)*surf(1)%nz(iteta,jzeta) ) @@ -179,15 +192,15 @@ subroutine bnormal( ideriv ) select case (case_bnormal) case (0) ! no normalization over |B|; - l1B(1:Ndof) = l1B(1:Ndof) + surf(1)%bn(iteta,jzeta) * surf(1)%ds(iteta,jzeta) * dBn(1:Ndof) - ldB(1:Ndof, iteta, jzeta) = ldB(1:Ndof, iteta, jzeta) + dBn(1:Ndof) + t1B(1:Ndof) = t1B(1:Ndof) + surf(1)%bn(iteta,jzeta) * surf(1)%ds(iteta,jzeta) * dBn(1:Ndof) + d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) case (1) ! normalized over |B|; - l1B(1:Ndof) = l1B(1:Ndof) + ( surf(1)%Bn(iteta,jzeta) * dBn(1:Ndof) & + t1B(1:Ndof) = t1B(1:Ndof) + ( surf(1)%Bn(iteta,jzeta) * dBn(1:Ndof) & & / bm(iteta, jzeta) & & - surf(1)%Bn(iteta,jzeta) * surf(1)%Bn(iteta,jzeta) & & / (bm(iteta, jzeta)*bm(iteta, jzeta)) & & * dBm(1:Ndof) ) * surf(1)%ds(iteta,jzeta) - ldB(1:Ndof, iteta, jzeta) = ldB(1:Ndof, iteta, jzeta) + dBn(1:Ndof) & + d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) & & / sqrt(bm(iteta, jzeta)) & & - surf(1)%Bn(iteta,jzeta) * dBm(1:Ndof) & & / (bm(iteta, jzeta) * sqrt(bm(iteta, jzeta))) @@ -201,8 +214,8 @@ subroutine bnormal( ideriv ) enddo !end jzeta; call MPI_BARRIER( MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE(l1B, t1B, Ndof, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE(ldB, dB, Ndof*NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, t1B, Ndof , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, d1B, Ndof*NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) t1B = t1B * discretefactor @@ -210,29 +223,22 @@ subroutine bnormal( ideriv ) if (mbnorm > 0) then do idof = 1, Ndof LM_fjac(ibnorm+1:ibnorm+mbnorm, idof) = weight_bnorm & - & * reshape(dB(idof, 0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) + & * reshape(d1B(idof, 0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) enddo endif - if (weight_bharm > sqrtmachprec) then - SALLOCATE( dBc, (1:NBmn), zero ) ! temporary dB_mn_cos - SALLOCATE( dBs, (1:NBmn), zero ) ! temporary dB_mn_sin + if (weight_bharm > sqrtmachprec) then + dBc = zero ; dBs = zero do idof = 1, Ndof - call twodft( dB(idof, 0:Nteta-1, 0:Nzeta-1), dBs, dBc, Bmnim, Bmnin, NBmn ) + call twodft( d1B(idof, 0:Nteta-1, 0:Nzeta-1), dBs, dBc, Bmnim, Bmnin, NBmn ) t1H(idof) = sum( wBmn * ( (Bmnc - tBmnc)*dBc + (Bmns - tBmns)*dBs ) ) if (mbharm > 0) then LM_fjac(ibharm+1 :ibharm+mbharm/2, idof) = weight_bharm * wBmn * dBc LM_fjac(ibharm+mbharm/2+1:ibharm+mbharm , idof) = weight_bharm * wBmn * dBs endif - enddo - DALLOCATE( dBc ) - DALLOCATE( dBs ) endif - DALLOCATE( ldB ) - DALLOCATE( dB ) - endif !-------------------------------------------------------------------------------------------- @@ -241,3 +247,4 @@ subroutine bnormal( ideriv ) return end subroutine bnormal + diff --git a/sources/datalloc.h b/sources/datalloc.h index 32d989b..3722431 100644 --- a/sources/datalloc.h +++ b/sources/datalloc.h @@ -7,6 +7,7 @@ subroutine AllocData(itype) ! part can be : -1('dof'), 0('costfun0'), 1('costfun1') !------------------------------------------------------------------------------------------------------ use globals + use bnorm_mod implicit none include "mpif.h" @@ -169,11 +170,15 @@ subroutine AllocData(itype) ! Bnorm and Bharm needed; if (weight_bnorm > sqrtmachprec .or. weight_bharm > sqrtmachprec .or. IsQuiet <= -2) then - SALLOCATE( bn, (0:Nteta-1,0:Nzeta-1), zero ) !Bn from coils; - SALLOCATE( surf(1)%bn, (0:Nteta-1,0:Nzeta-1), zero ) !total Bn; - SALLOCATE( surf(1)%Bx, (0:Nteta-1,0:Nzeta-1), zero ) !Bx on the surface; - SALLOCATE( surf(1)%By, (0:Nteta-1,0:Nzeta-1), zero ) !By on the surface; - SALLOCATE( surf(1)%Bz, (0:Nteta-1,0:Nzeta-1), zero ) !Bz on the surface; + SALLOCATE( bn, (0:Nteta-1,0:Nzeta-1), zero ) ! Bn from coils; + SALLOCATE( surf(1)%bn, (0:Nteta-1,0:Nzeta-1), zero ) ! total Bn; + SALLOCATE( surf(1)%Bx, (0:Nteta-1,0:Nzeta-1), zero ) ! Bx on the surface; + SALLOCATE( surf(1)%By, (0:Nteta-1,0:Nzeta-1), zero ) ! By on the surface; + SALLOCATE( surf(1)%Bz, (0:Nteta-1,0:Nzeta-1), zero ) ! Bz on the surface; + SALLOCATE( Bm, (0:Nteta-1,0:Nzeta-1), zero ) ! |B| on the surface; + SALLOCATE( dBx, (0:Cdof,0:Cdof), zero ) ! d^2Bx/(dx1,dx2) on each coil; Cdof is the max coil dof + SALLOCATE( dBy, (0:Cdof,0:Cdof), zero ) ! d^2By/(dx1,dx2) on each coil; + SALLOCATE( dBz, (0:Cdof,0:Cdof), zero ) ! d^2Bz/(dx1,dx2) on each coil; endif ! Bharm needed; @@ -196,7 +201,10 @@ subroutine AllocData(itype) ! Bnorm related; if (weight_bnorm > sqrtmachprec .or. weight_bharm > sqrtmachprec) then - SALLOCATE( t1B, (1:Ndof), zero ) !total dB/dx; + SALLOCATE( t1B, (1:Ndof), zero ) !total d bnorm / d x; + SALLOCATE( dBn, (1:Ndof), zero ) !total d Bn / d x; + SALLOCATE( dBm, (1:Ndof), zero ) !total d Bm / d x; + SALLOCATE( d1B, (1:Ndof,0:Nteta-1,0:Nzeta-1), zero ) ! discretized dBn endif ! Bharm related; diff --git a/sources/diagnos.h b/sources/diagnos.h index 74f8f47..ae110a9 100644 --- a/sources/diagnos.h +++ b/sources/diagnos.h @@ -260,36 +260,27 @@ subroutine importance(icoil) INTEGER :: iteta, jzeta, NumGrid REAL :: dBx, dBy, dBz - REAL, dimension(0:Nteta-1, 0:Nzeta-1) :: lbx, lby, lbz ! local Bx, By and Bz REAL, dimension(0:Nteta-1, 0:Nzeta-1) :: tbx, tby, tbz ! summed Bx, By and Bz !--------------------------initialize and allocate arrays------------------------------------- NumGrid = Nteta*Nzeta - lbx = zero; lby = zero; lbz = zero !already allocted; reset to zero; tbx = zero; tby = zero; tbz = zero !already allocted; reset to zero; do jzeta = 0, Nzeta - 1 do iteta = 0, Nteta - 1 if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - call bfield0(icoil, iteta, jzeta, lbx(iteta, jzeta), lby(iteta, jzeta), lbz(iteta, jzeta)) + call bfield0(icoil, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & + & surf(1)%zz(iteta, jzeta), tbx(iteta, jzeta), tby(iteta, jzeta), tbz(iteta, jzeta)) enddo ! end do iteta enddo ! end do jzeta call MPI_BARRIER( MPI_COMM_WORLD, ierr ) - call MPI_REDUCE( lbx, tbx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) - call MPI_REDUCE( lby, tby, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) - call MPI_REDUCE( lbz, tbz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) - - RlBCAST( tbx, NumGrid, 0 ) ! total Bx from icoil; - RlBCAST( tby, NumGrid, 0 ) ! total By from icoil; - RlBCAST( tbz, NumGrid, 0 ) ! total Bz from icoil; - - tbx = tbx * coil(icoil)%I * bsconstant - tby = tby * coil(icoil)%I * bsconstant - tbz = tbz * coil(icoil)%I * bsconstant + call MPI_ALLREDUCE( MPI_IN_PLACE, tbx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, tby, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, tbz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) coil_importance(icoil) = sum( (tbx*surf(1)%Bx + tby*surf(1)%By + tbz*surf(1)%Bz) / & (surf(1)%Bx**2 + surf(1)%By**2 + surf(1)%Bz**2) ) / NumGrid diff --git a/sources/globals.h b/sources/globals.h index 857b397..d831404 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.04' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.05' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.h b/sources/initial.h index f9361f1..c984c9e 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -57,6 +57,9 @@ !latex \item[-1:] read the standard \emph{coils.example} file; !latex \item[0:] read FOCUS format data in \emph{example.focus}; !latex \item[1:] toroidally spaced \inputvar{Ncoils} circular coils with radius of \inputvar{init\_radius}; +!latex \item[2:] toroidally spaced \inputvar{Ncoils}-1 magnetic dipoles pointing poloidallly on the toroidal surface +!latex with radius of \inputvar{init\_radius} and a central infinitely long current. +!latex Dipole magnetizations anc the central current are all set to \inputvar{init\_current}. !latex \ei !latex !latex \item \inputvar{case\_coils = 1} \\ @@ -212,7 +215,7 @@ !latex \textit{the stopping criteria of finding minimum; if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; seen in \link{lmalg}}; !latex !latex \item \inputvar{LM\_factor = 1.000D+02} \\ -!latex \textit{factor is a positive input variable used in determining the initial step bound. this bound is set to the product of factor and the euclidean norm of diag*x if nonzero, or else to factor itself. in most cases factor should lie in the interval (.1,100.).100. is a generally recommended value. seen in \link{lmalg}}; +!latex \textit{factor is a positive input variable used in determining the initial step bound. this bound is set to the product of factor and the euclidean norm of diag*x if nonzero, or else to factor itself. in most cases factor should lie in the interval (0.1,100.0). 100 is a generally recommended value. seen in \link{lmalg}}; !latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} !latex @@ -221,9 +224,39 @@ !latex \bi \vspace{-5mm} !latex \item[ 0:] no extra post-processing; !latex \item[ 1:] evaluate the present coils for each cost functions, coil curvature, coil-coil separation, and coil-plasma separation, Bn harmonics overlap, coil importance; -!latex \item[ 2:] diagnos; write SPEC input file; (not ready) +!latex \item[ 2:] diagnos; write SPEC input file; +!latex \item[ 3:] diagnos; Field-line tracing, axis locating and iota calculating; +!latex \item[ 4:] diagnos; Field-line tracing; Calculates Bmn coefficients in Boozer coordinates; !latex \ei !latex +!latex \item \inputvar{update\_plasma = 0} \\ +!latex \textit{if euqals 1, write example.plasma file with updated Bn coefficients}; +!latex +!latex \item \inputvar{pp\_phi = 0.0} \\ +!latex \textit{Toroidal angle $\phi = pp\_phi * \pi$ for filed-line tracing, axis locating, etc.} +!latex +!latex \item \inputvar{pp\_raxis = 0.0} \\ +!latex \inputvar{pp\_zaxis = 0.0} \\ +!latex \textit{Initial guess for axis positions (raxis, zaxis). +!latex If both zero, will be overide to ($\frac{r_1+r_2}{2}, \frac{z_1+z_2}{2}$), +!latex where $r_1 = R(0, \phi)$ , $r_2=R(\pi, \phi)$ (likewise for $z_1, z_2$.)} +!latex +!latex \item \inputvar{pp\_rmax = 0.0} \\ +!latex \inputvar{pp\_zmax = 0.0} \\ +!latex \textit{Upper bounds for field-line tracing. +!latex If both zero, will be overide to ($r_1, z_1$).} +!latex +!latex \item \inputvar{pp\_ns = 10} \\ +!latex \textit{Number of surfaces for filed-line tracing, axis locating, etc. +!latex Starting points on $\phi$ will be interpolated between +!latex ($r_{axis}, z_{axis}$) and ($r_{max}, z_{max}$).} +!latex +!latex \item \inputvar{pp\_maxiter = 1000} \\ +!latex \textit{Cycles for tracing the field-line, representing the dots for each field-line in Poincare plots.} +!latex +!latex \item \inputvar{pp\_tol = 1.0E-6} \\ +!latex \textit{Tolerance of ODE solver used for tracing field-lines.} +!latex !latex \item \inputvar{save\_freq = 1} \\ !latex \textit{frequency for writing output files; should be positive; seen in \link{solvers}}; !latex diff --git a/sources/packdof.h b/sources/packdof.h index 16110de..b124481 100644 --- a/sources/packdof.h +++ b/sources/packdof.h @@ -6,10 +6,10 @@ !latex \bi !latex \item The \inputvar{case\_coils} determines the packing and unpacking patern. !latex \item \inputvar{case\_coils} = 1: Coils are represented with Fourier series. -!latex \item For each coil, the number of DOF is $6N_F+3$ ($\sin 0$ terms are omitted.) +!latex \item For each coil, the number of DOF is $6N_F+4$ ($\sin 0$ terms are omitted.) !latex \be -!latex \vect{X_i} = \left[ \overbrace{I, \underbrace{X_{c,0}, \cdots, X_{c,N}}_\text{N+1}, -!latex \underbrace{X_{s,1}, \cdots, X_{s,N}}_\text{N}, Y_{c,0}, \cdots, Z_{s,N}}^\text{6N+4} \right ] +!latex \vect{X_i} = \left [ \overbrace{I, \underbrace{X_{c,0}, \cdots, X_{c,N}}_{\text{N+1}}, +!latex \underbrace{X_{s,1}, \cdots, X_{s,N}}_{\mathrm{N}}, Y_{c,0}, \cdots, Z_{s,N}}^{\mathrm{6N+4}} \right ] !latex \ee !latex \item Coil currents/geometry can also be fixed, and they are determined by coil\%Ic and coil\%Lc. !latex \item The total number of DOF $Ndof$ should be diff --git a/sources/poinplot.h b/sources/poinplot.h index 3cd3bfd..8dae522 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -270,91 +270,19 @@ subroutine coils_bfield(s, x,y,z) INTEGER :: ierr, astat REAL :: Bx, By, Bz - INTEGER :: icoil, kseg - REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, & - m_dot_r, mx, my, mz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! s(1:4) = zero do icoil = 1, Ncoils*Npc - Bx = zero; By = zero; Bz = zero - - select case (coil(icoil)%itype) - !--------------------------------------------------------------------------------------------- - case(1) - - dlx = zero; ltx = zero - dly = zero; lty = zero - dlz = zero; ltz = zero - - do kseg = 0, coil(icoil)%NS-1 - - dlx = x - coil(icoil)%xx(kseg) - dly = y - coil(icoil)%yy(kseg) - dlz = z - coil(icoil)%zz(kseg) - rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) - - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) - - Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) - By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) - Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) - - enddo ! enddo kseg - - Bx = Bx * coil(icoil)%I * bsconstant - By = By * coil(icoil)%I * bsconstant - Bz = Bz * coil(icoil)%I * bsconstant - - !--------------------------------------------------------------------------------------------- - case(2) - - dlx = x - coil(icoil)%ox - dly = y - coil(icoil)%oy - dlz = z - coil(icoil)%oz - r2 = dlx**2 + dly**2 + dlz**2 - rm3 = one/(sqrt(r2)*r2) - mx = sin(coil(icoil)%mt) * cos(coil(icoil)%mp) - my = sin(coil(icoil)%mt) * sin(coil(icoil)%mp) - mz = cos(coil(icoil)%mt) - m_dot_r = mx * dlx + my * dly + mz * dlz - - Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - mx * rm3 - By = 3.0_dp * m_dot_r * rm3 / r2 * dly - my * rm3 - Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - mz * rm3 - - Bx = Bx * coil(icoil)%I * bsconstant - By = By * coil(icoil)%I * bsconstant - Bz = Bz * coil(icoil)%I * bsconstant - - !--------------------------------------------------------------------------------------------- - case(3) - ! might be only valid for cylindrical coordinates - ! Bt = u0*I/(2 pi R) - rr = sqrt( x**2 + y**2 ) - coil(icoil)%Bt = two/rr * coil(icoil)%I * bsconstant - - Bx = - coil(icoil)%Bt * ( y/rr ) ! sin(phi) - By = coil(icoil)%Bt * ( x/rr ) ! cos(phi) - Bz = coil(icoil)%Bz - - !--------------------------------------------------------------------------------------------- - case default - FATAL(coils_bfield, .true., not supported coil types) - end select - + call bfield0( icoil, x, y, z, Bx, By, Bz ) s(1) = s(1) + Bx s(2) = s(2) + By s(3) = s(3) + Bz - enddo - s(4) = sqrt( s(1)*s(1) + s(2)*s(2) + s(3)*s(3) ) return diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 1f34f68..d39f961 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -378,8 +378,8 @@ subroutine rdcoils !------------- permanent dipoles and background magnetic field ---------------------------------------- case( 2 ) ! averagely positioned permanent dipoles ; 2019/01/03 - allocate( coil(1:Ncoils*Npc) ) - allocate( DoF(1:Ncoils*Npc) ) + allocate( coil(1:Ncoils*Npc) ) + allocate( DoF(1:Ncoils*Npc) ) num_per_array = 16 ! number of dipoles at each toroidal cross-section num_tor = (Ncoils-1)/num_per_array ! number of toroidal arrangements diff --git a/sources/saving.h b/sources/saving.h index b57d41b..fe3af07 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -314,7 +314,7 @@ subroutine saving !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - if (Update_plasma == 1 ) call write_plasma + if (update_plasma == 1 ) call write_plasma return diff --git a/sources/solvers.h b/sources/solvers.h index c9c7cb7..1224724 100644 --- a/sources/solvers.h +++ b/sources/solvers.h @@ -35,7 +35,7 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! subroutine solvers - use globals, only: dp, ierr, iout, myid, ounit, IsQuiet, IsNormWeight, Ndof, Nouts, xdof, & + use globals, only: dp, ierr, iout, myid, ounit, zero, IsQuiet, IsNormWeight, Ndof, Nouts, xdof, & case_optimize, DF_maxiter, LM_maxiter, CG_maxiter, HN_maxiter, TN_maxiter, coil, DoF, & weight_bnorm, weight_bharm, weight_tflux, weight_ttlen, weight_cssep, & target_tflux, target_length, cssep_factor @@ -75,7 +75,7 @@ subroutine solvers call costfun(1) call saveBmn ! in bmnharm.h; iout = 0 ! reset output counter; - call output(0.0) + call output(zero) !--------------------------------DF-------------------------------------------------------------------- if (DF_maxiter > 0) then diff --git a/sources/torflux.h b/sources/torflux.h index 2dd0dda..5d5a887 100644 --- a/sources/torflux.h +++ b/sources/torflux.h @@ -227,7 +227,6 @@ subroutine torflux( ideriv ) endif - !-------------------------------------------------------------------------------------------- call MPI_barrier( MPI_COMM_WORLD, ierr ) From 2030e2393b652f63cd5f31d3dd3490fc9c4b3db9 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 15 Apr 2019 09:40:06 -0400 Subject: [PATCH 17/72] minor fixes --- sources/rdcoils.h | 2 +- sources/saving.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/sources/rdcoils.h b/sources/rdcoils.h index d39f961..0400c5c 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -201,7 +201,7 @@ subroutine rdcoils open( runit, file=trim(coilfile), status="old", action='read') read( runit,*) read( runit,*) Ncoils - write(ounit,'("rdcoils : identified "i3" unique coils in "A" ;")') Ncoils, trim(coilfile) + write(ounit,'("rdcoils : identified "i6" unique coils in "A" ;")') Ncoils, trim(coilfile) endif IlBCAST( Ncoils , 1, 0 ) diff --git a/sources/saving.h b/sources/saving.h index fe3af07..6bda15d 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -268,7 +268,7 @@ subroutine saving do ii = 0, coil(icoil)%NS-1 write(funit,1010) coil(icoil)%xx(ii), coil(icoil)%yy(ii), coil(icoil)%zz(ii), coil(icoil)%I enddo - ii = coil(icoil)%NS + ii = 0 write(funit,1010) coil(icoil)%xx(ii), coil(icoil)%yy(ii), coil(icoil)%zz(ii), & zero, icoil, coil(icoil)%name enddo From b826c2e989652534fc405b21954f1f0480226207 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 22 Apr 2019 23:26:05 -0400 Subject: [PATCH 18/72] add flexible interface for IO --- sources/bmnharm.h | 9 +++++---- sources/globals.h | 24 ++++++++++++++---------- sources/initial.h | 34 +++++++++++++++++++++------------- sources/rdcoils.h | 8 ++++---- sources/rdsurf.h | 6 +++--- sources/saving.h | 6 +++--- 6 files changed, 50 insertions(+), 37 deletions(-) diff --git a/sources/bmnharm.h b/sources/bmnharm.h index 9940e70..2218b3d 100644 --- a/sources/bmnharm.h +++ b/sources/bmnharm.h @@ -125,7 +125,8 @@ SUBROUTINE readBmn ! allocate trig functions; !---------------------------------------------------------------------------------------- use globals, only: dp, zero, half, pi2, myid, ounit, runit, ext, IsQuiet, Nteta, Nzeta, Nfp, & - NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, Nfp_raw, case_bnormal + NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, Nfp_raw, case_bnormal, & + input_harm use bharm_mod implicit none include "mpif.h" @@ -135,11 +136,11 @@ SUBROUTINE readBmn LOGICAL :: exist !---------------------------------------------------------------------------------------- - inquire( file="target.harmonics", exist=exist) + inquire( file=trim(input_harm), exist=exist) FATAL( readBmn, .not.exist, ext.harmonics does not exist ) if (myid == 0) then - open(runit, file="target.harmonics", status='old', action='read') + open(runit, file=trim(input_harm), status='old', action='read') read(runit,*) ! comment line; read(runit,*) NBmn !read dimensions endif @@ -175,7 +176,7 @@ SUBROUTINE readBmn enddo endif close(runit) - write(ounit, '("******* : case_bnormal has been reset to 0.")') + write(ounit, '("******* : case_bnormal has been reset to 0, since Bn harmonics is turned on.")') endif case_bnormal = 0 diff --git a/sources/globals.h b/sources/globals.h index d831404..84af6c0 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -68,13 +68,11 @@ module globals CHARACTER(LEN=100) :: ext ! extention CHARACTER(LEN=100) :: inputfile ! input namelist - CHARACTER(LEN=100) :: surffile ! surface file - CHARACTER(LEN=100) :: knotfile ! knototran file - CHARACTER(LEN=100) :: coilfile ! FOCUS coil file - CHARACTER(LEN=100) :: harmfile ! harmonics file + CHARACTER(LEN=100) :: knotfile ! input knot file CHARACTER(LEN=100) :: hdf5file ! hdf5 file - CHARACTER(LEN=100) :: inpcoils ! input coils.ext file - CHARACTER(LEN=100) :: outcoils ! output ext.coils file + CHARACTER(LEN=100) :: out_coils ! output ext.coils file + CHARACTER(LEN=100) :: out_focus ! output ext.focus file + CHARACTER(LEN=100) :: out_harm ! output harmonics file !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -157,8 +155,12 @@ module globals INTEGER :: pp_ns = 10 INTEGER :: pp_maxiter = 1000 REAL :: pp_xtol = 1.000D-06 - + CHARACTER(LEN=100) :: input_surf = 'plasma.boundary' ! surface file + CHARACTER(LEN=100) :: input_focus = 'none' ! FOCUS coil file + CHARACTER(LEN=100) :: input_harm = 'target.harmonics' ! input target harmonics file + CHARACTER(LEN=100) :: input_coils = 'none' ! input coils.ext file + namelist / focusin / IsQuiet , & IsSymmetric , & case_surface , & @@ -226,10 +228,12 @@ module globals pp_zmax , & pp_ns , & pp_maxiter , & - pp_xtol + pp_xtol , & + input_surf , & + input_focus , & + input_harm , & + input_coils - - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! !latex \subsection{MPI stuffs} diff --git a/sources/initial.h b/sources/initial.h index c984c9e..7e3065a 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -279,7 +279,7 @@ subroutine initial include "mpif.h" LOGICAL :: exist - INTEGER :: icpu + INTEGER :: icpu, index_dot !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -291,20 +291,28 @@ subroutine initial !-------------read input namelist---------------------------------------------------------------------- if( myid == 0 ) then ! only the master node reads the input; 25 Mar 15; call getarg(1,ext) ! get argument from command line + ! check if .input appened + index_dot = INDEX(ext,'.') + IF (index_dot .gt. 0) ext = ext(1:index_dot-1) write(ounit, '("initial : machine_prec = ", ES12.5, " ; sqrtmachprec = ", ES12.5 & & )') machprec, sqrtmachprec +#ifdef DEBUG + write(ounit, '("DEBUG info: extension from command line is "A)') trim(ext) +#endif endif ClBCAST( ext , 100, 0 ) !-------------IO files name --------------------------------------------------------------------------- inputfile = trim(ext)//".input" - surffile = "plasma.boundary" + ! input_surf = "plasma.boundary" + ! input_harm = "target.harmonics" knotfile = trim(ext)//".knot" - coilfile = trim(ext)//".focus" - harmfile = trim(ext)//".harmonics" + if (trim(input_focus) == 'none') input_focus = trim(ext)//".focus" ! if not specified + if (trim(input_focus) == 'none') input_coils = "coils."//trim(ext) hdf5file = "focus_"//trim(ext)//".h5" - inpcoils = "coils."//trim(ext) - outcoils = trim(ext)//".coils" + out_focus = trim(ext)//".focus" + out_coils = trim(ext)//".coils" + out_harm = trim(ext)//".harmonics" !-------------read the namelist----------------------------------------------------------------------- if( myid == 0 ) then @@ -360,7 +368,7 @@ subroutine initial select case (case_surface) case (0) - inquire( file=trim(surffile), exist=exist ) + inquire( file=trim(input_surf), exist=exist ) FATAL( initial, .not.exist, plasma boundary file not provided ) write(ounit, 1000) 'case_surface', case_surface, 'Read VMEC-like Fourier harmonics for plasma boundary.' case (1) @@ -379,14 +387,14 @@ subroutine initial select case( case_init ) case(-1 ) - inquire( file=trim(inpcoils), exist=exist ) + inquire( file=trim(input_coils), exist=exist ) FATAL( initial, .not.exist, coils file coils.ext not provided ) FATAL( initial, NFcoil <= 0 , no enough harmonics ) FATAL( initial, Nseg <= 0 , no enough segments ) FATAL( initial, target_length < zero, illegal ) if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Read coils in MAKEGRID format.' case( 0 ) - inquire( file=trim(coilfile), exist=exist ) + inquire( file=trim(input_focus), exist=exist ) FATAL( initial, .not.exist, FOCUS coil file ext.focus not provided ) if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Read coils in FOCUS format.' case( 1 ) @@ -543,10 +551,10 @@ subroutine initial if (IsQuiet < 0) write(ounit, '(8X,": Files saving setteings: freq = "I4" ; coils = "I1" ; harmonics = "& & I1" ; filaments = " I1)') save_freq, save_coils, save_harmonics, save_filaments if (IsQuiet < 0) then - write(ounit,'(8X,5A)') ": '", trim(coilfile), "' and '", trim(hdf5file), "' will be stored." - if (save_coils /= 0) write(ounit,'(8X, 3A)') ": new coils file '", trim(outcoils), "' will be updated." - if (save_harmonics /= 0) write(ounit,'(8X,3A)')": Bmn harmonics file '", trim(harmfile), & - & "' will be updated." + write(ounit,'(8X,5A)') ": '", trim(out_focus), "' and '", trim(hdf5file), "' will be stored." + if (save_coils /= 0) write(ounit,'(8X, 3A)') ": new coils file '", trim(out_coils), "' will be saved." + if (save_harmonics /= 0) write(ounit,'(8X,3A)')": Bmn harmonics file '", trim(out_harm), & + & "' will be saved." endif endif diff --git a/sources/rdcoils.h b/sources/rdcoils.h index 0400c5c..b97403c 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -117,8 +117,8 @@ subroutine rdcoils !-------------read coils file-------------------------------------------------------------------------- case(-1 ) if (myid == 0) then - write(ounit,'("rdcoils : Reading coils data (MAKEGRID format) from "A)') trim(inpcoils) - call readcoils(inpcoils, maxnseg) + write(ounit,'("rdcoils : Reading coils data (MAKEGRID format) from "A)') trim(input_coils) + call readcoils(input_coils, maxnseg) write(ounit,'(" : Read ",i6," coils.")') Ncoils if (IsQuiet < 0) write(ounit, '(8X,": NFcoil = "I3" ; IsVaryCurrent = "I1 & " ; IsVaryGeometry = "I1)') NFcoil, IsVaryCurrent, IsVaryGeometry @@ -198,10 +198,10 @@ subroutine rdcoils case( 0 ) if( myid==0 ) then !get file number; - open( runit, file=trim(coilfile), status="old", action='read') + open( runit, file=trim(input_focus), status="old", action='read') read( runit,*) read( runit,*) Ncoils - write(ounit,'("rdcoils : identified "i6" unique coils in "A" ;")') Ncoils, trim(coilfile) + write(ounit,'("rdcoils : identified "i6" unique coils in "A" ;")') Ncoils, trim(input_focus) endif IlBCAST( Ncoils , 1, 0 ) diff --git a/sources/rdsurf.h b/sources/rdsurf.h index 0b3229c..f3e57bd 100644 --- a/sources/rdsurf.h +++ b/sources/rdsurf.h @@ -64,7 +64,7 @@ subroutine fousurf - use globals, only : dp, zero, half, pi2, myid, ounit, runit, surffile, IsQuiet, IsSymmetric, & + use globals, only : dp, zero, half, pi2, myid, ounit, runit, input_surf, IsQuiet, IsSymmetric, & Nfou, Nfp, NBnf, bim, bin, Bnim, Bnin, Rbc, Rbs, Zbc, Zbs, Bnc, Bns, & Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw @@ -80,10 +80,10 @@ subroutine fousurf teta, zeta, arg, dd !-------------read plasma.boundary--------------------------------------------------------------------- - inquire( file=trim(surffile), exist=exist) + inquire( file=trim(input_surf), exist=exist) FATAL( surface, .not.exist, plasma.boundary does not exist ) if( myid == 0 ) then - open(runit, file=trim(surffile), status='old', action='read') + open(runit, file=trim(input_surf), status='old', action='read') read(runit,*) !empty line read(runit,*) Nfou, Nfp, NBnf !read dimensions endif diff --git a/sources/saving.h b/sources/saving.h index 6bda15d..4ad3117 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -215,7 +215,7 @@ subroutine saving !--------------------------write focus coil file----------------------------------------- if( save_coils == 1 ) then - open( wunit, file=trim(coilfile), status="unknown", form="formatted") + open( wunit, file=trim(out_focus), status="unknown", form="formatted") write(wunit, *) "# Total number of coils" write(wunit, '(8X,I6)') Ncoils @@ -260,7 +260,7 @@ subroutine saving if( save_coils == 1 ) then - open(funit,file=trim(outcoils), status="unknown", form="formatted" ) + open(funit,file=trim(out_coils), status="unknown", form="formatted" ) write(funit,'("periods "I3)') Nfp_raw write(funit,'("begin filament")') write(funit,'("mirror NIL")') @@ -301,7 +301,7 @@ subroutine saving if (save_harmonics == 1 .and. allocated(Bmnc)) then - open(wunit, file=trim(harmfile), status='unknown', action='write') + open(wunit, file=trim(out_harm), status='unknown', action='write') write(wunit,'("#NBmn")') ! comment line; write(wunit,'(I6)') NBmn ! write dimensions write(wunit,'("# n m Bmnc Bmns wBmn")') ! comment line; From 5815db470bb23ad2ffd7fe0ab4f31beea890ef74 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 23 Apr 2019 10:11:10 -0400 Subject: [PATCH 19/72] add flexible interfaces for IO --- sources/globals.h | 19 +++-- sources/initial.h | 179 ++++++++++++++++++++++++++++++---------------- sources/rdcoils.h | 4 +- sources/rdknot.h | 2 +- sources/saving.h | 8 ++- 5 files changed, 136 insertions(+), 76 deletions(-) diff --git a/sources/globals.h b/sources/globals.h index 84af6c0..e62ed04 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.05' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.06' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -68,11 +68,11 @@ module globals CHARACTER(LEN=100) :: ext ! extention CHARACTER(LEN=100) :: inputfile ! input namelist - CHARACTER(LEN=100) :: knotfile ! input knot file CHARACTER(LEN=100) :: hdf5file ! hdf5 file CHARACTER(LEN=100) :: out_coils ! output ext.coils file CHARACTER(LEN=100) :: out_focus ! output ext.focus file CHARACTER(LEN=100) :: out_harm ! output harmonics file + CHARACTER(LEN=100) :: out_plasma ! updated plasma boundary !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -157,12 +157,14 @@ module globals REAL :: pp_xtol = 1.000D-06 CHARACTER(LEN=100) :: input_surf = 'plasma.boundary' ! surface file - CHARACTER(LEN=100) :: input_focus = 'none' ! FOCUS coil file + CHARACTER(LEN=100) :: input_coils = 'none' ! input file for coils CHARACTER(LEN=100) :: input_harm = 'target.harmonics' ! input target harmonics file - CHARACTER(LEN=100) :: input_coils = 'none' ! input coils.ext file namelist / focusin / IsQuiet , & - IsSymmetric , & + IsSymmetric , & + input_surf , & + input_harm , & + input_coils , & case_surface , & knotsurf , & ellipticity , & @@ -228,11 +230,8 @@ module globals pp_zmax , & pp_ns , & pp_maxiter , & - pp_xtol , & - input_surf , & - input_focus , & - input_harm , & - input_coils + pp_xtol + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.h b/sources/initial.h index 7e3065a..5aee9a5 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -8,7 +8,8 @@ !latex \section{Input namelist} !latex The \emph{focusin} namelist is the only input namelist needed for FOCUS running. It should be -!latex written from the file \emph{example.input}. Here are the details for the variables. \\ +!latex written to the file \emph{example.input}, where `example' is the argument passed by command line. +!latex Here are the details for the variables. \\ !latex \bi !latex \item \inputvar{IsQuiet = -1} \\ !latex \textit{Information displayed to the user} \\ @@ -29,6 +30,19 @@ !latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} !latex +!latex \item \inputvar{input\_surf = 'plasma.boundary'} \\ +!latex \textit{Input file containing plasma boundary information.} +!latex +!latex \item \inputvar{input\_coils = 'none'} \\ +!latex \textit{Input file containing initial guess for coils (in either format).} +!latex If it is 'none' by default, it will be updated to 'coils.example' (case\_init=-1) +!latex or 'example.focus' (case\_init=0). +!latex +!latex \item \inputvar{input\_harm = 'target.harmonics'} \\ +!latex \textit{Input file containing the target harmonics for Bmn optimization.} +!latex +!latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} +!latex !latex \item \inputvar{case\_surface = 0} \\ !latex \textit{Specify the input plasma boundary format} \\ !latex \bi \vspace{-5mm} @@ -291,28 +305,31 @@ subroutine initial !-------------read input namelist---------------------------------------------------------------------- if( myid == 0 ) then ! only the master node reads the input; 25 Mar 15; call getarg(1,ext) ! get argument from command line - ! check if .input appened - index_dot = INDEX(ext,'.') - IF (index_dot .gt. 0) ext = ext(1:index_dot-1) - write(ounit, '("initial : machine_prec = ", ES12.5, " ; sqrtmachprec = ", ES12.5 & - & )') machprec, sqrtmachprec + + select case(trim(ext)) + case ( '-h', '--help' ) + write(ounit,*)'-------HELP INFORMATION--------------------------' + write(ounit,*)' Usage: xfocus input_file' + write(ounit,*)' ' + write(ounit,*)' --init / -i : Write an example input file' + write(ounit,*)' --help / -h : Output help message' + write(ounit,*)'-------------------------------------------------' + call MPI_ABORT( MPI_COMM_WORLD, 1, ierr ) + case ( '-i', '--init' ) + call write_focus_namelist ! in initial.h + case default + index_dot = INDEX(ext,'.') + IF (index_dot .gt. 0) ext = ext(1:index_dot-1) + write(ounit, '("initial : machine_prec = ", ES12.5, " ; sqrtmachprec = ", ES12.5 & + & )') machprec, sqrtmachprec #ifdef DEBUG - write(ounit, '("DEBUG info: extension from command line is "A)') trim(ext) + write(ounit, '("DEBUG info: extension from command line is "A)') trim(ext) #endif + end select endif - ClBCAST( ext , 100, 0 ) - !-------------IO files name --------------------------------------------------------------------------- + ClBCAST( ext, 100, 0 ) inputfile = trim(ext)//".input" - ! input_surf = "plasma.boundary" - ! input_harm = "target.harmonics" - knotfile = trim(ext)//".knot" - if (trim(input_focus) == 'none') input_focus = trim(ext)//".focus" ! if not specified - if (trim(input_focus) == 'none') input_coils = "coils."//trim(ext) - hdf5file = "focus_"//trim(ext)//".h5" - out_focus = trim(ext)//".focus" - out_coils = trim(ext)//".coils" - out_harm = trim(ext)//".harmonics" !-------------read the namelist----------------------------------------------------------------------- if( myid == 0 ) then @@ -329,12 +346,56 @@ subroutine initial endif ! end of if( myid == 0 ) enddo + !-------------output files name --------------------------------------------------------------------------- + + hdf5file = "focus_"//trim(ext)//".h5" + out_focus = trim(ext)//".focus" + out_coils = trim(ext)//".coils" + out_harm = trim(ext)//".harmonics" + out_plasma = trim(ext)//".plasma" + !-------------show the namelist for checking---------------------------------------------------------- if (myid == 0) then ! Not quiet to output more informations; write(ounit, *) "-----------INPUT NAMELIST------------------------------------" - write(ounit, '("initial : Read namelist focusin from ", A)') trim(inputfile) + write(ounit, '("initial : Read namelist focusin from : ", A)') trim(inputfile) + write(ounit, '(" : Read plasma boundary from : ", A)') trim(input_surf) + if (weight_bharm > machprec) then + write(ounit, '(" : Read Bmn harmonics from : ", A)') trim(input_harm) + endif + + select case( case_init ) + case(-1 ) + if (trim(input_coils) == 'none') input_coils = "coils."//trim(ext) + inquire( file=trim(input_coils), exist=exist ) + FATAL( initial, .not.exist, coils file coils.ext not provided ) + FATAL( initial, NFcoil <= 0 , no enough harmonics ) + FATAL( initial, Nseg <= 0 , no enough segments ) + FATAL( initial, target_length < zero, illegal ) + write(ounit, '(" : Read initial coils from : ", A, A)') trim(input_coils), '(MAKEGRID format)' + case( 0 ) + if (trim(input_coils) == 'none') input_coils = trim(ext)//".focus" + inquire( file=trim(input_coils), exist=exist ) + FATAL( initial, .not.exist, FOCUS coil file ext.focus not provided ) + write(ounit, '(" : Read initial coils from : ", A, A)') trim(input_coils), '(MAKEGRID format)' + case( 1 ) + FATAL( initial, Ncoils < 1, should provide the No. of coils) + FATAL( initial, init_current == zero, invalid coil current) + FATAL( initial, init_radius < zero, invalid coil radius) + FATAL( initial, NFcoil <= 0 , no enough harmonics ) + FATAL( initial, Nseg <= 0 , no enough segments ) + FATAL( initial, target_length < zero, illegal ) + if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Initialize circular coils.' + case( 2 ) + FATAL( initial, Ncoils < 1, should provide the No. of coils) + FATAL( initial, init_current == zero, invalid coil current) + FATAL( initial, init_radius < zero, invalid coil radius) + FATAL( initial, target_length < zero, illegal ) + if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Initialize magnetic dipoles.' + case default + FATAL( initial, .true., selected case_init is not supported ) + end select select case (IsQuiet) case (:-2) @@ -372,7 +433,7 @@ subroutine initial FATAL( initial, .not.exist, plasma boundary file not provided ) write(ounit, 1000) 'case_surface', case_surface, 'Read VMEC-like Fourier harmonics for plasma boundary.' case (1) - inquire( file=trim(knotfile), exist=exist ) + inquire( file=trim(input_surf), exist=exist ) FATAL( initial, .not.exist, axis file not provided ) FATAL( initial, knotsurf < zero, illegal minor radius) write(ounit, 1000) 'case_surface', case_surface, 'Read axis information for expanding plasma boundary.' @@ -385,36 +446,6 @@ subroutine initial FATAL( initial, Nteta <= 0, illegal surface resolution ) FATAL( initial, Nzeta <= 0, illegal surface resolution ) - select case( case_init ) - case(-1 ) - inquire( file=trim(input_coils), exist=exist ) - FATAL( initial, .not.exist, coils file coils.ext not provided ) - FATAL( initial, NFcoil <= 0 , no enough harmonics ) - FATAL( initial, Nseg <= 0 , no enough segments ) - FATAL( initial, target_length < zero, illegal ) - if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Read coils in MAKEGRID format.' - case( 0 ) - inquire( file=trim(input_focus), exist=exist ) - FATAL( initial, .not.exist, FOCUS coil file ext.focus not provided ) - if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Read coils in FOCUS format.' - case( 1 ) - FATAL( initial, Ncoils < 1, should provide the No. of coils) - FATAL( initial, init_current == zero, invalid coil current) - FATAL( initial, init_radius < zero, invalid coil radius) - FATAL( initial, NFcoil <= 0 , no enough harmonics ) - FATAL( initial, Nseg <= 0 , no enough segments ) - FATAL( initial, target_length < zero, illegal ) - if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Initialize circular coils.' - case( 2 ) - FATAL( initial, Ncoils < 1, should provide the No. of coils) - FATAL( initial, init_current == zero, invalid coil current) - FATAL( initial, init_radius < zero, invalid coil radius) - FATAL( initial, target_length < zero, illegal ) - if (IsQuiet < 1) write(ounit, 1000) 'case_init', case_init, 'Initialize magnetic dipoles.' - case default - FATAL( initial, .true., selected case_init is not supported ) - end select - FATAL( initial, case_coils /= 1, only fourier representation is valid ) if (IsQuiet < 0) write(ounit, 1000) 'case_coils', case_coils, 'Using Fourier series as the basic representation.' @@ -542,19 +573,22 @@ subroutine initial & 'Coil evaluations and field-line tracing will be performed.' case ( 4 ) if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & - & 'Coil evaluations and writing last surface will be performed.' + & 'Vacuum Boozer coordinates decompostion will be performed.' case default FATAL( initial, .true., selected case_postproc is not supported ) end select FATAL( initial, save_freq <= 0, should not be negative ) - if (IsQuiet < 0) write(ounit, '(8X,": Files saving setteings: freq = "I4" ; coils = "I1" ; harmonics = "& - & I1" ; filaments = " I1)') save_freq, save_coils, save_harmonics, save_filaments - if (IsQuiet < 0) then - write(ounit,'(8X,5A)') ": '", trim(out_focus), "' and '", trim(hdf5file), "' will be stored." - if (save_coils /= 0) write(ounit,'(8X, 3A)') ": new coils file '", trim(out_coils), "' will be saved." - if (save_harmonics /= 0) write(ounit,'(8X,3A)')": Bmn harmonics file '", trim(out_harm), & - & "' will be saved." + write(ounit, '("outputs : HDF5 outputs are saved in : ", A)') trim(hdf5file) + if (save_coils /= 0) then + write(ounit, '("outputs : Optimizated coils are saved in : ", A, " ; ", A)') & + trim(out_focus), trim(out_coils) + endif + if (weight_bharm > machprec) then + write(ounit, '("outputs : Realized Bn harmonics are saved in : ", A)') trim(out_harm) + endif + if (update_plasma/=0) then + write(ounit, '("outputs : Updated plasma boundary is saved in : ", A)') trim(out_plasma) endif endif @@ -579,9 +613,32 @@ subroutine initial call MPI_BARRIER( MPI_COMM_WORLD, ierr ) - return - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - end subroutine initial + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +SUBROUTINE write_focus_namelist + use globals + implicit none + include "mpif.h" + + LOGICAL :: exist + CHARACTER(LEN=100) :: example = 'example.input' + + if( myid == 0 ) then + inquire(file=trim(example), EXIST=exist) ! inquire if inputfile existed; + FATAL( initial, exist, example input file example.input already existed ) + write(ounit, *) 'Writing an template input file in ', trim(example) + open(wunit, file=trim(example), status='unknown', action='write') + write(wunit, focusin) + close(wunit) + endif + + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) + call MPI_FINALIZE( ierr ) + stop + + return +END SUBROUTINE write_focus_namelist diff --git a/sources/rdcoils.h b/sources/rdcoils.h index b97403c..dbe548e 100644 --- a/sources/rdcoils.h +++ b/sources/rdcoils.h @@ -198,10 +198,10 @@ subroutine rdcoils case( 0 ) if( myid==0 ) then !get file number; - open( runit, file=trim(input_focus), status="old", action='read') + open( runit, file=trim(input_coils), status="old", action='read') read( runit,*) read( runit,*) Ncoils - write(ounit,'("rdcoils : identified "i6" unique coils in "A" ;")') Ncoils, trim(input_focus) + write(ounit,'("rdcoils : identified "i6" unique coils in "A" ;")') Ncoils, trim(input_coils) endif IlBCAST( Ncoils , 1, 0 ) diff --git a/sources/rdknot.h b/sources/rdknot.h index b472b3f..3306e46 100644 --- a/sources/rdknot.h +++ b/sources/rdknot.h @@ -24,7 +24,7 @@ subroutine rdknot use globals, only : dp, zero, one, half, ten, pi2, sqrtmachprec, myid, ncpu, ounit, runit, & - ext, & + ext, input_surf, & NFcoil, knotsurf, knotphase, & xkc, xks, ykc, yks, zkc, zks!, kspring, tauend, itau diff --git a/sources/saving.h b/sources/saving.h index 4ad3117..49605e0 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -69,6 +69,9 @@ subroutine saving !INPUT namelist; HWRITEIV( 1 , IsQuiet , IsQuiet ) HWRITEIV( 1 , IsSymmetric , IsSymmetric ) + HWRITECH( 100 , input_surf , input_surf ) + HWRITECH( 100 , input_coils , input_coils ) + HWRITECH( 100 , input_harm , input_harm ) HWRITEIV( 1 , case_surface , case_surface ) HWRITERV( 1 , knotsurf , knotsurf ) HWRITEIV( 1 , Nteta , Nteta ) @@ -119,6 +122,7 @@ subroutine saving HWRITEIV( 1 , save_coils , save_coils ) HWRITEIV( 1 , save_harmonics, save_harmonics ) HWRITEIV( 1 , save_filaments, save_filaments ) + HWRITEIV( 1 , update_plasma , update_plasma ) HWRITERV( 1 , pp_phi , pp_phi ) HWRITERV( 1 , pp_raxis , pp_raxis ) HWRITERV( 1 , pp_zaxis , pp_zaxis ) @@ -330,7 +334,7 @@ SUBROUTINE write_plasma !-------------------------------------------------------------------------------! use globals, only : dp, zero, half, two, pi2, myid, ncpu, ounit, wunit, ext, & Nfou, Nfp, NBnf, bim, bin, Bnim, Bnin, Rbc, Rbs, Zbc, Zbs, Bnc, Bns, & - Nteta, Nzeta, surf, Nfp_raw, bnorm, sqrtmachprec + Nteta, Nzeta, surf, Nfp_raw, bnorm, sqrtmachprec, out_plasma implicit none include "mpif.h" @@ -407,7 +411,7 @@ SUBROUTINE write_plasma !---------------------------------------------- - open(wunit, file=trim(ext)//".plasma", status='unknown', action='write') + open(wunit, file=trim(out_plasma), status='unknown', action='write') write(wunit,* ) "#Nfou Nfp Nbnf" write(wunit,'(3I)' ) Nfou, Nfp_raw, Nbnf From 2a9cdd2bc05121ad138cd2a64ce1752428e860a3 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 23 Apr 2019 10:24:02 -0400 Subject: [PATCH 20/72] update documentations --- sources/focus.h | 59 +++-------------------------------------------- sources/globals.h | 2 +- sources/initial.h | 10 ++++---- 3 files changed, 9 insertions(+), 62 deletions(-) diff --git a/sources/focus.h b/sources/focus.h index bcde85c..35f5189 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -16,64 +16,11 @@ !latex coils using space curves (either Fundamental theorem of space curves or Fourier series or other !latex representations.). And for the first time, the derivatives (both the first and the second ones) !latex are analytically calculated. \par - -!latex Parts of the code were first written by -!latex \href{http://w3.pppl.gov/~shudson/}{\blu{Dr. Stuart R. Hudson}} in April 2016. -!latex Then Caoxiang Zhu (CZHU) took over the whole project and it's currently under developping. +!latex For more information, please visti \href{https://princetonuniversity.github.io/FOCUS/} !latex If you have any questions, please send a email to czhu@pppl.gov (or zcxiang@mail.ustc.edu.cn). -!latex \subsection{Update Diary} -!latex 2015/10/30: Dr. Stuart Hudson wrote the code {\bf OPTIM} using -!latex \nag{http://www.nag.co.uk/numeric/FL/manual19/pdf/E04/e04jyf_fl19.pdf}{E04JYF} to find the -!latex optimal Fourier series for coils on a given winding surface. \par -!latex 2016/04/xx: New code {\bf KNOTOPT} that represents coils using 3D Fourier series was written.\par -!latex 2016/04/21: CZHU began to join the project and mainly took over the project. \par -!latex 2016/xx/xx: A lot of new stuffs were added in but not well documented. \par -!latex 2016/11/01: The code was renmaed to FOCUS and a poster was presented by CZHU at the APS-DPP -!latex meeting in San Jose, CA. \par -!latex 2017/02/15: A re-writing for debugging and better structure began by CZHU. \par -!latex 2017/04/04: The code repository was tranported to Princeton University @ GitHub \par -!latex 2017/05/15: Nonlinear Conjugate Gradient method was implemented. \par -!latex 2017/05/20: Truncated Newton Method with Preconditioning CG method was implemented.\par -!latex 2017/06/04: The first paper introducing FOCUS was submitted to Nuclear Fusion. \par -!latex 2017/06/07: Hybrid Newton method was implemented. \par -!latex 2017/06/23: NAG and OCULUS dependance have been removed in the new code.\par -!latex 2017/07/18: Enable field periodicity and add coil diagnostic part. \par -!latex 2018/06/19: Update diary in this doc will not be 'updated' any more. Please view the website. \par - -!!$!latex \subsection{Structure of the code} -!!$!latex \begin{tikzpicture}[node distance=2cm, auto] -!!$!latex \node [block] (start) {Main program in \link{focus}}; -!!$!latex \node [io, below of=start] (input) {read input in \link{initial} \& allocate data in \link{datalloc}}; -!!$!latex \node [io, below of=input] (surface) {read \& discretize surface data in \link{rdsurf}}; -!!$!latex \node [io, below of=surface] (coils) {initialize coils data in \link{rdcoils}}; -!!$!latex \node [cloud, left of=coils, xshift=-4cm, yshift=1.0cm] (diagnos) -!!$!latex {coils evaluation in \link{diagnos}}; -!!$!latex \node [block, below of=coils] (pack) {Packing degrees of freedom in \link{packdof}}; -!!$!latex \node [decision, below of=pack,] (optimizer) {Optimizing in \link{solvers}}; -!!$!latex \node [block, right of=optimizer, xshift=2.5cm] (unpack) -!!$!latex {unpack DOF to coils in \link{packdof}}; -!!$!latex \node [block, right of=unpack, xshift=2cm] (costfun) -!!$!latex {calculate the cost functions in \link{solvers}}; -!!$!latex \node [block, below of=optimizer, yshift=-1.5cm] (postproc) {post proceedings}; -!!$!latex \node [io, below of=postproc] (output) {saving all the data in \link{saving}}; -!!$!latex \node [block, below of=output] (clean) {clean and finish in \link{cleanup}}; -!!$ -!!$!latex \path [line] (start) -- (input); -!!$!latex \path [line] (input) -- (surface); -!!$!latex \path [line] (surface) -- (coils); -!!$!latex \path [line, dashed] (surface) -| (diagnos); -!!$!latex \path [line, dashed] (coils) -| (diagnos); -!!$!latex \path [line] (coils) -- (pack); -!!$!latex \path [line] (pack) -- (optimizer); -!!$!latex \path [line] (optimizer) -- node {iterations} (unpack); -!!$!latex \path [line] (unpack) -- (costfun); -!!$!latex \path [line] (costfun) |- (pack); -!!$!latex \path [line] (optimizer) -- node {is over} (postproc); -!!$!latex \path [line] (postproc) -- (output); -!!$!latex \path [line, dashed] (postproc) -| (diagnos); -!!$!latex \path [line] (output) -- (clean); -!!$!latex \end{tikzpicture} +!latex \subsection{How to execute} +!latex A brief help message will be printed if you just type `xfocus --help` !latex \subsection{Misc} !latex \bi diff --git a/sources/globals.h b/sources/globals.h index e62ed04..03cde6d 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.06' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.08' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.h b/sources/initial.h index 5aee9a5..4d3f9e2 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -30,15 +30,15 @@ !latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} !latex -!latex \item \inputvar{input\_surf = 'plasma.boundary'} \\ +!latex \item \inputvar{input\_surf = `plasma.boundary'} \\ !latex \textit{Input file containing plasma boundary information.} !latex -!latex \item \inputvar{input\_coils = 'none'} \\ +!latex \item \inputvar{input\_coils = `none'} \\ !latex \textit{Input file containing initial guess for coils (in either format).} !latex If it is 'none' by default, it will be updated to 'coils.example' (case\_init=-1) !latex or 'example.focus' (case\_init=0). !latex -!latex \item \inputvar{input\_harm = 'target.harmonics'} \\ +!latex \item \inputvar{input\_harm = `target.harmonics'} \\ !latex \textit{Input file containing the target harmonics for Bmn optimization.} !latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} @@ -68,8 +68,8 @@ !latex \item \inputvar{case\_init = 0} \\ !latex \textit{Specify the initializing method for coils, seen in \link{rdcoils}} \\ !latex \bi \vspace{-5mm} -!latex \item[-1:] read the standard \emph{coils.example} file; -!latex \item[0:] read FOCUS format data in \emph{example.focus}; +!latex \item[-1:] read the standard MAKEGRID format coils from \inputvar{input_coils}; +!latex \item[0:] read FOCUS format data from \inputvar{input_coils}; !latex \item[1:] toroidally spaced \inputvar{Ncoils} circular coils with radius of \inputvar{init\_radius}; !latex \item[2:] toroidally spaced \inputvar{Ncoils}-1 magnetic dipoles pointing poloidallly on the toroidal surface !latex with radius of \inputvar{init\_radius} and a central infinitely long current. From da7908220c37b7f4e53e3eee8527b9febd0b0632 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 23 Apr 2019 10:55:45 -0400 Subject: [PATCH 21/72] revise command-line reading extension --- sources/initial.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/initial.h b/sources/initial.h index 4d3f9e2..89a842a 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -318,7 +318,7 @@ subroutine initial case ( '-i', '--init' ) call write_focus_namelist ! in initial.h case default - index_dot = INDEX(ext,'.') + index_dot = INDEX(ext,'.input') IF (index_dot .gt. 0) ext = ext(1:index_dot-1) write(ounit, '("initial : machine_prec = ", ES12.5, " ; sqrtmachprec = ", ES12.5 & & )') machprec, sqrtmachprec From 7d527eae8e330b02b3cb6ba04a29f704d8834a52 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Fri, 26 Apr 2019 16:18:15 -0400 Subject: [PATCH 22/72] optimize MPI settings in Fieldline tracing --- sources/boozer.h | 130 +------------------------- sources/globals.h | 4 +- sources/poinplot.h | 221 +++++++++++++++++++++++++++++---------------- 3 files changed, 147 insertions(+), 208 deletions(-) diff --git a/sources/boozer.h b/sources/boozer.h index db22dbb..306495b 100644 --- a/sources/boozer.h +++ b/sources/boozer.h @@ -47,7 +47,8 @@ end subroutine boozmn subroutine boozsurf(XYZB, x, y, z, iota, isurf) USE globals, only : dp, myid, ncpu, zero, half, two, pi, pi2, ounit, total_num, pp_maxiter, & - bmin, bmim, booz_mnc, booz_mns, booz_mn, machprec + bmin, bmim, booz_mnc, booz_mns, booz_mn, machprec, & + masterid USE mpi IMPLICIT NONE @@ -172,7 +173,7 @@ subroutine boozsurf(XYZB, x, y, z, iota, isurf) ! finish decomposition write(ounit, '("boozmn : myid="I6" ; Gpol="ES12.5" ; iota="ES12.5" ; Booz_mnc(1)="ES12.5 & - " ; Booz_mns(1)="ES12.5)') myid, Gpol, iota, booz_mnc(1, isurf), booz_mns(1, isurf) + " ; Booz_mns(1)="ES12.5)') masterid, Gpol, iota, booz_mnc(1, isurf), booz_mns(1, isurf) return end subroutine boozsurf @@ -385,128 +386,3 @@ end subroutine fieldline_tracing !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - -subroutine wtmgrid - use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit - implicit none - - include "mpif.h" - - -!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - - LOGICAL :: exist - INTEGER :: ierr, astat, iostat, imn, ibn00aa, ip, iz, ir, np, nz, nr, itangent, ibfield, Mfp, nextcur - REAL :: RpZ(1:3), R, P, Z, Pmin, Pmax, Zmin, Zmax, Rmin, Rmax, B(1:4), pressure, gap, & - czeta, szeta, xx, yy, zz, dx, dy, dz, dBx, dBy, dBz - REAL, allocatable :: BRZp(:,:,:,:), dBRZp(:,:,:,:), BRpZ(:,:,:,:), dBRpZ(:,:,:,:) - CHARACTER*13 :: suffix - CHARACTER*30 :: curlabel(1:1) - - np = 72 ; nz = 121 ; nr = 121 ; Mfp = 2 ! SHOULD BE USER INPUT; 04 Aug 16; - !np = 12 ; nz = 11 ; nr = 11 ; Mfp = 2 ! SHOULD BE USER INPUT; 04 Aug 16; - B = zero ; dx = 1E-4 ; dy = 1E-4 ; dz = 1E-4 - - SALLOCATE( BRZp, (1:3,1:Nr,1:Nz,1:Np), zero ) - SALLOCATE(dBRZp, (1:3,1:Nr,1:Nz,1:Np), zero ) - SALLOCATE( BRpZ, (1:2,1:Nr,1:Nz,1:Np), zero ) - SALLOCATE(dBRpZ, (1:2,1:Nr,1:Nz,1:Np), zero ) - - Pmin = zero ; Pmax = pi2 ! DO NOT CHANGE; 04 Aug 16; - - !call plasdim(Rmin, Rmax, Zmin, Zmax) !calculate plasma surface boundary ;09/11/2016 - !call coildim(Rmin, Rmax, Zmin, Zmax) - - !gap = 0.3 - !Rmin = Rmin -gap; Rmax = Rmax + gap - !Zmin = Zmin -gap; Zmax = Zmax + gap - - Rmin = 2.8 ; Rmax = 3.2 - Zmin = -0.2 ; Zmax = 0.2 - - if( myid.eq.0 ) write( ounit,'("wtmgrid : writing mgrid file at grid of [ "4(ES12.5,2X)" ]",3i6)') Rmin, Rmax, Zmin, Zmax, np, nr, nz - - do ip = 1, np ; RpZ(2) = Pmin + ( Pmax - Pmin ) * ( ip - 1 ) / ( np - 0 ) / Mfp - - if ( myid.ne.modulo(ip,ncpu) ) cycle - - do iz = 1, nz ; RpZ(3) = Zmin + ( Zmax - Zmin ) * ( iz - 1 ) / ( nz - 1 ) - - do ir = 1, nr ; RpZ(1) = Rmin + ( Rmax - Rmin ) * ( ir - 1 ) / ( nr - 1 ) - - czeta = cos(RpZ(2)) - szeta = sin(RpZ(2)) - - xx = RpZ(1) * czeta - yy = RpZ(1) * szeta - zz = RpZ(3) - - call coils_bfield(B,xx,yy,zz) - - dBRZp(1,ir,iz,ip) = ( B(1) * czeta + B(2) * szeta ) - dBRZp(3,ir,iz,ip) = ( - B(1) * szeta + B(2) * czeta ) - dBRZp(2,ir,iz,ip) = B(3) - - dBx = B(1) ; dBy = B(2) ; dBz = B(3) - dBRpZ(2,ir,iz,ip) = B(4) - - xx = xx + dx - call coils_bfield(B,xx,yy,zz) - dBx = ( B(1) - dBx ) / dx - xx = xx - dx - - yy = yy + dy - call coils_bfield(B,xx,yy,zz) - dBy = ( B(2) - dBy ) / dy - yy = yy - dy - - zz = zz + dz - call coils_bfield(B,xx,yy,zz) - dBz = ( B(3) - dBz ) / dz - zz = zz - dz - - ! write(ounit, '("(x, y, z) = "3ES12.5" ; div B = " ES12.5)') xx, yy, zz, dBx + dBy + dBz - dBRpZ(1,ir,iz,ip) = dBx + dBy + dBz - dBRpZ(2,ir,iz,ip) = dBRpZ(1,ir,iz,ip) / dBRpZ(2,ir,iz,ip) - - enddo - - enddo - - enddo - - call MPI_Reduce(dBRZp, BRZp, 3*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr) - call MPI_Reduce(dBRpZ, BRpZ, 2*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr) - - if( myid.eq.0 ) then - - write(ounit, '("wtmgrid : max. div B = "ES23.15 " ; max. div B / |B| = "ES23.15 )') maxval(BRpZ(1,1:Nr,1:Nz,1:Np)), maxval(BRpZ(2,1:Nr,1:Nz,1:Np)) - - nextcur = 1 ; curlabel(1) = "focus-space-curves" - - write(suffix,'(i3.3,".",i4.4,".",i4.4)') Np, Nr, Nz - - write( ounit,'("wtmgrid : writing mgrid.ext.f."i3.3"."i4.4"."i4.4" ; Mfp="i3" ;")') np, nr, nz, Mfp - - !open( wunit, file=trim(ext)//".fo.mgrid", status="unknown", form="unformatted", iostat=iostat ) - open( wunit, file="mgrid."//trim(ext)//".f."//suffix, status="unknown", form="unformatted", iostat=iostat ) - FATAL( wtmgrid, iostat.ne.0, error opening ext.fo.mgrid ) - write(wunit) Nr, Nz, Np, Mfp, nextcur - write(wunit) Rmin, Zmin, Rmax, Zmax - write(wunit) curlabel(1:nextcur) - write(wunit) BRZp(1:3,1:Nr,1:Nz,1:Np) - close(wunit) - - endif - - DEALLOCATE(dBRZp) - DEALLOCATE( BRZp) - DEALLOCATE(dBRpZ) - DEALLOCATE( BRpZ) - - -!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - - return - -end subroutine wtmgrid diff --git a/sources/globals.h b/sources/globals.h index 03cde6d..9ef804c 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -236,7 +236,9 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! !latex \subsection{MPI stuffs} - INTEGER :: myid, ncpu + INTEGER, PARAMETER :: master=0 + INTEGER :: myid, ncpu, myworkid, color, masterid, nmaster, nworker + INTEGER :: MPI_COMM_MASTERS = 101, MPI_COMM_MYWORLD = 102, MPI_COMM_WORKERS = 103 REAL :: machprec, vsmall, small, sqrtmachprec CHARACTER :: nodelabel*3 diff --git a/sources/poinplot.h b/sources/poinplot.h index 8dae522..55f67f4 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -5,7 +5,8 @@ SUBROUTINE poinplot !------------------------------------------------------------------------------------------------------ USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw, & - XYZB, lboozmn, booz_mnc, booz_mns, booz_mn, total_num + XYZB, lboozmn, booz_mnc, booz_mns, booz_mn, total_num, & + master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS USE mpi IMPLICIT NONE @@ -14,7 +15,8 @@ SUBROUTINE poinplot INTEGER :: ierr, astat, iflag INTEGER :: ip, is, niter REAL :: theta, zeta, r, RZ(2), r1, z1, rzrzt(5), x, y, z, tmpB(4) - REAL, ALLOCATABLE :: lppr(:,:), lppz(:,:), liota(:) ! local ppr ppz + ! REAL, ALLOCATABLE :: lppr(:,:), lppz(:,:), liota(:) ! local ppr ppz + REAL :: B(4), start, finish !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -32,80 +34,112 @@ SUBROUTINE poinplot pp_raxis = (r+r1)*half pp_zaxis = (z+z1)*half endif - - if (myid == 0) then - RZ(1) = pp_raxis ; RZ(2) = pp_zaxis - call find_axis(RZ, pp_maxiter, pp_xtol) - pp_raxis = RZ(1) ; pp_zaxis = RZ(2) - endif - !endif - call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; - RlBCAST( pp_raxis, 1, 0 ) - RlBCAST( pp_zaxis, 1, 0 ) - - ! poincare plot and calculate iota - SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) - SALLOCATE( ppz , (1:pp_ns, 0:pp_maxiter), zero ) - SALLOCATE( lppr, (1:pp_ns, 0:pp_maxiter), zero ) - SALLOCATE( lppz, (1:pp_ns, 0:pp_maxiter), zero ) - SALLOCATE( iota, (1:pp_ns) , zero ) - SALLOCATE(liota, (1:pp_ns) , zero ) - - ! if pp_rmax and pp_zmax not provied - if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then - zeta = pp_phi - theta = zero ; call surfcoord( theta, zeta, r , z ) - pp_rmax = r*1.0 ; pp_zmax = z*1.0 + + ! split cores for calculating axis + color = 0 + !CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) + CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MYWORLD, ierr) + CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) + CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) + + if (myworkid /= 0) then ! slave cores waiting in coils_bfield + call coils_bfield(B, x, y, z, 'work') + else + RZ(1) = pp_raxis ; RZ(2) = pp_zaxis + start = MPI_Wtime() + call find_axis(RZ, pp_maxiter, pp_xtol) + finish = MPI_Wtime() + !print *, 'finding axis takes ', finish-start + pp_raxis = RZ(1) ; pp_zaxis = RZ(2) + call coils_bfield(B, x, y, z, 'exit') ! finish endif - if(myid==0) write(ounit, '("poinplot: following fieldlines between ("ES12.5 & - ","ES12.5" ) and ("ES12.5","ES12.5" )")') pp_raxis, pp_zaxis, pp_rmax, pp_zmax - do is = 1, pp_ns ! pp_ns is the number of eavaluation surfaces - niter = 0 ! number of successful iterations - if ( myid .ne. modulo(is, ncpu) ) cycle ! MPI + call MPI_BCAST( pp_raxis, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( pp_zaxis, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + + ! split cores + color = modulo(myid, pp_ns) + CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) + CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MYWORLD, ierr) + CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) + CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) + + if (myworkid /= 0) then + color = MPI_UNDEFINED + masterid = -1 + else + color = 0 + endif + !CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) + CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MASTERS, ierr) + + if (masterid == -1) then ! slave cores waiting in coils_bfield + call coils_bfield(B, x, y, z, 'work') + else + CALL MPI_COMM_RANK(MPI_COMM_MASTERS, masterid, ierr) + CALL MPI_COMM_SIZE(MPI_COMM_MASTERS, nmaster, ierr) + + ! poincare plot and calculate iota + SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( ppz , (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( iota, (1:pp_ns) , zero ) + + ! if pp_rmax and pp_zmax not provied + if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then + zeta = pp_phi + theta = zero ; call surfcoord( theta, zeta, r , z ) + pp_rmax = r*1.0 ; pp_zmax = z*1.0 + endif - rzrzt(1:5) = (/ pp_raxis + is*(pp_rmax-pp_raxis)/pp_ns, & - pp_zaxis + is*(pp_zmax-pp_zaxis)/pp_ns, & - pp_raxis, pp_zaxis, zero /) - lppr(is, 0) = rzrzt(1) ; lppz(is, 0) = rzrzt(2) - - do ip = 1, pp_maxiter - iflag = 1 - call ppiota(rzrzt, iflag) - if (iflag >= 0) niter = niter + 1 ! counting - lppr(is, ip) = rzrzt(1) - lppz(is, ip) = rzrzt(2) - ! FATAL( poinplot, abs((rzrzt(3)-pp_raxis)/pp_raxis)>pp_xtol, magnetic axis is not coming back ) + if(masterid==0) write(ounit, '("poinplot: following fieldlines between ("ES12.5 & + ","ES12.5" ) and ("ES12.5","ES12.5" )")') pp_raxis, pp_zaxis, pp_rmax, pp_zmax + + do is = 1, pp_ns ! pp_ns is the number of eavaluation surfaces + niter = 0 ! number of successful iterations + if ( masterid /= modulo((is-1), nmaster)) cycle ! MPI + rzrzt(1:5) = (/ pp_raxis + is*(pp_rmax-pp_raxis)/pp_ns, & + pp_zaxis + is*(pp_zmax-pp_zaxis)/pp_ns, & + pp_raxis, pp_zaxis, zero /) + ppr(is, 0) = rzrzt(1) ; ppz(is, 0) = rzrzt(2) + + do ip = 1, pp_maxiter + iflag = 1 + call ppiota(rzrzt, iflag) + if (iflag >= 0) niter = niter + 1 ! counting + ppr(is, ip) = rzrzt(1) + ppz(is, ip) = rzrzt(2) + ! FATAL( poinplot, abs((rzrzt(3)-pp_raxis)/pp_raxis)>pp_xtol, magnetic axis is not coming back ) + enddo + + if (niter==0) then + iota(is) = zero + else + iota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) + endif + + write(ounit, '(8X": order="I6" ; myid="I6" ; (R,Z)=("ES12.5","ES12.5 & + " ) ; iota="ES12.5" ; niter="I6" .")') is, masterid, ppr(is,0), ppz(is,0), iota(is), niter + + if(lboozmn .and. abs(iota(is))>sqrtmachprec) then + x = ppr(is, 0) * cos(pp_phi) ; y = ppr(is, 0) * sin(pp_phi) ; z = ppz(is, 0) + call boozsurf( XYZB(1:total_num, 1:4, is), x, y, z, iota(is), is) + endif enddo - - if (niter==0) then - liota(is) = zero - else - liota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) - endif - write(ounit, '(8X": order="I6" ; myid="I6" ; (R,Z)=("ES12.5","ES12.5 & - " ) ; iota="ES12.5" ; niter="I6" .")') is, myid, lppr(is,0), lppz(is,0), liota(is), niter + call MPI_ALLREDUCE( MPI_IN_PLACE, ppr, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, ppz, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, iota, pp_ns , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) - if(lboozmn .and. abs(liota(is))>sqrtmachprec) then - x = lppr(is, 0) * cos(pp_phi) ; y = lppr(is, 0) * sin(pp_phi) ; z = lppz(is, 0) - call boozsurf( XYZB(1:total_num, 1:4, is), x, y, z, liota(is), is) + if(lboozmn) then + call MPI_ALLREDUCE (MPI_IN_PLACE, XYZB, 4*pp_ns*total_num, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) + call MPI_ALLREDUCE (MPI_IN_PLACE, booz_mnc, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) + call MPI_ALLREDUCE (MPI_IN_PLACE, booz_mns, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) endif - enddo - - call MPI_ALLREDUCE( lppr, ppr, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( lppz, ppz, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( liota, iota, pp_ns , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - - if(lboozmn) then - call MPI_ALLREDUCE(MPI_IN_PLACE, XYZB, 4*pp_ns*total_num, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE(MPI_IN_PLACE, booz_mnc, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE(MPI_IN_PLACE, booz_mns, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) + call coils_bfield(B, x, y, z, 'exit') ! finish endif - DALLOCATE( lppz ) - DALLOCATE( lppr ) - DALLOCATE( liota ) + CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) return @@ -257,34 +291,61 @@ END SUBROUTINE ppiota !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine coils_bfield(s, x,y,z) +subroutine coils_bfield(s,x,y,z,command) use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc, bsconstant, one, two + zero, myid, ounit, Npc, bsconstant, one, two, ncpu, & + master, nworker, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS use mpi implicit none REAL , intent( in) :: x, y, z REAL , intent(out) :: s(4) + CHARACTER(LEN=4), optional :: command !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat REAL :: Bx, By, Bz INTEGER :: icoil, kseg + CHARACTER(LEN=4) :: command_local !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + !MPIOUT( len(command) ) - s(1:4) = zero - - do icoil = 1, Ncoils*Npc - Bx = zero; By = zero; Bz = zero - call bfield0( icoil, x, y, z, Bx, By, Bz ) - s(1) = s(1) + Bx - s(2) = s(2) + By - s(3) = s(3) + Bz - enddo - s(4) = sqrt( s(1)*s(1) + s(2)*s(2) + s(3)*s(3) ) - + if (present(command)) then + command_local = command + else + command_local = 'work' ! default value + endif + + do + ! broadcast master parameter + call MPI_BCAST( command_local, 4, MPI_CHARACTER, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( x, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( y, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( z, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + + select case (command_local) + case ('work') + call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) ! wait all cpus; + ! MPIOUT( x ) + s(1:4) = zero + do icoil = 1, Ncoils*Npc + if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI + Bx = zero; By = zero; Bz = zero + call bfield0( icoil, x, y, z, Bx, By, Bz ) + s(1) = s(1) + Bx + s(2) = s(2) + By + s(3) = s(3) + Bz + enddo + call MPI_ALLREDUCE(MPI_IN_PLACE, s, 4, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MYWORLD, ierr ) + s(4) = sqrt( s(1)*s(1) + s(2)*s(2) + s(3)*s(3) ) + if (myworkid==0) return + case ('exit') + return + end select + end do return end subroutine coils_bfield From f2a019bf30c4e7a55074df5867f891ddbb710b85 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sun, 28 Apr 2019 20:40:54 -0400 Subject: [PATCH 23/72] add write mgrid; optimize MPI; bugs in intel exsit --- sources/Makefile | 2 +- sources/bfield.h | 52 ++++++++++++++++++++++++ sources/boozer.h | 38 ++++++++++++------ sources/focus.h | 1 + sources/globals.h | 2 +- sources/initial.h | 3 ++ sources/poinplot.h | 98 ++++++++++------------------------------------ sources/saving.h | 12 +++--- 8 files changed, 110 insertions(+), 98 deletions(-) diff --git a/sources/Makefile b/sources/Makefile index b463e48..7682f88 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -4,7 +4,7 @@ ALLFILES= globals initial rdsurf rdknot rdcoils packdof bfield bmnharm bnormal fdcheck \ torflux length surfsep datalloc solvers descent congrad lmalg saving diagnos \ - specinp poinplot boozer focus + specinp poinplot boozer wtmgrid focus HFILES= $(ALLFILES:=.h) FFILES= $(ALLFILES:=.F90) PFILES= $(ALLFILES:=.pdf) diff --git a/sources/bfield.h b/sources/bfield.h index 781f8f1..5873631 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -260,3 +260,55 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) end subroutine bfield1 !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +subroutine coils_bfield(B,x,y,z,icommand) + use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & + zero, myid, ounit, Npc, bsconstant, one, two, ncpu, & + master, nworker, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS + use mpi + implicit none + + REAL , intent( in) :: x, y, z + REAL , intent(out) :: B(3) + INTEGER, INTENT(inout) :: icommand ! icommand==1, leave + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + INTEGER :: ierr, astat + REAL :: Bx, By, Bz + INTEGER :: icoil + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +!!$ if (icommand == 1) then +!!$ print *, 'enter bfield', myid, myworkid, nworker +!!$ endif + + do + ! broadcast master parameter + call MPI_BCAST( x, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( y, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( z, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BCAST( icommand, 1, MPI_INTEGER, master, MPI_COMM_MYWORLD, ierr ) + call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) ! wait all cpus; + +!!$ if (icommand == 1) then +!!$ print *, 'after bcast', myid, myworkid, nworker +!!$ endif + + B = zero + do icoil = 1, Ncoils*Npc + if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI + Bx = zero; By = zero; Bz = zero + call bfield0( icoil, x, y, z, Bx, By, Bz ) + B(1) = B(1) + Bx + B(2) = B(2) + By + B(3) = B(3) + Bz + enddo + call MPI_ALLREDUCE(MPI_IN_PLACE, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MYWORLD, ierr ) + if (myworkid==0) exit + if (icommand == 1) exit + end do + return + +end subroutine coils_bfield diff --git a/sources/boozer.h b/sources/boozer.h index 306495b..5402558 100644 --- a/sources/boozer.h +++ b/sources/boozer.h @@ -294,7 +294,7 @@ subroutine fieldline_tracing(x,y,z,imax,n2,H) do j=1,imax H(j,1)=x ; H(j,2)=y ; H(j,3)=z - call coils_bfield(s,x,y,z) + call get_bfield(s,x,y,z) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) H(j,4)=B dt=(y-x*tan(j*dphi))/(tan(j*dphi)*Bx/sqrt(Bx**2+By**2)-By/sqrt(Bx**2+By**2))*sqrt(B**2/(Bx**2+By**2)) @@ -307,44 +307,44 @@ subroutine fieldline_tracing(x,y,z,imax,n2,H) if(j<8)then k1x=Bx/B ; k1y=By/B ; k1z=Bz/B - call coils_bfield(s,x+dt*4/27*k1x,y+dt*4/27*k1y,z+dt*4/27*k1z) + call get_bfield(s,x+dt*4/27*k1x,y+dt*4/27*k1y,z+dt*4/27*k1z) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k2x=Bx/B ; k2y=By/B ; k2z=Bz/B - call coils_bfield(s,x+dt/18*(k1x+3*k2x),y+dt/18*(k1y+3*k2y),z+dt/18*(k1z+3*k2z)) + call get_bfield(s,x+dt/18*(k1x+3*k2x),y+dt/18*(k1y+3*k2y),z+dt/18*(k1z+3*k2z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k3x=Bx/B ; k3y=By/B ; k3z=Bz/B - call coils_bfield(s,x+dt/12*(k1x+3*k3x),y+dt/12*(k1y+3*k3y),z+dt/12*(k1z+3*k3z)) + call get_bfield(s,x+dt/12*(k1x+3*k3x),y+dt/12*(k1y+3*k3y),z+dt/12*(k1z+3*k3z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k4x=Bx/B ; k4y=By/B ; k4z=Bz/B - call coils_bfield(s,x+dt/8*(k1x+3*k4x),y+dt/8*(k1y+3*k4y),z+dt/8*(k1z+3*k4z)) + call get_bfield(s,x+dt/8*(k1x+3*k4x),y+dt/8*(k1y+3*k4y),z+dt/8*(k1z+3*k4z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k5x=Bx/B ; k5y=By/B ; k5z=Bz/B - call coils_bfield(s,x+dt/54*(13*k1x-27*k3x+42*k4x+8*k5x),y+dt/54*(13*k1y-27*k3y+& + call get_bfield(s,x+dt/54*(13*k1x-27*k3x+42*k4x+8*k5x),y+dt/54*(13*k1y-27*k3y+& 42*k4y+8*k5y),z+dt/54*(13*k1z-27*k3z+42*k4z+8*k5z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k6x=Bx/B ; k6y=By/B ; k6z=Bz/B - call coils_bfield(s,x+dt/4320*(389*k1x-54*k3x+966*k4x-824*k5x+243*k6x),y+dt/4320*(389*k1y-& + call get_bfield(s,x+dt/4320*(389*k1x-54*k3x+966*k4x-824*k5x+243*k6x),y+dt/4320*(389*k1y-& 54*k3y+966*k4y-824*k5y+243*k6y),z+dt/4320*(389*k1z-54*k3z+966*k4z-824*k5z+243*k6z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k7x=Bx/B ; k7y=By/B ; k7z=Bz/B - call coils_bfield(s,x+dt/20*(-234*k1x+81*k3x-1164*k4x+656*k5x-122*k6x+800*k7x),y+dt/20*(-234*k1y+81*k3y-& + call get_bfield(s,x+dt/20*(-234*k1x+81*k3x-1164*k4x+656*k5x-122*k6x+800*k7x),y+dt/20*(-234*k1y+81*k3y-& 1164*k4y+656*k5y-122*k6y+800*k7y),z+dt/20*(-234*k1z+81*k3z-1164*k4z+656*k5z-122*k6z+800*k7z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k8x=Bx/B ; k8y=By/B ; k8z=Bz/B - call coils_bfield(s,x+dt/288*(-127*k1x+18*k3x-678*k4x+456*k5x-9*k6x+576*k7x+4*k8x),y+& + call get_bfield(s,x+dt/288*(-127*k1x+18*k3x-678*k4x+456*k5x-9*k6x+576*k7x+4*k8x),y+& dt/288*(-127*k1y+18*k3y-678*k4y+456*k5y-9*k6y+576*k7y+4*k8y),z+dt/288*(-127*k1z+& 18*k3z-678*k4z+456*k5z-9*k6z+576*k7z+4*k8z)) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) k9x=Bx/B ; k9y=By/B ; k9z=Bz/B - call coils_bfield(s,x+dt/820*(1481*k1x-81*k3x+7104*k4x-3376*k5x+& + call get_bfield(s,x+dt/820*(1481*k1x-81*k3x+7104*k4x-3376*k5x+& 72*k6x-5040*k7x-60*k8x+720*k9x),y+dt/820*(1481*k1y-81*k3y+& 7104*k4y-3376*k5y+72*k6y-5040*k7y-60*k8y+720*k9y),z+dt/820*(1481*k1z-& 81*k3z+7104*k4z-3376*k5z+72*k6z-5040*k7z-60*k8z+720*k9z)) @@ -364,7 +364,7 @@ subroutine fieldline_tracing(x,y,z,imax,n2,H) +2102243.0*f(j-4,3)-2664477.0*f(j-3,3)+2183877.0*f(j-2,3)-1152169.0*f(j-1,3)+434241.0*f(j,3)) end if - call coils_bfield(s,x,y,z) + call get_bfield(s,x,y,z) Bx=s(1) ; By=s(2) ; Bz=s(3) ; B=s(4) f(j+1,1)=Bx/B f(j+1,2)=By/B @@ -384,5 +384,19 @@ subroutine fieldline_tracing(x,y,z,imax,n2,H) end subroutine fieldline_tracing - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + +SUBROUTINE get_bfield(B,x,y,z) + use globals, only: dp + use mpi + implicit none + + REAL , intent( in) :: x, y, z + REAL , intent(out) :: B(4) + INTEGER :: icommand = 0 + + call coils_bfield(B(1:3), x, y, z, icommand) + B(4) = sqrt( B(1)*B(1) + B(2)*B(2) + B(3)*B(3) ) + + return +END SUBROUTINE get_bfield diff --git a/sources/focus.h b/sources/focus.h index 35f5189..985a871 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -127,6 +127,7 @@ PROGRAM focus !case( 2 ) ; call saving ; call diagnos ; call wtmgrid ! write mgrid file; case( 3 ) ; call diagnos ; call poinplot ! Poincare plots; for future; case( 4 ) ; call diagnos ; call boozmn ; call poinplot ! Last closed surface + case( 5 ) ; call diagnos ; call wtmgrid ! write mgrid file !case( 4 ) ; call saving ; call diagnos ; call resonant ! resonant harmonics analysis; for future; end select diff --git a/sources/globals.h b/sources/globals.h index 9ef804c..4456ff5 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.08' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.09' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.h b/sources/initial.h index 89a842a..a3184ea 100644 --- a/sources/initial.h +++ b/sources/initial.h @@ -574,6 +574,9 @@ subroutine initial case ( 4 ) if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & & 'Vacuum Boozer coordinates decompostion will be performed.' + case ( 5 ) + if (IsQuiet < 1) write(ounit, 1000) 'case_postproc', case_postproc, & + & 'A binary mgrid file will be saved.' case default FATAL( initial, .true., selected case_postproc is not supported ) end select diff --git a/sources/poinplot.h b/sources/poinplot.h index 55f67f4..661b8e0 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -13,9 +13,8 @@ SUBROUTINE poinplot !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, iflag - INTEGER :: ip, is, niter - REAL :: theta, zeta, r, RZ(2), r1, z1, rzrzt(5), x, y, z, tmpB(4) - ! REAL, ALLOCATABLE :: lppr(:,:), lppz(:,:), liota(:) ! local ppr ppz + INTEGER :: ip, is, niter, icommand + REAL :: theta, zeta, r, RZ(2), r1, z1, rzrzt(5), x, y, z REAL :: B(4), start, finish !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -42,8 +41,10 @@ SUBROUTINE poinplot CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) + !print *, myid, color, myworkid, nworker + if (myworkid /= 0) then ! slave cores waiting in coils_bfield - call coils_bfield(B, x, y, z, 'work') + icommand = 0 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 else RZ(1) = pp_raxis ; RZ(2) = pp_zaxis start = MPI_Wtime() @@ -51,15 +52,16 @@ SUBROUTINE poinplot finish = MPI_Wtime() !print *, 'finding axis takes ', finish-start pp_raxis = RZ(1) ; pp_zaxis = RZ(2) - call coils_bfield(B, x, y, z, 'exit') ! finish + icommand = 1 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 ! finish endif + call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) call MPI_BCAST( pp_raxis, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) call MPI_BCAST( pp_zaxis, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) + CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) ! split cores color = modulo(myid, pp_ns) - CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MYWORLD, ierr) CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) @@ -74,7 +76,7 @@ SUBROUTINE poinplot CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MASTERS, ierr) if (masterid == -1) then ! slave cores waiting in coils_bfield - call coils_bfield(B, x, y, z, 'work') + icommand = 0 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 else CALL MPI_COMM_RANK(MPI_COMM_MASTERS, masterid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MASTERS, nmaster, ierr) @@ -135,8 +137,7 @@ SUBROUTINE poinplot call MPI_ALLREDUCE (MPI_IN_PLACE, booz_mnc, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) call MPI_ALLREDUCE (MPI_IN_PLACE, booz_mns, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) endif - CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) - call coils_bfield(B, x, y, z, 'exit') ! finish + icommand = 1 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 ! finish endif CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) @@ -291,81 +292,22 @@ END SUBROUTINE ppiota !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine coils_bfield(s,x,y,z,command) - use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc, bsconstant, one, two, ncpu, & - master, nworker, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS - use mpi - implicit none - - REAL , intent( in) :: x, y, z - REAL , intent(out) :: s(4) - CHARACTER(LEN=4), optional :: command - - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - - INTEGER :: ierr, astat - REAL :: Bx, By, Bz - INTEGER :: icoil, kseg - CHARACTER(LEN=4) :: command_local - - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - - !MPIOUT( len(command) ) - - if (present(command)) then - command_local = command - else - command_local = 'work' ! default value - endif - - do - ! broadcast master parameter - call MPI_BCAST( command_local, 4, MPI_CHARACTER, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( x, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( y, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( z, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - - select case (command_local) - case ('work') - call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) ! wait all cpus; - ! MPIOUT( x ) - s(1:4) = zero - do icoil = 1, Ncoils*Npc - if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI - Bx = zero; By = zero; Bz = zero - call bfield0( icoil, x, y, z, Bx, By, Bz ) - s(1) = s(1) + Bx - s(2) = s(2) + By - s(3) = s(3) + Bz - enddo - call MPI_ALLREDUCE(MPI_IN_PLACE, s, 4, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MYWORLD, ierr ) - s(4) = sqrt( s(1)*s(1) + s(2)*s(2) + s(3)*s(3) ) - if (myworkid==0) return - case ('exit') - return - end select - end do - return - -end subroutine coils_bfield - -!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - SUBROUTINE BRpZ( t, x, dx ) !---------------------- ! dR/dphi = BR / Bphi ! dZ/dphi = BZ / Bphi !---------------------- use globals, only : dp, zero, ounit, myid, ierr + USE MPI implicit none - include "mpif.h" + !--------------------------------------------------------------------------------------------- INTEGER, parameter :: n=2 REAL, INTENT( IN) :: t, x(n) REAL, INTENT(OUT) :: dx(n) - REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(4) + INTEGER :: icommand = 0 + REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(3) external :: coils_bfield !--------------------------------------------------------------------------------------------- @@ -373,7 +315,7 @@ SUBROUTINE BRpZ( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero - call coils_bfield(B, XX, YY, ZZ) + icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) BR = B(1)*cos(t) + B(2)*sin(t) BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR @@ -393,14 +335,16 @@ SUBROUTINE BRpZ_iota( t, x, dx ) ! dZ/dphi = BZ / Bphi !---------------------- use globals, only : dp, zero, ounit, myid, ierr + USE MPI implicit none - include "mpif.h" + !--------------------------------------------------------------------------------------------- INTEGER, parameter :: n=5 REAL, INTENT( IN) :: t, x(n) REAL, INTENT(OUT) :: dx(n) - REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(4), length + INTEGER :: icommand = 0 + REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(3), length external :: coils_bfield !--------------------------------------------------------------------------------------------- @@ -409,7 +353,7 @@ SUBROUTINE BRpZ_iota( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero - call coils_bfield(B, XX, YY, ZZ) + icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) BR = B(1)*cos(t) + B(2)*sin(t) BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR @@ -423,7 +367,7 @@ SUBROUTINE BRpZ_iota( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero - call coils_bfield(B, XX, YY, ZZ) + icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) BR = B(1)*cos(t) + B(2)*sin(t) BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR diff --git a/sources/saving.h b/sources/saving.h index 49605e0..6017b33 100644 --- a/sources/saving.h +++ b/sources/saving.h @@ -18,13 +18,11 @@ subroutine saving use globals - + use mpi use hdf5 implicit none - include "mpif.h" - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -414,22 +412,22 @@ SUBROUTINE write_plasma open(wunit, file=trim(out_plasma), status='unknown', action='write') write(wunit,* ) "#Nfou Nfp Nbnf" - write(wunit,'(3I)' ) Nfou, Nfp_raw, Nbnf + write(wunit,'(3I6)' ) Nfou, Nfp_raw, Nbnf write(wunit,* ) "#------- plasma boundary------" write(wunit,* ) "# n m Rbc Rbs Zbc Zbs" do imn = 1, Nfou - write(wunit,'(2I, 4ES15.6)') bin(imn)/Nfp_raw, bim(imn), Rbc(imn), Rbs(imn), Zbc(imn), Zbs(imn) + write(wunit,'(2I6, 4ES15.6)') bin(imn)/Nfp_raw, bim(imn), Rbc(imn), Rbs(imn), Zbc(imn), Zbs(imn) enddo write(wunit,* ) "#-------Bn harmonics----------" write(wunit,* ) "# n m bnc bns" if (Nbnf .gt. 0) then do imn = 1, Nbnf - write(wunit,'(2I, 2ES15.6)') bnin(imn)/Nfp_raw, bnim(imn), bnc(imn), bns(imn) + write(wunit,'(2I6, 2ES15.6)') bnin(imn)/Nfp_raw, bnim(imn), bnc(imn), bns(imn) enddo else - write(wunit,'(2I, 2ES15.6)') 0, 0, 0.0, 0.0 + write(wunit,'(2I6, 2ES15.6)') 0, 0, 0.0, 0.0 endif close(wunit) From cbdc5c49e701767b0b3dbe4254e50679863e04e3 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sun, 28 Apr 2019 20:41:32 -0400 Subject: [PATCH 24/72] add wtmgrid.h --- sources/wtmgrid.h | 144 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 144 insertions(+) create mode 100644 sources/wtmgrid.h diff --git a/sources/wtmgrid.h b/sources/wtmgrid.h new file mode 100644 index 0000000..fd0887c --- /dev/null +++ b/sources/wtmgrid.h @@ -0,0 +1,144 @@ +! write binary mgrid file + +subroutine wtmgrid + use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit, nfp_raw, & + pp_raxis, pp_zaxis, pp_rmax, pp_zmax, & + master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS + implicit none + include "mpif.h" + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + LOGICAL :: exist + INTEGER :: ierr, astat, iostat, ip, iz, ir, np, nz, nr, Mfp, nextcur, icommand + REAL :: RpZ(1:3), R, P, Z, Pmin, Pmax, Zmin, Zmax, Rmin, Rmax, B(1:3), pressure, gap, & + czeta, szeta, xx, yy, zz, dx, dy, dz, dBx, dBy, dBz + REAL, allocatable :: BRZp(:,:,:,:), BRpZ(:,:,:,:) + CHARACTER(LEN=100) :: mgrid_name + CHARACTER(LEN=30) :: curlabel(1:1) + + icommand = 0 + mgrid_name = "mgrid.focus_"//trim(ext) ! filename, could be user input + np = 72 ; nz = 121 ; nr = 121 ; Mfp = nfp_raw ! SHOULD BE USER INPUT; 04 Aug 16; + !np = 12 ; nz = 11 ; nr = 11 ; Mfp = 2 ! SHOULD BE USER INPUT; 04 Aug 16; + B = zero ; dx = 1E-4 ; dy = 1E-4 ; dz = 1E-4 + + SALLOCATE( BRZp, (1:3,1:Nr,1:Nz,1:Np), zero ) +#ifdef DIV_CHECK + SALLOCATE( BRpZ, (1:2,1:Nr,1:Nz,1:Np), zero ) +#endif + + Pmin = zero ; Pmax = pi2 ! DO NOT CHANGE; 04 Aug 16; + + ! Rmin = 4.8 ; Rmax = 6.8 + ! Zmin = -1.5 ; Zmax = 1.5 + + Rmin = pp_raxis ; Zmin = pp_zaxis + Rmax = pp_rmax ; Zmax = pp_zmax + + if( myid.eq.0 ) write( ounit,'("wtmgrid : writing mgrid file at grid of [ "4(ES12.5,2X)" ]",3i6)') Rmin, Rmax, Zmin, Zmax, np, nr, nz + + ! split cores + color = modulo(myid, np) + CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MYWORLD, ierr) + CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) + CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) + + if (myworkid /= 0) then + color = MPI_UNDEFINED + masterid = -1 + else + color = 0 + endif + CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MASTERS, ierr) + + if (masterid == -1) then ! slave cores waiting in coils_bfield + call coils_bfield(B, xx, yy, zz, icommand) + else + CALL MPI_COMM_RANK(MPI_COMM_MASTERS, masterid, ierr) + CALL MPI_COMM_SIZE(MPI_COMM_MASTERS, nmaster, ierr) + + do ip = 1, np + RpZ(2) = Pmin + ( Pmax - Pmin ) * ( ip - 1 ) / ( np - 0 ) / Mfp + if ( masterid .ne. modulo(ip-1,nmaster) ) cycle + do iz = 1, nz ; RpZ(3) = Zmin + ( Zmax - Zmin ) * ( iz - 1 ) / ( nz - 1 ) + do ir = 1, nr ; RpZ(1) = Rmin + ( Rmax - Rmin ) * ( ir - 1 ) / ( nr - 1 ) + + czeta = cos(RpZ(2)) + szeta = sin(RpZ(2)) + + xx = RpZ(1) * czeta + yy = RpZ(1) * szeta + zz = RpZ(3) + + call coils_bfield(B,xx,yy,zz,icommand) + + BRZp(1,ir,iz,ip) = ( B(1) * czeta + B(2) * szeta ) + BRZp(3,ir,iz,ip) = ( - B(1) * szeta + B(2) * czeta ) + BRZp(2,ir,iz,ip) = B(3) +#ifdef DIV_CHECK + dBx = B(1) ; dBy = B(2) ; dBz = B(3) + BRpZ(2,ir,iz,ip) = sqrt( B(1)*B(1) + B(2)*B(2) + B(3)*B(3) ) + + xx = xx + dx + call coils_bfield(B,xx,yy,zz,icommand) + dBx = ( B(1) - dBx ) / dx + xx = xx - dx + + yy = yy + dy + call coils_bfield(B,xx,yy,zz,icommand) + dBy = ( B(2) - dBy ) / dy + yy = yy - dy + + zz = zz + dz + call coils_bfield(B,xx,yy,zz,icommand) + dBz = ( B(3) - dBz ) / dz + zz = zz - dz + + BRpZ(1,ir,iz,ip) = dBx + dBy + dBz + BRpZ(2,ir,iz,ip) = BRpZ(1,ir,iz,ip) / BRpZ(2,ir,iz,ip) +#endif + enddo + enddo + enddo + call MPI_ALLREDUCE( MPI_IN_PLACE, BRZp, 3*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr) +#ifdef DIV_CHECK + call MPI_ALLREDUCE( MPI_IN_PLACE, BRpZ, 2*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr) +#endif + CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) + icommand = 1 ; call coils_bfield(B, xx, yy, zz, icommand) ! finish + endif + + CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) + + if( myid.eq.0 ) then +#ifdef DIV_CHECK + write(ounit, '("wtmgrid : max. div B = "ES23.15 " ; max. div B / |B| = "ES23.15 )') maxval(BRpZ(1,1:Nr,1:Nz,1:Np)), maxval(BRpZ(2,1:Nr,1:Nz,1:Np)) +#endif + nextcur = 1 ; curlabel(1) = "focus-coils" + + !write(suffix,'(i3.3,".",i4.4,".",i4.4)') Np, Nr, Nz + + write( ounit,'("wtmgrid : writing ",A," ; Mfp="i3" ;")') trim(mgrid_name), Mfp + + !open( wunit, file=trim(ext)//".fo.mgrid", status="unknown", form="unformatted", iostat=iostat ) + open( wunit, file=trim(mgrid_name), status="unknown", form="unformatted", iostat=iostat ) + FATAL( wtmgrid, iostat.ne.0, error opening ext.fo.mgrid ) + write(wunit) Nr, Nz, Np, Mfp, nextcur + write(wunit) Rmin, Zmin, Rmax, Zmax + write(wunit) curlabel(1:nextcur) + write(wunit) BRZp(1:3,1:Nr,1:Nz,1:Np) + close(wunit) + + endif + + DEALLOCATE(BRZp) +#ifdef DIV_CHECK + DEALLOCATE(BRpZ) +#endif + + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + + return + +end subroutine wtmgrid From 7b63948a5843b77aa1b800229737ea06887afd5c Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 29 Apr 2019 20:46:26 -0400 Subject: [PATCH 25/72] update debug flags; MPI bugs not resolved --- sources/Makefile | 10 ++++++---- sources/bfield.h | 40 ++++++++++++++++++++-------------------- sources/focus.h | 1 + sources/globals.h | 2 +- sources/poinplot.h | 16 ++++++++++------ 5 files changed, 38 insertions(+), 31 deletions(-) diff --git a/sources/Makefile b/sources/Makefile index 7682f88..cb313e6 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -21,11 +21,13 @@ ifeq ($(CC),gfortran) # RFLAGS=-O3 -w -fdefault-real-8 -ffree-line-length-none -march=native -ffast-math RFLAGS=-O3 -w -ffree-line-length-none -march=native -ffast-math $(PFLAGS) - DFLAGS=-g3 -Wextra -Wtarget-lifetime -fbacktrace -fbounds-check -ffpe-trap=zero -fcheck=all -DDEBUG + DFLAGS=-Og $(PFLAGS) -w -ffree-line-length-none -Wextra -Wtarget-lifetime -fbacktrace -fbounds-check \ + -ffpe-trap=zero -fcheck=all -DDEBUG else # RFLAGS=-r8 -mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback #-vec_report0 #-ipo -xhost RFLAGS=-mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback $(PFLAGS) #-vec_report0 #-ipo -xhost - DFLAGS=-check all -check noarg_temp_created -debug full -D DEBUG + DFLAGS=-O0 -g -traceback $(PFLAGS) -check all -check bounds -check noarg_temp_created -check uninit \ + -ftrapuv -init=snan,arrays -debug all -D DEBUG endif ############################################################################################################ @@ -58,13 +60,13 @@ lmder1.o : lmder1.f $(FC) -c $(RFLAGS) -o $@ $< hybrj.o: hybrj.f - $(FC) -c $(FLAGS) $(DFLAGS) -o $@ $< + $(FC) -c $(FLAGS) -o $@ $< $(ROBJS): %_r.o: %.F90 $(FC) -c $(RFLAGS) -o $@ $< $(HDF5) $(DOBJS): %_d.o: %.F90 - $(FC) -c $(RFLAGS) $(DFLAGS) -o $@ $< $(HDF5) + $(FC) -c $(DFLAGS) -o $@ $< $(HDF5) $(FFILES): %.F90: %.h m4 -P $(MACROS) $< > $@ diff --git a/sources/bfield.h b/sources/bfield.h index 5873631..19b232c 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -46,15 +46,13 @@ subroutine bfield0(icoil, xx, yy, zz, Bx, By, Bz) FATAL( bfield0, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) Bx = zero; By = zero; Bz = zero + dlx = zero ; dly = zero ; dlz = zero + ltx = zero ; lty = zero ; ltz = zero select case (coil(icoil)%itype) !--------------------------------------------------------------------------------------------- case(1) - dlx = zero; ltx = zero - dly = zero; lty = zero - dlz = zero; ltz = zero - do kseg = 0, coil(icoil)%NS-1 dlx = xx - coil(icoil)%xx(kseg) @@ -148,6 +146,8 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) FATAL( bfield1, ND <= 0, wrong inout dimension of ND ) Bx = zero; By = zero; Bz = zero + dlx = zero ; dly = zero ; dlz = zero + ltx = zero ; lty = zero ; ltz = zero select case (coil(icoil)%itype) !--------------------------------------------------------------------------------------------- @@ -155,10 +155,6 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) NS = coil(icoil)%NS - dlx = zero; ltx = zero - dly = zero; lty = zero - dlz = zero; ltz = zero - do kseg = 0, NS-1 dlx = xx - coil(icoil)%xx(kseg) @@ -268,9 +264,9 @@ subroutine coils_bfield(B,x,y,z,icommand) use mpi implicit none - REAL , intent( in) :: x, y, z - REAL , intent(out) :: B(3) - INTEGER, INTENT(inout) :: icommand ! icommand==1, leave + REAL , intent( in) :: x, y, z + REAL , intent(inout) :: B(3) + INTEGER, INTENT(inout) :: icommand ! icommand==1, leave !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -280,9 +276,9 @@ subroutine coils_bfield(B,x,y,z,icommand) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -!!$ if (icommand == 1) then -!!$ print *, 'enter bfield', myid, myworkid, nworker -!!$ endif + if (icommand == 1) then + print *, 'stupid bug' + endif do ! broadcast master parameter @@ -292,23 +288,27 @@ subroutine coils_bfield(B,x,y,z,icommand) call MPI_BCAST( icommand, 1, MPI_INTEGER, master, MPI_COMM_MYWORLD, ierr ) call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) ! wait all cpus; -!!$ if (icommand == 1) then -!!$ print *, 'after bcast', myid, myworkid, nworker -!!$ endif - B = zero do icoil = 1, Ncoils*Npc if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI - Bx = zero; By = zero; Bz = zero + ! Bx = zero; By = zero; Bz = zero call bfield0( icoil, x, y, z, Bx, By, Bz ) B(1) = B(1) + Bx B(2) = B(2) + By B(3) = B(3) + Bz enddo - call MPI_ALLREDUCE(MPI_IN_PLACE, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MYWORLD, ierr ) + + if (myworkid == master) then + call MPI_REDUCE(MPI_IN_PLACE, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, master, MPI_COMM_MYWORLD, ierr ) + else + call MPI_REDUCE( B, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, master, MPI_COMM_MYWORLD, ierr ) + endif + if (myworkid==0) exit if (icommand == 1) exit end do return end subroutine coils_bfield + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/focus.h b/sources/focus.h index 985a871..7eace2e 100644 --- a/sources/focus.h +++ b/sources/focus.h @@ -126,6 +126,7 @@ PROGRAM focus case( 2 ) ; call diagnos ; call specinp !; call saving !case( 2 ) ; call saving ; call diagnos ; call wtmgrid ! write mgrid file; case( 3 ) ; call diagnos ; call poinplot ! Poincare plots; for future; + ! case( 3 ) ; call poinplot ! Poincare plots; for future; case( 4 ) ; call diagnos ; call boozmn ; call poinplot ! Last closed surface case( 5 ) ; call diagnos ; call wtmgrid ! write mgrid file !case( 4 ) ; call saving ; call diagnos ; call resonant ! resonant harmonics analysis; for future; diff --git a/sources/globals.h b/sources/globals.h index 4456ff5..810ed94 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -238,7 +238,7 @@ module globals !latex \subsection{MPI stuffs} INTEGER, PARAMETER :: master=0 INTEGER :: myid, ncpu, myworkid, color, masterid, nmaster, nworker - INTEGER :: MPI_COMM_MASTERS = 101, MPI_COMM_MYWORLD = 102, MPI_COMM_WORKERS = 103 + INTEGER :: MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS REAL :: machprec, vsmall, small, sqrtmachprec CHARACTER :: nodelabel*3 diff --git a/sources/poinplot.h b/sources/poinplot.h index 661b8e0..6732d04 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -15,7 +15,7 @@ SUBROUTINE poinplot INTEGER :: ierr, astat, iflag INTEGER :: ip, is, niter, icommand REAL :: theta, zeta, r, RZ(2), r1, z1, rzrzt(5), x, y, z - REAL :: B(4), start, finish + REAL :: B(3), start, finish !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -23,6 +23,7 @@ SUBROUTINE poinplot FATAL( poinplot, pp_maxiter<1 , not enough max. iterations ) pp_phi = pp_phi * pi ! pp_phi=0.5 -> pi/2 + x = zero ; y = zero ; z = zero ; B = zero ! if raxis, zaxis not provided if ( (abs(pp_raxis) + abs(pp_zaxis)) < sqrtmachprec) then @@ -41,10 +42,11 @@ SUBROUTINE poinplot CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) - !print *, myid, color, myworkid, nworker + !print *, 'in poinplot', myid, color, myworkid, nworker - if (myworkid /= 0) then ! slave cores waiting in coils_bfield - icommand = 0 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 + if (myworkid /= master) then ! slave cores waiting in coils_bfield + !icommand = 0 ; call test_bfield(B, x, y, z, icommand, myworkid, nworker, MPI_COMM_MYWORLD) ; icommand = 0 + icommand = 0 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 else RZ(1) = pp_raxis ; RZ(2) = pp_zaxis start = MPI_Wtime() @@ -52,7 +54,8 @@ SUBROUTINE poinplot finish = MPI_Wtime() !print *, 'finding axis takes ', finish-start pp_raxis = RZ(1) ; pp_zaxis = RZ(2) - icommand = 1 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 ! finish + !icommand = 1 ; call test_bfield(B, x, y, z, icommand, myworkid, nworker, MPI_COMM_MYWORLD) ; icommand = 0 ! finish + icommand = 1 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 endif call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) @@ -297,7 +300,7 @@ SUBROUTINE BRpZ( t, x, dx ) ! dR/dphi = BR / Bphi ! dZ/dphi = BZ / Bphi !---------------------- - use globals, only : dp, zero, ounit, myid, ierr + use globals, only : dp, zero, ounit, myid, ierr, myworkid, nworker, MPI_COMM_MYWORLD USE MPI implicit none @@ -315,6 +318,7 @@ SUBROUTINE BRpZ( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero + !icommand = 0 ; call test_bfield(B, XX, YY, ZZ, icommand, myworkid, nworker, MPI_COMM_MYWORLD) icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) BR = B(1)*cos(t) + B(2)*sin(t) From 14690b07a9bd0f90ac401d63579765b675730822 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 2 May 2019 17:49:57 -0400 Subject: [PATCH 26/72] fix MPI issue --- sources/bfield.h | 49 +++++-------- sources/boozer.h | 3 +- sources/globals.h | 2 +- sources/poinplot.h | 175 +++++++++++++++++++++------------------------ sources/wtmgrid.h | 85 +++++++++++----------- 5 files changed, 142 insertions(+), 172 deletions(-) diff --git a/sources/bfield.h b/sources/bfield.h index 19b232c..0199bcc 100644 --- a/sources/bfield.h +++ b/sources/bfield.h @@ -257,7 +257,7 @@ end subroutine bfield1 !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine coils_bfield(B,x,y,z,icommand) +subroutine coils_bfield(B,x,y,z) use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & zero, myid, ounit, Npc, bsconstant, one, two, ncpu, & master, nworker, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS @@ -266,7 +266,7 @@ subroutine coils_bfield(B,x,y,z,icommand) REAL , intent( in) :: x, y, z REAL , intent(inout) :: B(3) - INTEGER, INTENT(inout) :: icommand ! icommand==1, leave + !INTEGER, INTENT(in) :: comm ! MPI communicator !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -276,37 +276,20 @@ subroutine coils_bfield(B,x,y,z,icommand) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - if (icommand == 1) then - print *, 'stupid bug' - endif - - do - ! broadcast master parameter - call MPI_BCAST( x, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( y, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( z, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( icommand, 1, MPI_INTEGER, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) ! wait all cpus; - - B = zero - do icoil = 1, Ncoils*Npc - if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI - ! Bx = zero; By = zero; Bz = zero - call bfield0( icoil, x, y, z, Bx, By, Bz ) - B(1) = B(1) + Bx - B(2) = B(2) + By - B(3) = B(3) + Bz - enddo - - if (myworkid == master) then - call MPI_REDUCE(MPI_IN_PLACE, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, master, MPI_COMM_MYWORLD, ierr ) - else - call MPI_REDUCE( B, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, master, MPI_COMM_MYWORLD, ierr ) - endif - - if (myworkid==0) exit - if (icommand == 1) exit - end do + call MPI_BARRIER(MPI_COMM_MYWORLD, ierr ) ! wait all cpus; + + B = zero + do icoil = 1, Ncoils*Npc + if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI + ! Bx = zero; By = zero; Bz = zero + call bfield0( icoil, x, y, z, Bx, By, Bz ) + B(1) = B(1) + Bx + B(2) = B(2) + By + B(3) = B(3) + Bz + enddo + + call MPI_ALLREDUCE(MPI_IN_PLACE, B, 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MYWORLD, ierr ) + return end subroutine coils_bfield diff --git a/sources/boozer.h b/sources/boozer.h index 5402558..8b61844 100644 --- a/sources/boozer.h +++ b/sources/boozer.h @@ -393,9 +393,8 @@ SUBROUTINE get_bfield(B,x,y,z) REAL , intent( in) :: x, y, z REAL , intent(out) :: B(4) - INTEGER :: icommand = 0 - call coils_bfield(B(1:3), x, y, z, icommand) + call coils_bfield(B(1:3), x, y, z) B(4) = sqrt( B(1)*B(1) + B(2)*B(2) + B(3)*B(3) ) return diff --git a/sources/globals.h b/sources/globals.h index 810ed94..0780b0a 100644 --- a/sources/globals.h +++ b/sources/globals.h @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.09' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.10' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/poinplot.h b/sources/poinplot.h index 6732d04..d41fc0e 100644 --- a/sources/poinplot.h +++ b/sources/poinplot.h @@ -41,26 +41,15 @@ SUBROUTINE poinplot CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MYWORLD, ierr) CALL MPI_COMM_RANK(MPI_COMM_MYWORLD, myworkid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MYWORLD, nworker, ierr) - - !print *, 'in poinplot', myid, color, myworkid, nworker - - if (myworkid /= master) then ! slave cores waiting in coils_bfield - !icommand = 0 ; call test_bfield(B, x, y, z, icommand, myworkid, nworker, MPI_COMM_MYWORLD) ; icommand = 0 - icommand = 0 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 - else - RZ(1) = pp_raxis ; RZ(2) = pp_zaxis - start = MPI_Wtime() - call find_axis(RZ, pp_maxiter, pp_xtol) - finish = MPI_Wtime() - !print *, 'finding axis takes ', finish-start - pp_raxis = RZ(1) ; pp_zaxis = RZ(2) - !icommand = 1 ; call test_bfield(B, x, y, z, icommand, myworkid, nworker, MPI_COMM_MYWORLD) ; icommand = 0 ! finish - icommand = 1 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 - endif + + RZ(1) = pp_raxis ; RZ(2) = pp_zaxis + start = MPI_Wtime() + call find_axis(RZ, pp_maxiter, pp_xtol) + finish = MPI_Wtime() + !print *, 'finding axis takes ', finish-start + pp_raxis = RZ(1) ; pp_zaxis = RZ(2) call MPI_BARRIER( MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( pp_raxis, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) - call MPI_BCAST( pp_zaxis, 1, MPI_DOUBLE_PRECISION, master, MPI_COMM_MYWORLD, ierr ) CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) ! split cores @@ -77,60 +66,60 @@ SUBROUTINE poinplot endif !CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MASTERS, ierr) - - if (masterid == -1) then ! slave cores waiting in coils_bfield - icommand = 0 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 - else + if (myworkid==0) then CALL MPI_COMM_RANK(MPI_COMM_MASTERS, masterid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MASTERS, nmaster, ierr) + endif + IlBCAST( nmaster, 1, master ) - ! poincare plot and calculate iota - SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) - SALLOCATE( ppz , (1:pp_ns, 0:pp_maxiter), zero ) - SALLOCATE( iota, (1:pp_ns) , zero ) + ! poincare plot and calculate iota + SALLOCATE( ppr , (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( ppz , (1:pp_ns, 0:pp_maxiter), zero ) + SALLOCATE( iota, (1:pp_ns) , zero ) - ! if pp_rmax and pp_zmax not provied - if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then - zeta = pp_phi - theta = zero ; call surfcoord( theta, zeta, r , z ) - pp_rmax = r*1.0 ; pp_zmax = z*1.0 - endif + ! if pp_rmax and pp_zmax not provied + if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then + zeta = pp_phi + theta = zero ; call surfcoord( theta, zeta, r , z ) + pp_rmax = r*1.0 ; pp_zmax = z*1.0 + endif - if(masterid==0) write(ounit, '("poinplot: following fieldlines between ("ES12.5 & - ","ES12.5" ) and ("ES12.5","ES12.5" )")') pp_raxis, pp_zaxis, pp_rmax, pp_zmax - - do is = 1, pp_ns ! pp_ns is the number of eavaluation surfaces - niter = 0 ! number of successful iterations - if ( masterid /= modulo((is-1), nmaster)) cycle ! MPI - rzrzt(1:5) = (/ pp_raxis + is*(pp_rmax-pp_raxis)/pp_ns, & - pp_zaxis + is*(pp_zmax-pp_zaxis)/pp_ns, & - pp_raxis, pp_zaxis, zero /) - ppr(is, 0) = rzrzt(1) ; ppz(is, 0) = rzrzt(2) - - do ip = 1, pp_maxiter - iflag = 1 - call ppiota(rzrzt, iflag) - if (iflag >= 0) niter = niter + 1 ! counting - ppr(is, ip) = rzrzt(1) - ppz(is, ip) = rzrzt(2) - ! FATAL( poinplot, abs((rzrzt(3)-pp_raxis)/pp_raxis)>pp_xtol, magnetic axis is not coming back ) - enddo - - if (niter==0) then - iota(is) = zero - else - iota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) - endif - - write(ounit, '(8X": order="I6" ; myid="I6" ; (R,Z)=("ES12.5","ES12.5 & - " ) ; iota="ES12.5" ; niter="I6" .")') is, masterid, ppr(is,0), ppz(is,0), iota(is), niter - - if(lboozmn .and. abs(iota(is))>sqrtmachprec) then - x = ppr(is, 0) * cos(pp_phi) ; y = ppr(is, 0) * sin(pp_phi) ; z = ppz(is, 0) - call boozsurf( XYZB(1:total_num, 1:4, is), x, y, z, iota(is), is) - endif + if(myid==0) write(ounit, '("poinplot: following fieldlines between ("ES12.5 & + ","ES12.5" ) and ("ES12.5","ES12.5" )")') pp_raxis, pp_zaxis, pp_rmax, pp_zmax + + do is = 1, pp_ns ! pp_ns is the number of eavaluation surfaces + niter = 0 ! number of successful iterations + if ( modulo(myid, pp_ns) /= modulo((is-1), nmaster)) cycle ! MPI + rzrzt(1:5) = (/ pp_raxis + is*(pp_rmax-pp_raxis)/pp_ns, & + pp_zaxis + is*(pp_zmax-pp_zaxis)/pp_ns, & + pp_raxis, pp_zaxis, zero /) + ppr(is, 0) = rzrzt(1) ; ppz(is, 0) = rzrzt(2) + + do ip = 1, pp_maxiter + iflag = 1 + call ppiota(rzrzt, iflag) + if (iflag >= 0) niter = niter + 1 ! counting + ppr(is, ip) = rzrzt(1) + ppz(is, ip) = rzrzt(2) + ! FATAL( poinplot, abs((rzrzt(3)-pp_raxis)/pp_raxis)>pp_xtol, magnetic axis is not coming back ) enddo + if (niter==0) then + iota(is) = zero + else + iota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) + endif + + if (myworkid == 0) write(ounit, '(8X": order="I6" ; masterid="I6" ; (R,Z)=("ES12.5","ES12.5 & + " ) ; iota="ES12.5" ; niter="I6" .")') is, masterid, ppr(is,0), ppz(is,0), iota(is), niter + + if(lboozmn .and. abs(iota(is))>sqrtmachprec) then + x = ppr(is, 0) * cos(pp_phi) ; y = ppr(is, 0) * sin(pp_phi) ; z = ppz(is, 0) + call boozsurf( XYZB(1:total_num, 1:4, is), x, y, z, iota(is), is) + endif + enddo + + if (masterid >= 0) then call MPI_ALLREDUCE( MPI_IN_PLACE, ppr, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, ppz, pp_ns*(pp_maxiter+1), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, iota, pp_ns , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) @@ -140,12 +129,13 @@ SUBROUTINE poinplot call MPI_ALLREDUCE (MPI_IN_PLACE, booz_mnc, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) call MPI_ALLREDUCE (MPI_IN_PLACE, booz_mns, pp_ns*booz_mn, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr ) endif - icommand = 1 ; call coils_bfield(B, x, y, z, icommand) ; icommand = 0 ! finish + + CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) endif CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) - - return + +return END SUBROUTINE poinplot @@ -182,24 +172,26 @@ SUBROUTINE find_axis(RZ, MAXFEV, XTOL) call hybrd(axis_fcn,n,RZ,fvec,xtol,maxfev,ml,mu,epsfcn,diag, & mode,factor,nprint,info,nfev,fjac,ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) - write(ounit,'("findaxis: Finding axis at phi = "ES12.5" with (R,Z) = ( "ES12.5,","ES12.5" ).")') & - pp_phi, RZ(1), RZ(2) - select case (info) - case (0) - write(ounit,'("findaxis: info=0, improper input parameters.")') - case (1) - write(ounit,'("findaxis: info=1, relative error between two consecutive iterates is at most xtol.")') - case (2) - write(ounit,'("findaxis: info=2, number of calls to fcn has reached or exceeded maxfev.")') - case (3) - write(ounit,'("findaxis: info=3, xtol is too small.")') - case (4) - write(ounit,'("findaxis: info=4, iteration is not making good progress, jacobian.")') - case (5) - write(ounit,'("findaxis: info=5, iteration is not making good progress, function.")') - case default - write(ounit,'("findaxis: info="I2", something wrong with the axis finding subroutine.")') info - end select + if (myid == 0) then + write(ounit,'("findaxis: Finding axis at phi = "ES12.5" with (R,Z) = ( "ES12.5,","ES12.5" ).")') & + pp_phi, RZ(1), RZ(2) + select case (info) + case (0) + write(ounit,'("findaxis: info=0, improper input parameters.")') + case (1) + write(ounit,'("findaxis: info=1, relative error between two consecutive iterates is at most xtol.")') + case (2) + write(ounit,'("findaxis: info=2, number of calls to fcn has reached or exceeded maxfev.")') + case (3) + write(ounit,'("findaxis: info=3, xtol is too small.")') + case (4) + write(ounit,'("findaxis: info=4, iteration is not making good progress, jacobian.")') + case (5) + write(ounit,'("findaxis: info=5, iteration is not making good progress, function.")') + case default + write(ounit,'("findaxis: info="I2", something wrong with the axis finding subroutine.")') info + end select + endif return @@ -228,7 +220,7 @@ SUBROUTINE axis_fcn(n,x,fvec,iflag) call ode( BRpZ, n, rz_end, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) if ( ifail /= 2 ) then - if ( IsQuiet < 0 ) then + if ( myid==0 .and. IsQuiet < 0 ) then write ( ounit, '(A,I3)' ) 'axis_fcn: ODE solver ERROR; returned IFAIL = ', ifail select case ( ifail ) case ( 3 ) @@ -309,7 +301,6 @@ SUBROUTINE BRpZ( t, x, dx ) REAL, INTENT( IN) :: t, x(n) REAL, INTENT(OUT) :: dx(n) - INTEGER :: icommand = 0 REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(3) external :: coils_bfield !--------------------------------------------------------------------------------------------- @@ -318,8 +309,7 @@ SUBROUTINE BRpZ( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero - !icommand = 0 ; call test_bfield(B, XX, YY, ZZ, icommand, myworkid, nworker, MPI_COMM_MYWORLD) - icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) + call coils_bfield(B, XX, YY, ZZ) BR = B(1)*cos(t) + B(2)*sin(t) BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR @@ -347,7 +337,6 @@ SUBROUTINE BRpZ_iota( t, x, dx ) REAL, INTENT( IN) :: t, x(n) REAL, INTENT(OUT) :: dx(n) - INTEGER :: icommand = 0 REAL :: RR, ZZ, XX, YY, BR, BP, BZ, B(3), length external :: coils_bfield !--------------------------------------------------------------------------------------------- @@ -357,7 +346,7 @@ SUBROUTINE BRpZ_iota( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero - icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) + call coils_bfield(B, XX, YY, ZZ) BR = B(1)*cos(t) + B(2)*sin(t) BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR @@ -371,7 +360,7 @@ SUBROUTINE BRpZ_iota( t, x, dx ) XX = RR*cos(t); YY = RR*sin(t) ! cartesian coordinate B = zero - icommand = 0 ; call coils_bfield(B, XX, YY, ZZ, icommand) + call coils_bfield(B, XX, YY, ZZ) BR = B(1)*cos(t) + B(2)*sin(t) BP = ( - B(1)*sin(t) + B(2)*cos(t) ) / RR diff --git a/sources/wtmgrid.h b/sources/wtmgrid.h index fd0887c..478ad56 100644 --- a/sources/wtmgrid.h +++ b/sources/wtmgrid.h @@ -51,62 +51,62 @@ subroutine wtmgrid color = 0 endif CALL MPI_COMM_SPLIT(MPI_COMM_WORLD, color, myid, MPI_COMM_MASTERS, ierr) - - if (masterid == -1) then ! slave cores waiting in coils_bfield - call coils_bfield(B, xx, yy, zz, icommand) - else + if ( myworkid == 0 ) then CALL MPI_COMM_RANK(MPI_COMM_MASTERS, masterid, ierr) CALL MPI_COMM_SIZE(MPI_COMM_MASTERS, nmaster, ierr) + endif + IlBCAST( nmaster, 1, master ) - do ip = 1, np - RpZ(2) = Pmin + ( Pmax - Pmin ) * ( ip - 1 ) / ( np - 0 ) / Mfp - if ( masterid .ne. modulo(ip-1,nmaster) ) cycle - do iz = 1, nz ; RpZ(3) = Zmin + ( Zmax - Zmin ) * ( iz - 1 ) / ( nz - 1 ) - do ir = 1, nr ; RpZ(1) = Rmin + ( Rmax - Rmin ) * ( ir - 1 ) / ( nr - 1 ) + do ip = 1, np + RpZ(2) = Pmin + ( Pmax - Pmin ) * ( ip - 1 ) / ( np - 0 ) / Mfp + if ( modulo(myid, np) .ne. modulo(ip-1,nmaster) ) cycle + do iz = 1, nz ; RpZ(3) = Zmin + ( Zmax - Zmin ) * ( iz - 1 ) / ( nz - 1 ) + do ir = 1, nr ; RpZ(1) = Rmin + ( Rmax - Rmin ) * ( ir - 1 ) / ( nr - 1 ) - czeta = cos(RpZ(2)) - szeta = sin(RpZ(2)) + czeta = cos(RpZ(2)) + szeta = sin(RpZ(2)) - xx = RpZ(1) * czeta - yy = RpZ(1) * szeta - zz = RpZ(3) + xx = RpZ(1) * czeta + yy = RpZ(1) * szeta + zz = RpZ(3) - call coils_bfield(B,xx,yy,zz,icommand) + call coils_bfield(B,xx,yy,zz) - BRZp(1,ir,iz,ip) = ( B(1) * czeta + B(2) * szeta ) - BRZp(3,ir,iz,ip) = ( - B(1) * szeta + B(2) * czeta ) - BRZp(2,ir,iz,ip) = B(3) + BRZp(1,ir,iz,ip) = ( B(1) * czeta + B(2) * szeta ) + BRZp(3,ir,iz,ip) = ( - B(1) * szeta + B(2) * czeta ) + BRZp(2,ir,iz,ip) = B(3) #ifdef DIV_CHECK - dBx = B(1) ; dBy = B(2) ; dBz = B(3) - BRpZ(2,ir,iz,ip) = sqrt( B(1)*B(1) + B(2)*B(2) + B(3)*B(3) ) - - xx = xx + dx - call coils_bfield(B,xx,yy,zz,icommand) - dBx = ( B(1) - dBx ) / dx - xx = xx - dx - - yy = yy + dy - call coils_bfield(B,xx,yy,zz,icommand) - dBy = ( B(2) - dBy ) / dy - yy = yy - dy - - zz = zz + dz - call coils_bfield(B,xx,yy,zz,icommand) - dBz = ( B(3) - dBz ) / dz - zz = zz - dz - - BRpZ(1,ir,iz,ip) = dBx + dBy + dBz - BRpZ(2,ir,iz,ip) = BRpZ(1,ir,iz,ip) / BRpZ(2,ir,iz,ip) + dBx = B(1) ; dBy = B(2) ; dBz = B(3) + BRpZ(2,ir,iz,ip) = sqrt( B(1)*B(1) + B(2)*B(2) + B(3)*B(3) ) + + xx = xx + dx + call coils_bfield(B,xx,yy,zz) + dBx = ( B(1) - dBx ) / dx + xx = xx - dx + + yy = yy + dy + call coils_bfield(B,xx,yy,zz) + dBy = ( B(2) - dBy ) / dy + yy = yy - dy + + zz = zz + dz + call coils_bfield(B,xx,yy,zz) + dBz = ( B(3) - dBz ) / dz + zz = zz - dz + + BRpZ(1,ir,iz,ip) = dBx + dBy + dBz + BRpZ(2,ir,iz,ip) = BRpZ(1,ir,iz,ip) / BRpZ(2,ir,iz,ip) #endif - enddo enddo enddo + enddo + + if (masterid >=0) then call MPI_ALLREDUCE( MPI_IN_PLACE, BRZp, 3*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr) #ifdef DIV_CHECK call MPI_ALLREDUCE( MPI_IN_PLACE, BRpZ, 2*nr*nz*np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MASTERS, ierr) #endif CALL MPI_COMM_FREE(MPI_COMM_MASTERS, ierr) - icommand = 1 ; call coils_bfield(B, xx, yy, zz, icommand) ! finish endif CALL MPI_COMM_FREE(MPI_COMM_MYWORLD, ierr) @@ -117,8 +117,6 @@ subroutine wtmgrid #endif nextcur = 1 ; curlabel(1) = "focus-coils" - !write(suffix,'(i3.3,".",i4.4,".",i4.4)') Np, Nr, Nz - write( ounit,'("wtmgrid : writing ",A," ; Mfp="i3" ;")') trim(mgrid_name), Mfp !open( wunit, file=trim(ext)//".fo.mgrid", status="unknown", form="unformatted", iostat=iostat ) @@ -137,8 +135,9 @@ subroutine wtmgrid DEALLOCATE(BRpZ) #endif - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! return end subroutine wtmgrid + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From 7b84433709741fa9311f5b29c068a6656af5f292 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sun, 12 May 2019 17:32:20 -0400 Subject: [PATCH 27/72] avoid currents rescaling in calculating harmonics --- sources/solvers.h | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/sources/solvers.h b/sources/solvers.h index 1224724..5ba1a3b 100644 --- a/sources/solvers.h +++ b/sources/solvers.h @@ -419,10 +419,10 @@ subroutine normweight if ( weight_bharm >= machprec ) then modBn = sqrt(sum(Bmnc**2 + Bmns**2)) modtBn = sqrt(sum(tBmnc**2 + tBmns**2)) - do icoil = 1, Ncoils - coil(icoil)%I = coil(icoil)%I * modtBn / modBn - enddo - if(myid .eq. 0) write(ounit,'(8X,": rescale coil currents with a factor of "ES12.5)') & +!!$ do icoil = 1, Ncoils +!!$ coil(icoil)%I = coil(icoil)%I * modtBn / modBn +!!$ enddo + if(myid .eq. 0) write(ounit,'(8X,": Please rescale coil currents with a factor of "ES12.5)') & modtBn / modBn call bnormal(0) if (abs(bharm) > machprec) weight_bharm = weight_bharm / bharm From 702849dab8d381481403ecb0293ccb81af84b82a Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 15 May 2019 15:03:54 -0400 Subject: [PATCH 28/72] update example input namelist for OMFIT --- examples/d3d_RMP/d3d.input | 46 +++++++++++++++++++++++--------------- 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/examples/d3d_RMP/d3d.input b/examples/d3d_RMP/d3d.input index db5a1e1..f9e258e 100644 --- a/examples/d3d_RMP/d3d.input +++ b/examples/d3d_RMP/d3d.input @@ -2,14 +2,18 @@ IsQuiet = -1 ! -2 verbose and including unconstrained cost functions; -1: verbose; 0: normal; 1: concise IsSymmetric = 0 ! 0: no stellarator symmetry enforced; 1: plasm periodicity enforced; 2: coil periodicity enforced + input_surf = 'plasma.boundary' ! specify the filename of plasma surface + input_harm = 'target.harmonics' ! specify the filename of target Bn harmonics + input_coils = 'none' ! specify the filename of input coils + case_surface = 0 ! 0: general VMEC-like format (Rbc, Rbs, Zbc, Zbs); 1: read axis for knots knotsurf = 0.200D-00 ! minor plasma radius for knototrans, only valid for case surface = 1 ellipticity = 0.000D+00 ! ellipticity of plasma for knototrans, only valid for case surface = 1 Nteta = 256 ! poloidal number for discretizing the surface Nzeta = 64 ! toroidal number for discretizing the surface - case_init = -1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils - case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation + case_init = -1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize dipoles + case_coils = 1 ! 1: using Fourier series representation Ncoils = 16 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 init_radius = 0.500D+00 ! initial coil radius (meter); only valid when case_init = 1 @@ -23,19 +27,19 @@ case_bnormal = 0 ! 0: keep raw Bn error; 1: Bn residue normalized to local |B| case_length = 2 ! 1: quadratic format, converging the target length; 2: exponential format, as short as possible weight_bnorm = 0.000D+00 ! weight for real space Bn errors - weight_bharm = 1.000D+00 ! weight for Bnm harmonic errors - weight_tflux = 0.000D+00 ! weight for toroidal flux error - target_tflux = 0.000D+00 ! target for the toroidal flux + weight_bharm = 1.000D+00 ! weight for Bmn harmonic errors + weight_tflux = 0.000D+00 ! weight for toroidal flux error, specified by target_tflux + target_tflux = 0.000D+00 ! target for the toroidal flux, 0: the present value weight_ttlen = 0.000D+00 ! weight for coil length error weight_cssep = 1.000D+00 ! weight for coil surface separation constraint cssep_factor = 3.00D+00 ! exponential factor for cssep target_length = 0.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length - weight_specw = 0.000D+00 ! weight for spectral condensation error (not ready) weight_ccsep = 0.000D+00 ! weight for coil-coil separation constraint (not ready) - weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. - weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. + weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. + weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. + weight_mnorm = 1.0 ! weight for normalization of magnetic moment - case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing with algorithms using the gradient (DF and/or CG); 2: optimizing with algorithms using the Hessian (HT and/or NT) + case_optimize = 1 ! -1: check the 1st derivatives; 0: no optimizations; 1: optimizing with algorithms using the gradient; exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold DF_maxiter = 100 ! maximum iterations allowed for using Differential Flow (DF) @@ -48,18 +52,24 @@ CG_wolfe_c1 = 1.000D-04 ! c1 value in the strong wolfe condition for line search; CG_wolfe_c2 = 0.1 ! c2 value in the strong wolfe condition for line search; if one CG step takes too long, try to increase c2, but remember 0 < c1 < c2 < 1 - HN_maxiter = 0 - HN_xtol = 1.000D-08 - HN_factor = 100.0 - - TN_maxiter = 0 - TN_xtol = 1.000D-08 - TN_reorder = 0 - TN_cr = 0.1 + LM_MAXITER = 0 ! maximum iterations for levenberg-marquardt (LM) method + LM_XTOL = 1.0000E-008 ! relative tolerance desired in approximated solution + LM_FTOL = 1.00000000E-008 ! relative tolerance desired in sum of squares + LM_FACTOR = 100.000000000000 ! initial step bound for line search - case_postproc = 0 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write mgrid file (not ready) + case_postproc = 0 ! 0: no post-processing; 1: coil diagnos; 2: write SPEC interface; 3: fieldline tracing; 4: Boozer spectrum; 5: write mgrid save_freq = 1 ! frequency for writing output files; should be positive save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 1 ! flag for indicating whether write example.harmonics save_filaments = 0 ! flag for indicating whether write .example.filaments.xxxxxx + update_plasma = 0 ! write ext.plamsa file with present Bn info + + pp_phi = 0.000000 ! (*pi) toroidal angle for fieldline tracing + pp_raxis = 0.000000 ! initial guess r position for finding magnetic axis + pp_zaxis = 0.000000 ! initial guess z position for finding magnetic axis + pp_rmax = 0.000000 ! upper bound r position for fieldline tracing + pp_zmax = 0.000000 ! upper bound z position for fieldline tracing + pp_ns = 10 ! number of fieldlines traced + pp_maxiter = 1000 ! number of toroidal periods for each fieldline + pp_xtol = 1.000000E-006 ! ODE tolarence for fieldline tracing / From 09e30328fdb2e9f67d53d26bc9c8289225fd7bbc Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 16 May 2019 10:08:11 -0400 Subject: [PATCH 29/72] update Makefile for eddy cluster --- sources/Makefile | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/sources/Makefile b/sources/Makefile index b463e48..6725bb1 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -15,17 +15,27 @@ ############################################################################################################ MACROS=macros - CC=intel # if want to use gfortran; make CC=gfortran xfocus; otherwise using Intel + +#### Default Intel+OpenMPI+HDF5############### +# available env: /p/focus/modules/focus/basis + CC=intel # if want to use gfortran; make CC=gfortran or other options FC=mpif90 PFLAGS= # for pre-processing compiler flags, like -D dposition + RFLAGS=-mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback $(PFLAGS) #-vec_report0 #-ipo -xhost + DFLAGS=-check all -check noarg_temp_created -debug full -D DEBUG + +#### GFORTRAN+OpenMPI+HDF5############### +# available env: /p/focus/modules/focus/gfortran ifeq ($(CC),gfortran) # RFLAGS=-O3 -w -fdefault-real-8 -ffree-line-length-none -march=native -ffast-math RFLAGS=-O3 -w -ffree-line-length-none -march=native -ffast-math $(PFLAGS) DFLAGS=-g3 -Wextra -Wtarget-lifetime -fbacktrace -fbounds-check -ffpe-trap=zero -fcheck=all -DDEBUG -else -# RFLAGS=-r8 -mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback #-vec_report0 #-ipo -xhost - RFLAGS=-mcmodel=large -O3 -m64 -unroll0 -fno-alias -ip -traceback $(PFLAGS) #-vec_report0 #-ipo -xhost - DFLAGS=-check all -check noarg_temp_created -debug full -D DEBUG +endif + +#### EDDY Intel+IntelMPI+HDF5############### +# available env: /home/caoxiang/Modules/focus/develop +ifeq ($(CC),eddyintel) + FC=mpiifort endif ############################################################################################################ From acd1f5d5d9aa61a7aeb723df8353a2a7830060e0 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 16 May 2019 11:21:18 -0400 Subject: [PATCH 30/72] Change file extensions to .f90 for IDE reading --- sources/Makefile | 28 ++++++++++++++-------------- sources/{bfield.h => bfield.f90} | 0 sources/{bmnharm.h => bmnharm.f90} | 0 sources/{bnormal.h => bnormal.f90} | 0 sources/{boozer.h => boozer.f90} | 0 sources/{congrad.h => congrad.f90} | 0 sources/{datalloc.h => datalloc.f90} | 0 sources/{descent.h => descent.f90} | 0 sources/{diagnos.h => diagnos.f90} | 0 sources/{fdcheck.h => fdcheck.f90} | 0 sources/{focus.h => focus.f90} | 0 sources/{globals.h => globals.f90} | 0 sources/{initial.h => initial.f90} | 0 sources/{length.h => length.f90} | 0 sources/{lmalg.h => lmalg.f90} | 0 sources/{packdof.h => packdof.f90} | 0 sources/{poinplot.h => poinplot.f90} | 0 sources/{rdcoils.h => rdcoils.f90} | 0 sources/{rdknot.h => rdknot.f90} | 0 sources/{rdsurf.h => rdsurf.f90} | 0 sources/{saving.h => saving.f90} | 0 sources/{solvers.h => solvers.f90} | 0 sources/{specinp.h => specinp.f90} | 0 sources/{surfsep.h => surfsep.f90} | 0 sources/{torflux.h => torflux.f90} | 0 sources/{wtmgrid.h => wtmgrid.f90} | 0 26 files changed, 14 insertions(+), 14 deletions(-) rename sources/{bfield.h => bfield.f90} (100%) rename sources/{bmnharm.h => bmnharm.f90} (100%) rename sources/{bnormal.h => bnormal.f90} (100%) rename sources/{boozer.h => boozer.f90} (100%) rename sources/{congrad.h => congrad.f90} (100%) rename sources/{datalloc.h => datalloc.f90} (100%) rename sources/{descent.h => descent.f90} (100%) rename sources/{diagnos.h => diagnos.f90} (100%) rename sources/{fdcheck.h => fdcheck.f90} (100%) rename sources/{focus.h => focus.f90} (100%) rename sources/{globals.h => globals.f90} (100%) rename sources/{initial.h => initial.f90} (100%) rename sources/{length.h => length.f90} (100%) rename sources/{lmalg.h => lmalg.f90} (100%) rename sources/{packdof.h => packdof.f90} (100%) rename sources/{poinplot.h => poinplot.f90} (100%) rename sources/{rdcoils.h => rdcoils.f90} (100%) rename sources/{rdknot.h => rdknot.f90} (100%) rename sources/{rdsurf.h => rdsurf.f90} (100%) rename sources/{saving.h => saving.f90} (100%) rename sources/{solvers.h => solvers.f90} (100%) rename sources/{specinp.h => specinp.f90} (100%) rename sources/{surfsep.h => surfsep.f90} (100%) rename sources/{torflux.h => torflux.f90} (100%) rename sources/{wtmgrid.h => wtmgrid.f90} (100%) diff --git a/sources/Makefile b/sources/Makefile index 3d10aaf..3826f9b 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -5,12 +5,12 @@ ALLFILES= globals initial rdsurf rdknot rdcoils packdof bfield bmnharm bnormal fdcheck \ torflux length surfsep datalloc solvers descent congrad lmalg saving diagnos \ specinp poinplot boozer wtmgrid focus - HFILES= $(ALLFILES:=.h) - FFILES= $(ALLFILES:=.F90) - PFILES= $(ALLFILES:=.pdf) - ROBJS=$(ALLFILES:=_r.o) - DOBJS=$(ALLFILES:=_d.o) - NUMOBJ= ode.o lmder1.o hybrj.o + HFILES= $(ALLFILES:=.f90) # raw source files + FFILES= $(ALLFILES:=_m.F90) # Fortran 90 files + PFILES= $(ALLFILES:=.pdf) # documentations + ROBJS=$(ALLFILES:=_r.o) # release version objectives + DOBJS=$(ALLFILES:=_d.o) # debug version objectives + NUMOBJ= ode.o lmder1.o hybrj.o # numerical libraries ############################################################################################################ @@ -37,7 +37,7 @@ endif #### EDDY Intel+IntelMPI+HDF5############### # available env: /home/caoxiang/Modules/focus/develop ifeq ($(CC),eddyintel) - FC=mpiifort + FC=mpiifort # this is optional after recent updates endif ############################################################################################################ @@ -72,13 +72,13 @@ lmder1.o : lmder1.f hybrj.o: hybrj.f $(FC) -c $(FLAGS) -o $@ $< -$(ROBJS): %_r.o: %.F90 +$(ROBJS): %_r.o: %_m.F90 $(FC) -c $(RFLAGS) -o $@ $< $(HDF5) -$(DOBJS): %_d.o: %.F90 +$(DOBJS): %_d.o: %_m.F90 $(FC) -c $(DFLAGS) -o $@ $< $(HDF5) -$(FFILES): %.F90: %.h +$(FFILES): %_m.F90: %.f90 m4 -P $(MACROS) $< > $@ ############################################################################################################ @@ -88,12 +88,12 @@ clean: ############################################################################################################ -$(PFILES): %.pdf: %.h head.tex end.tex -# @ls -lT $*.h | cut -c 35-55 > .$*.date - @ls --full-time $*.h | cut -c 32-50 > .$*.date +$(PFILES): %.pdf: %.f90 head.tex end.tex +# @ls -lT $*.f90 | cut -c 35-55 > .$*.date + @ls --full-time $*.f90 | cut -c 32-50 > .$*.date @awk -v file=$* -v date=.$*.date 'BEGIN{getline cdate < date ; FS="!latex" ; print "\\input{head} \\code{"file"}"} \ {if(NF>1) print $$2} \ - END{print "\\vspace{1mm} \\hrule \\vspace{1mm} \\footnotesize $*.h last modified on "cdate";" ; print "\\input{end}"}' $*.h > $*.tex + END{print "\\vspace{1mm} \\hrule \\vspace{1mm} \\footnotesize $*.f90 last modified on "cdate";" ; print "\\input{end}"}' $*.f90 > $*.tex @echo $*.pdf @pdflatex -shell-escape -interaction=nonstopmode -file-line-error $*.tex | grep ".*:[0-9]*:.*" ||: @pdflatex -shell-escape -interaction=nonstopmode -file-line-error $*.tex | grep ".*:[0-9]*:.*" ||: diff --git a/sources/bfield.h b/sources/bfield.f90 similarity index 100% rename from sources/bfield.h rename to sources/bfield.f90 diff --git a/sources/bmnharm.h b/sources/bmnharm.f90 similarity index 100% rename from sources/bmnharm.h rename to sources/bmnharm.f90 diff --git a/sources/bnormal.h b/sources/bnormal.f90 similarity index 100% rename from sources/bnormal.h rename to sources/bnormal.f90 diff --git a/sources/boozer.h b/sources/boozer.f90 similarity index 100% rename from sources/boozer.h rename to sources/boozer.f90 diff --git a/sources/congrad.h b/sources/congrad.f90 similarity index 100% rename from sources/congrad.h rename to sources/congrad.f90 diff --git a/sources/datalloc.h b/sources/datalloc.f90 similarity index 100% rename from sources/datalloc.h rename to sources/datalloc.f90 diff --git a/sources/descent.h b/sources/descent.f90 similarity index 100% rename from sources/descent.h rename to sources/descent.f90 diff --git a/sources/diagnos.h b/sources/diagnos.f90 similarity index 100% rename from sources/diagnos.h rename to sources/diagnos.f90 diff --git a/sources/fdcheck.h b/sources/fdcheck.f90 similarity index 100% rename from sources/fdcheck.h rename to sources/fdcheck.f90 diff --git a/sources/focus.h b/sources/focus.f90 similarity index 100% rename from sources/focus.h rename to sources/focus.f90 diff --git a/sources/globals.h b/sources/globals.f90 similarity index 100% rename from sources/globals.h rename to sources/globals.f90 diff --git a/sources/initial.h b/sources/initial.f90 similarity index 100% rename from sources/initial.h rename to sources/initial.f90 diff --git a/sources/length.h b/sources/length.f90 similarity index 100% rename from sources/length.h rename to sources/length.f90 diff --git a/sources/lmalg.h b/sources/lmalg.f90 similarity index 100% rename from sources/lmalg.h rename to sources/lmalg.f90 diff --git a/sources/packdof.h b/sources/packdof.f90 similarity index 100% rename from sources/packdof.h rename to sources/packdof.f90 diff --git a/sources/poinplot.h b/sources/poinplot.f90 similarity index 100% rename from sources/poinplot.h rename to sources/poinplot.f90 diff --git a/sources/rdcoils.h b/sources/rdcoils.f90 similarity index 100% rename from sources/rdcoils.h rename to sources/rdcoils.f90 diff --git a/sources/rdknot.h b/sources/rdknot.f90 similarity index 100% rename from sources/rdknot.h rename to sources/rdknot.f90 diff --git a/sources/rdsurf.h b/sources/rdsurf.f90 similarity index 100% rename from sources/rdsurf.h rename to sources/rdsurf.f90 diff --git a/sources/saving.h b/sources/saving.f90 similarity index 100% rename from sources/saving.h rename to sources/saving.f90 diff --git a/sources/solvers.h b/sources/solvers.f90 similarity index 100% rename from sources/solvers.h rename to sources/solvers.f90 diff --git a/sources/specinp.h b/sources/specinp.f90 similarity index 100% rename from sources/specinp.h rename to sources/specinp.f90 diff --git a/sources/surfsep.h b/sources/surfsep.f90 similarity index 100% rename from sources/surfsep.h rename to sources/surfsep.f90 diff --git a/sources/torflux.h b/sources/torflux.f90 similarity index 100% rename from sources/torflux.h rename to sources/torflux.f90 diff --git a/sources/wtmgrid.h b/sources/wtmgrid.f90 similarity index 100% rename from sources/wtmgrid.h rename to sources/wtmgrid.f90 From 79f075ca698f4aca850e187d98cf5e48df3d333c Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 30 May 2019 14:05:32 -0400 Subject: [PATCH 31/72] independent input namelist for writing mgrid --- sources/globals.f90 | 2 +- sources/initial.f90 | 2 +- sources/wtmgrid.f90 | 51 +++++++++++++++++++++++++-------------------- 3 files changed, 30 insertions(+), 25 deletions(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index 0780b0a..f196f09 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.10' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.11' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.f90 b/sources/initial.f90 index a3184ea..72bc44e 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -378,7 +378,7 @@ subroutine initial if (trim(input_coils) == 'none') input_coils = trim(ext)//".focus" inquire( file=trim(input_coils), exist=exist ) FATAL( initial, .not.exist, FOCUS coil file ext.focus not provided ) - write(ounit, '(" : Read initial coils from : ", A, A)') trim(input_coils), '(MAKEGRID format)' + write(ounit, '(" : Read initial coils from : ", A, A)') trim(input_coils), '(Parameters only)' case( 1 ) FATAL( initial, Ncoils < 1, should provide the No. of coils) FATAL( initial, init_current == zero, invalid coil current) diff --git a/sources/wtmgrid.f90 b/sources/wtmgrid.f90 index 478ad56..8e8bb15 100644 --- a/sources/wtmgrid.f90 +++ b/sources/wtmgrid.f90 @@ -1,41 +1,51 @@ ! write binary mgrid file +module mgrid_mod + use globals, only : dp, zero, pi2 + INTEGER :: NR = 101, NZ=101, NP=72, MFP=0 + REAL :: Rmin=zero, Rmax=zero, Zmin=zero, Zmax=zero, Pmin=zero, Pmax=pi2 + namelist / mgrid / Rmin, Rmax, Zmin, Zmax, Pmin, Pmax, NR, NZ, NP +end module mgrid_mod + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! subroutine wtmgrid - use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit, nfp_raw, & - pp_raxis, pp_zaxis, pp_rmax, pp_zmax, & - master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS + use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit, runit, nfp_raw, & + sqrtmachprec, master, nmaster, nworker, masterid, color, myworkid, & + MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS + use mgrid_mod implicit none include "mpif.h" - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! + !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! LOGICAL :: exist - INTEGER :: ierr, astat, iostat, ip, iz, ir, np, nz, nr, Mfp, nextcur, icommand - REAL :: RpZ(1:3), R, P, Z, Pmin, Pmax, Zmin, Zmax, Rmin, Rmax, B(1:3), pressure, gap, & + INTEGER :: ierr, astat, iostat, ip, iz, ir, nextcur, icpu + REAL :: RpZ(1:3), R, P, Z, B(1:3), pressure, gap, & czeta, szeta, xx, yy, zz, dx, dy, dz, dBx, dBy, dBz REAL, allocatable :: BRZp(:,:,:,:), BRpZ(:,:,:,:) CHARACTER(LEN=100) :: mgrid_name CHARACTER(LEN=30) :: curlabel(1:1) - icommand = 0 + do icpu = 1, ncpu + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) + if (myid == icpu-1) then ! each cpu read the namelist in turn; + open(runit, file=trim(trim(ext)//".input"), status="old", action='read') + read(runit, mgrid) + close(runit) + endif ! end of if( myid == 0 ) + enddo + mgrid_name = "mgrid.focus_"//trim(ext) ! filename, could be user input - np = 72 ; nz = 121 ; nr = 121 ; Mfp = nfp_raw ! SHOULD BE USER INPUT; 04 Aug 16; - !np = 12 ; nz = 11 ; nr = 11 ; Mfp = 2 ! SHOULD BE USER INPUT; 04 Aug 16; + if (Mfp <= 0) Mfp = nfp_raw ! overrid to nfp_raw if not specified B = zero ; dx = 1E-4 ; dy = 1E-4 ; dz = 1E-4 + FATAL( wrmgrid, abs(Rmin)+abs(Rmax) Date: Thu, 8 Aug 2019 10:37:25 -0400 Subject: [PATCH 32/72] fix coil-coil separation for periodicity --- sources/diagnos.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index ae110a9..bbe9ee3 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -86,8 +86,9 @@ SUBROUTINE diagnos if(coil(icoil)%itype .ne. 1) exit ! only for Fourier if(Ncoils .eq. 1) exit !if only one coil - itmp = icoil + 1 - if(icoil .eq. Ncoils) itmp = 1 + itmp = icoil + 1 ! the guessed adjacent coil + if(icoil .eq. Ncoils .and. npc==1) itmp = 1 + ! only when if npc==1, the last coil would be compared with the first one SALLOCATE(Atmp, (1:3,0:coil(icoil)%NS-1), zero) SALLOCATE(Btmp, (1:3,0:coil(itmp )%NS-1), zero) From 6b113fec404bccea30f5d66b483b717e10c20d34 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 8 Aug 2019 13:08:46 -0400 Subject: [PATCH 33/72] add debug info for coil-coil separation --- sources/diagnos.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index bbe9ee3..762f914 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -103,6 +103,11 @@ SUBROUTINE diagnos call mindist(Atmp, coil(icoil)%NS, Btmp, coil(itmp)%NS, tmp_dist) +#ifdef DEBUG + if(myid .eq. 0) write(ounit, '(8X": distance between "I3 "-th and "I3"-th coil is : " ES23.15)') & + icoil, itmp, tmp_dist +#endif + if (minCCdist .ge. tmp_dist) minCCdist=tmp_dist DALLOCATE(Atmp) From 3d3f9fdceb9bdb2fc84a85253e416bf35cc32ed0 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 8 Aug 2019 13:43:46 -0400 Subject: [PATCH 34/72] plasma volume is multiplied by Nfp --- sources/rdsurf.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index f3e57bd..f35ffc2 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -273,8 +273,8 @@ subroutine fousurf enddo ! end of do jj; 14 Apr 16; enddo ! end of do ii; 14 Apr 16; - surf(1)%vol = abs(surf(1)%vol) * discretefactor - if( myid == 0 .and. IsQuiet <= 0) write(ounit, '(8X": Enclosed volume ="ES12.5" m^3 ;" )') surf(1)%vol + surf(1)%vol = abs(surf(1)%vol) * discretefactor * Nfp + if( myid == 0 .and. IsQuiet <= 0) write(ounit, '(8X": Enclosed total plasma volume ="ES12.5" m^3 ;" )') surf(1)%vol !calculate target Bn with input harmonics; 05 Jan 17; if(NBnf > 0) then From 58c48f9b999bd556a486153cfaf36de9e8ed6d3e Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 8 Aug 2019 13:44:29 -0400 Subject: [PATCH 35/72] update the version number --- sources/globals.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index f196f09..ccd3747 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.11' ! version number + CHARACTER(LEN=10), parameter :: version='v0.7.12' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From b83783872f34c9998f68f015b363eabfab888062 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sun, 25 Aug 2019 18:12:30 -0400 Subject: [PATCH 36/72] add bharm_jsurf conditions --- sources/bmnharm.f90 | 10 +++++++++- sources/globals.f90 | 2 ++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/sources/bmnharm.f90 b/sources/bmnharm.f90 index 2218b3d..6fb025f 100644 --- a/sources/bmnharm.f90 +++ b/sources/bmnharm.f90 @@ -126,7 +126,7 @@ SUBROUTINE readBmn !---------------------------------------------------------------------------------------- use globals, only: dp, zero, half, pi2, myid, ounit, runit, ext, IsQuiet, Nteta, Nzeta, Nfp, & NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, Nfp_raw, case_bnormal, & - input_harm + input_harm, bharm_jsurf, surf use bharm_mod implicit none include "mpif.h" @@ -195,6 +195,14 @@ SUBROUTINE readBmn carg(ij, imn) = cos(arg) sarg(ij, imn) = sin(arg) enddo + ! Additional weighting + if (bharm_jsurf == 1) then ! Bn * dA**2 + carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta))**2 + sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta))**2 + else if ( bharm_jsurf == 2) then ! Bn * dA + carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta)) + sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta)) + end if enddo enddo diff --git a/sources/globals.f90 b/sources/globals.f90 index ccd3747..7fb5361 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -101,6 +101,7 @@ module globals INTEGER :: case_bnormal = 0 INTEGER :: case_length = 1 REAL :: weight_bnorm = 1.000D+00 + INTEGER :: bharm_jsurf = 0 REAL :: weight_bharm = 0.000D+00 REAL :: weight_tflux = 0.000D+00 REAL :: target_tflux = 0.000D+00 @@ -184,6 +185,7 @@ module globals case_bnormal , & case_length , & weight_bnorm , & + bharm_jsurf , & weight_bharm , & weight_tflux , & target_tflux , & From 4f7bb0de30504399f5f0bfdcd3c37bd0500c32c6 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 26 Aug 2019 13:57:47 -0400 Subject: [PATCH 37/72] replace CG with CG-descent --- sources/Makefile | 5 +- sources/cg_descent.f | 1607 ++++++++++++++++++++++++++++++++++++++++++ sources/congrad.f90 | 95 ++- sources/globals.f90 | 8 +- sources/initial.f90 | 2 +- sources/saving.f90 | 2 +- 6 files changed, 1708 insertions(+), 11 deletions(-) create mode 100644 sources/cg_descent.f diff --git a/sources/Makefile b/sources/Makefile index 3826f9b..fea0614 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -10,7 +10,7 @@ PFILES= $(ALLFILES:=.pdf) # documentations ROBJS=$(ALLFILES:=_r.o) # release version objectives DOBJS=$(ALLFILES:=_d.o) # debug version objectives - NUMOBJ= ode.o lmder1.o hybrj.o # numerical libraries + NUMOBJ= ode.o lmder1.o hybrj.o cg_descent.o # numerical libraries ############################################################################################################ @@ -72,6 +72,9 @@ lmder1.o : lmder1.f hybrj.o: hybrj.f $(FC) -c $(FLAGS) -o $@ $< +cg_descent.o : cg_descent.f + $(FC) -c $(RFLAGS) -o $@ $< + $(ROBJS): %_r.o: %_m.F90 $(FC) -c $(RFLAGS) -o $@ $< $(HDF5) diff --git a/sources/cg_descent.f b/sources/cg_descent.f new file mode 100644 index 0000000..98c2521 --- /dev/null +++ b/sources/cg_descent.f @@ -0,0 +1,1607 @@ +c ________________________________________________________________ +c | A conjugate gradient method with guaranteed descent | +c | | +c | Version 1.1 (December 10, 2004) | +c | Version 1.2 (June 4, 2005) | +c | Version 1.3 (October 6, 2005) | +c | Version 1.4 (November 14, 2005) | +c | | +c | William W. Hager and Hongchao Zhang | +c | hager@math.ufl.edu hzhang@math.ufl.edu | +c | Department of Mathematics | +c | University of Florida | +c | Gainesville, Florida 32611 USA | +c | 352-392-0281 x 244 | +c | | +c | Copyright 2004 by William W. Hager | +c | | +c |This program is free software; you can redistribute it and/or | +c |modify it under the terms of the GNU General Public License as | +c |published by the Free Software Foundation; either version 2 of | +c |the License, or (at your option) any later version. | +c |This program is distributed in the hope that it will be useful, | +c |but WITHOUT ANY WARRANTY; without even the implied warranty of | +c |MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | +c |GNU General Public License for more details. | +c | | +c |You should have received a copy of the GNU General Public | +c |License along with this program; if not, write to the Free | +c |Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, | +c |MA 02110-1301 USA | +c | | +c | http://www.math.ufl.edu/~hager/papers/CG | +c | | +c | INPUT: | +c | | +c |(double) grad_tol-- StopRule = T: |g|_infty <= max (grad_tol, | +c | StopFac*initial |g|_infty) [default] | +c | StopRule = F: |g|_infty <= grad_tol(1+|f|) | +c | | +c |(double) x --starting guess (length n) | +c | | +c |(int) dim --problem dimension (also denoted n) | +c | | +c | cg_value--name of cost evaluation subroutine | +c | (external in main program, cg_value(f, x, n) | +c | puts value of cost function at x in f | +c | f is double precision scalar and x is | +c | double precision array of length n) | +c | | +c | cg_grad --name gradient evaluation subroutine | +c | (external in main program, cg_grad (g, x, n) | +c | puts gradient at x in g, g and x are | +c | double precision arrays of length n) | +c | | +c |(double) gnorm --if the parameter Step in cg_descent.parm is | +c | .true., then gnorm contains the initial step | +c | used at iteration 0 in the line search | +c | | +c |(double) d --direction (work array, length n) | +c | | +c |(double) g --gradient (work array, length n) | +c | | +c |(double) xtemp --work array (work array, length n) | +c | | +c |(double) gtemp --work array (work array, length n) | +c | | +c | OUTPUT: | +c | | +c |(int) status -- 0 (convergence tolerance satisfied) | +c | 1 (change in func <= feps*|f|) | +c | 2 (total iterations exceeded maxit) | +c | 3 (slope always negative in line search) | +c | 4 (number secant iterations exceed nsecant) | +c | 5 (search direction not a descent direction)| +c | 6 (line search fails in initial interval) | +c | 7 (line search fails during bisection) | +c | 8 (line search fails during interval update)| +c | | +c |(double) gnorm --max abs component of gradient | +c | | +c |(double) f --function value at solution | +c | | +c |(double) x --solution (length n) | +c | | +c |(int) iter --number of iterations | +c | | +c |(int) nfunc --number of function evaluations | +c | | +c |(int) ngrad --number of gradient evaluations | +c | | +c |Note: The file cg_descent.parm must be placed in the directory | +c | where the code is run | +c |________________________________________________________________| +c + subroutine cg_descent (grad_tol, x, dim, cg_value, cg_grad, + & status, gnorm, f, iter, nfunc, ngrad, + & d, g, xtemp, gtemp) + + use globals, only: dp, myid, ounit, IsQuiet, tstart, tfinish + use mpi + + double precision x (*), d (*), g (*), xtemp (*), gtemp (*), + & delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & grad_tol, delta2, eta_sq, Qk, + & f, ftemp, gnorm, xnorm, gnorm2, dnorm2, denom, + & t, t1, t2, t3, t4, dphi, dphi0, alpha, talpha, + & yk, yk2, ykgk, dkyk, beta + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, + & iter, status, nfunc, ngrad, + & i, j, i1, i2, i3, i4, dim + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug, + & cg_tol + + external cg_value, cg_grad + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + +c initialize the parameters + + call cg_init (grad_tol, dim) + + if ( Step ) then + alpha = gnorm + endif + delta2 = 2*delta - 1 + eta_sq = eta*eta + iter = 0 + Ck = 0 + Qk = 0 + +c initial function and gradient evaluations, initial direction + + call cg_value (f, x, n) + nf = nf + 1 + call cg_grad (g, x, n) + ng = ng + 1 + f0 = f + f + gnorm = zero + xnorm = zero + gnorm2 = zero + do i = 1, n5 + xnorm = dmax1 (xnorm, dabs (x (i))) + t = g (i) + d (i) = -t + gnorm = dmax1 (gnorm, dabs(t)) + gnorm2 = gnorm2 + t*t + enddo + do i = n6, n, 5 + xnorm = dmax1 (xnorm, dabs (x (i))) + t = g (i) + gnorm = dmax1 (gnorm, dabs (t)) + d (i) = -t + j = i + 1 + t1 = g (j) + d (j) = -t1 + gnorm = dmax1 (gnorm, dabs (t1)) + xnorm = dmax1 (xnorm, dabs (x (j))) + j = i + 2 + t2 = g (j) + d (j) = -t2 + gnorm = dmax1 (gnorm, dabs (t2)) + xnorm = dmax1 (xnorm, dabs (x (j))) + j = i + 3 + t3 = g (j) + d (j) = -t3 + gnorm = dmax1 (gnorm, dabs (t3)) + xnorm = dmax1 (xnorm, dabs (x (j))) + j = i + 4 + t4 = g (j) + d (j) = -t4 + gnorm = dmax1 (gnorm, dabs (t4)) + xnorm = dmax1 (xnorm, dabs (x (j))) + gnorm2 = gnorm2 + t*t + t1*t1 + t2*t2 + t3*t3 + t4*t4 + enddo + + if ( StopRule ) then + tol = dmax1 (gnorm*StopFac, tol) + endif + + if ( PrintLevel ) then + write (*, 10) iter, f, gnorm, AWolfe +10 format ('iter: ', i5, ' f= ', e14.6, + & ' gnorm= ', e14.6, ' AWolfe= ', l2) + endif + + if ( cg_tol (f, gnorm) ) goto 100 + + dphi0 = -gnorm2 + if ( .not.Step ) then + alpha = psi0*xnorm/gnorm + if ( xnorm .eq. zero ) then + if ( f .ne. zero ) then + alpha = psi0*dabs (f)/gnorm2 + else + alpha = 1.d0 + endif + endif + endif + +c start the conjugate gradient iteration + +c +c alpha starts as old step, ends as initial step for next iteration +c f is function value for alpha = 0 +c QuadOK = .true. means that a quadratic step was taken +c + + do iter = 1, maxit + QuadOK = .false. + alpha = psi2*alpha + if ( QuadStep ) then + if ( f .ne. zero ) then + t = dabs ((f-f0)/f) + else + t = 1.d0 + endif + if ( t .gt. QuadCutOff ) then + talpha = psi1*alpha + call cg_step (xtemp, x, d, talpha) + call cg_value (ftemp, xtemp, n) + nf = nf + 1 + if ( ftemp .lt. f ) then + denom = 2.0d0*(((ftemp-f)/talpha)-dphi0) + if ( denom .gt. zero ) then + QuadOK = .true. + alpha = -dphi0*talpha/denom + endif + endif + endif + endif + f0 = f + + if ( PrintLevel .and. IsQuiet<0 ) then + if (myid .eq. 0) write (*, 20) QuadOK, alpha, f0, dphi0 +20 format ('QuadOK:', l2, ' initial a:', + & e14.6,' f0:', e14.6, ' dphi', e14.6) + endif + +c parameters in Wolfe and approximiate Wolfe conditions, and in update + + Qk = Qdecay*Qk + 1. + Ck = Ck + (dabs (f) - Ck)/Qk + + if ( PertRule ) then + fpert = f + eps*Ck + else + fpert = f + eps + endif + + wolfe_hi = delta*dphi0 + wolfe_lo = sigma*dphi0 + awolfe_hi = delta2*dphi0 + if ( AWolfe ) then + call cg_line (alpha, f, dphi, dphi0, x, xtemp, d, gtemp, + & cg_value, cg_grad) + else + call cg_lineW (alpha, f, dphi, dphi0, x, xtemp, d, gtemp, + & cg_value, cg_grad) + endif + + if ( info .gt. 0 ) goto 100 +c +c Test for convergence to within machine epsilon +c (set feps to zero to remove this test) +c + if ( -alpha*dphi0 .le. feps*dabs (f) ) then + info = 1 + goto 100 + endif + +c compute beta, yk2, gnorm, gnorm2, dnorm2, update x and g, + + if ( mod (iter, nrestart) .ne. 0 ) then + gnorm = zero + dnorm2 = zero + yk2 = zero + ykgk = zero + do i = 1, n5 + x (i) = xtemp (i) + t = gtemp (i) + yk = t - g (i) + yk2 = yk2 + yk**2 + ykgk = ykgk + yk*t + g (i) = t + gnorm = dmax1 (gnorm, dabs (t)) + dnorm2 = dnorm2 + d (i)**2 + enddo + do i = n6, n, 5 + x (i) = xtemp (i) + t = gtemp (i) + yk = t - g (i) + yk2 = yk2 + yk**2 + ykgk = ykgk + yk*t + i1 = i + 1 + x (i1) = xtemp (i1) + t1 = gtemp (i1) + i2 = i + 2 + x (i2) = xtemp (i2) + t2 = gtemp (i2) + i3 = i + 3 + x (i3) = xtemp (i3) + t3 = gtemp (i3) + i4 = i + 4 + x (i4) = xtemp (i4) + t4 = gtemp (i4) + yk2 = yk2 + (t1-g (i1))**2 + (t2-g (i2))**2 + & + (t3-g (i3))**2 + (t4-g (i4))**2 + ykgk = ykgk + (t1-g (i1))*t1 + (t2-g (i2))*t2 + & + (t3-g (i3))*t3 + (t4-g (i4))*t4 + g (i) = t + gnorm = dmax1 (gnorm, dabs (t)) + g (i1) = t1 + gnorm = dmax1 (gnorm, dabs (t1)) + g (i2) = t2 + gnorm = dmax1 (gnorm, dabs (t2)) + g (i3) = t3 + gnorm = dmax1 (gnorm, dabs (t3)) + g (i4) = t4 + gnorm = dmax1 (gnorm, dabs (t4)) + dnorm2 = dnorm2 + d (i)**2 + d (i1)**2 + d (i2)**2 + & + d (i3)**2 + d (i4)**2 + enddo + if ( cg_tol (f, gnorm) ) goto 100 + dkyk = dphi - dphi0 + beta = (ykgk - 2.d0*dphi*yk2/dkyk)/dkyk + +c faster: initialize dnorm2 = gnorm2 at start, then +c dnorm2 = gnorm2 + beta**2*dnorm2 - 2.d0*beta*dphi +c gnorm2 = ||g_{k+1}||^2 +c dnorm2 = ||d_{k+1}||^2 +c dpi = g_{k+1}' d_k + + beta = dmax1 (beta, + & -1.d0/dsqrt (dmin1 (eta_sq, gnorm2)*dnorm2)) + +c update search direction d = -g + beta*dold + + gnorm2 = zero + do i = 1, n5 + t = g (i) + d (i) = -t + beta*d (i) + gnorm2 = gnorm2 + t*t + enddo + do i = n6, n, 5 + d (i) = -g (i) + beta*d (i) + i1 = i + 1 + d (i1) = -g (i1) + beta*d (i1) + i2 = i + 2 + d (i2) = -g (i2) + beta*d (i2) + i3 = i + 3 + d (i3) = -g (i3) + beta*d (i3) + i4 = i + 4 + d (i4) = -g (i4) + beta*d (i4) + gnorm2 = gnorm2 + g (i)**2 + g (i1)**2 + g (i2)**2 + & + g (i3)**2 + g (i4)**2 + enddo + dphi0 = -gnorm2 + beta*dphi + + else + +c search direction d = -g + + if ( PrintLevel .and. IsQuiet <0 ) then + if (myid .eq. 0) write (*, *) "RESTART CG" + endif + gnorm = zero + gnorm2 = zero + do i = 1, n5 + x (i) = xtemp (i) + t = gtemp (i) + g (i) = t + d (i) = -t + gnorm = dmax1 (gnorm, dabs(t)) + gnorm2 = gnorm2 + t*t + enddo + do i = n6, n, 5 + x (i) = xtemp (i) + t = gtemp (i) + g (i) = t + d (i) = -t + gnorm = dmax1 (gnorm, dabs(t)) + j = i + 1 + x (j) = xtemp (j) + t1 = gtemp (j) + g (j) = t1 + d (j) = -t1 + gnorm = dmax1 (gnorm, dabs(t1)) + j = i + 2 + x (j) = xtemp (j) + t2 = gtemp (j) + g (j) = t2 + d (j) = -t2 + gnorm = dmax1 (gnorm, dabs(t2)) + j = i + 3 + x (j) = xtemp (j) + t3 = gtemp (j) + g (j) = t3 + d (j) = -t3 + gnorm = dmax1 (gnorm, dabs(t3)) + j = i + 4 + x (j) = xtemp (j) + t4 = gtemp (j) + g (j) = t4 + d (j) = -t4 + gnorm = dmax1 (gnorm, dabs(t4)) + gnorm2 = gnorm2 + t*t + t1*t1 + t2*t2 + t3*t3 + t4*t4 + enddo + if ( cg_tol (f, gnorm) ) goto 100 + dphi0 = -gnorm2 + endif + if ( .not.AWolfe ) then + if ( dabs (f-f0) .lt. AWolfeFac*Ck ) then + AWolfe = .true. + endif + endif + + if ( PrintLevel .or. PrintFinal ) then + tstart = MPI_Wtime() + call output(tstart-tfinish) +c write (*, 10) iter, f, gnorm, AWolfe + endif + + if ( debug ) then + if ( f .gt. f0 + 1.e-10*Ck ) then + write (*, 270) + write (*, 50) f, f0 +50 format (' new value:', e30.16, 'old value:', e30.16) + stop + endif + endif + + if ( dphi0 .gt. zero ) then + info = 5 + goto 100 + endif + enddo + info = 2 +100 nfunc = nf + ngrad = ng + status = info + if ( info .gt. 2 ) then + gnorm = zero + do i = 1, n + x (i) = xtemp (i) + g (i) = gtemp (i) + gnorm = dmax1 (gnorm, dabs(g (i))) + enddo + endif + if ( PrintFinal .and. .false. ) then + write (6, *) 'Termination status:', status + if ( status .eq. 0 ) then + write (6, 200) + else if ( status .eq. 1 ) then + write (6, 210) + else if ( status .eq. 2 ) then + write (6, 220) maxit + write (6, 300) + write (6, 400) grad_tol + else if ( status .eq. 3 ) then + write (6, 230) + write (6, 300) + write (6, 430) + write (6, 410) + else if ( status .eq. 4 ) then + write (6, 240) + write (6, 300) + write (6, 400) grad_tol + else if ( status .eq. 5 ) then + write (6, 250) + else if ( status .eq. 6 ) then + write (6, 260) + write (6, 300) + write (6, 400) grad_tol + write (6, 410) + write (6, 420) + else if ( status .eq. 7 ) then + write (6, 260) + write (6, 300) + write (6, 400) grad_tol + else if ( status .eq. 8 ) then + write (6, 260) + write (6, 300) + write (6, 400) grad_tol + write (6, 410) + write (6, 420) + endif + write (6, 500) gnorm + write (6, *) 'function value:', f + write (6, *) 'cg iterations:', iter + write (6, *) 'function evaluations:', nfunc + write (6, *) 'gradient evaluations:', ngrad + endif + return +200 format (' Convergence tolerance for gradient satisfied') +210 format (' Terminating since change in function value <= feps*|f|') +220 format (' Total number of iterations exceed max allow:', i10) +230 format (' Slope always negative in line search') +240 format (' Line search fails, too many secant steps') +250 format (' Search direction not a descent direction') +260 format (' Line search fails') +270 format (' Debugger is on, function value does not improve') +300 format (' Possible causes of this error message:') +400 format (' - your tolerance (grad_tol = ', d12.4, + & ') may be too strict') +410 format (' - your gradient routine has an error') +420 format (' - parameter epsilon in cg_descent.parm is too small') +430 format (' - your cost function has an error') +500 format (' absolute largest component of gradient: ', d12.4) + end + +c PARAMETERS: +c +c delta - range (0, .5), used in the Wolfe conditions +c sigma - range [delta, 1), used in the Wolfe conditions +c eps - range [0, infty), used to compute line search perturbation +c gamma - range (0,1), determines when to perform bisection step +c rho - range (1, infty), growth factor when finding initial interval +c eta - range (0, infty), used in lower bound for beta +c psi0 - range (0, 1), factor used in very initial starting guess +c psi1 - range (0, 1), factor previous step multiplied by in QuadStep +c psi2 - range (1, infty), factor previous step is multipled by for startup +c QuadCutOff - perform QuadStep if relative change in f > QuadCutOff +c StopFac - used in StopRule +c AWolfeFac - used to decide when to switch from Wolfe to AWolfe +c restart_fac - range (0, infty) restart cg when iter = n*restart +c maxit_fac - range (0, infty) terminate in maxit = maxit_fac*n iterations +c feps - stop when -alpha*dphi0 (est. change in value) <= feps*|f| +c (feps = 0 removes this test, example: feps = eps*1.e-5 +c where eps is machine epsilon) +c tol - range (0, infty), convergence tolerance +c nexpand - range [0, infty), number of grow/shrink allowed in bracket +c nsecant - range [0, infty), maximum number of secant steps +c PertRule - gives the rule used for the perturbation in f +c F => fpert = eps +c T => fpert = eps*Ck, Ck is an average of prior |f| +c Ck is an average of prior |f| +c QuadStep- .true. (use quadratic step) .false. (no quadratic step) +c PrintLevel- .false. (no printout) .true. (print intermediate results) +c PrintFinal- .false. (no printout) .true. (print messages, final error) +c StopRule - .true. (max abs grad <= max (tol, StopFac*initial abs grad)) +c .false. (... <= tol*(1+|f|)) +c AWolfe - .false. (use standard Wolfe initially) +c - .true. (use approximate + standard Wolfe) +c Step - .false. (program computing starting step at iteration 0) +c - .true. (user provides starting step in gnorm argument of cg_descent +c debug - .false. (no debugging) +c - .true. (check that function values do not increase) +c info - same as status +c +c DEFAULT PARAMETER VALUES: +c +c delta : 0.1 +c sigma : 0.9 +c eps : 1.e-6 +c gamma : 0.66 +c rho : 5.0 +c restart: 1.0 +c eta : 0.01 +c psi0 : 0.01 +c psi1 : 0.1 +c psi2 : 2.0 +c QuadCutOff: 1.d-12 +c StopFac: 0.d0 +c AWolfeFac: 1.d-3 +c tol : grad_tol +c nrestart: n (restart_fac = 1) +c maxit : 500*n (maxit_fac = 500) +c feps : 0.0 +c Qdecay : 0.7 +c nexpand: 50 +c nsecant: 50 +c PertRule: .true. +c QuadStep: .true. +c PrintLevel: .false. +c PrintFinal: .true. +c StopRule: .true. +c AWolfe: .false. +c Step: .false. +c debug: .false. +c info : 0 +c feps : 0.0 +c + +c (double) grad_tol-- used in stopping rule +c (int) dim --problem dimension (also denoted n) + + subroutine cg_init (grad_tol, dim) + use globals, only : cg_maxiter, CG_wolfe_c1, CG_wolfe_c2, cg_xtol, + & IsQuiet + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & grad_tol, restart_fac, maxit_fac + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, dim + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + n = dim + tol = grad_tol +c$$$ open (10, file='cg_descent_f.parm') +c$$$ read (10, *) delta +c$$$ read (10, *) sigma +c$$$ read (10, *) eps +c$$$ read (10, *) gamma +c$$$ read (10, *) rho +c$$$ read (10, *) eta +c$$$ read (10, *) psi0 +c$$$ read (10, *) psi1 +c$$$ read (10, *) psi2 +c$$$ read (10, *) QuadCutOff +c$$$ read (10, *) StopFac +c$$$ read (10, *) AWolfeFac +c$$$ read (10, *) restart_fac +c$$$ read (10, *) maxit_fac +c$$$ read (10, *) feps +c$$$ read (10, *) Qdecay +c$$$ read (10, *) nexpand +c$$$ read (10, *) nsecant +c$$$ read (10, *) PertRule +c$$$ read (10, *) QuadStep +c$$$ read (10, *) PrintLevel +c$$$ read (10, *) PrintFinal +c$$$ read (10, *) StopRule +c$$$ read (10, *) AWolfe +c$$$ read (10, *) Step +c$$$ read (10, *) debug + delta = cg_Wolfe_c1 + sigma = cg_Wolfe_c2 + eps = 1.d-6 + gamma = .66d0 + rho = 5.0d0 + eta = .01d0 + psi0 = .01d0 + psi1 = .1d0 + psi2 = 2.d0 + QuadCutOff = 1.d-12 + StopFact = 0.d-12 + AWolfeFac = 1.d-3 + restart_fac= 1.0d0 + maxit_fac = 500.d0 + feps = 0.d0 + Qdecay = .7d0 + nexpand = 50 + nsecant = 50 + PertRule = .true. + QuadStep = .true. + if (myid==0 .and. IsQuiet<-1) then + PrintLevel = .true. + else + PrintLevel = .false. + end if + if (myid==0) then + PrintFinal = .true. + else + PrintFinal = .false. + end if + StopRule = .true. + AWolfe = .false. + Step = .false. + if (myid==0 .and. IsQuiet<-1) then + debug = .true. + else + debug = .false. + end if + nrestart = n*restart_fac +c maxit = n*maxit_fac + maxit = cg_maxiter + zero = 0.d0 + info = 0 + n5 = mod (n, 5) + n6 = n5 + 1 + nf = 0 + ng = 0 +c close (10) + return + end + +c check whether the Wolfe or the approximate Wolfe conditions +c are satisfied + +c (double) alpha -- stepsize +c (double) f -- function value associated with stepsize alpha +c (double) dphi -- derivative value associated with stepsize alpha + + logical function cg_Wolfe (alpha, f, dphi) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & alpha, f, dphi + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + if ( dphi .ge. wolfe_lo ) then + +c test original Wolfe conditions + + if ( f-f0 .le. alpha*wolfe_hi ) then + cg_Wolfe = .true. + if ( PrintLevel) then + write (*, 10) f, f0, alpha*wolfe_hi, dphi +10 format (' wolfe f:', e14.6, ' f0: ', + & e14.6, e14.6, ' dphi:', e14.6) + endif + return + +c test approximate Wolfe conditions + + elseif ( AWolfe ) then + if ( (f .le. fpert).and.(dphi .le. awolfe_hi) ) then + cg_Wolfe = .true. + if ( PrintLevel ) then + write (*, 20) f, fpert, dphi, awolfe_hi +20 format ('f:', e14.6, ' fpert:', e14.6, + & ' dphi: ', e14.6, ' fappx:', e14.6) + endif + return + endif + endif + endif + cg_Wolfe = .false. + return + end + +c check for convergence of the cg iterations +c (double) f -- function value associated with stepsize +c (double) gnorm -- gradient (infinity) norm + + logical function cg_tol (f, gnorm) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & f, gnorm + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + if ( StopRule ) then + if ( gnorm .le. tol ) then + cg_tol = .true. + return + endif + else + if ( gnorm .le. tol*(1.0 + dabs (f)) ) then + cg_tol = .true. + return + endif + endif + cg_tol = .false. + return + end + +c compute dot product of x and y, vectors of length n +c (double) x -- first vector +c (double) y -- second vector + + double precision function cg_dot (x, y) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & x (*), y(*), t + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, i + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + t = zero + do i = 1, n5 + t = t + x (i)*y (i) + enddo + do i = n6, n, 5 + t = t + x (i)*y(i) + x (i+1)*y (i+1) + x (i+2)*y (i+2) + & + x (i+3)*y (i+3) + x (i+4)*y (i+4) + enddo + cg_dot = t + return + end + +c +c compute xtemp = x + alpha d +c +c (double) xtemp -- output vector +c (double) x -- initial vector +c (double) d -- search direction vector +c (double) alpha -- stepsize along search direction vector + + subroutine cg_step (xtemp, x, d, alpha) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & xtemp (*), x (*), d (*), alpha + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, i, j + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + do i = 1, n5 + xtemp (i) = x(i) + alpha*d(i) + enddo + do i = n6, n, 5 + xtemp (i) = x (i) + alpha*d (i) + j = i + 1 + xtemp (j) = x (j) + alpha*d (j) + j = i + 2 + xtemp (j) = x (j) + alpha*d (j) + j = i + 3 + xtemp (j) = x (j) + alpha*d (j) + j = i + 4 + xtemp (j) = x (j) + alpha*d (j) + enddo + end + +c (double) alpha -- stepsize along search direction vector +c (double) phi -- function value for step alpha +c (double) dphi -- function derivative for step alpha +c (double) dphi0 -- function derivative at starting point (alpha = 0) +c (double) x -- current iterate +c (double) xtemp -- x + alpha*d +c (double) d -- current search direction +c (double) gtemp -- gradient at x + alpha*d +c (external) cg_value -- routine to evaluate function value +c (external) cg_grad -- routine to evaluate function gradient + + subroutine cg_line (alpha, phi, dphi, dphi0, x, xtemp, d, gtemp, + & cg_value, cg_grad) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & x (*), xtemp (*), d (*), gtemp (*), + & a, dphia, b, dphib, alpha, phi, dphi, c, + & a0, da0, b0, db0, width, fquad, dphi0, + & cg_dot + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, + & ngrow, nshrink, cg_update, iter, flag + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug, + & cg_Wolfe + + external cg_value, cg_grad + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) +c +c Find initial interval [a,b] such that dphia < 0, dphib >= 0, +c and phia <= phi0 + feps*dabs (phi0) +c + a = zero + dphia = dphi0 + ngrow = 0 + nshrink = 0 + do while ( dphi .lt. zero ) + call cg_value (phi, xtemp, n) + nf = nf + 1 +c +c if quadstep in effect and quadratic conditions hold, check wolfe condition +c + if ( QuadOK ) then + if ( ngrow .eq. 0 ) fquad = dmin1 (phi, f0) + if ( phi .le. fquad ) then + if ( PrintLevel ) then + write (*, 10) alpha, phi, fquad +10 format ('alpha:', e14.6, ' phi:', e14.6, + & ' fquad:', e14.6) + endif + if ( cg_Wolfe (alpha, phi, dphi) ) return + endif + endif + if ( phi .le. fpert ) then + a = alpha + dphia = dphi + else +c +c contraction phase +c + b = alpha + do while ( .true. ) + alpha = .5d0*(a+b) + nshrink = nshrink + 1 + if ( nshrink .gt. nexpand ) then + info = 6 + return + endif + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + if ( dphi .ge. zero ) goto 100 + call cg_value (phi, xtemp, n) + nf = nf + 1 + if ( PrintLevel ) then + write (6, 20) a, b, alpha, phi, dphi +20 format ('contract, a:', e14.6, + & ' b:', e14.6, ' alpha:', e14.6, + & ' phi:', e14.6, ' dphi:', e14.6) + endif + if ( QuadOK .and. (phi .le. fquad) ) then + if ( cg_Wolfe (alpha, phi, dphi) ) return + endif + if ( phi .le. fpert ) then + a = alpha + dphia = dphi + else + b = alpha + endif + enddo + endif +c +c expansion phase +c + ngrow = ngrow + 1 + if ( ngrow .gt. nexpand ) then + info = 3 + return + endif + alpha = rho*alpha + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + if ( PrintLevel ) then + write (*, 30) a, alpha, phi, dphi +30 format ('expand, a:', e14.6, ' alpha:', e14.6, + & ' phi:', e14.6, ' dphi:', e14.6) + endif + enddo +100 continue + b = alpha + dphib = dphi + if ( QuadOK ) then + call cg_value (phi, xtemp, n) + nf = nf + 1 + if ( ngrow + nshrink .eq. 0 ) fquad = dmin1 (phi, f0) + if ( phi .le. fquad ) then + if ( cg_Wolfe (alpha, phi, dphi) ) return + endif + endif + do iter = 1, nsecant + if ( PrintLevel ) then + write (*, 40) a, b, dphia, dphib +40 format ('secant, a:', e14.6, ' b:', e14.6, + & ' da:', e14.6, ' db:', e14.6) + endif + width = gamma*(b - a) + if ( -dphia .le. dphib ) then + alpha = a - (a-b)*(dphia/(dphia-dphib)) + else + alpha = b - (a-b)*(dphib/(dphia-dphib)) + endif + c = alpha + a0 = a + b0 = b + da0 = dphia + db0 = dphib + flag = cg_update (a, dphia, b, dphib, alpha, phi, + & dphi, x, xtemp, d, gtemp, cg_value, cg_grad) + if ( flag .gt. 0 ) then + return + else if ( flag .eq. 0 ) then + if ( c .eq. a ) then + if ( dphi .gt. da0 ) then + alpha = c - (c-a0)*(dphi/(dphi-da0)) + else + alpha = a + endif + else + if ( dphi .lt. db0 ) then + alpha = c - (c-b0)*(dphi/(dphi-db0)) + else + alpha = b + endif + endif + if ( (alpha .gt. a) .and. (alpha .lt. b) ) then + if ( PrintLevel ) write (*, *) "2nd secant" + flag = cg_update (a, dphia, b, dphib, alpha, phi, + & dphi, x, xtemp, d, gtemp, cg_value, cg_grad) + if ( flag .gt. 0 ) return + endif + endif +c +c bisection iteration +c + if ( (b-a) .ge. width ) then + alpha = .5d0*(b+a) + if ( PrintLevel ) write (*, *) "bisection" + flag = cg_update (a, dphia, b, dphib, alpha, phi, + & dphi, x, xtemp, d, gtemp, cg_value, cg_grad) + if ( flag .gt. 0 ) return + else + if ( b .le. a ) then + info = 7 + return + endif + endif + end do + info = 4 + return + end + +c This routine is identical to cg_line except that the function +c psi (a) = phi (a) - phi (0) - a*delta*dphi (0) is miniminized instead of +c the function phi + +c (double) alpha -- stepsize along search direction vector +c (double) phi -- function value for step alpha +c (double) dphi -- function derivative for step alpha +c (double) dphi0 -- function derivative at starting point (alpha = 0) +c (double) x -- current iterate +c (double) xtemp -- x + alpha*d +c (double) d -- current search direction +c (double) gtemp -- gradient at x + alpha*d +c (external) cg_value -- routine to evaluate function value +c (external) cg_grad -- routine to evaluate function gradient + + subroutine cg_lineW (alpha, phi, dphi, dphi0, x, xtemp, d, gtemp, + & cg_value, cg_grad) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & x (*), xtemp (*), d (*), gtemp (*), + & a, dpsia, b, dpsib, alpha, phi, dphi, c, + & a0, da0, b0, db0, width, fquad, dphi0, + & cg_dot, psi, dpsi + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, + & ngrow, nshrink, cg_updateW, iter, flag + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug, + & cg_Wolfe + + external cg_value, cg_grad + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + dpsi = dphi - wolfe_hi +c +c Find initial interval [a,b] such that dpsia < 0, dpsib >= 0, +c and psia <= phi0 + feps*dabs (phi0) +c + a = zero + dpsia = dphi0 - wolfe_hi + ngrow = 0 + nshrink = 0 + do while ( dpsi .lt. zero ) + call cg_value (phi, xtemp, n) + psi = phi - alpha*wolfe_hi + + nf = nf + 1 +c +c if quadstep in effect and quadratic conditions hold, check wolfe condition +c + if ( QuadOK ) then + if ( ngrow .eq. 0 ) fquad = dmin1 (phi, f0) + if ( phi .le. fquad ) then + if ( PrintLevel ) then + write (*, 10) alpha, phi, fquad +10 format ('alpha:', e14.6, ' phi:', e14.6, + & ' fquad:', e14.6) + endif + if ( cg_Wolfe (alpha, phi, dphi) ) return + endif + endif + if ( psi .le. fpert ) then + a = alpha + dpsia = dpsi + else +c +c contraction phase +c + b = alpha + do while ( .true. ) + alpha = .5d0*(a+b) + nshrink = nshrink + 1 + if ( nshrink .gt. nexpand ) then + info = 6 + return + endif + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + dpsi = dphi - wolfe_hi + if ( dpsi .ge. zero ) goto 100 + call cg_value (phi, xtemp, n) + psi = phi - alpha*wolfe_hi + nf = nf + 1 + if ( PrintLevel ) then + write (6, 20) a, b, alpha, phi, dphi +20 format ('contract, a:', e14.6, + & ' b:', e14.6, ' alpha:', e14.6, + & ' phi:', e14.6, ' dphi:', e14.6) + endif + if ( QuadOK .and. (phi .le. fquad) ) then + if ( cg_Wolfe (alpha, phi, dphi) ) return + endif + if ( psi .le. fpert ) then + a = alpha + dpsia = dpsi + else + b = alpha + endif + enddo + endif +c +c expansion phase +c + ngrow = ngrow + 1 + if ( ngrow .gt. nexpand ) then + info = 3 + return + endif + alpha = rho*alpha + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + dpsi = dphi - wolfe_hi + if ( PrintLevel ) then + write (*, 30) a, alpha, phi, dphi +30 format ('expand, a:', e14.6, ' alpha:', e14.6, + & ' phi:', e14.6, ' dphi:', e14.6) + write (6, *) "expand, alpha:", alpha, "dphi:", dphi + endif + enddo +100 continue + b = alpha + dpsib = dpsi + if ( QuadOK ) then + call cg_value (phi, xtemp, n) + nf = nf + 1 + if ( ngrow + nshrink .eq. 0 ) fquad = dmin1 (phi, f0) + if ( phi .le. fquad ) then + if ( cg_Wolfe (alpha, phi, dphi) ) return + endif + endif + do iter = 1, nsecant + if ( PrintLevel ) then + write (*, 40) a, b, dpsia, dpsib +40 format ('secant, a:', e14.6, ' b:', e14.6, + & ' da:', e14.6, ' db:', e14.6) + endif + width = gamma*(b - a) + if ( -dpsia .le. dpsib ) then + alpha = a - (a-b)*(dpsia/(dpsia-dpsib)) + else + alpha = b - (a-b)*(dpsib/(dpsia-dpsib)) + endif + c = alpha + a0 = a + b0 = b + da0 = dpsia + db0 = dpsib + flag = cg_updateW (a, dpsia, b, dpsib, alpha, + & phi, dphi, dpsi, x, xtemp, d, gtemp, + & cg_value, cg_grad) + if ( flag .gt. 0 ) then + return + else if ( flag .eq. 0 ) then + if ( c .eq. a ) then + if ( dpsi .gt. da0 ) then + alpha = c - (c-a0)*(dpsi/(dpsi-da0)) + else + alpha = a + endif + else + if ( dpsi .lt. db0 ) then + alpha = c - (c-b0)*(dpsi/(dpsi-db0)) + else + alpha = b + endif + endif + if ( (alpha .gt. a) .and. (alpha .lt. b) ) then + if ( PrintLevel ) write (*, *) "2nd secant" + flag = cg_updateW (a, dpsia, b, dpsib, alpha, + & phi, dphi, dpsi, x, xtemp, d, gtemp, + & cg_value, cg_grad) + if ( flag .gt. 0 ) return + endif + endif +c +c bisection iteration +c + if ( (b-a) .ge. width ) then + alpha = .5d0*(b+a) + if ( PrintLevel ) write (*, *) "bisection" + flag = cg_updateW (a, dpsia, b, dpsib, alpha, + & phi, dphi, dpsi, x, xtemp, d, gtemp, + & cg_value, cg_grad) + if ( flag .gt. 0 ) return + else + if ( b .le. a ) then + info = 7 + return + endif + endif + end do + info = 4 + return + end +c +c update returns 1 if Wolfe condition is satisfied or too many iterations +c returns 0 if the interval updated successfully +c returns -1 if search done +c +c (double) a -- left side of bracketting interval +c (double) dphia -- derivative at a +c (double) b -- right side of bracketting interval +c (double) dphib -- derivative at b +c (double) alpha -- trial step (between a and b) +c (double) phi -- function value at alpha (returned) +c (double) dphi -- function derivative at alpha (returned) +c (double) x -- current iterate +c (double) xtemp -- x + alpha*d +c (double) d -- current search direction +c (double) gtemp -- gradient at x + alpha*d +c (external) cg_value -- routine to evaluate function value +c (external) cg_grad -- routine to evaluate function gradient + + integer function cg_update (a, dphia, b, dphib, alpha, phi, + & dphi, x, xtemp, d, gtemp, cg_value, cg_grad) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & a, dphia, b, dphib, alpha, phi, dphi, + & x (*), xtemp (*), d (*), gtemp (*), + & cg_dot + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, + & nshrink + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug, + & cg_Wolfe + + external cg_value, cg_grad + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + call cg_step (xtemp, x, d, alpha) + call cg_value (phi, xtemp, n) + nf = nf + 1 + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + if ( PrintLevel ) then + write (*, 10) alpha, phi, dphi +10 format ('update alpha:', e14.6, ' phi:', e14.6, + & ' dphi:', e14.6) + endif + cg_update = 0 + if ( cg_Wolfe (alpha, phi, dphi) ) then + cg_update = 1 + goto 110 + endif + if ( dphi .ge. zero ) then + b = alpha + dphib = dphi + goto 110 + else + if ( phi .le. fpert ) then + a = alpha + dphia = dphi + goto 110 + endif + endif + nshrink = 0 + b = alpha + do while ( .true. ) + alpha = .5d0*(a+b) + nshrink = nshrink + 1 + if ( nshrink .gt. nexpand ) then + info = 8 + cg_update = 1 + goto 110 + endif + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + call cg_value (phi, xtemp, n) + nf = nf + 1 + if ( PrintLevel ) then + write (6, 20) a, alpha, phi, dphi +20 format ('contract, a:', e14.6, ' alpha:', e14.6, + & ' phi:', e14.6, ' dphi:', e14.6) + endif + if ( cg_Wolfe (alpha, phi, dphi) ) then + cg_update = 1 + goto 110 + endif + if ( dphi .ge. zero ) then + b = alpha + dphib = dphi + goto 100 + endif + if ( phi .le. fpert ) then + if ( PrintLevel ) then + write (6, *) "update a:", alpha, "dphia:", dphi + endif + a = alpha + dphia = dphi + else + b = alpha + endif + enddo +100 continue + cg_update = -1 +110 continue + if ( PrintLevel ) then + write (*, 200) a, b, dphia, dphib, cg_update +200 format ('UP a:', e14.6, ' b:', e14.6, + & ' da:', e14.6, ' db:', e14.6, ' up:', i2) + endif + return + end + +c This routine is identical to cg_update except that the function +c psi (a) = phi (a) - phi (0) - a*delta*dphi (0) is miniminized instead of +c the function phi +c +c update returns 1 if Wolfe condition is satisfied or too many iterations +c returns 0 if the interval updated successfully +c returns -1 if search done +c +c (double) a -- left side of bracketting interval +c (double) dpsia -- derivative at a +c (double) b -- right side of bracketting interval +c (double) dpsib -- derivative at b +c (double) alpha -- trial step (between a and b) +c (double) phi -- function value at alpha (returned) +c (double) dphi -- derivative of phi at alpha (returned) +c (double) dpsi -- derivative of psi at alpha (returned) +c (double) x -- current iterate +c (double) xtemp -- x + alpha*d +c (double) d -- current search direction +c (double) gtemp -- gradient at x + alpha*d +c (external) cg_value -- routine to evaluate function value +c (external) cg_grad -- routine to evaluate function gradient + + integer function cg_updateW (a, dpsia, b, dpsib, alpha, phi, dphi, + & dpsi, x, xtemp, d, gtemp, cg_value, cg_grad) + + double precision delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & a, dpsia, b, dpsib, alpha, phi, dphi, + & x (*), xtemp (*), d (*), gtemp (*), + & cg_dot, psi, dpsi + + integer n, n5, n6, nf, ng, info, nrestart, + & nexpand, nsecant, maxit, nshrink + + logical PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug, + & cg_Wolfe + + external cg_value, cg_grad + + common /cgparms/delta, sigma, eps, + & gamma, rho, tol, eta, fpert, f0, Ck, Qdecay, + & wolfe_hi, wolfe_lo, awolfe_hi, + & QuadCutOff, StopFac, AWolfeFac, + & zero, feps, psi0, psi1, psi2, + & n, n5, n6, nf, ng, info, + & nrestart, nexpand, nsecant, maxit, + & PertRule, QuadOK, QuadStep, PrintLevel, + & PrintFinal, StopRule, AWolfe, Step, debug + + call cg_step (xtemp, x, d, alpha) + call cg_value (phi, xtemp, n) + psi = phi - alpha*wolfe_hi + nf = nf + 1 + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + dpsi = dphi - wolfe_hi + if ( PrintLevel ) then + write (*, 10) alpha, psi, dpsi +10 format ('update alpha:', e14.6, ' psi:', e14.6, + & ' dpsi:', e14.6) + endif + cg_updateW = 0 + if ( cg_Wolfe (alpha, phi, dphi) ) then + cg_updateW = 1 + goto 110 + endif + if ( dpsi .ge. zero ) then + b = alpha + dpsib = dpsi + goto 110 + else + if ( psi .le. fpert ) then + a = alpha + dpsia = dpsi + goto 110 + endif + endif + nshrink = 0 + b = alpha + do while ( .true. ) + alpha = .5d0*(a+b) + nshrink = nshrink + 1 + if ( nshrink .gt. nexpand ) then + info = 8 + cg_updateW = 1 + goto 110 + endif + call cg_step (xtemp, x, d, alpha) + call cg_grad (gtemp, xtemp, n) + ng = ng + 1 + dphi = cg_dot (gtemp, d) + dpsi = dphi - wolfe_hi + call cg_value (phi, xtemp, n) + psi = phi - alpha*wolfe_hi + nf = nf + 1 + if ( PrintLevel ) then + write (6, 20) a, alpha, phi, dphi +20 format ('contract, a:', e14.6, ' alpha:', e14.6, + & ' phi:', e14.6, ' dphi:', e14.6) + endif + if ( cg_Wolfe (alpha, phi, dphi) ) then + cg_updateW = 1 + goto 110 + endif + if ( dpsi .ge. zero ) then + b = alpha + dpsib = dpsi + goto 100 + endif + if ( psi .le. fpert ) then + if ( PrintLevel ) then + write (6, *) "update a:", alpha, "dpsia:", dpsi + endif + a = alpha + dpsia = dpsi + else + b = alpha + endif + enddo +100 continue + cg_updateW = -1 +110 continue + if ( PrintLevel ) then + write (*, 200) a, b, dpsia, dpsib, cg_updateW +200 format ('UP a:', e14.6, ' b:', e14.6, + & ' da:', e14.6, ' db:', e14.6, ' up:', i2) + endif + return + end +c Version 1.2 Changes: +c +c 1. Fix problem with user specified initial step (overwriting step) +c 2. Change dphi to dpsi at lines 1228 and 1234 in cg_lineW +c 3. Add comment about how to compute dnorm2 by an update of previous dnorm2 +c 4. In comment statements for cg_lineW and cg_updateW, insert "delta" +c in definition of psi (a) +c 5. In dimension statements, change "(1)" to "(*)" + +c Version 1.3 Changes: +c 1. Remove extraneous write in line 985 (same thing written out twice) +c 2. Remove the parameter theta from cg_descent.parm and from the code +c (we use theta = .5 in the cg_update) + +c Version 1.4 Change: +c 1. The variable dpsi needs to be included in the argument list for +c subroutine updateW (update of a Wolfe line search) diff --git a/sources/congrad.f90 b/sources/congrad.f90 index 0195a2b..71e9516 100644 --- a/sources/congrad.f90 +++ b/sources/congrad.f90 @@ -31,7 +31,7 @@ !latex the strong Wolfe conditions. !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - +#ifdef oldcg SUBROUTINE congrad use globals, only: dp, sqrtmachprec, myid, ounit, Ncoils, Ndof, t1E, iout, CG_maxiter, CG_xtol, xdof, & exit_signal, tstart, tfinish @@ -95,6 +95,7 @@ SUBROUTINE congrad return END SUBROUTINE congrad +#endif !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -105,9 +106,9 @@ SUBROUTINE wolfe( x0, p, alpha, iflag ) implicit none include "mpif.h" - REAL , INTENT( in) :: x0(1:Ndof), p(1:Ndof) - INTEGER, INTENT(out) :: iflag - REAL , INTENT(out) :: alpha + REAL , INTENT( in) :: x0(1:Ndof), p(1:Ndof) + INTEGER, INTENT(out) :: iflag + REAL , INTENT(inout) :: alpha REAL :: zoom INTEGER :: i, maxiter @@ -265,3 +266,89 @@ SUBROUTINE getdf(lxdof, f, g) return END SUBROUTINE getdf + +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! +#ifndef oldcg + +SUBROUTINE congrad + use globals, only: dp, sqrtmachprec, myid, ounit, Ncoils, Ndof, t1E, iout, CG_maxiter, CG_xtol, xdof, & + exit_signal, tstart, tfinish + use mpi + implicit none + + INTEGER :: ierr, astat, iter, n, nfunc, ngrad, status + REAL :: f, gnorm + REAL, dimension(1:Ndof) :: x, g, d, xtemp, gtemp + EXTERNAL :: myvalue, mygrad + + tfinish = MPI_Wtime() + iter = 0 + n = Ndof + call packdof(x(1:n)) ! initial xdof; + call cg_descent (CG_xtol, x, n, myvalue, mygrad, status, gnorm, f, iter, nfunc, ngrad, d, g, xtemp, gtemp) + + tstart = MPI_Wtime() + call output(tstart-tfinish) + + if (myid == 0) then + select case (status) + case (0) + write(ounit, '("congrad : status="I1": convergence tolerance satisfied.")') status + case (1) + write(ounit, '("congrad : status="I1": change in func <= feps*|f|.")') status + case (2) + write(ounit, '("congrad : status="I1": total iterations exceeded maxit.")') status + case (3) + write(ounit, '("congrad : status="I1": slope always negative in line search.")') status + case (4) + write(ounit, '("congrad : status="I1": number secant iterations exceed nsecant.")') status + case (5) + write(ounit, '("congrad : status="I1": search direction not a descent direction.")') status + case (6) + write(ounit, '("congrad : status="I1": line search fails in initial interval.")') status + case (7) + write(ounit, '("congrad : status="I1": line search fails during bisection.")') status + case (8) + write(ounit, '("congrad : status="I1": line search fails during interval update.")') status + case default + write(ounit, '("congrad : status="I1": unknow options!")') status + end select + end if + + if(myid .eq. 0) write(ounit, '("congrad : Computation using conjugate gradient finished.")') + + return +END SUBROUTINE congrad +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!- +SUBROUTINE myvalue(f, x, n) + use globals, only: dp, myid, ounit, ierr, chi + implicit none + include "mpif.h" + + INTEGER, INTENT(in) :: n + REAL, INTENT(in) :: x(n) + REAL, INTENT(out) :: f + + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; + call unpacking(x) + call costfun(0) + f = chi + return + +END SUBROUTINE myvalue +!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! +SUBROUTINE mygrad(g, x, n) + use globals, only: dp, myid, ounit, ierr, t1E + implicit none + include "mpif.h" + + INTEGER, INTENT(in) :: n + REAL, INTENT(in) :: x(n) + REAL, INTENT(out) :: g(n) + + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) ! wait all cpus; + call unpacking(x) + call costfun(1) + g = t1E +END SUBROUTINE mygrad +#endif diff --git a/sources/globals.f90 b/sources/globals.f90 index ccd3747..6cdb315 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.7.12' ! version number + CHARACTER(LEN=10), parameter :: version='v0.8.00' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -123,8 +123,8 @@ module globals INTEGER :: CG_maxiter = 0 REAL :: CG_xtol = 1.000D-08 - REAL :: CG_wolfe_c1 = 1.000D-04 - REAL :: CG_wolfe_c2 = 0.1 + REAL :: CG_wolfe_c1 = 0.1 + REAL :: CG_wolfe_c2 = 0.9 INTEGER :: LM_maxiter = 0 REAL :: LM_xtol = 1.000D-08 @@ -347,7 +347,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! !latex \subsection{Miscellaneous} - REAL :: tmpw_bnorm, tmpw_tflux ,tmpt_tflux, tmpw_ttlen, tmpw_specw, tmpw_ccsep, tmpw_bharm + REAL :: tmpw_bnorm, tmpw_tflux ,tmpt_tflux, tmpw_ttlen, tmpw_specw, tmpw_cssep, tmpw_bharm REAL :: overlap = 0.0 !tmp weight for saving to restart file REAL, allocatable :: mincc(:,:), coil_importance(:) diff --git a/sources/initial.f90 b/sources/initial.f90 index 72bc44e..5edc93c 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -612,7 +612,7 @@ subroutine initial tmpt_tflux = target_tflux tmpw_ttlen = weight_ttlen !tmpw_specw = weight_specw - tmpw_ccsep = weight_ccsep + tmpw_cssep = weight_cssep call MPI_BARRIER( MPI_COMM_WORLD, ierr ) diff --git a/sources/saving.f90 b/sources/saving.f90 index 6017b33..38e90c9 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -96,7 +96,7 @@ subroutine saving HWRITERV( 1 , weight_ttlen , weight_ttlen ) HWRITERV( 1 , target_length , target_length ) HWRITERV( 1 , weight_specw , weight_specw ) - HWRITERV( 1 , weight_ccsep , weight_ccsep ) + HWRITERV( 1 , weight_cssep , weight_cssep ) HWRITERV( 1 , weight_gnorm , weight_gnorm ) HWRITERV( 1 , weight_inorm , weight_inorm ) HWRITERV( 1 , weight_mnorm , weight_mnorm ) From 026f44fc1b908b4d78a731855ec7a887e7e07516 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 26 Aug 2019 14:10:59 -0400 Subject: [PATCH 38/72] update example inputs --- examples/d3d_RMP/d3d.input | 4 ++-- examples/rotating_ellipse/ellipse.input | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/examples/d3d_RMP/d3d.input b/examples/d3d_RMP/d3d.input index f9e258e..1dcce45 100644 --- a/examples/d3d_RMP/d3d.input +++ b/examples/d3d_RMP/d3d.input @@ -49,8 +49,8 @@ CG_maxiter = 0 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization - CG_wolfe_c1 = 1.000D-04 ! c1 value in the strong wolfe condition for line search; - CG_wolfe_c2 = 0.1 ! c2 value in the strong wolfe condition for line search; if one CG step takes too long, try to increase c2, but remember 0 < c1 < c2 < 1 + CG_wolfe_c1 = 0.1 ! c1 value in the strong wolfe condition for line search, (0.0, 0.5) + CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; 0 < c1 < c2 < 1 LM_MAXITER = 0 ! maximum iterations for levenberg-marquardt (LM) method LM_XTOL = 1.0000E-008 ! relative tolerance desired in approximated solution diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index fa27eba..181d161 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -20,20 +20,20 @@ IsNormalize = 1 ! 0: do not normalize coil parameters; 1: normalize; I = I/I0, x = x/R0; I0 & R0 are quadrtic mean values. IsNormWeight = 1 ! 0: do not normalize the weights; 1: normalize the weights - case_bnormal = 0 ! 0: keep raw Bn error; 1: Bn residue normalized to local |B| + case_bnormal = 1 ! 0: keep raw Bn error; 1: Bn residue normalized to local |B| case_length = 1 ! 1: quadratic format, converging the target length; 2: exponential format, as short as possible - weight_bnorm = 1.000D+00 ! weight for real space Bn errors + weight_bnorm = 1.000D+02 ! weight for real space Bn errors weight_bharm = 0.000D+00 ! weight for Bnm harmonic errors - weight_tflux = 0.010D+00 ! weight for toroidal flux error + weight_tflux = 0.000D+00 ! weight for toroidal flux error target_tflux = 0.000D+00 ! target for the toroidal flux - weight_ttlen = 0.100D+00 ! weight for coil length error - target_length = 5.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length + weight_ttlen = 0.100D-02 ! weight for coil length error + target_length = 3.500D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length weight_specw = 0.000D+00 ! weight for spectral condensation error weight_cssep = 0.010D+00 ! weight for coil-surface separation constraint weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. - case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing with algorithms using the gradient (DF and/or CG); + case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing using the gradient (DF and/or CG); exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold DF_maxiter = 0 ! maximum iterations allowed for using Differential Flow (DF) @@ -41,10 +41,10 @@ DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea DF_tauend = 1.000D-00 ! ending value of τ. The larger value of τend − τsta, the more optimized - CG_maxiter = 20 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_maxiter = 50 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization - CG_wolfe_c1 = 1.000D-04 ! c1 value in the strong wolfe condition for line search; - CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; if one CG step takes too long, try to increase c2, but remember 0 < c1 < c2 < 1 + CG_wolfe_c1 = 0.1 ! c1 value in the strong wolfe condition for line search, (0.0, 0.5) + CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; 0 < c1 < c2 < 1 LM_maxiter = 0 ! maximum iterations allowed for using Levenberg-Marquard (LM) LM_xtol = 1.000D-08 ! if the relative error between two consecutivec iterates is at most xtol, the optimization terminates From f144bf9caaddb6c6fd638314c758f8a00a77555b Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 3 Sep 2019 22:41:42 -0400 Subject: [PATCH 39/72] fix bound exceed in congrad; update gitignore --- .gitignore | 6 +++++- examples/rotating_ellipse/ellipse.input | 2 +- sources/congrad.f90 | 4 ++-- sources/globals.f90 | 2 +- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/.gitignore b/.gitignore index 8596e99..3ba476b 100644 --- a/.gitignore +++ b/.gitignore @@ -20,4 +20,8 @@ .project bin/ -docs/ \ No newline at end of file +docs/ + +examples/d3d_RMPx/ +examples/rotating_ellipse/ +examples/lhd/ diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 181d161..2f7edb6 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -41,7 +41,7 @@ DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea DF_tauend = 1.000D-00 ! ending value of τ. The larger value of τend − τsta, the more optimized - CG_maxiter = 50 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_maxiter = 10 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization CG_wolfe_c1 = 0.1 ! c1 value in the strong wolfe condition for line search, (0.0, 0.5) CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; 0 < c1 < c2 < 1 diff --git a/sources/congrad.f90 b/sources/congrad.f90 index 71e9516..7e2ed4c 100644 --- a/sources/congrad.f90 +++ b/sources/congrad.f90 @@ -287,8 +287,8 @@ SUBROUTINE congrad call packdof(x(1:n)) ! initial xdof; call cg_descent (CG_xtol, x, n, myvalue, mygrad, status, gnorm, f, iter, nfunc, ngrad, d, g, xtemp, gtemp) - tstart = MPI_Wtime() - call output(tstart-tfinish) + !tstart = MPI_Wtime() + !call output(tstart-tfinish) if (myid == 0) then select case (status) diff --git a/sources/globals.f90 b/sources/globals.f90 index 6cdb315..286ba8a 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.8.00' ! version number + CHARACTER(LEN=10), parameter :: version='v0.8.01' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From 68933b60069a86837ea63ca6292b2f30e1f68117 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Fri, 13 Sep 2019 16:05:42 -0400 Subject: [PATCH 40/72] fix bug in counting DOF num in length.h --- sources/length.f90 | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/sources/length.f90 b/sources/length.f90 index b50346a..c80f31d 100644 --- a/sources/length.f90 +++ b/sources/length.f90 @@ -130,30 +130,33 @@ subroutine length(ideriv) idof = 0 ; ivec = 1 do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier - ND = DoF(icoil)%ND - if (case_length == 1) then - norm(icoil) = (coil(icoil)%L - coil(icoil)%Lo) / coil(icoil)%Lo**2 ! quadratic; - elseif (case_length == 2) then - norm(icoil) = exp(coil(icoil)%L) / exp(coil(icoil)%Lo) ! exponential; - else - FATAL( length, .true. , invalid case_length option ) - end if - if ( coil(icoil)%Ic /= 0 ) then !if current is free; idof = idof +1 endif if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; - call lenDeriv1( icoil, d1L(idof+1:idof+ND), ND ) - t1L(idof+1:idof+ND) = d1L(idof+1:idof+ND) * norm(icoil) - if (mttlen > 0) then ! L-M format of targets - LM_fjac(ivec, idof+1:idof+ND) = weight_ttlen * d1L(idof+1:idof+ND) - if (case_length == 2) LM_fjac(ivec, idof+1:idof+ND) = LM_fjac(ivec, idof+1:idof+ND) * exp(coil(icoil)%L) / exp(coil(icoil)%Lo) - ivec = ivec + 1 - endif + if(coil(icoil)%itype .eq. 1) then ! only for Fourier + ! calculate normalization + if (case_length == 1) then + norm(icoil) = (coil(icoil)%L - coil(icoil)%Lo) / coil(icoil)%Lo**2 ! quadratic; + elseif (case_length == 2) then + norm(icoil) = exp(coil(icoil)%L) / exp(coil(icoil)%Lo) ! exponential; + else + FATAL( length, .true. , invalid case_length option ) + end if + ! call lederiv1 to calculate the 1st derivatives + call lenDeriv1( icoil, d1L(idof+1:idof+ND), ND ) + t1L(idof+1:idof+ND) = d1L(idof+1:idof+ND) * norm(icoil) + if (mttlen > 0) then ! L-M format of targets + LM_fjac(ivec, idof+1:idof+ND) = weight_ttlen * d1L(idof+1:idof+ND) + if (case_length == 2) & + & LM_fjac(ivec, idof+1:idof+ND) = LM_fjac(ivec, idof+1:idof+ND) & + & * exp(coil(icoil)%L) / exp(coil(icoil)%Lo) + ivec = ivec + 1 + endif + endif idof = idof + ND endif From 29cd23a9a0c20a6b1d5b075da379f774eeb94fd1 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 25 Sep 2019 11:04:03 -0400 Subject: [PATCH 41/72] update LHD examples --- examples/lhd/lhd.focus | 114 ----------------------------------------- examples/lhd/lhd.input | 16 +++--- sources/globals.f90 | 2 +- 3 files changed, 9 insertions(+), 123 deletions(-) delete mode 100644 examples/lhd/lhd.focus diff --git a/examples/lhd/lhd.focus b/examples/lhd/lhd.focus deleted file mode 100644 index bdfde86..0000000 --- a/examples/lhd/lhd.focus +++ /dev/null @@ -1,114 +0,0 @@ - # Total number of coils - 8 - #----------------- 1 --------------------------- - #coil_type coil_name - 1 HC1 - #Nseg current Ifree Length Lfree target_length - 256 -5.400000000000000E+06 0 3.974462158514986E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.801028462169698E-16 3.850062473963758E+00 -2.763221750178167E-16 -2.368475785867001E-16 4.993752603624194E-01 1.184237892933500E-16 4.993752603624194E-01 - 0.000000000000000E+00 -2.235094825269673E-16 -5.551115123125783E-17 -4.965164082351395E-16 2.716962457485453E-16 -2.405483220021173E-16 -5.618962085741764E-16 - 1.045460014855356E-16 1.225871256356944E-16 1.796402532900427E-16 -2.320674516751195E-17 -1.312992924261557E-16 3.927413949611491E-16 -4.596631717232766E-16 - 0.000000000000000E+00 3.850062473963758E+00 1.310439025810813E-16 2.626901397024324E-16 -4.993752603624201E-01 -8.638441042732284E-17 4.993752603624196E-01 - 7.632783294297952E-18 1.202741610010586E-17 6.908054375445419E-17 5.566534887356688E-17 7.709882115452476E-20 -4.107825191113079E-16 1.865791471939499E-17 - 0.000000000000000E+00 1.806039885544743E-17 2.833381677428785E-18 -1.261047593508696E-17 -9.030199427723713E-17 -9.962526034072401E-01 8.545440589714638E-17 - #----------------- 2 --------------------------- - #coil_type coil_name - 1 HC2 - #Nseg current Ifree Length Lfree target_length - 256 -5.400000000000000E+06 0 3.974462158514986E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.739349405246079E-16 3.850062473963757E+00 -5.575786745895231E-16 -4.292862361883939E-16 -4.993752603624201E-01 3.454027187722709E-17 -4.993752603624204E-01 - 0.000000000000000E+00 -3.975600712833069E-16 8.753029165673197E-16 -6.013708050052931E-18 -1.480297366166875E-17 -1.144146505933148E-16 1.122558836009880E-16 - 1.024450586090748E-16 3.455569164145800E-16 5.049972785621372E-18 -6.522560269672795E-17 7.316678127564400E-17 1.895860012189764E-16 -5.759281940243000E-16 - 0.000000000000000E+00 3.850062473963758E+00 -5.601024563132533E-16 1.492006749629719E-16 4.993752603624194E-01 -9.946229796565911E-17 -4.993752603624199E-01 - -2.532696274926139E-17 -1.393175698262263E-16 -1.912050764632214E-17 -1.006910604278093E-16 -6.499430623326438E-17 2.096316947191528E-16 -1.193489751472043E-16 - 0.000000000000000E+00 1.789294985325244E-17 -8.921779210475162E-18 2.957703526540456E-17 1.113981592156440E-16 9.962526034072401E-01 -2.396809602641288E-17 - #----------------- 3 --------------------------- - #coil_type coil_name - 1 OV - #Nseg current Ifree Length Lfree target_length - 256 2.824400000000000E+06 0 3.487167845484684E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.713878504639272E-16 5.550000000000002E+00 -7.253457094217689E-16 -1.430954120627980E-16 -2.960594732333751E-16 6.414621920056461E-17 -6.414621920056460E-16 - 0.000000000000000E+00 -5.751572058127547E-16 -6.059967342745647E-17 5.242719838507684E-17 4.786294817272897E-16 -2.097087935403073E-17 -9.806970050855550E-17 - 2.224300990308039E-17 2.079355206537533E-16 -3.858795998783964E-16 -3.227356653528407E-16 5.512565712548520E-17 4.751600347753361E-16 -7.392234972295834E-16 - 0.000000000000000E+00 5.550000000000002E+00 -4.511437519857016E-16 3.228754069661832E-16 -2.913178957323718E-16 -1.267890113886160E-16 1.395777783476228E-16 - 1.550000000000005E+00 -1.097887213240432E-16 -1.085551401855709E-16 -4.317533984653387E-17 -1.924386576016938E-16 -1.541976423090495E-16 1.381610875089084E-16 - 0.000000000000000E+00 -2.512843328478848E-16 1.561251128379126E-17 -1.047001991278446E-16 1.009994557124274E-17 8.804685375846728E-17 -2.066248406941264E-16 - #----------------- 4 --------------------------- - #coil_type coil_name - 1 OV - #Nseg current Ifree Length Lfree target_length - 256 2.824400000000000E+06 0 3.487167845484684E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.713878504639272E-16 5.550000000000002E+00 -7.253457094217689E-16 -1.430954120627980E-16 -2.960594732333751E-16 6.414621920056461E-17 -6.414621920056460E-16 - 0.000000000000000E+00 -5.751572058127547E-16 -6.059967342745647E-17 5.242719838507684E-17 4.786294817272897E-16 -2.097087935403073E-17 -9.806970050855550E-17 - 2.224300990308039E-17 2.079355206537533E-16 -3.858795998783964E-16 -3.227356653528407E-16 5.512565712548520E-17 4.751600347753361E-16 -7.392234972295834E-16 - 0.000000000000000E+00 5.550000000000002E+00 -4.511437519857016E-16 3.228754069661832E-16 -2.913178957323718E-16 -1.267890113886160E-16 1.395777783476228E-16 - -1.550000000000005E+00 1.097887213240432E-16 1.085551401855709E-16 4.317533984653387E-17 1.924386576016938E-16 1.541976423090495E-16 -1.381610875089084E-16 - 0.000000000000000E+00 2.512843328478848E-16 -1.561251128379126E-17 1.047001991278446E-16 -1.009994557124274E-17 -8.804685375846728E-17 2.066248406941264E-16 - #----------------- 5 --------------------------- - #coil_type coil_name - 1 IS - #Nseg current Ifree Length Lfree target_length - 256 6.822000000000000E+05 0 1.771858256624639E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.713878504639272E-17 2.819999999999999E+00 -5.600458368664678E-16 -1.258252761241844E-16 -2.343804163097553E-16 1.036208156316813E-16 -3.503370433261605E-16 - 0.000000000000000E+00 -2.684195458494780E-16 8.172475042379625E-18 -4.163336342344337E-18 2.231239884211947E-16 -3.156425738066244E-16 -2.454826465560069E-16 - -6.599659090827319E-17 2.118290111220568E-16 1.732410511342171E-16 -2.046202713441087E-16 8.211024452956887E-18 1.266733631568842E-16 -3.808296270927750E-16 - 0.000000000000000E+00 2.819999999999999E+00 -8.529779891667625E-17 1.568455049480752E-16 -2.663137842966950E-16 -1.209487756861607E-17 9.724088818114436E-17 - 2.000000000000000E+00 -1.184237892933500E-16 -1.838035896323870E-16 -8.388351741612294E-17 -2.565848768022584E-16 -1.344603440934912E-16 1.480297366166876E-16 - 0.000000000000000E+00 -7.416906595065283E-17 -2.632924742427020E-16 -3.179555384412601E-16 1.159566270164052E-16 3.750086660956084E-16 -3.062365176257723E-16 - #----------------- 6 --------------------------- - #coil_type coil_name - 1 IS - #Nseg current Ifree Length Lfree target_length - 256 6.822000000000000E+05 0 1.771858256624639E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.713878504639272E-17 2.819999999999999E+00 -5.600458368664678E-16 -1.258252761241844E-16 -2.343804163097553E-16 1.036208156316813E-16 -3.503370433261605E-16 - 0.000000000000000E+00 -2.684195458494780E-16 8.172475042379625E-18 -4.163336342344337E-18 2.231239884211947E-16 -3.156425738066244E-16 -2.454826465560069E-16 - -6.599659090827319E-17 2.118290111220568E-16 1.732410511342171E-16 -2.046202713441087E-16 8.211024452956887E-18 1.266733631568842E-16 -3.808296270927750E-16 - 0.000000000000000E+00 2.819999999999999E+00 -8.529779891667625E-17 1.568455049480752E-16 -2.663137842966950E-16 -1.209487756861607E-17 9.724088818114436E-17 - -2.000000000000000E+00 1.184237892933500E-16 1.838035896323870E-16 8.388351741612294E-17 2.565848768022584E-16 1.344603440934912E-16 -1.480297366166876E-16 - 0.000000000000000E+00 7.416906595065283E-17 2.632924742427020E-16 3.179555384412601E-16 -1.159566270164052E-16 -3.750086660956084E-16 3.062365176257723E-16 - #----------------- 7 --------------------------- - #coil_type coil_name - 1 IV - #Nseg current Ifree Length Lfree target_length - 256 -2.940000000000000E+06 0 1.130973355292326E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 4.872645496965965E-17 1.800000000000000E+00 -2.097087935403073E-17 -1.850371707708594E-16 -1.517304800321047E-16 6.291263806209220E-17 -2.035408878479454E-16 - 0.000000000000000E+00 -2.153755568951649E-16 2.636779683484747E-17 -1.145688482356238E-16 9.298117831235686E-17 -8.650487733537678E-17 -9.621932880084690E-17 - 5.780484116060494E-17 3.908910232534406E-17 1.070517131730576E-16 3.473301893011340E-17 3.550400714165866E-17 9.922618282587337E-17 -2.476221388430449E-16 - 0.000000000000000E+00 1.800000000000000E+00 4.176708169138325E-17 1.946612720552891E-16 -1.105018854197226E-16 -4.499920883447060E-17 5.895891413976174E-17 - 7.999999999999994E-01 -7.709882115452476E-17 -3.330669073875469E-17 -4.317533984653387E-17 -1.215077421395310E-16 -6.537980033903700E-17 6.414621920056461E-17 - 0.000000000000000E+00 8.719876672576750E-17 -7.603871236365005E-17 -5.736152293896643E-17 4.348373513115196E-17 8.550259266036796E-17 -1.276756478318930E-16 - #----------------- 8 --------------------------- - #coil_type coil_name - 1 IV - #Nseg current Ifree Length Lfree target_length - 256 -2.940000000000000E+06 0 1.130973355292326E+01 1 1.000000000000000E+00 - #NFcoil - 6 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 4.872645496965965E-17 1.800000000000000E+00 -2.097087935403073E-17 -1.850371707708594E-16 -1.517304800321047E-16 6.291263806209220E-17 -2.035408878479454E-16 - 0.000000000000000E+00 -2.153755568951649E-16 2.636779683484747E-17 -1.145688482356238E-16 9.298117831235686E-17 -8.650487733537678E-17 -9.621932880084690E-17 - 5.780484116060494E-17 3.908910232534406E-17 1.070517131730576E-16 3.473301893011340E-17 3.550400714165866E-17 9.922618282587337E-17 -2.476221388430449E-16 - 0.000000000000000E+00 1.800000000000000E+00 4.176708169138325E-17 1.946612720552891E-16 -1.105018854197226E-16 -4.499920883447060E-17 5.895891413976174E-17 - -7.999999999999994E-01 7.709882115452476E-17 3.330669073875469E-17 4.317533984653387E-17 1.215077421395310E-16 6.537980033903700E-17 -6.414621920056461E-17 - 0.000000000000000E+00 -8.719876672576750E-17 7.603871236365005E-17 5.736152293896643E-17 -4.348373513115196E-17 -8.550259266036796E-17 1.276756478318930E-16 diff --git a/examples/lhd/lhd.input b/examples/lhd/lhd.input index b63c826..f7787a5 100644 --- a/examples/lhd/lhd.input +++ b/examples/lhd/lhd.input @@ -1,20 +1,20 @@ &focusin IsQuiet = -1 ! -2 verbose and including unconstrained cost functions; -1: verbose; 0: normal; 1: concise - IsSymmetric = 1 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced + IsSymmetric = 0 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced case_surface = 0 ! 0: general VMEC-like format (Rbc, Rbs, Zbc, Zbs); 1: read axis for knots knotsurf = 0.200D-00 ! minor plasma radius for knototrans, only valid for case surface = 1 ellipticity = 0.000D+00 ! ellipticity of plasma for knototrans, only valid for case surface = 1 Nteta = 64 ! poloidal number for discretizing the surface - Nzeta = 64 ! toroidal number for discretizing the surface + Nzeta = 360 ! toroidal number for discretizing the surface case_init = -1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation Ncoils = 16 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 init_radius = 0.500D+00 ! initial coil currents (Amper); only valid when case_init = 1 - IsVaryCurrent = 1 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus - IsVaryGeometry = 0 ! 0: all the geometries fixed; 1: geometries can be changed; overwritten by ext.focus + IsVaryCurrent = 0 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus + IsVaryGeometry = 1 ! 0: all the geometries fixed; 1: geometries can be changed; overwritten by ext.focus NFcoil = 8 ! number of Fourier harmonics representing the coils; overwritten by ext.focus Nseg = 256 ! number of coil segments for discretizing; overwritten by ext.focus @@ -36,15 +36,15 @@ case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing with algorithms using the gradient (DF and/or CG); 2: optimizing with algorithms using the Hessian (HT and/or NT) exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold - DF_maxiter = 100 ! maximum iterations allowed for using Differential Flow (DF) + DF_maxiter = 0 ! maximum iterations allowed for using Differential Flow (DF) DF_xtol = 1.000D-08 ! relative error for ODE solver DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea DF_tauend = 1.000D-04 ! ending value of τ. The larger value of τend − τsta, the more optimized - CG_maxiter = 0 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_maxiter = 100 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization CG_wolfe_c1 = 1.000D-04 ! c1 value in the strong wolfe condition for line search; - CG_wolfe_c2 = 0.1 ! c2 value in the strong wolfe condition for line search; if one CG step takes too long, try to increase c2, but remember 0 < c1 < c2 < 1 + CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; if one CG step takes too long, try to increase c2, but remember 0 < c1 < c2 < 1 HN_maxiter = 0 HN_xtol = 1.000D-08 @@ -55,7 +55,7 @@ TN_reorder = 0 TN_cr = 0.1 - case_postproc = 1 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write mgrid file (not ready) + case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write mgrid file (not ready) save_freq = 1 ! frequency for writing output files; should be positive save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics diff --git a/sources/globals.f90 b/sources/globals.f90 index 286ba8a..a67f165 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.8.01' ! version number + CHARACTER(LEN=10), parameter :: version='v0.8.02' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From d6715b23f6395dde9a140c255e7feaddd2a75d4e Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 25 Sep 2019 11:26:35 -0400 Subject: [PATCH 42/72] add bnorm_jsurf, need cleanning --- examples/d3d_RMP/d3d.input | 1 + sources/bmnharm.f90 | 40 +++++++++++++++++++++++++++++++------- sources/globals.f90 | 2 +- sources/rdsurf.f90 | 12 ++++++++++-- 4 files changed, 45 insertions(+), 10 deletions(-) diff --git a/examples/d3d_RMP/d3d.input b/examples/d3d_RMP/d3d.input index 1dcce45..a156e13 100644 --- a/examples/d3d_RMP/d3d.input +++ b/examples/d3d_RMP/d3d.input @@ -28,6 +28,7 @@ case_length = 2 ! 1: quadratic format, converging the target length; 2: exponential format, as short as possible weight_bnorm = 0.000D+00 ! weight for real space Bn errors weight_bharm = 1.000D+00 ! weight for Bmn harmonic errors + bharm_jsurf = 0 ! 0: no weightes; 1: weighted with area square; 2: weighted with area weight_tflux = 0.000D+00 ! weight for toroidal flux error, specified by target_tflux target_tflux = 0.000D+00 ! target for the toroidal flux, 0: the present value weight_ttlen = 0.000D+00 ! weight for coil length error diff --git a/sources/bmnharm.f90 b/sources/bmnharm.f90 index 6fb025f..981e30e 100644 --- a/sources/bmnharm.f90 +++ b/sources/bmnharm.f90 @@ -194,14 +194,21 @@ SUBROUTINE readBmn arg = Bmnim(imn) * teta - Bmnin(imn) * zeta carg(ij, imn) = cos(arg) sarg(ij, imn) = sin(arg) + if (ij==1 .and. imn==6) then + TMPOUT( Bmnim(imn) ) + TMPOUT( Bmnin(imn) ) + TMPOUT( arg ) + endif enddo ! Additional weighting - if (bharm_jsurf == 1) then ! Bn * dA**2 - carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta))**2 - sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta))**2 - else if ( bharm_jsurf == 2) then ! Bn * dA - carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta)) - sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(1)%ds(ii, jj) * (pi2/(Nzeta*Nfp)) * (pi2/Nteta)) + if (bharm_jsurf == 0) then + continue + else if (bharm_jsurf == 1) then ! Bn * dA + carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(1)%ds(ii, jj)) + sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(1)%ds(ii, jj)) + else if ( bharm_jsurf == 2) then ! Bn * sqrt(dA) + carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * sqrt(surf(1)%ds(ii, jj)) + sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * sqrt(surf(1)%ds(ii, jj)) end if enddo enddo @@ -209,6 +216,10 @@ SUBROUTINE readBmn SALLOCATE( dBc, (1:NBmn), zero ) ! dB_mn_cos SALLOCATE( dBs, (1:NBmn), zero ) ! dB_mn_sin + TMPOUT( carg(1, 6) ) + TMPOUT( sarg(1, 6) ) + TMPOUT( surf(1)%ds(0, 0) ) + return END SUBROUTINE readBmn @@ -223,7 +234,8 @@ SUBROUTINE twodft(func, hs, hc, im, in, mn) ! carg and sarg stored the trig functions. ! Right now, it's using normal Fourier transforming, later FFT will be enabled. !-------------------------------------------------------------------------------! - use globals, only: dp, zero, half, two, pi2, myid, ounit, Nteta, Nzeta, carg, sarg + use globals, only: dp, zero, half, two, pi2, myid, ounit, & + Nteta, Nzeta, carg, sarg, bharm_jsurf, surf implicit none include "mpif.h" !------------------------------------------------------------------------------- @@ -248,6 +260,7 @@ SUBROUTINE twodft(func, hs, hc, im, in, mn) hs(imn) = sum(func(1:Nteta*Nzeta) * sarg(1:Nteta*Nzeta, imn)) if (m==0 .and. n==0) then ! for (0,0) term, times a half factor; + ! if (m==0) then ! for (0,0) term, times a half factor; hc(imn) = hc(imn)*half hs(imn) = hs(imn)*half endif @@ -257,6 +270,19 @@ SUBROUTINE twodft(func, hs, hc, im, in, mn) hc = hc * two/(Nteta*Nzeta) ! Discretizing factor; hs = hs * two/(Nteta*Nzeta) ! Discretizing factor; + ! Additional weighting + if (bharm_jsurf == 0) then + ! continue + hc = hc * two + hs = hs * two + else if (bharm_jsurf == 1) then ! divide by A + hc = hc / surf(1)%area * two * pi2**2 + hs = hs / surf(1)%area * two * pi2**2 + else if (bharm_jsurf == 2) then ! divide by sqrt(A) + hc = hc / sqrt(surf(1)%area) * two * pi2 + hs = hs / sqrt(surf(1)%area) * two * pi2 + end if + return END SUBROUTINE twodft diff --git a/sources/globals.f90 b/sources/globals.f90 index 6c6cf42..6f2ef43 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -253,7 +253,7 @@ module globals xt(:,:), yt(:,:), zt(:,:), xp(:,:), yp(:,:), zp(:,:), & ds(:,:), bn(:,:), pb(:,:), & Bx(:,:), By(:,:), Bz(:,:) - REAL :: vol + REAL :: vol, area end type toroidalsurface type arbitrarycoil diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index f35ffc2..ff9741e 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -213,6 +213,7 @@ subroutine fousurf SALLOCATE( surf(1)%zp, (0:Nteta-1,0:Nzeta-1), zero ) !dz/dzeta; surf(1)%vol = zero ! volume enclosed by plasma boundary + surf(1)%area = zero ! surface area ! The center point value was used to discretize grid; do ii = 0, Nteta-1; teta = ( ii + half ) * pi2 / Nteta @@ -270,11 +271,18 @@ subroutine fousurf ! using Gauss theorom; V = \int_S x \cdot n dt dz surf(1)%vol = surf(1)%vol + surf(1)%xx(ii,jj) * ds(1) + ! surface area + surf(1)%area = surf(1)%area + surf(1)%ds(ii,jj) + enddo ! end of do jj; 14 Apr 16; enddo ! end of do ii; 14 Apr 16; - surf(1)%vol = abs(surf(1)%vol) * discretefactor * Nfp - if( myid == 0 .and. IsQuiet <= 0) write(ounit, '(8X": Enclosed total plasma volume ="ES12.5" m^3 ;" )') surf(1)%vol + surf(1)%vol = abs(surf(1)%vol ) * discretefactor * Nfp + surf(1)%area = abs(surf(1)%area) * discretefactor * Nfp + if( myid == 0 .and. IsQuiet <= 0) then + write(ounit, '(8X": Enclosed total plasma volume ="ES12.5" m^3 ; area ="ES12.5" m^2." )') & + surf(1)%vol, surf(1)%area + endif !calculate target Bn with input harmonics; 05 Jan 17; if(NBnf > 0) then From 9bbd83aab80445b51fc7ccddeedb5ed8843b5e13 Mon Sep 17 00:00:00 2001 From: CaoXiang ZHU Date: Wed, 9 Oct 2019 16:30:35 -0400 Subject: [PATCH 43/72] minor fix --- examples/rotating_ellipse/ellipse.input | 2 +- sources/boozer.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 2f7edb6..eb7ac12 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -51,7 +51,7 @@ LM_ftol = 1.000D-08 ! if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; LM_factor = 100.0 ! the initial step bound, which is set to the product of factor and the euclidean norm of diag*x if nonzero - case_postproc = 4 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates + case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates save_freq = 1 ! frequency for writing output files; should be positive save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics diff --git a/sources/boozer.f90 b/sources/boozer.f90 index 8b61844..ed66b6c 100644 --- a/sources/boozer.f90 +++ b/sources/boozer.f90 @@ -172,7 +172,7 @@ subroutine boozsurf(XYZB, x, y, z, iota, isurf) ! finish decomposition - write(ounit, '("boozmn : myid="I6" ; Gpol="ES12.5" ; iota="ES12.5" ; Booz_mnc(1)="ES12.5 & + write(ounit, '("boozmn : myid ="I6" ; Gpol="ES12.5" ; iota="ES12.5" ; Booz_mnc(1)="ES12.5 & " ; Booz_mns(1)="ES12.5)') masterid, Gpol, iota, booz_mnc(1, isurf), booz_mns(1, isurf) return From 2262ca17b2b3eeca3cd0b6a89eb0e676b537530a Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 24 Oct 2019 11:28:14 -0400 Subject: [PATCH 44/72] update README.md --- README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index c065ab9..65a59c9 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# FOCUS Flexible Optimized Coils Using Space curves +# FOCUS Flexible Optimized Coils Using Space curves **FOCUS** is a nonlinear optimization code for designing 3D coils. @@ -11,10 +11,11 @@ There are several branches available. Please use the correct one. - **master:** the basic branch for the latest stable version. - **develop:** the develop branch including the newest features. +- **dipole:** branch for designing permanent magnets. - **old:** the old branch that was originally developped (require NAG library). - **gh-pages:** the branch hosting GitHub pages for the offcicial website. - **others:** task-oriented branches. -*Photo credit: iStockphoto.com* +*Photo credit: internet* From 92b45ace5fe772c3d1d40b6882e872660e6b4c54 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 24 Oct 2019 11:36:08 -0400 Subject: [PATCH 45/72] add w7x_high_mirror example --- .../w7x_high_mirror/w7x_high_mirror.boundary | 33 +++++++++ .../w7x_high_mirror/w7x_high_mirror.input | 72 +++++++++++++++++++ 2 files changed, 105 insertions(+) create mode 100644 examples/w7x_high_mirror/w7x_high_mirror.boundary create mode 100644 examples/w7x_high_mirror/w7x_high_mirror.input diff --git a/examples/w7x_high_mirror/w7x_high_mirror.boundary b/examples/w7x_high_mirror/w7x_high_mirror.boundary new file mode 100644 index 0000000..f30216c --- /dev/null +++ b/examples/w7x_high_mirror/w7x_high_mirror.boundary @@ -0,0 +1,33 @@ +#bmn bNfp nbf +22 5 0 +#plasma boundary +# n m Rbc Rbs Zbc Zbs + 0 0 5.50000000e+00 0.0 0.0 0.00000000e+00 + 0 1 4.76850003e-01 0.0 0.0 6.23149991e-01 + -1 0 2.35400006e-01 0.0 0.0 -1.15500003e-01 + -1 1 -2.23299995e-01 0.0 0.0 2.23299995e-01 + -1 2 1.00649998e-01 0.0 0.0 1.31999999e-01 + 0 2 6.15999997e-02 0.0 0.0 6.43500015e-02 + -2 2 5.49999997e-02 0.0 0.0 -5.49999997e-02 + -2 1 -3.13500017e-02 0.0 0.0 3.13500017e-02 + -2 0 1.26499999e-02 0.0 0.0 -1.26499999e-02 + 1 1 -1.20999999e-02 0.0 0.0 -1.20999999e-02 + -1 3 1.11649996e-02 0.0 0.0 -1.11649996e-02 + -2 4 -6.87499996e-03 0.0 0.0 -6.87499996e-03 + -3 3 -6.76500006e-03 0.0 0.0 6.76500006e-03 + -2 3 6.43499987e-03 0.0 0.0 6.43499987e-03 + -3 4 -2.73899990e-03 0.0 0.0 2.73899990e-03 + -3 0 1.97999994e-03 0.0 0.0 -1.97999994e-03 + -3 2 -1.87000004e-03 0.0 0.0 1.76000001e-03 + -4 2 -1.76000001e-03 0.0 0.0 1.76000001e-03 + 2 1 -1.70499994e-03 0.0 0.0 -1.70499994e-03 + 1 2 1.37499999e-03 0.0 0.0 1.37499999e-03 + -4 3 1.26499997e-03 0.0 0.0 -1.26499997e-03 + 0 3 2.03500007e-04 0.0 0.0 2.03500007e-04 + +#Bn harmonics +# n m bnc bns +0 0 1.0 0.0 +0 1 0.5 0.25 +1 0 0.5 0.0 + diff --git a/examples/w7x_high_mirror/w7x_high_mirror.input b/examples/w7x_high_mirror/w7x_high_mirror.input new file mode 100644 index 0000000..b48cd1a --- /dev/null +++ b/examples/w7x_high_mirror/w7x_high_mirror.input @@ -0,0 +1,72 @@ +&focusin + IsQuiet = -1 ! -2 verbose and including unconstrained cost functions; -1: verbose; 0: normal; 1: concise + IsSymmetric = 2 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced + + input_surf = 'w7x_high_mirror.boundary' ! define the boundary + + case_surface = 0 ! 0: general VMEC-like format (Rbc, Rbs, Zbc, Zbs); 1: read axis for knots + knotsurf = 0.200D-00 ! minor plasma radius for knototrans, only valid for case surface = 1 + ellipticity = 0.000D+00 ! ellipticity of plasma for knototrans, only valid for case surface = 1 + Nteta = 128 ! poloidal number for discretizing the surface + Nzeta = 128 ! toroidal number for discretizing the surface + + case_init = 1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles + case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation + Ncoils = 10 ! number of coils; only valid when case_init = 1 + init_current = 1.450D+06 ! initial coil currents (Amper); only valid when case_init = 1 + init_radius = 1.500D+00 ! initial coil radius (meter); only valid when case_init = 1 + IsVaryCurrent = 0 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus + IsVaryGeometry = 1 ! 0: all the geometries fixed; 1: geometries can be changed; overwritten by ext.focus + NFcoil = 6 ! number of Fourier harmonics representing the coils; overwritten by ext.focus + Nseg = 128 ! number of coil segments for discretizing; overwritten by ext.focus + + IsNormalize = 1 ! 0: do not normalize coil parameters; 1: normalize; I = I/I0, x = x/R0; I0 & R0 are quadrtic mean values. + IsNormWeight = 1 ! 0: do not normalize the weights; 1: normalize the weights + case_bnormal = 1 ! 0: keep raw Bn error; 1: Bn residue normalized to local |B| + case_length = 2 ! 1: quadratic format, converging the target length; 2: exponential format, as short as possible + weight_bnorm = 1.000D+02 ! weight for real space Bn errors + weight_bharm = 0.000D+00 ! weight for Bnm harmonic errors + weight_tflux = 0.000D+00 ! weight for toroidal flux error + target_tflux = 0.000D+00 ! target for the toroidal flux + weight_ttlen = 0.100D+00 ! weight for coil length error + target_length = 8.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length + weight_specw = 0.000D+00 ! weight for spectral condensation error + weight_cssep = 0.000D+00 ! weight for coil-surface separation constraint + weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. + weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. + + case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing using the gradient (DF and/or CG); + exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold + + DF_maxiter = 0 ! maximum iterations allowed for using Differential Flow (DF) + DF_xtol = 1.000D-08 ! relative error for ODE solver + DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea + DF_tauend = 1.000D-00 ! ending value of τ. The larger value of τend − τsta, the more optimized + + CG_maxiter = 200 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization + CG_wolfe_c1 = 0.1 ! c1 value in the strong wolfe condition for line search, (0.0, 0.5) + CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; 0 < c1 < c2 < 1 + + LM_maxiter = 0 ! maximum iterations allowed for using Levenberg-Marquard (LM) + LM_xtol = 1.000D-08 ! if the relative error between two consecutivec iterates is at most xtol, the optimization terminates + LM_ftol = 1.000D-08 ! if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; + LM_factor = 100.0 ! the initial step bound, which is set to the product of factor and the euclidean norm of diag*x if nonzero + + case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates + save_freq = 1 ! frequency for writing output files; should be positive + save_coils = 1 ! flag for indicating whether write example.focus and example.coils + save_harmonics = 0 ! flag for indicating whether write example.harmonics + save_filaments = 0 ! flag for indicating whether write .example.filaments.xxxxxx + + update_plasma = 0 ! if == 1, write new example.plasma file with updated Bn harmonics. + pp_phi = 0.000D+00 ! toroidal plane for poincare plots, cylindrical angle phi = pp_phi*Pi + pp_raxis = 0.000D+00 ! pp_raxis, pp_zaxis are initial guesses for magnetic axis at the specified toroidal angle + pp_zaxis = 0.000D+00 ! If both zero, FOCUS will take the geometric center as initial guess + pp_rmax = 0.000D+00 ! pp_rmax, pp_zmax are the upper bounds for performing fieldline tracing + pp_zmax = 0.000D+00 ! FOCUS will start follow fieldlines at interpolation between (pp_raxis, pp_zaxis) and (pp_rmax, pp_zmax) + pp_ns = 32 ! number of following fieldlines + pp_maxiter = 1000 ! number of periods for each fieldline following + pp_xtol = 1.000D-06 ! tolarence of ODE solver during fieldline fowllowing + +/ From 36a9efe05b2b569c8996befe8f0b134f617a7336 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 24 Oct 2019 11:39:26 -0400 Subject: [PATCH 46/72] add a resulting coil --- .../w7x_high_mirror/w7x_high_mirror.focus | 142 ++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 examples/w7x_high_mirror/w7x_high_mirror.focus diff --git a/examples/w7x_high_mirror/w7x_high_mirror.focus b/examples/w7x_high_mirror/w7x_high_mirror.focus new file mode 100644 index 0000000..6c3a3b2 --- /dev/null +++ b/examples/w7x_high_mirror/w7x_high_mirror.focus @@ -0,0 +1,142 @@ + # Total number of coils + 10 + #----------------- 1 --------------------------- + #coil_type coil_name + 1 Mod_001 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 8.878681892908563E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 5.487179148911487E+00 1.429400016395425E+00 2.217953982818665E-02 -1.201023461002381E-01 6.344103257196283E-02 2.053702634952239E-02 -4.287107014357909E-02 + 0.000000000000000E+00 1.764280659281571E-03 6.799528037889046E-03 3.186420232013008E-02 -3.420489197864295E-02 4.957521567012077E-03 1.499050738254608E-02 + 2.608800463669345E-01 1.749926971101852E-01 -2.716745032401698E-02 -1.579001282012432E-02 7.401562885725494E-03 -4.501482985059499E-03 -1.217361863774398E-02 + 0.000000000000000E+00 1.851013869483588E-01 9.957075639044627E-03 -1.130451356987468E-02 -6.665190221525366E-03 -5.343291592437382E-04 -2.754159552478410E-02 + -7.126101514752108E-02 1.397243974420135E-02 2.926821671304291E-02 -1.855281804741378E-02 1.630700758548324E-03 3.597647289966902E-02 -2.944002808313162E-02 + 0.000000000000000E+00 1.327602349616050E+00 1.121354142089685E-01 -2.072391519585482E-02 -9.840487797932793E-02 2.900406935444091E-02 -4.001295678150159E-02 + #----------------- 2 --------------------------- + #coil_type coil_name + 1 Mod_002 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.126952778870734E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 5.716291592369995E+00 8.936205506037964E-01 1.898951827658998E-01 -9.624477965542874E-02 1.130551461493882E-02 1.672648809098414E-02 -2.174521899312509E-02 + 0.000000000000000E+00 1.131216954774785E-01 -4.787208802595770E-02 5.415409177638602E-02 -6.961881336313257E-02 3.743241866891335E-02 -1.185475833351934E-02 + 8.179646867434526E-01 5.440214897932921E-01 -2.628478288525486E-01 1.918010418117438E-01 -1.333801531166808E-01 3.969884273656217E-02 1.808399246390630E-02 + 0.000000000000000E+00 1.931634716985232E-01 -8.661090157005172E-02 6.440275957968432E-02 -2.907651939033939E-02 5.834337608480664E-03 8.435448902977975E-03 + -2.479052883328618E-01 1.396277769611820E-01 -8.358959993472168E-02 2.549650229639158E-02 1.338689925620846E-02 -1.843721132776129E-02 -9.613013394576094E-03 + 0.000000000000000E+00 1.351347591340651E+00 6.503256291302819E-03 -3.675006465023361E-02 -1.555953278211165E-02 1.757251136217697E-02 9.185358917476405E-04 + #----------------- 3 --------------------------- + #coil_type coil_name + 1 Mod_003 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.247875441250233E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 5.370945492192305E+00 8.438920652568541E-01 1.707299934197729E-01 5.156173639541974E-02 2.485809450317264E-02 -1.774405627671423E-02 -1.136786679212789E-02 + 0.000000000000000E+00 1.532174185677675E-01 -1.268598195079201E-01 1.828696030777839E-01 -5.485294582567019E-02 -4.757407025860440E-02 1.721870113479997E-02 + 1.457837778449846E+00 6.693277690968167E-01 -3.081756669341515E-01 1.615708566629775E-01 4.712713533086026E-02 -6.391124145938072E-02 -2.100512345446192E-03 + 0.000000000000000E+00 6.687416249097021E-02 3.159114327523829E-02 -1.375373706407340E-01 1.131376770483891E-01 -7.142098990956991E-03 -2.530511088765757E-02 + -3.078129769548630E-01 1.553495715170987E-01 -3.578472612940695E-02 -5.411821218116108E-02 1.686631529275658E-02 2.681906774439566E-02 1.061875574804644E-02 + 0.000000000000000E+00 1.252344589983761E+00 1.950150410100455E-01 -4.060025433636689E-02 1.889219286139072E-02 -5.416472705607234E-02 -2.476180621257274E-02 + #----------------- 4 --------------------------- + #coil_type coil_name + 1 Mod_004 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.589929490011116E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 4.907469811740065E+00 7.952955805965581E-01 5.910097514888448E-02 2.050577950536197E-01 2.789715512382224E-02 5.969588915193909E-03 2.704489851936327E-03 + 0.000000000000000E+00 2.145867991092079E-01 -1.028987621263155E-01 1.310794795611224E-01 -4.537249368207783E-02 1.244816843815540E-02 3.079686114651623E-02 + 2.060252928423281E+00 7.802290138956457E-01 -2.151194243809135E-01 -1.569110533599021E-01 6.070145059387227E-02 4.246710435056101E-02 4.212568029254247E-02 + 0.000000000000000E+00 -1.499619488757697E-01 2.942556366488437E-01 -9.705500583479713E-02 -1.672260227489441E-01 -3.565669350486429E-02 3.024334206563705E-02 + -2.960348322122993E-01 8.384711732454050E-02 2.071545194216714E-01 -1.004761113053840E-01 9.916300024152491E-02 -1.032082371779672E-02 -2.665352660980468E-02 + 0.000000000000000E+00 1.115268737974466E+00 2.004644993902690E-01 1.271347663212788E-01 9.558075738371842E-02 3.782078781542389E-02 4.989524950505019E-02 + #----------------- 5 --------------------------- + #coil_type coil_name + 1 Mod_005 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.592448203414783E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 4.399597992000233E+00 8.566405226226123E-01 7.147805437848011E-02 2.390145527944005E-01 5.228282237830489E-02 1.775467735177900E-02 2.220635371480953E-02 + 0.000000000000000E+00 2.829516048355245E-01 -5.268193612981097E-02 -6.075828324623614E-02 -6.528405354259513E-02 -6.363939123407998E-02 -6.443784205666468E-02 + 2.711674331049954E+00 7.217699232777867E-01 -2.091475919785378E-02 -9.524129428616150E-02 -1.375185481215237E-01 -7.486159793850741E-02 -3.519706256860552E-02 + 0.000000000000000E+00 -2.856307343928454E-01 3.135709176464370E-01 1.738789628730727E-01 -1.822946747271399E-02 -8.313381097845912E-03 -5.466211170804170E-02 + -1.399792355222378E-01 -5.209067733814801E-03 1.593133375789115E-01 4.995084170515299E-02 1.456470205612989E-01 5.203532945481463E-02 5.061308456713046E-02 + 0.000000000000000E+00 1.124254034457361E+00 -1.409787599545690E-01 1.047583148040741E-01 -1.043043006225683E-01 -1.296290199767139E-02 -1.958904419893276E-02 + #----------------- 6 --------------------------- + #coil_type coil_name + 1 Mod_006 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.592415309427746E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 3.938492917637658E+00 9.511471935380084E-01 2.189720261284961E-03 -1.672046212478434E-02 -1.146320741713078E-01 -6.570887907895596E-02 -2.660922412070501E-02 + 0.000000000000000E+00 1.842105913305720E-01 -2.819467027487222E-01 -1.465995569059480E-01 3.750357005621357E-02 2.756923763702959E-02 7.189685916554893E-02 + 3.346315131499947E+00 5.916811530473499E-01 7.444021309227024E-02 2.567449464996025E-01 9.221361795430791E-02 4.001727256452022E-02 3.199385099640822E-02 + 0.000000000000000E+00 -3.573660866836764E-01 1.470031469317822E-01 1.115188449469101E-01 5.646187857821160E-02 5.795902704596963E-02 4.439521676839540E-02 + 1.399750171610648E-01 5.213100186686659E-03 -1.593128878929978E-01 -4.995983088664074E-02 -1.456534738528208E-01 -5.203508241592496E-02 -5.061153612429899E-02 + 0.000000000000000E+00 1.124260406820432E+00 -1.409810295335269E-01 1.047609736166758E-01 -1.042938714769722E-01 -1.295516932286644E-02 -1.958538764859711E-02 + #----------------- 7 --------------------------- + #coil_type coil_name + 1 Mod_007 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.589878182406867E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 3.475890568322427E+00 9.878005022586565E-01 -1.863195771849197E-01 -8.587917293196706E-02 6.634380789125621E-02 4.223859913385011E-02 4.089332606682831E-02 + 0.000000000000000E+00 7.631693546727060E-02 -2.480656783513641E-01 5.178457992213949E-02 1.730710311017398E-01 3.006378282542537E-02 -3.828600696095484E-02 + 4.030623937113064E+00 5.152608893186009E-01 1.226660702732870E-01 2.435009739913578E-01 7.774512801052208E-03 -7.454662839964846E-03 -1.045799514144361E-02 + 0.000000000000000E+00 -2.504241308857673E-01 1.887915466656375E-01 -1.546465800038216E-01 -8.519005239233076E-03 -2.286333580811500E-02 -1.993537921065092E-02 + 2.959916567177005E-01 -8.383939213403890E-02 -2.071267150989329E-01 1.004592325009762E-01 -9.917698691119617E-02 1.034676123924799E-02 2.665722636171160E-02 + 0.000000000000000E+00 1.115306428169187E+00 2.004479636890725E-01 1.271144070826361E-01 9.560059157436313E-02 3.782334374131620E-02 4.987000839620320E-02 + #----------------- 8 --------------------------- + #coil_type coil_name + 1 Mod_008 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.247934279457624E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 3.046172805905547E+00 8.973713254001562E-01 -2.403222661621839E-01 1.695846187714737E-01 5.251658616456707E-02 -6.628963266088313E-02 -5.501440070619484E-03 + 0.000000000000000E+00 -1.109307906927187E-01 9.128491577621632E-03 7.430486701784161E-02 -9.066357112928325E-02 2.149012898089881E-02 1.876247623761067E-02 + 4.657583700935778E+00 5.957200215330040E-01 2.575826204864069E-01 -8.614111147534031E-04 9.061326067281026E-03 2.875070160884010E-03 -1.013555000193618E-02 + 0.000000000000000E+00 -1.250659049219811E-01 1.304515131589798E-01 -2.164203583919537E-01 8.711572347073039E-02 4.306525853103116E-02 -2.421044695388754E-02 + 3.077425834235493E-01 -1.553082310877080E-01 3.580546171895414E-02 5.406737007960228E-02 -1.682688902127233E-02 -2.683481741536933E-02 -1.064276283397544E-02 + 0.000000000000000E+00 1.252397113153944E+00 1.949510944297579E-01 -4.058501703166175E-02 1.890807029193821E-02 -5.420730150982682E-02 -2.472452435960300E-02 + #----------------- 9 --------------------------- + #coil_type coil_name + 1 Mod_009 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 9.126921402483722E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 2.544345668332877E+00 7.935830437347137E-01 -1.913104509192696E-01 1.526788175634955E-01 -1.233714383383178E-01 4.293039455577786E-02 1.047941059861469E-02 + 0.000000000000000E+00 -2.186588536094592E-01 9.713511484730336E-02 -7.797459914902452E-02 4.915494664370501E-02 -1.709888893739096E-02 -4.377241827138344E-03 + 5.183766024579499E+00 6.817402544016562E-01 2.618238301830882E-01 -1.507856091684961E-01 5.194111199531284E-02 3.665235348338292E-03 -2.629079304861204E-02 + 0.000000000000000E+00 -4.790612777134268E-02 1.879471815965041E-02 -3.162200730828499E-02 5.723220928920287E-02 -3.379545037026075E-02 1.387304176761329E-02 + 2.478482524305033E-01 -1.395761653842763E-01 8.356228898452858E-02 -2.549400016487971E-02 -1.337101213047707E-02 1.841566871605571E-02 9.630201192468740E-03 + 0.000000000000000E+00 1.351372733352590E+00 6.455531086437420E-03 -3.670359093361790E-02 -1.559107659996455E-02 1.758789863462591E-02 9.186392688217332E-04 + #----------------- 10 --------------------------- + #coil_type coil_name + 1 Mod_010 + #Nseg current Ifree Length Lfree target_length + 128 1.450000000000000E+06 0 8.878668350627589E+00 1 8.000000000000000E+00 + #NFcoil + 6 + #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) + 1.943737605105631E+00 6.081620305348665E-01 -1.897336984214495E-02 -5.213751067153701E-02 2.663745557352018E-02 2.074852897861712E-03 -2.483230856729705E-02 + 0.000000000000000E+00 -1.765889173435116E-01 -1.157643347770281E-02 8.991099898348183E-04 1.690932077717289E-02 -1.019564427186906E-03 2.155725881892951E-02 + 5.138003681373048E+00 1.305358000943127E+00 2.948251982239166E-02 -1.093406990533121E-01 5.805292809903444E-02 2.091735253083694E-02 -3.701004214260908E-02 + 0.000000000000000E+00 5.551471521335664E-02 -3.387627913591810E-03 -3.379879015687111E-02 3.046636013610797E-02 -4.881299352057672E-03 -2.276252222775712E-02 + 7.126383589202243E-02 -1.397360949196934E-02 -2.927089136923838E-02 1.855886199367714E-02 -1.628625699788456E-03 -3.597973202612652E-02 2.943853985364262E-02 + 0.000000000000000E+00 1.327601255565311E+00 1.121360355004071E-01 -2.072265918624493E-02 -9.840540823406364E-02 2.900098316196363E-02 -4.001218588616975E-02 From 2ff3a5126736a2b1aad791bc1117b4c2c1ec3947 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 24 Oct 2019 11:40:14 -0400 Subject: [PATCH 47/72] update version number --- sources/globals.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index a67f165..d754f52 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.8.02' ! version number + CHARACTER(LEN=10), parameter :: version='v0.8.03' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From 8f45b00b9d6e461cdcb627e3be5f38dcd283a667 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 14 Nov 2019 21:35:19 -0500 Subject: [PATCH 48/72] fix boozer print information --- sources/boozer.f90 | 7 ++++--- sources/poinplot.f90 | 6 ++++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/sources/boozer.f90 b/sources/boozer.f90 index 8b61844..951e681 100644 --- a/sources/boozer.f90 +++ b/sources/boozer.f90 @@ -48,7 +48,7 @@ end subroutine boozmn subroutine boozsurf(XYZB, x, y, z, iota, isurf) USE globals, only : dp, myid, ncpu, zero, half, two, pi, pi2, ounit, total_num, pp_maxiter, & bmin, bmim, booz_mnc, booz_mns, booz_mn, machprec, & - masterid + masterid, myworkid USE mpi IMPLICIT NONE @@ -172,8 +172,9 @@ subroutine boozsurf(XYZB, x, y, z, iota, isurf) ! finish decomposition - write(ounit, '("boozmn : myid="I6" ; Gpol="ES12.5" ; iota="ES12.5" ; Booz_mnc(1)="ES12.5 & - " ; Booz_mns(1)="ES12.5)') masterid, Gpol, iota, booz_mnc(1, isurf), booz_mns(1, isurf) + if (myworkid == 0) write(ounit, '("boozmn : order="I6" ; Gpol="ES12.5" ; iota="ES12.5 & + " ; Booz_mnc(1)="ES12.5" ; Booz_mns(1)="ES12.5)') isurf, Gpol, iota, & + booz_mnc(1, isurf), booz_mns(1, isurf) return end subroutine boozsurf diff --git a/sources/poinplot.f90 b/sources/poinplot.f90 index d41fc0e..63320c0 100644 --- a/sources/poinplot.f90 +++ b/sources/poinplot.f90 @@ -6,7 +6,8 @@ SUBROUTINE poinplot USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw, & XYZB, lboozmn, booz_mnc, booz_mns, booz_mn, total_num, & - master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS + master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, & + MPI_COMM_MYWORLD, MPI_COMM_WORKERS USE mpi IMPLICIT NONE @@ -328,7 +329,7 @@ SUBROUTINE BRpZ_iota( t, x, dx ) ! dR/dphi = BR / Bphi ! dZ/dphi = BZ / Bphi !---------------------- - use globals, only : dp, zero, ounit, myid, ierr + use globals, only : dp, zero, ounit, myid, ierr, machprec USE MPI implicit none @@ -371,6 +372,7 @@ SUBROUTINE BRpZ_iota( t, x, dx ) ! integrate theta length = (x(1) - x(3))**2 + (x(2)-x(4))**2 ! delta R^2 + delta Z^2 + FATAL( poinplot, length < machprec, the field line is too close to the axis ) dx(5) = ( (x(1) - x(3))*(dx(2)-dx(4)) - (x(2)-x(4))*(dx(1)-dx(3)) ) / length return From b351c934a91a9f13d3ea18ff2a69d235a6c09c63 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 25 Nov 2019 13:53:00 -0500 Subject: [PATCH 49/72] add more options for bharm_jsurf --- sources/bmnharm.f90 | 9 --------- sources/globals.f90 | 2 +- sources/initial.f90 | 11 +++++++++++ 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/sources/bmnharm.f90 b/sources/bmnharm.f90 index 981e30e..2e68151 100644 --- a/sources/bmnharm.f90 +++ b/sources/bmnharm.f90 @@ -194,11 +194,6 @@ SUBROUTINE readBmn arg = Bmnim(imn) * teta - Bmnin(imn) * zeta carg(ij, imn) = cos(arg) sarg(ij, imn) = sin(arg) - if (ij==1 .and. imn==6) then - TMPOUT( Bmnim(imn) ) - TMPOUT( Bmnin(imn) ) - TMPOUT( arg ) - endif enddo ! Additional weighting if (bharm_jsurf == 0) then @@ -216,10 +211,6 @@ SUBROUTINE readBmn SALLOCATE( dBc, (1:NBmn), zero ) ! dB_mn_cos SALLOCATE( dBs, (1:NBmn), zero ) ! dB_mn_sin - TMPOUT( carg(1, 6) ) - TMPOUT( sarg(1, 6) ) - TMPOUT( surf(1)%ds(0, 0) ) - return END SUBROUTINE readBmn diff --git a/sources/globals.f90 b/sources/globals.f90 index 6f2ef43..561f1d7 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.8.00' ! version number + CHARACTER(LEN=10), parameter :: version='v0.9.00' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.f90 b/sources/initial.f90 index 5edc93c..41b47f5 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -543,6 +543,17 @@ subroutine initial FATAL( initial, .true., selected case_bnormal is not supported ) end select + select case ( bharm_jsurf ) + case ( 0 ) + if (IsQuiet < 1) write(ounit, 1000) 'bharm_jsurf', case_bnormal, 'No normalization on Bn harmonics.' + case ( 1 ) + if (IsQuiet < 1) write(ounit, 1000) 'bharm_jsurf', case_bnormal, 'Bn harmonics are multiplied with surface area.' + case ( 2 ) + if (IsQuiet < 1) write(ounit, 1000) 'bharm_jsurf', case_bnormal, 'Bn harmonics are multiplied with sqrt(surface area).' + case default + FATAL( initial, .true., selected case_bnormal is not supported ) + end select + select case ( case_length ) case ( 1 ) if (IsQuiet < 1) write(ounit, 1000) 'case_length', case_length, 'Quadratic format of length penalty.' From 661a062d086145c2a509cf3f3eb460c7d3378946 Mon Sep 17 00:00:00 2001 From: CaoXiang ZHU Date: Mon, 16 Dec 2019 10:22:46 -0500 Subject: [PATCH 50/72] initial commit to separate plasma surface and limiter surface --- sources/Makefile | 2 +- sources/bmnharm.f90 | 25 ++-- sources/bnormal.f90 | 99 ++++++------- sources/datalloc.f90 | 14 +- sources/diagnos.f90 | 28 ++-- sources/focus.f90 | 2 +- sources/globals.f90 | 14 +- sources/initial.f90 | 11 +- sources/poinplot.f90 | 8 +- sources/rdcoils.f90 | 8 +- sources/rdsurf.f90 | 337 +++++++++++++++++++++---------------------- sources/saving.f90 | 83 ++++++----- sources/specinp.f90 | 31 ++-- sources/torflux.f90 | 42 +++--- 14 files changed, 359 insertions(+), 345 deletions(-) diff --git a/sources/Makefile b/sources/Makefile index fea0614..53f068e 100644 --- a/sources/Makefile +++ b/sources/Makefile @@ -2,7 +2,7 @@ ############################################################################################################ - ALLFILES= globals initial rdsurf rdknot rdcoils packdof bfield bmnharm bnormal fdcheck \ + ALLFILES= globals initial surface rdsurf rdknot rdcoils packdof bfield bmnharm bnormal fdcheck \ torflux length surfsep datalloc solvers descent congrad lmalg saving diagnos \ specinp poinplot boozer wtmgrid focus HFILES= $(ALLFILES:=.f90) # raw source files diff --git a/sources/bmnharm.f90 b/sources/bmnharm.f90 index 2e68151..8139a71 100644 --- a/sources/bmnharm.f90 +++ b/sources/bmnharm.f90 @@ -126,12 +126,12 @@ SUBROUTINE readBmn !---------------------------------------------------------------------------------------- use globals, only: dp, zero, half, pi2, myid, ounit, runit, ext, IsQuiet, Nteta, Nzeta, Nfp, & NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, Nfp_raw, case_bnormal, & - input_harm, bharm_jsurf, surf + input_harm, bharm_jsurf, surf, plasma use bharm_mod implicit none include "mpif.h" - INTEGER :: ii, jj, ij, imn, ierr, astat + INTEGER :: ii, jj, ij, imn, ierr, astat, isurf REAL :: teta, zeta, arg LOGICAL :: exist @@ -199,11 +199,11 @@ SUBROUTINE readBmn if (bharm_jsurf == 0) then continue else if (bharm_jsurf == 1) then ! Bn * dA - carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(1)%ds(ii, jj)) - sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(1)%ds(ii, jj)) + carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * (surf(isurf)%ds(ii, jj)) + sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * (surf(isurf)%ds(ii, jj)) else if ( bharm_jsurf == 2) then ! Bn * sqrt(dA) - carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * sqrt(surf(1)%ds(ii, jj)) - sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * sqrt(surf(1)%ds(ii, jj)) + carg(ij, 1:NBmn) = carg(ij, 1:NBmn) * sqrt(surf(isurf)%ds(ii, jj)) + sarg(ij, 1:NBmn) = sarg(ij, 1:NBmn) * sqrt(surf(isurf)%ds(ii, jj)) end if enddo enddo @@ -226,7 +226,7 @@ SUBROUTINE twodft(func, hs, hc, im, in, mn) ! Right now, it's using normal Fourier transforming, later FFT will be enabled. !-------------------------------------------------------------------------------! use globals, only: dp, zero, half, two, pi2, myid, ounit, & - Nteta, Nzeta, carg, sarg, bharm_jsurf, surf + Nteta, Nzeta, carg, sarg, bharm_jsurf, surf, plasma implicit none include "mpif.h" !------------------------------------------------------------------------------- @@ -234,11 +234,12 @@ SUBROUTINE twodft(func, hs, hc, im, in, mn) REAL , INTENT(out) :: hc(1:mn), hs(1:mn) INTEGER, INTENT(in ) :: mn, im(1:mn), in(1:mn) - INTEGER :: m, n, imn, maxN, maxM, astat, ierr + INTEGER :: m, n, imn, maxN, maxM, astat, ierr, isurf !------------------------------------------------------------------------------- FATAL(twodft, mn < 1, invalid size for 2D Fourier transformation) + isurf = plasma maxN = maxval(abs(in)) maxM = maxval(abs(im)) FATAL(twodft, maxN >= Nzeta/2, toroidal grid resolution not enough) @@ -267,11 +268,11 @@ SUBROUTINE twodft(func, hs, hc, im, in, mn) hc = hc * two hs = hs * two else if (bharm_jsurf == 1) then ! divide by A - hc = hc / surf(1)%area * two * pi2**2 - hs = hs / surf(1)%area * two * pi2**2 + hc = hc / surf(isurf)%area * two * pi2**2 + hs = hs / surf(isurf)%area * two * pi2**2 else if (bharm_jsurf == 2) then ! divide by sqrt(A) - hc = hc / sqrt(surf(1)%area) * two * pi2 - hs = hs / sqrt(surf(1)%area) * two * pi2 + hc = hc / sqrt(surf(isurf)%area) * two * pi2 + hs = hs / sqrt(surf(isurf)%area) * two * pi2 end if return diff --git a/sources/bnormal.f90 b/sources/bnormal.f90 index b9ad4ef..6d35664 100644 --- a/sources/bnormal.f90 +++ b/sources/bnormal.f90 @@ -34,7 +34,7 @@ subroutine bnormal( ideriv ) ! ideriv = 2 -> calculate the Bn surface integral and its first & second derivatives; !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, half, one, pi2, sqrtmachprec, bsconstant, ncpu, myid, ounit, & - coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, & + coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, plasma, & bnorm, t1B, t2B, bn, Ndof, Npc, Cdof, weight_bharm, case_bnormal, & weight_bnorm, ibnorm, mbnorm, ibharm, mbharm, LM_fvec, LM_fjac, & bharm, t1H, Bmnc, Bmns, wBmn, tBmnc, tBmns, Bmnim, Bmnin, NBmn @@ -46,14 +46,15 @@ subroutine bnormal( ideriv ) INTEGER, INTENT(in) :: ideriv !-------------------------------------------------------------------------------------------- INTEGER :: astat, ierr - INTEGER :: icoil, iteta, jzeta, idof, ND, NumGrid, ip - - !--------------------------initialize and allocate arrays------------------------------------- + INTEGER :: icoil, iteta, jzeta, idof, ND, NumGrid, ip, isurf + !--------------------------initialize and allocate arrays------------------------------------- + + isurf = plasma NumGrid = Nteta*Nzeta ! reset to zero; bnorm = zero - surf(1)%Bx = zero; surf(1)%By = zero; surf(1)%Bz = zero; surf(1)%Bn = zero + surf(isurf)%Bx = zero; surf(isurf)%By = zero; surf(isurf)%Bz = zero; surf(isurf)%Bn = zero dBx = zero; dBy = zero; dBz = zero; Bm = zero bn = zero @@ -66,27 +67,27 @@ subroutine bnormal( ideriv ) if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; do icoil = 1, Ncoils*Npc - call bfield0(icoil, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & - & surf(1)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) - surf(1)%Bx(iteta, jzeta) = surf(1)%Bx(iteta, jzeta) + dBx( 0, 0) - surf(1)%By(iteta, jzeta) = surf(1)%By(iteta, jzeta) + dBy( 0, 0) - surf(1)%Bz(iteta, jzeta) = surf(1)%Bz(iteta, jzeta) + dBz( 0, 0) + call bfield0(icoil, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & + & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) + surf(isurf)%Bx(iteta, jzeta) = surf(isurf)%Bx(iteta, jzeta) + dBx( 0, 0) + surf(isurf)%By(iteta, jzeta) = surf(isurf)%By(iteta, jzeta) + dBy( 0, 0) + surf(isurf)%Bz(iteta, jzeta) = surf(isurf)%Bz(iteta, jzeta) + dBz( 0, 0) enddo ! end do icoil - surf(1)%Bn(iteta, jzeta) = surf(1)%Bx(iteta, jzeta)*surf(1)%nx(iteta, jzeta) & - & + surf(1)%By(iteta, jzeta)*surf(1)%ny(iteta, jzeta) & - & + surf(1)%Bz(iteta, jzeta)*surf(1)%nz(iteta, jzeta) & - & - surf(1)%pb(iteta, jzeta) + surf(isurf)%Bn(iteta, jzeta) = surf(isurf)%Bx(iteta, jzeta)*surf(isurf)%nx(iteta, jzeta) & + & + surf(isurf)%By(iteta, jzeta)*surf(isurf)%ny(iteta, jzeta) & + & + surf(isurf)%Bz(iteta, jzeta)*surf(isurf)%nz(iteta, jzeta) & + & - surf(isurf)%pb(iteta, jzeta) select case (case_bnormal) case (0) ! no normalization over |B|; - bnorm = bnorm + surf(1)%Bn(iteta, jzeta) * surf(1)%Bn(iteta, jzeta) * surf(1)%ds(iteta, jzeta) + bnorm = bnorm + surf(isurf)%Bn(iteta, jzeta) * surf(isurf)%Bn(iteta, jzeta) * surf(isurf)%ds(iteta, jzeta) case (1) ! normalized over |B|; - Bm(iteta, jzeta) = surf(1)%Bx(iteta, jzeta)*surf(1)%Bx(iteta, jzeta) & - & + surf(1)%By(iteta, jzeta)*surf(1)%By(iteta, jzeta) & - & + surf(1)%Bz(iteta, jzeta)*surf(1)%Bz(iteta, jzeta) - bnorm = bnorm + surf(1)%Bn(iteta, jzeta) * surf(1)%Bn(iteta, jzeta) & - & / Bm(iteta, jzeta) * surf(1)%ds(iteta, jzeta) + Bm(iteta, jzeta) = surf(isurf)%Bx(iteta, jzeta)*surf(isurf)%Bx(iteta, jzeta) & + & + surf(isurf)%By(iteta, jzeta)*surf(isurf)%By(iteta, jzeta) & + & + surf(isurf)%Bz(iteta, jzeta)*surf(isurf)%Bz(iteta, jzeta) + bnorm = bnorm + surf(isurf)%Bn(iteta, jzeta) * surf(isurf)%Bn(iteta, jzeta) & + & / Bm(iteta, jzeta) * surf(isurf)%ds(iteta, jzeta) case default FATAL( bnorm, .true., case_bnormal can only be 0/1 ) end select @@ -95,15 +96,15 @@ subroutine bnormal( ideriv ) enddo ! end do jzeta call MPI_BARRIER( MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%Bx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%By, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%Bz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - call MPI_ALLREDUCE( MPI_IN_PLACE, surf(1)%Bn, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%Bx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%By, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%Bz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) + call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%Bn, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, bnorm, 1 , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) bnorm = bnorm * half * discretefactor - bn = surf(1)%Bn + surf(1)%pb ! bn is B.n from coils - ! bn = surf(1)%Bx * surf(1)%nx + surf(1)%By * surf(1)%ny + surf(1)%Bz * surf(1)%nz + bn = surf(isurf)%Bn + surf(isurf)%pb ! bn is B.n from coils + ! bn = surf(isurf)%Bx * surf(isurf)%nx + surf(isurf)%By * surf(isurf)%ny + surf(isurf)%Bz * surf(isurf)%nz !! if (case_bnormal == 0) bnorm = bnorm * bsconstant * bsconstant ! take bsconst back if (case_bnormal == 1) then ! collect |B| @@ -116,10 +117,10 @@ subroutine bnormal( ideriv ) select case (case_bnormal) case (0) ! no normalization over |B|; LM_fvec(ibnorm+1:ibnorm+mbnorm) = weight_bnorm & - & * reshape(surf(1)%bn(0:Nteta-1, 0:Nzeta-1) , (/Nteta*Nzeta/)) + & * reshape(surf(isurf)%bn(0:Nteta-1, 0:Nzeta-1) , (/Nteta*Nzeta/)) case (1) ! normalized over |B|; LM_fvec(ibnorm+1:ibnorm+mbnorm) = weight_bnorm & - & * reshape(surf(1)%bn(0:Nteta-1, 0:Nzeta-1)/sqrt(bm(0:Nteta-1, 0:Nzeta-1)), (/Nteta*Nzeta/)) + & * reshape(surf(isurf)%bn(0:Nteta-1, 0:Nzeta-1)/sqrt(bm(0:Nteta-1, 0:Nzeta-1)), (/Nteta*Nzeta/)) case default FATAL( bnorm, .true., case_bnormal can only be 0/1 ) end select @@ -156,31 +157,31 @@ subroutine bnormal( ideriv ) do icoil = 1, Ncoils ND = DoF(icoil)%ND if ( coil(icoil)%Ic /= 0 ) then !if current is free; - call bfield0(icoil+(ip-1)*Ncoils, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & - & surf(1)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) + call bfield0(icoil+(ip-1)*Ncoils, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & + & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) if (coil(icoil+(ip-1)*Ncoils)%itype == 3) dBz(0,0) = zero ! Bz doesn't change in itype=3 - dBn(idof+1) = ( dBx(0,0)*surf(1)%nx(iteta,jzeta) & - & + dBy(0,0)*surf(1)%ny(iteta,jzeta) & - & + dBz(0,0)*surf(1)%nz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I + dBn(idof+1) = ( dBx(0,0)*surf(isurf)%nx(iteta,jzeta) & + & + dBy(0,0)*surf(isurf)%ny(iteta,jzeta) & + & + dBz(0,0)*surf(isurf)%nz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I if (case_bnormal == 1) then ! normalized over |B|; - dBm(idof+1) = ( dBx(0,0)*surf(1)%Bx(iteta,jzeta) & - & + dBy(0,0)*surf(1)%By(iteta,jzeta) & - & + dBz(0,0)*surf(1)%Bz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I + dBm(idof+1) = ( dBx(0,0)*surf(isurf)%Bx(iteta,jzeta) & + & + dBy(0,0)*surf(isurf)%By(iteta,jzeta) & + & + dBz(0,0)*surf(isurf)%Bz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I endif idof = idof +1 endif if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; - call bfield1(icoil+(ip-1)*Ncoils, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & - & surf(1)%zz(iteta, jzeta), dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) - dBn(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(1)%nx(iteta,jzeta) & - & + dBy(1:ND,0)*surf(1)%ny(iteta,jzeta) & - & + dBz(1:ND,0)*surf(1)%nz(iteta,jzeta) ) + call bfield1(icoil+(ip-1)*Ncoils, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & + & surf(isurf)%zz(iteta, jzeta), dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) + dBn(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(isurf)%nx(iteta,jzeta) & + & + dBy(1:ND,0)*surf(isurf)%ny(iteta,jzeta) & + & + dBz(1:ND,0)*surf(isurf)%nz(iteta,jzeta) ) if (case_bnormal == 1) then ! normalized over |B|; - dBm(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(1)%Bx(iteta,jzeta) & - & + dBy(1:ND,0)*surf(1)%By(iteta,jzeta) & - & + dBz(1:ND,0)*surf(1)%Bz(iteta,jzeta) ) + dBm(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(isurf)%Bx(iteta,jzeta) & + & + dBy(1:ND,0)*surf(isurf)%By(iteta,jzeta) & + & + dBz(1:ND,0)*surf(isurf)%Bz(iteta,jzeta) ) endif idof = idof + ND @@ -192,17 +193,17 @@ subroutine bnormal( ideriv ) select case (case_bnormal) case (0) ! no normalization over |B|; - t1B(1:Ndof) = t1B(1:Ndof) + surf(1)%bn(iteta,jzeta) * surf(1)%ds(iteta,jzeta) * dBn(1:Ndof) + t1B(1:Ndof) = t1B(1:Ndof) + surf(isurf)%bn(iteta,jzeta) * surf(isurf)%ds(iteta,jzeta) * dBn(1:Ndof) d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) case (1) ! normalized over |B|; - t1B(1:Ndof) = t1B(1:Ndof) + ( surf(1)%Bn(iteta,jzeta) * dBn(1:Ndof) & + t1B(1:Ndof) = t1B(1:Ndof) + ( surf(isurf)%Bn(iteta,jzeta) * dBn(1:Ndof) & & / bm(iteta, jzeta) & - & - surf(1)%Bn(iteta,jzeta) * surf(1)%Bn(iteta,jzeta) & + & - surf(isurf)%Bn(iteta,jzeta) * surf(isurf)%Bn(iteta,jzeta) & & / (bm(iteta, jzeta)*bm(iteta, jzeta)) & - & * dBm(1:Ndof) ) * surf(1)%ds(iteta,jzeta) + & * dBm(1:Ndof) ) * surf(isurf)%ds(iteta,jzeta) d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) & & / sqrt(bm(iteta, jzeta)) & - & - surf(1)%Bn(iteta,jzeta) * dBm(1:Ndof) & + & - surf(isurf)%Bn(iteta,jzeta) * dBm(1:Ndof) & & / (bm(iteta, jzeta) * sqrt(bm(iteta, jzeta))) case default FATAL( bnorm, .true., case_bnormal can only be 0/1 ) diff --git a/sources/datalloc.f90 b/sources/datalloc.f90 index 3722431..15426c4 100644 --- a/sources/datalloc.f90 +++ b/sources/datalloc.f90 @@ -13,9 +13,11 @@ subroutine AllocData(itype) INTEGER, intent(in) :: itype - INTEGER :: icoil, idof, ND, NF, icur, imag + INTEGER :: icoil, idof, ND, NF, icur, imag, isurf REAL :: xtmp, mtmp + isurf = plasma + !------------------------------------------------------------------------------------------- if (itype == -1) then ! dof related data; @@ -87,7 +89,7 @@ subroutine AllocData(itype) imag = imag + 1 endif enddo - Gnorm = (surf(1)%vol/(pi*pi2))**(one/three) ! Gnorm is a hybrid of major and minor radius + Gnorm = (surf(plasma)%vol/(pi*pi2))**(one/three) ! Gnorm is a hybrid of major and minor radius Gnorm = Gnorm * weight_gnorm icur = max(1, icur) ; imag = max(1, imag) ! avoid dividing zero @@ -171,10 +173,10 @@ subroutine AllocData(itype) ! Bnorm and Bharm needed; if (weight_bnorm > sqrtmachprec .or. weight_bharm > sqrtmachprec .or. IsQuiet <= -2) then SALLOCATE( bn, (0:Nteta-1,0:Nzeta-1), zero ) ! Bn from coils; - SALLOCATE( surf(1)%bn, (0:Nteta-1,0:Nzeta-1), zero ) ! total Bn; - SALLOCATE( surf(1)%Bx, (0:Nteta-1,0:Nzeta-1), zero ) ! Bx on the surface; - SALLOCATE( surf(1)%By, (0:Nteta-1,0:Nzeta-1), zero ) ! By on the surface; - SALLOCATE( surf(1)%Bz, (0:Nteta-1,0:Nzeta-1), zero ) ! Bz on the surface; + SALLOCATE( surf(isurf)%bn, (0:Nteta-1,0:Nzeta-1), zero ) ! total Bn; + SALLOCATE( surf(isurf)%Bx, (0:Nteta-1,0:Nzeta-1), zero ) ! Bx on the surface; + SALLOCATE( surf(isurf)%By, (0:Nteta-1,0:Nzeta-1), zero ) ! By on the surface; + SALLOCATE( surf(isurf)%Bz, (0:Nteta-1,0:Nzeta-1), zero ) ! Bz on the surface; SALLOCATE( Bm, (0:Nteta-1,0:Nzeta-1), zero ) ! |B| on the surface; SALLOCATE( dBx, (0:Cdof,0:Cdof), zero ) ! d^2Bx/(dx1,dx2) on each coil; Cdof is the max coil dof SALLOCATE( dBy, (0:Cdof,0:Cdof), zero ) ! d^2By/(dx1,dx2) on each coil; diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index 762f914..041fff8 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -7,17 +7,18 @@ SUBROUTINE diagnos !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, one, myid, ounit, sqrtmachprec, IsQuiet, case_optimize, coil, surf, Ncoils, & Nteta, Nzeta, bnorm, bharm, tflux, ttlen, specw, ccsep, coilspace, FouCoil, iout, Tdof, case_length, & - cssep, Bmnc, Bmns, tBmnc, tBmns, weight_bharm, coil_importance, Npc, weight_bnorm, overlap + cssep, Bmnc, Bmns, tBmnc, tBmns, weight_bharm, coil_importance, Npc, weight_bnorm, overlap, plasma implicit none include "mpif.h" - INTEGER :: icoil, itmp=0, astat, ierr, NF, idof, i, j + INTEGER :: icoil, itmp=0, astat, ierr, NF, idof, i, j, isurf LOGICAL :: lwbnorm = .True. , l_raw = .False.!if use raw coils data REAL :: MaxCurv, AvgLength, MinCCdist, MinCPdist, tmp_dist, ReDot, ImDot REAL, parameter :: infmax = 1.0E6 REAL, allocatable :: Atmp(:,:), Btmp(:,:) + isurf = plasma if (myid == 0 .and. IsQuiet < 0) write(ounit, *) "-----------COIL DIAGNOSTICS----------------------------------" !--------------------------------cost functions------------------------------------------------------- @@ -130,9 +131,9 @@ SUBROUTINE diagnos Atmp(2, 0:coil(icoil)%NS-1) = coil(icoil)%yy(0:coil(icoil)%NS-1) Atmp(3, 0:coil(icoil)%NS-1) = coil(icoil)%zz(0:coil(icoil)%NS-1) - Btmp(1, 1:(Nteta*Nzeta)) = reshape(surf(1)%xx(0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) - Btmp(2, 1:(Nteta*Nzeta)) = reshape(surf(1)%yy(0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) - Btmp(3, 1:(Nteta*Nzeta)) = reshape(surf(1)%zz(0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) + Btmp(1, 1:(Nteta*Nzeta)) = reshape(surf(isurf)%xx(0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) + Btmp(2, 1:(Nteta*Nzeta)) = reshape(surf(isurf)%yy(0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) + Btmp(3, 1:(Nteta*Nzeta)) = reshape(surf(isurf)%zz(0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) call mindist(Atmp, coil(icoil)%NS, Btmp, Nteta*Nzeta, tmp_dist) @@ -166,10 +167,10 @@ SUBROUTINE diagnos endif !--------------------------------calculate the average Bn error------------------------------- - if (allocated(surf(1)%bn)) then + if (allocated(surf(isurf)%bn)) then ! \sum{ |Bn| / |B| }/ (Nt*Nz) if(myid .eq. 0) write(ounit, '(8X": Average relative absolute Bn error is :" ES23.15)') & - sum(abs(surf(1)%bn/sqrt(surf(1)%Bx**2 + surf(1)%By**2 + surf(1)%Bz**2))) / (Nteta*Nzeta) + sum(abs(surf(isurf)%bn/sqrt(surf(isurf)%Bx**2 + surf(isurf)%By**2 + surf(isurf)%Bz**2))) / (Nteta*Nzeta) endif return @@ -258,18 +259,19 @@ end subroutine mindist subroutine importance(icoil) use globals, only: dp, zero, pi2, ncpu, astat, ierr, myid, ounit, coil, NFcoil, Nseg, Ncoils, & - surf, Nteta, Nzeta, bsconstant, coil_importance + surf, Nteta, Nzeta, bsconstant, coil_importance, plasma implicit none include "mpif.h" INTEGER, INTENT(in) :: icoil - INTEGER :: iteta, jzeta, NumGrid + INTEGER :: iteta, jzeta, NumGrid, isurf REAL :: dBx, dBy, dBz REAL, dimension(0:Nteta-1, 0:Nzeta-1) :: tbx, tby, tbz ! summed Bx, By and Bz !--------------------------initialize and allocate arrays------------------------------------- + isurf = plasma NumGrid = Nteta*Nzeta tbx = zero; tby = zero; tbz = zero !already allocted; reset to zero; @@ -277,8 +279,8 @@ subroutine importance(icoil) do iteta = 0, Nteta - 1 if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - call bfield0(icoil, surf(1)%xx(iteta, jzeta), surf(1)%yy(iteta, jzeta), & - & surf(1)%zz(iteta, jzeta), tbx(iteta, jzeta), tby(iteta, jzeta), tbz(iteta, jzeta)) + call bfield0(icoil, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & + & surf(isurf)%zz(iteta, jzeta), tbx(iteta, jzeta), tby(iteta, jzeta), tbz(iteta, jzeta)) enddo ! end do iteta enddo ! end do jzeta @@ -288,8 +290,8 @@ subroutine importance(icoil) call MPI_ALLREDUCE( MPI_IN_PLACE, tby, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, tbz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) - coil_importance(icoil) = sum( (tbx*surf(1)%Bx + tby*surf(1)%By + tbz*surf(1)%Bz) / & - (surf(1)%Bx**2 + surf(1)%By**2 + surf(1)%Bz**2) ) / NumGrid + coil_importance(icoil) = sum( (tbx*surf(isurf)%Bx + tby*surf(isurf)%By + tbz*surf(isurf)%Bz) / & + (surf(isurf)%Bx**2 + surf(isurf)%By**2 + surf(isurf)%Bz**2) ) / NumGrid return diff --git a/sources/focus.f90 b/sources/focus.f90 index 7eace2e..bce4f9b 100644 --- a/sources/focus.f90 +++ b/sources/focus.f90 @@ -69,7 +69,7 @@ PROGRAM focus select case( case_surface ) - case( 0 ) ; call fousurf ! general format (VMEC-like) plasma boundary; + case( 0 ) ; call surface ! general format (VMEC-like) plasma boundary; case( 1 ) ; call rdknot ! knototran-like plasma boundary; !case( 2 ) ; call readwout ! read vmec output for plasma boundary and Boozer coordinates; for future; diff --git a/sources/globals.f90 b/sources/globals.f90 index 561f1d7..c9655e8 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -160,10 +160,12 @@ module globals CHARACTER(LEN=100) :: input_surf = 'plasma.boundary' ! surface file CHARACTER(LEN=100) :: input_coils = 'none' ! input file for coils CHARACTER(LEN=100) :: input_harm = 'target.harmonics' ! input target harmonics file + CHARACTER(LEN=100) :: limiter_surf = 'none' ! limiter surface namelist / focusin / IsQuiet , & IsSymmetric , & - input_surf , & + input_surf , & + limiter_surf , & input_harm , & input_coils , & case_surface , & @@ -248,11 +250,13 @@ module globals !latex \subsection{surface and coils data} type toroidalsurface - INTEGER :: Nteta, Nzeta + INTEGER :: Nteta, Nzeta, Nfou=0, Nfp=0, NBnf=0 + REAL , allocatable :: Rbc(:), Zbs(:), Rbs(:), Zbc(:), Bnc(:), Bns(:) REAL , allocatable :: xx(:,:), yy(:,:), zz(:,:), nx(:,:), ny(:,:), nz(:,:), & xt(:,:), yt(:,:), zt(:,:), xp(:,:), yp(:,:), zp(:,:), & ds(:,:), bn(:,:), pb(:,:), & Bx(:,:), By(:,:), Bz(:,:) + INTEGER, allocatable :: bim(:), bin(:), Bnim(:), Bnin(:) REAL :: vol, area end type toroidalsurface @@ -279,9 +283,9 @@ module globals type(FourierCoil) , allocatable :: FouCoil(:) type(DegreeOfFreedom), allocatable :: DoF(:) - INTEGER :: Nfou=0, Nfp=0, NBnf=0, Npc = 1, Nfp_raw = 1 - INTEGER, allocatable :: bim(:), bin(:), Bnim(:), Bnin(:) - REAL , allocatable :: Rbc(:), Zbs(:), Rbs(:), Zbc(:), Bnc(:), Bns(:), cosip(:), sinip(:) + INTEGER :: Nfp = 1, Npc = 1, Nfp_raw = 1 + INTEGER :: plasma = 1, limiter = 1 + REAL , allocatable :: cosip(:), sinip(:) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.f90 b/sources/initial.f90 index 41b47f5..c374ccf 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -289,8 +289,8 @@ subroutine initial use globals + use mpi implicit none - include "mpif.h" LOGICAL :: exist INTEGER :: icpu, index_dot @@ -361,6 +361,12 @@ subroutine initial write(ounit, *) "-----------INPUT NAMELIST------------------------------------" write(ounit, '("initial : Read namelist focusin from : ", A)') trim(inputfile) write(ounit, '(" : Read plasma boundary from : ", A)') trim(input_surf) + if ( weight_cssep > machprec ) then + if (trim(limiter_surf) == 'none') then ! by default, use the plasma surface + limiter_surf = input_surf + endif + write(ounit, '(" : Read limiter surface from : ", A)') trim(limiter_surf) + endif if (weight_bharm > machprec) then write(ounit, '(" : Read Bmn harmonics from : ", A)') trim(input_harm) endif @@ -606,6 +612,9 @@ subroutine initial endif endif + + ClBCAST( limiter_surf, 100, 0 ) + ClBCAST( input_coils , 100, 0 ) FATAL( initial, ncpu >= 1000 , too macy cpus, modify nodelabel) write(nodelabel,'(i3.3)') myid ! nodelabel is global; 30 Oct 15; diff --git a/sources/poinplot.f90 b/sources/poinplot.f90 index 63320c0..9cf0704 100644 --- a/sources/poinplot.f90 +++ b/sources/poinplot.f90 @@ -7,7 +7,7 @@ SUBROUTINE poinplot pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw, & XYZB, lboozmn, booz_mnc, booz_mns, booz_mn, total_num, & master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, & - MPI_COMM_MYWORLD, MPI_COMM_WORKERS + MPI_COMM_MYWORLD, MPI_COMM_WORKERS, plasma USE mpi IMPLICIT NONE @@ -29,8 +29,8 @@ SUBROUTINE poinplot ! if raxis, zaxis not provided if ( (abs(pp_raxis) + abs(pp_zaxis)) < sqrtmachprec) then zeta = pp_phi - theta = zero ; call surfcoord( theta, zeta, r , z ) - theta = pi ; call surfcoord( theta, zeta, r1, z1) + theta = zero ; call surfcoord( plasma, theta, zeta, r , z ) + theta = pi ; call surfcoord( plasma, theta, zeta, r1, z1) pp_raxis = (r+r1)*half pp_zaxis = (z+z1)*half @@ -81,7 +81,7 @@ SUBROUTINE poinplot ! if pp_rmax and pp_zmax not provied if ( (abs(pp_rmax) + abs(pp_zmax)) < sqrtmachprec) then zeta = pp_phi - theta = zero ; call surfcoord( theta, zeta, r , z ) + theta = zero ; call surfcoord( plasma, theta, zeta, r , z ) pp_rmax = r*1.0 ; pp_zmax = z*1.0 endif diff --git a/sources/rdcoils.f90 b/sources/rdcoils.f90 index dbe548e..bc0dbef 100644 --- a/sources/rdcoils.f90 +++ b/sources/rdcoils.f90 @@ -358,8 +358,8 @@ subroutine rdcoils !initilize with circular coils; zeta = (icoil-1+half) * pi2 / (Ncoils*Npc) ! put a half for a shift; - call surfcoord( zero, zeta, r1, z1) - call surfcoord( pi, zeta, r2, z2) + call surfcoord( plasma, zero, zeta, r1, z1) + call surfcoord( plasma, pi, zeta, r2, z2) Rmaj = half * (r1 + r2) z0 = half * (z1 + z2) @@ -409,8 +409,8 @@ subroutine rdcoils !initilize with circular coils; zeta = (itor-1) * pi2 / num_tor ! put a half for a shift; - call surfcoord( zero, zeta, r1, z1) - call surfcoord( pi, zeta, r2, z2) + call surfcoord( plasma, zero, zeta, r1, z1) + call surfcoord( plasma, pi, zeta, r2, z2) Rmaj = half * (r1 + r2) z0 = half * (z1 + z2) diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index ff9741e..6529724 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -62,267 +62,252 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine fousurf - - use globals, only : dp, zero, half, pi2, myid, ounit, runit, input_surf, IsQuiet, IsSymmetric, & - Nfou, Nfp, NBnf, bim, bin, Bnim, Bnin, Rbc, Rbs, Zbc, Zbs, Bnc, Bns, & - Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw +subroutine fousurf(filename, index) + use globals, only : dp, zero, half, pi2, myid, ounit, runit, IsQuiet, IsSymmetric, & + Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw, Nfp, plasma + use mpi implicit none - - include "mpif.h" + + CHARACTER(LEN=100), INTENT(IN) :: filename + INTEGER, INTENT(IN) :: index !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - LOGICAL :: exist - INTEGER :: iosta, astat, ierr, ii, jj, imn + INTEGER :: iosta, astat, ierr, ii, jj, imn, Nfou, Nbnf REAL :: RR(0:2), ZZ(0:2), szeta, czeta, xx(1:3), xt(1:3), xz(1:3), ds(1:3), & teta, zeta, arg, dd - !-------------read plasma.boundary--------------------------------------------------------------------- - inquire( file=trim(input_surf), exist=exist) - FATAL( surface, .not.exist, plasma.boundary does not exist ) + ! read the header if( myid == 0 ) then - open(runit, file=trim(input_surf), status='old', action='read') + open(runit, file=trim(filename), status='old', action='read') read(runit,*) !empty line - read(runit,*) Nfou, Nfp, NBnf !read dimensions + read(runit,*) surf(index)%Nfou, surf(index)%Nfp, surf(index)%NBnf !read dimensions endif !Broadcast the values - IlBCAST( Nfou , 1, 0 ) - IlBCAST( Nfp , 1, 0 ) - IlBCAST( NBnf , 1, 0 ) - FATAL( surface, Nfou <= 0, invalid ) - FATAL( surface, Nfp <= 0, invalid ) - FATAL( surface, NBnf < 0, invalid ) + IlBCAST( surf(index)%Nfou , 1, 0 ) + IlBCAST( surf(index)%Nfp , 1, 0 ) + IlBCAST( surf(index)%NBnf , 1, 0 ) + FATAL( rdsurf, surf(index)%Nfou <= 0, invalid ) + FATAL( rdsurf, surf(index)%Nfp <= 0, invalid ) + FATAL( rdsurf, surf(index)%NBnf < 0, invalid ) + Nfou = surf(index)%Nfou + NBnf = surf(index)%NBnf !allocate arrays - SALLOCATE( bim, (1:Nfou), 0 ) - SALLOCATE( bin, (1:Nfou), 0 ) - SALLOCATE( Rbc, (1:Nfou), zero ) - SALLOCATE( Rbs, (1:Nfou), zero ) - SALLOCATE( Zbc, (1:Nfou), zero ) - SALLOCATE( Zbs, (1:Nfou), zero ) + SALLOCATE( surf(index)%bim, (1:Nfou), 0 ) + SALLOCATE( surf(index)%bin, (1:Nfou), 0 ) + SALLOCATE( surf(index)%Rbc, (1:Nfou), zero ) + SALLOCATE( surf(index)%Rbs, (1:Nfou), zero ) + SALLOCATE( surf(index)%Zbc, (1:Nfou), zero ) + SALLOCATE( surf(index)%Zbs, (1:Nfou), zero ) if( myid == 0 ) then read(runit,*) !empty line read(runit,*) !empty line - do imn = 1, Nfou - read(runit,*) bin(imn), bim(imn), Rbc(imn), Rbs(imn), Zbc(imn), Zbs(imn) + do imn = 1, surf(index)%Nfou + read(runit,*) surf(index)%bin(imn), surf(index)%bim(imn), surf(index)%Rbc(imn), & + & surf(index)%Rbs(imn), surf(index)%Zbc(imn), surf(index)%Zbs(imn) enddo endif - IlBCAST( bim(1:Nfou), Nfou, 0 ) - IlBCAST( bin(1:Nfou), Nfou, 0 ) + IlBCAST( surf(index)%bim(1:Nfou), surf(index)%Nfou, 0 ) + IlBCAST( surf(index)%bin(1:Nfou), surf(index)%Nfou, 0 ) - bin(1:Nfou) = bin(1:Nfou) * Nfp !The full plasma; + surf(index)%bin(1:Nfou) = surf(index)%bin(1:Nfou) * surf(index)%Nfp !The full plasma; - RlBCAST( Rbc(1:Nfou), Nfou, 0 ) - RlBCAST( Rbs(1:Nfou), Nfou, 0 ) - RlBCAST( Zbc(1:Nfou), Nfou, 0 ) - RlBCAST( Zbs(1:Nfou), Nfou, 0 ) + RlBCAST( surf(index)%Rbc(1:Nfou), surf(index)%Nfou, 0 ) + RlBCAST( surf(index)%Rbs(1:Nfou), surf(index)%Nfou, 0 ) + RlBCAST( surf(index)%Zbc(1:Nfou), surf(index)%Nfou, 0 ) + RlBCAST( surf(index)%Zbs(1:Nfou), surf(index)%Nfou, 0 ) !read Bnormal ditributions - if( NBnf > 0) then - SALLOCATE( Bnim, (1:NBnf), 0 ) - SALLOCATE( Bnin, (1:NBnf), 0 ) - SALLOCATE( Bnc , (1:NBnf), zero ) - SALLOCATE( Bns , (1:NBnf), zero ) + if( surf(index)%NBnf > 0) then + SALLOCATE( surf(index)%Bnim, (1:NBnf), 0 ) + SALLOCATE( surf(index)%Bnin, (1:NBnf), 0 ) + SALLOCATE( surf(index)%Bnc , (1:NBnf), zero ) + SALLOCATE( surf(index)%Bns , (1:NBnf), zero ) if( myid == 0 ) then read(runit,*) !empty line read(runit,*) !empty line - do imn = 1, NBnf - read(runit,*) Bnin(imn), Bnim(imn), Bnc(imn), Bns(imn) + do imn = 1, surf(index)%NBnf + read(runit,*) surf(index)%Bnin(imn), surf(index)%Bnim(imn), surf(index)%Bnc(imn), surf(index)%Bns(imn) enddo endif - IlBCAST( Bnim(1:NBnf), NBnf, 0 ) - IlBCAST( Bnin(1:NBnf), NBnf, 0 ) + IlBCAST( surf(index)%Bnim(1:NBnf), surf(index)%NBnf, 0 ) + IlBCAST( surf(index)%Bnin(1:NBnf), surf(index)%NBnf, 0 ) !if (IsSymmetric == 0) - Bnin(1:NBnf) = Bnin(1:NBnf) * Nfp ! Disarde periodicity; + surf(index)%Bnin(1:NBnf) = surf(index)%Bnin(1:NBnf) * surf(index)%Nfp ! periodicity; ! This should be consistent with bnftran; Before fully constructed the stellarator symmetry, ! it's turned off; - RlBCAST( Bnc(1:NBnf) , NBnf, 0 ) - RlBCAST( Bns(1:NBnf) , NBnf, 0 ) + RlBCAST( surf(index)%Bnc(1:NBnf) , surf(index)%NBnf, 0 ) + RlBCAST( surf(index)%Bns(1:NBnf) , surf(index)%NBnf, 0 ) endif if( myid == 0 ) close(runit,iostat=iosta) IlBCAST( iosta, 1, 0 ) - FATAL( surface, iosta.ne.0, error closing plasma.boundary ) + FATAL( surface, iosta.ne.0, error closing the surface ) !-------------output for check------------------------------------------------------------------------- if( myid == 0 .and. IsQuiet <= 0) then write(ounit, *) "-----------Reading surface-----------------------------------" - write(ounit, '("surface : Plasma boundary will be discretized in "I6" X "I6" elements.")') Nteta, Nzeta - write(ounit, '(8X": Nfou = " I06 " ; Nfp = " I06 " ; NBnf = " I06 " ;" )') Nfou, Nfp, NBnf + write(ounit, '("surface : The surface", A," will be discretized in "I6" X "I6" elements.")') trim(filename), Nteta, Nzeta + write(ounit, '(8X": Nfou = " I06 " ; Nfp = " I06 " ; NBnf = " I06 " ;" )') surf(index)%Nfou, surf(index)%Nfp, surf(index)%NBnf endif - if( myid == 0 .and. IsQuiet <= -2) then !very detailed output; - write(ounit,'(" : " 10x " : bim ="10i13 )') bim(1:Nfou) - write(ounit,'(" : " 10x " : bin ="10i13 )') bin(1:Nfou) - write(ounit,'(" : " 10x " : Rbc ="10es13.5)') Rbc(1:Nfou) - write(ounit,'(" : " 10x " : Rbs ="10es13.5)') Rbs(1:Nfou) - write(ounit,'(" : " 10x " : Zbc ="10es13.5)') Zbc(1:Nfou) - write(ounit,'(" : " 10x " : Zbs ="10es13.5)') Zbs(1:Nfou) + if( myid == 0 .and. IsQuiet <= -2) then ! very detailed output; + write(ounit,'(" : " 10x " : bim ="10i13 )') surf(index)%bim(1:Nfou) + write(ounit,'(" : " 10x " : bin ="10i13 )') surf(index)%bin(1:Nfou) + write(ounit,'(" : " 10x " : Rbc ="10es13.5)') surf(index)%Rbc(1:Nfou) + write(ounit,'(" : " 10x " : Rbs ="10es13.5)') surf(index)%Rbs(1:Nfou) + write(ounit,'(" : " 10x " : Zbc ="10es13.5)') surf(index)%Zbc(1:Nfou) + write(ounit,'(" : " 10x " : Zbs ="10es13.5)') surf(index)%Zbs(1:Nfou) if(Nbnf > 0) then - write(ounit,'(" : " 10x " : Bnim ="10i13 )') Bnim(1:NBnf) - write(ounit,'(" : " 10x " : Bnin ="10i13 )') Bnin(1:NBnf) - write(ounit,'(" : " 10x " : Bnc ="10es13.5)') Bnc (1:NBnf) - write(ounit,'(" : " 10x " : Bns ="10es13.5)') Bns (1:NBnf) + write(ounit,'(" : " 10x " : Bnim ="10i13 )') surf(index)%Bnim(1:NBnf) + write(ounit,'(" : " 10x " : Bnin ="10i13 )') surf(index)%Bnin(1:NBnf) + write(ounit,'(" : " 10x " : Bnc ="10es13.5)') surf(index)%Bnc (1:NBnf) + write(ounit,'(" : " 10x " : Bns ="10es13.5)') surf(index)%Bns (1:NBnf) endif endif - !-------------discretize surface data------------------------------------------------------------------ - - Nfp_raw = Nfp ! save the raw value of Nfp - select case (IsSymmetric) - case ( 0 ) - Nfp = 1 !reset Nfp to 1; - Npc = 1 !number of coils periodicity - case ( 1 ) !plasma periodicity enabled; - Npc = 1 - case ( 2 ) !plasma and coil periodicity enabled; - Npc = Nfp - end select - discretefactor = discretefactor/Nfp - - allocate( surf(1:1) ) ! can allow for myltiple plasma boundaries - ! if multiple currents are allowed; 14 Apr 16; + if (index == plasma) then + Nfp = surf(plasma)%Nfp + Nfp_raw = Nfp ! save the raw value of Nfp + select case (IsSymmetric) + case ( 0 ) + Nfp = 1 !reset Nfp to 1; + Npc = 1 !number of coils periodicity + case ( 1 ) !plasma periodicity enabled; + Npc = 1 + case ( 2 ) !plasma and coil periodicity enabled; + Npc = Nfp + end select + discretefactor = discretefactor/Nfp + endif - surf(1)%Nteta = Nteta ! not used yet; used for multiple surfaces; 20170307; - surf(1)%Nzeta = Nzeta ! not used yet; used for multiple surfaces; 20170307; + surf(index)%Nteta = Nteta ! not used yet; used for multiple surfaces; 20170307; + surf(index)%Nzeta = Nzeta ! not used yet; used for multiple surfaces; 20170307; - SALLOCATE( surf(1)%xx, (0:Nteta-1,0:Nzeta-1), zero ) !x coordinates; - SALLOCATE( surf(1)%yy, (0:Nteta-1,0:Nzeta-1), zero ) !y coordinates - SALLOCATE( surf(1)%zz, (0:Nteta-1,0:Nzeta-1), zero ) !z coordinates - SALLOCATE( surf(1)%nx, (0:Nteta-1,0:Nzeta-1), zero ) !unit nx; - SALLOCATE( surf(1)%ny, (0:Nteta-1,0:Nzeta-1), zero ) !unit ny; - SALLOCATE( surf(1)%nz, (0:Nteta-1,0:Nzeta-1), zero ) !unit nz; - SALLOCATE( surf(1)%ds, (0:Nteta-1,0:Nzeta-1), zero ) !jacobian; - SALLOCATE( surf(1)%xt, (0:Nteta-1,0:Nzeta-1), zero ) !dx/dtheta; - SALLOCATE( surf(1)%yt, (0:Nteta-1,0:Nzeta-1), zero ) !dy/dtheta; - SALLOCATE( surf(1)%zt, (0:Nteta-1,0:Nzeta-1), zero ) !dz/dtheta; - SALLOCATE( surf(1)%pb, (0:Nteta-1,0:Nzeta-1), zero ) !target Bn; - SALLOCATE( surf(1)%xp, (0:Nteta-1,0:Nzeta-1), zero ) !dx/dzeta; - SALLOCATE( surf(1)%yp, (0:Nteta-1,0:Nzeta-1), zero ) !dy/dzeta; - SALLOCATE( surf(1)%zp, (0:Nteta-1,0:Nzeta-1), zero ) !dz/dzeta; + SALLOCATE( surf(index)%xx, (0:Nteta-1,0:Nzeta-1), zero ) !x coordinates; + SALLOCATE( surf(index)%yy, (0:Nteta-1,0:Nzeta-1), zero ) !y coordinates + SALLOCATE( surf(index)%zz, (0:Nteta-1,0:Nzeta-1), zero ) !z coordinates + SALLOCATE( surf(index)%nx, (0:Nteta-1,0:Nzeta-1), zero ) !unit nx; + SALLOCATE( surf(index)%ny, (0:Nteta-1,0:Nzeta-1), zero ) !unit ny; + SALLOCATE( surf(index)%nz, (0:Nteta-1,0:Nzeta-1), zero ) !unit nz; + SALLOCATE( surf(index)%ds, (0:Nteta-1,0:Nzeta-1), zero ) !jacobian; + SALLOCATE( surf(index)%xt, (0:Nteta-1,0:Nzeta-1), zero ) !dx/dtheta; + SALLOCATE( surf(index)%yt, (0:Nteta-1,0:Nzeta-1), zero ) !dy/dtheta; + SALLOCATE( surf(index)%zt, (0:Nteta-1,0:Nzeta-1), zero ) !dz/dtheta; + SALLOCATE( surf(index)%pb, (0:Nteta-1,0:Nzeta-1), zero ) !target Bn; + SALLOCATE( surf(index)%xp, (0:Nteta-1,0:Nzeta-1), zero ) !dx/dzeta; + SALLOCATE( surf(index)%yp, (0:Nteta-1,0:Nzeta-1), zero ) !dy/dzeta; + SALLOCATE( surf(index)%zp, (0:Nteta-1,0:Nzeta-1), zero ) !dz/dzeta; - surf(1)%vol = zero ! volume enclosed by plasma boundary - surf(1)%area = zero ! surface area + surf(index)%vol = zero ! volume enclosed by plasma boundary + surf(index)%area = zero ! surface area -! The center point value was used to discretize grid; - do ii = 0, Nteta-1; teta = ( ii + half ) * pi2 / Nteta - do jj = 0, Nzeta-1; zeta = ( jj + half ) * pi2 / ( Nzeta*Nfp ) - - RR(0:2) = zero ; ZZ(0:2) = zero - - do imn = 1, Nfou ; arg = bim(imn) * teta - bin(imn) * zeta - - RR(0) = RR(0) + Rbc(imn) * cos(arg) + Rbs(imn) * sin(arg) - ZZ(0) = ZZ(0) + Zbc(imn) * cos(arg) + Zbs(imn) * sin(arg) - - RR(1) = RR(1) + ( - Rbc(imn) * sin(arg) + Rbs(imn) * cos(arg) ) * bim(imn) - ZZ(1) = ZZ(1) + ( - Zbc(imn) * sin(arg) + Zbs(imn) * cos(arg) ) * bim(imn) - - RR(2) = RR(2) - ( - Rbc(imn) * sin(arg) + Rbs(imn) * cos(arg) ) * bin(imn) - ZZ(2) = ZZ(2) - ( - Zbc(imn) * sin(arg) + Zbs(imn) * cos(arg) ) * bin(imn) - - enddo ! end of do imn; 30 Oct 15; - - szeta = sin(zeta) - czeta = cos(zeta) - - xx(1:3) = (/ RR(0) * czeta, RR(0) * szeta, ZZ(0) /) - xt(1:3) = (/ RR(1) * czeta, RR(1) * szeta, ZZ(1) /) - xz(1:3) = (/ RR(2) * czeta, RR(2) * szeta, ZZ(2) /) + (/ - RR(0) * szeta, RR(0) * czeta, zero /) - - ds(1:3) = -(/ xt(2) * xz(3) - xt(3) * xz(2), & ! minus sign for theta counterclockwise direction; - xt(3) * xz(1) - xt(1) * xz(3), & - xt(1) * xz(2) - xt(2) * xz(1) /) - - dd = sqrt( sum( ds(1:3)*ds(1:3) ) ) - - ! x, y, z coordinates for the surface; - surf(1)%xx(ii,jj) = xx(1) - surf(1)%yy(ii,jj) = xx(2) - surf(1)%zz(ii,jj) = xx(3) - - ! dx/dt, dy/dt, dz/dt (dt for d theta) - surf(1)%xt(ii,jj) = xt(1) - surf(1)%yt(ii,jj) = xt(2) - surf(1)%zt(ii,jj) = xt(3) - - ! dx/dp, dy/dp, dz/dp (dp for d zeta(phi)) - surf(1)%xp(ii,jj) = xz(1) - surf(1)%yp(ii,jj) = xz(2) - surf(1)%zp(ii,jj) = xz(3) - - ! surface normal vectors and ds for the jacobian; - surf(1)%nx(ii,jj) = ds(1) / dd - surf(1)%ny(ii,jj) = ds(2) / dd - surf(1)%nz(ii,jj) = ds(3) / dd - surf(1)%ds(ii,jj) = dd - - ! using Gauss theorom; V = \int_S x \cdot n dt dz - surf(1)%vol = surf(1)%vol + surf(1)%xx(ii,jj) * ds(1) - - ! surface area - surf(1)%area = surf(1)%area + surf(1)%ds(ii,jj) - - enddo ! end of do jj; 14 Apr 16; + ! The center point value was used to discretize grid; + do ii = 0, Nteta-1 + teta = ( ii + half ) * pi2 / Nteta + do jj = 0, Nzeta-1 + zeta = ( jj + half ) * pi2 / ( Nzeta*Nfp ) + RR(0:2) = zero ; ZZ(0:2) = zero + do imn = 1, surf(index)%Nfou + arg = surf(index)%bim(imn) * teta - surf(index)%bin(imn) * zeta + RR(0) = RR(0) + surf(index)%Rbc(imn) * cos(arg) + surf(index)%Rbs(imn) * sin(arg) + ZZ(0) = ZZ(0) + surf(index)%Zbc(imn) * cos(arg) + surf(index)%Zbs(imn) * sin(arg) + RR(1) = RR(1) + ( - surf(index)%Rbc(imn) * sin(arg) + surf(index)%Rbs(imn) * cos(arg) ) * surf(index)%bim(imn) + ZZ(1) = ZZ(1) + ( - surf(index)%Zbc(imn) * sin(arg) + surf(index)%Zbs(imn) * cos(arg) ) * surf(index)%bim(imn) + RR(2) = RR(2) - ( - surf(index)%Rbc(imn) * sin(arg) + surf(index)%Rbs(imn) * cos(arg) ) * surf(index)%bin(imn) + ZZ(2) = ZZ(2) - ( - surf(index)%Zbc(imn) * sin(arg) + surf(index)%Zbs(imn) * cos(arg) ) * surf(index)%bin(imn) + enddo ! end of do imn; 30 Oct 15; + szeta = sin(zeta) + czeta = cos(zeta) + xx(1:3) = (/ RR(0) * czeta, RR(0) * szeta, ZZ(0) /) + xt(1:3) = (/ RR(1) * czeta, RR(1) * szeta, ZZ(1) /) + xz(1:3) = (/ RR(2) * czeta, RR(2) * szeta, ZZ(2) /) + (/ - RR(0) * szeta, RR(0) * czeta, zero /) + ds(1:3) = -(/ xt(2) * xz(3) - xt(3) * xz(2), & ! minus sign for theta counterclockwise direction; + xt(3) * xz(1) - xt(1) * xz(3), & + xt(1) * xz(2) - xt(2) * xz(1) /) + dd = sqrt( sum( ds(1:3)*ds(1:3) ) ) + ! x, y, z coordinates for the surface; + surf(index)%xx(ii,jj) = xx(1) + surf(index)%yy(ii,jj) = xx(2) + surf(index)%zz(ii,jj) = xx(3) + ! dx/dt, dy/dt, dz/dt (dt for d theta) + surf(index)%xt(ii,jj) = xt(1) + surf(index)%yt(ii,jj) = xt(2) + surf(index)%zt(ii,jj) = xt(3) + ! dx/dp, dy/dp, dz/dp (dp for d zeta(phi)) + surf(index)%xp(ii,jj) = xz(1) + surf(index)%yp(ii,jj) = xz(2) + surf(index)%zp(ii,jj) = xz(3) + ! surface normal vectors and ds for the jacobian; + surf(index)%nx(ii,jj) = ds(1) / dd + surf(index)%ny(ii,jj) = ds(2) / dd + surf(index)%nz(ii,jj) = ds(3) / dd + surf(index)%ds(ii,jj) = dd + ! using Gauss theorom; V = \int_S x \cdot n dt dz + surf(index)%vol = surf(index)%vol + surf(index)%xx(ii,jj) * ds(1) + ! surface area + surf(index)%area = surf(index)%area + surf(index)%ds(ii,jj) + enddo ! end of do jj; 14 Apr 16; enddo ! end of do ii; 14 Apr 16; - surf(1)%vol = abs(surf(1)%vol ) * discretefactor * Nfp - surf(1)%area = abs(surf(1)%area) * discretefactor * Nfp + ! print volume and area + surf(index)%vol = abs(surf(index)%vol ) * discretefactor * Nfp + surf(index)%area = abs(surf(index)%area) * discretefactor * Nfp if( myid == 0 .and. IsQuiet <= 0) then - write(ounit, '(8X": Enclosed total plasma volume ="ES12.5" m^3 ; area ="ES12.5" m^2." )') & - surf(1)%vol, surf(1)%area + write(ounit, '(8X": Enclosed total surface volume ="ES12.5" m^3 ; area ="ES12.5" m^2." )') & + surf(index)%vol, surf(index)%area endif !calculate target Bn with input harmonics; 05 Jan 17; - if(NBnf > 0) then - - do jj = 0, Nzeta-1 ; zeta = ( jj + half ) * pi2 / (Nzeta*Nfp) - do ii = 0, Nteta-1 ; teta = ( ii + half ) * pi2 / Nteta - do imn = 1, NBnf - arg = Bnim(imn) * teta - Bnin(imn) * zeta - surf(1)%pb(ii,jj) = surf(1)%pb(ii,jj) + Bnc(imn)*cos(arg) + Bns(imn)*sin(arg) + if(surf(index)%NBnf > 0) then + do jj = 0, Nzeta-1 + zeta = ( jj + half ) * pi2 / (Nzeta*Nfp) + do ii = 0, Nteta-1 + teta = ( ii + half ) * pi2 / Nteta + do imn = 1, surf(index)%NBnf + arg = surf(index)%Bnim(imn) * teta - surf(index)%Bnin(imn) * zeta + surf(index)%pb(ii,jj) = surf(index)%pb(ii,jj) + surf(index)%Bnc(imn)*cos(arg) + surf(index)%Bns(imn)*sin(arg) enddo enddo enddo - endif - return end subroutine fousurf !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine surfcoord( theta, zeta, r, z) - use globals, only: dp, zero, Nfou, bim, bin, Rbc, Rbs, Zbc, Zbs +subroutine surfcoord( index, theta, zeta, r, z) + use globals, only: dp, zero, surf + use mpi implicit none - include "mpif.h" + INTEGER, INTENT(in) :: index REAL, INTENT(in ) :: theta, zeta REAL, INTENT(out) :: r, z INTEGER :: imn REAL :: arg !-------------calculate r, z coodinates for theta, zeta------------------------------------------------ - if( .not. allocated(bim) ) STOP "please allocate surface data first!" + if( .not. allocated(surf(index)%bim) ) STOP "please allocate surface data first!" r = zero; z = zero - do imn = 1, Nfou - arg = bim(imn) * theta - bin(imn) * zeta - R = R + Rbc(imn) * cos(arg) + Rbs(imn) * sin(arg) - Z = Z + Zbc(imn) * cos(arg) + Zbs(imn) * sin(arg) + do imn = 1, surf(index)%Nfou + arg = surf(index)%bim(imn) * theta - surf(index)%bin(imn) * zeta + R = R + surf(index)%Rbc(imn) * cos(arg) + surf(index)%Rbs(imn) * sin(arg) + Z = Z + surf(index)%Zbc(imn) * cos(arg) + surf(index)%Zbs(imn) * sin(arg) enddo return diff --git a/sources/saving.f90 b/sources/saving.f90 index 38e90c9..14ba683 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -131,21 +131,21 @@ subroutine saving HWRITERV( 1 , pp_xtol , pp_xtol ) HWRITEIV( 1 , Nfp , Nfp_raw ) - HWRITERV( 1 , surf_vol , surf(1)%vol ) - HWRITERA( Nteta,Nzeta , xsurf , surf(1)%xx(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , ysurf , surf(1)%yy(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , zsurf , surf(1)%zz(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , nx , surf(1)%nx(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , ny , surf(1)%ny(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , nz , surf(1)%nz(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , nn , surf(1)%ds(0:Nteta-1,0:Nzeta-1) ) + HWRITERV( 1 , surf_vol , surf(plasma)%vol ) + HWRITERA( Nteta,Nzeta , xsurf , surf(plasma)%xx(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , ysurf , surf(plasma)%yy(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , zsurf , surf(plasma)%zz(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , nx , surf(plasma)%nx(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , ny , surf(plasma)%ny(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , nz , surf(plasma)%nz(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , nn , surf(plasma)%ds(0:Nteta-1,0:Nzeta-1) ) if (allocated(bn)) then - HWRITERA( Nteta,Nzeta , plas_Bn , surf(1)%pb(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , Bn , surf(1)%bn(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , Bx , surf(1)%Bx(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , By , surf(1)%By(0:Nteta-1,0:Nzeta-1) ) - HWRITERA( Nteta,Nzeta , Bz , surf(1)%Bz(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , plas_Bn , surf(plasma)%pb(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , Bn , surf(plasma)%bn(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , Bx , surf(plasma)%Bx(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , By , surf(plasma)%By(0:Nteta-1,0:Nzeta-1) ) + HWRITERA( Nteta,Nzeta , Bz , surf(plasma)%Bz(0:Nteta-1,0:Nzeta-1) ) endif HWRITEIV( 1 , iout , iout ) @@ -331,7 +331,7 @@ SUBROUTINE write_plasma ! CZHU; first version: 2017/01/11; last revised: 2017/01/11 ! !-------------------------------------------------------------------------------! use globals, only : dp, zero, half, two, pi2, myid, ncpu, ounit, wunit, ext, & - Nfou, Nfp, NBnf, bim, bin, Bnim, Bnin, Rbc, Rbs, Zbc, Zbs, Bnc, Bns, & + plasma, & Nteta, Nzeta, surf, Nfp_raw, bnorm, sqrtmachprec, out_plasma implicit none @@ -339,10 +339,12 @@ SUBROUTINE write_plasma !------------------------------------------------------------------------------- INTEGER :: mf, nf ! predefined Fourier modes size - INTEGER :: imn=0, ii, jj, im, in, astat, ierr, maxN, maxM + INTEGER :: imn=0, ii, jj, im, in, astat, ierr, maxN, maxM, isurf REAL :: teta, zeta, arg, tol, tmpc, tmps !------------------------------------------------------------------------------- + ! use plasma as default + isurf = plasma mf = 24 ; nf = 24 FATAL(bnftran, mf .le. 0 .and. nf .le. 0, INVALID size for Fourier harmonics) @@ -356,19 +358,19 @@ SUBROUTINE write_plasma if(myid .ne. 0) return - if(Nbnf .gt. 0) then ! if there is input Bn target - DALLOCATE(bnim) - DALLOCATE(bnin) - DALLOCATE(bnc ) - DALLOCATE(bns ) + if(surf(isurf)%Nbnf .gt. 0) then ! if there is input Bn target + DALLOCATE(surf(isurf)%bnim) + DALLOCATE(surf(isurf)%bnin) + DALLOCATE(surf(isurf)%bnc ) + DALLOCATE(surf(isurf)%bns ) endif - Nbnf = (mf+1)*(2*nf+1) ! (0:mf)*(-nf:nf) + surf(isurf)%Nbnf = (mf+1)*(2*nf+1) ! (0:mf)*(-nf:nf) - SALLOCATE( bnim, (1:Nbnf), 0 ) - SALLOCATE( bnin, (1:Nbnf), 0 ) - SALLOCATE( bnc , (1:Nbnf), zero ) - SALLOCATE( bns , (1:Nbnf), zero ) + SALLOCATE( surf(isurf)%bnim, (1:surf(isurf)%Nbnf), 0 ) + SALLOCATE( surf(isurf)%bnin, (1:surf(isurf)%Nbnf), 0 ) + SALLOCATE( surf(isurf)%bnc , (1:surf(isurf)%Nbnf), zero ) + SALLOCATE( surf(isurf)%bns , (1:surf(isurf)%Nbnf), zero ) imn = 0 do in = -nf, nf @@ -381,8 +383,8 @@ SUBROUTINE write_plasma zeta = ( jj + half ) * pi2 / Nzeta arg = im*teta - in*Nfp_raw*zeta - tmpc = tmpc + surf(1)%bn(ii,jj)*cos(arg) - tmps = tmps + surf(1)%bn(ii,jj)*sin(arg) + tmpc = tmpc + surf(isurf)%bn(ii,jj)*cos(arg) + tmps = tmps + surf(isurf)%bn(ii,jj)*sin(arg) enddo ! end jj enddo ! end ii @@ -390,41 +392,44 @@ SUBROUTINE write_plasma if ( (abs(tmpc) + abs(tmps)) .lt. tol ) cycle imn = imn + 1 - bnin(imn) = in * Nfp_raw ; bnim(imn) = im + surf(isurf)%bnin(imn) = in * Nfp_raw + surf(isurf)%bnim(imn) = im if (im .eq. 0 ) then tmpc = tmpc*half tmps = tmps*half endif - bnc(imn) = tmpc - bns(imn) = tmps + surf(isurf)%bnc(imn) = tmpc + surf(isurf)%bns(imn) = tmps enddo ! end im enddo ! end in - Nbnf = imn + surf(isurf)%Nbnf = imn - bnc = bnc * two / (Nteta*Nzeta) - bns = bns * two / (Nteta*Nzeta) + surf(isurf)%bnc = surf(isurf)%bnc * two / (Nteta*Nzeta) + surf(isurf)%bns = surf(isurf)%bns * two / (Nteta*Nzeta) !---------------------------------------------- open(wunit, file=trim(out_plasma), status='unknown', action='write') write(wunit,* ) "#Nfou Nfp Nbnf" - write(wunit,'(3I6)' ) Nfou, Nfp_raw, Nbnf + write(wunit,'(3I6)' ) surf(isurf)%Nfou, Nfp_raw, surf(isurf)%Nbnf write(wunit,* ) "#------- plasma boundary------" write(wunit,* ) "# n m Rbc Rbs Zbc Zbs" - do imn = 1, Nfou - write(wunit,'(2I6, 4ES15.6)') bin(imn)/Nfp_raw, bim(imn), Rbc(imn), Rbs(imn), Zbc(imn), Zbs(imn) + do imn = 1, surf(isurf)%Nfou + write(wunit,'(2I6, 4ES15.6)') surf(isurf)%bin(imn)/Nfp_raw, surf(isurf)%bim(imn), surf(isurf)%Rbc(imn), & + surf(isurf)%Rbs(imn), surf(isurf)%Zbc(imn), surf(isurf)%Zbs(imn) enddo write(wunit,* ) "#-------Bn harmonics----------" write(wunit,* ) "# n m bnc bns" - if (Nbnf .gt. 0) then - do imn = 1, Nbnf - write(wunit,'(2I6, 2ES15.6)') bnin(imn)/Nfp_raw, bnim(imn), bnc(imn), bns(imn) + if (surf(isurf)%Nbnf .gt. 0) then + do imn = 1, surf(isurf)%Nbnf + write(wunit,'(2I6, 2ES15.6)') surf(isurf)%bnin(imn)/Nfp_raw, surf(isurf)%bnim(imn), & + surf(isurf)%bnc(imn), surf(isurf)%bns(imn) enddo else write(wunit,'(2I6, 2ES15.6)') 0, 0, 0.0, 0.0 diff --git a/sources/specinp.f90 b/sources/specinp.f90 index b24894e..11bca0a 100644 --- a/sources/specinp.f90 +++ b/sources/specinp.f90 @@ -7,16 +7,19 @@ SUBROUTINE specinp ! 3. Write down a xxx.Vns file with all the information for SPEC !-------------------------------------------------------------------------------! use globals, only: dp, zero, half, two, pi2, mu0, myid, wunit, ounit, surf, bn, ext, & - Nfou, Nfp_raw, bim, bin, Rbc, Rbs, Zbc, Zbs, Nteta, Nzeta + Nfp_raw, Nteta, Nzeta, plasma implicit none include "mpif.h" !------------------------------------------------------------------------------- INTEGER :: mf, nf ! Fourier modes size - INTEGER :: imn=0, ii, jj, im, in, astat, ierr, Nbf, iteta, jzeta + INTEGER :: imn=0, ii, jj, im, in, astat, ierr, Nbf, iteta, jzeta, isurf REAL :: teta, zeta, arg, tol, tmpc, tmps, curtor, curpol INTEGER, allocatable:: bnim(:), bnin(:) REAL , allocatable:: bnc(:), bns(:) + ! use the plasma for now; could be the limiter surface; 2019/12/15 + isurf = plasma + ! default Fourier resolution; could be customized mf = 24 ; nf = 12 ! compute Bn call bnormal(0) ! calculate Bn @@ -38,8 +41,8 @@ SUBROUTINE specinp do jj = 0, Nzeta-1 zeta = ( jj + half ) * pi2 / Nzeta arg = im*teta - in*Nfp_raw*zeta - tmpc = tmpc + (-bn(ii, jj)*surf(1)%ds(ii,jj))*cos(arg) ! minus sign is required because - tmps = tmps + (-bn(ii, jj)*surf(1)%ds(ii,jj))*sin(arg) ! the normal vector in SPEC is e_t x e_z + tmpc = tmpc + (-bn(ii, jj)*surf(isurf)%ds(ii,jj))*cos(arg) ! minus sign is required because + tmps = tmps + (-bn(ii, jj)*surf(isurf)%ds(ii,jj))*sin(arg) ! the normal vector in SPEC is e_t x e_z enddo ! end jj enddo ! end ii @@ -71,17 +74,17 @@ SUBROUTINE specinp jzeta = 0 do iteta = 0, Nteta-1 - curtor = curtor + surf(1)%Bx(iteta,jzeta)*surf(1)%xt(iteta,jzeta) & - & + surf(1)%By(iteta,jzeta)*surf(1)%yt(iteta,jzeta) & - & + surf(1)%Bz(iteta,jzeta)*surf(1)%zt(iteta,jzeta) + curtor = curtor + surf(isurf)%Bx(iteta,jzeta)*surf(isurf)%xt(iteta,jzeta) & + & + surf(isurf)%By(iteta,jzeta)*surf(isurf)%yt(iteta,jzeta) & + & + surf(isurf)%Bz(iteta,jzeta)*surf(isurf)%zt(iteta,jzeta) enddo curtor = curtor * pi2/Nteta ! / mu0 ! SPEC currents are normalized with mu0 iteta = 0 do jzeta = 0, Nzeta-1 - curpol = curpol + surf(1)%Bx(iteta,jzeta)*surf(1)%xp(iteta,jzeta) & - & + surf(1)%By(iteta,jzeta)*surf(1)%yp(iteta,jzeta) & - & + surf(1)%Bz(iteta,jzeta)*surf(1)%zp(iteta,jzeta) + curpol = curpol + surf(isurf)%Bx(iteta,jzeta)*surf(isurf)%xp(iteta,jzeta) & + & + surf(isurf)%By(iteta,jzeta)*surf(isurf)%yp(iteta,jzeta) & + & + surf(isurf)%Bz(iteta,jzeta)*surf(isurf)%zp(iteta,jzeta) enddo curpol = curpol * pi2/Nzeta @@ -102,9 +105,11 @@ SUBROUTINE specinp write(wunit,'(" curtor = ",es23.15 )') curtor write(wunit,'(" curpol = ",es23.15 )') curpol write(wunit,'(" Nfp = ",i9 )') Nfp_raw - do imn = 1, Nfou - write(wunit,1010) bin(imn)/Nfp_raw, bim(imn), Rbc(imn), bin(imn)/Nfp_raw, bim(imn), Zbs(imn), & - bin(imn/Nfp_raw), bim(imn), Rbs(imn), bin(imn)/Nfp_raw, bim(imn), Zbc(imn) ! wall is read as plasma boundary + do imn = 1, surf(isurf)%Nfou + write(wunit,1010) surf(isurf)%bin(imn)/Nfp_raw, surf(isurf)%bim(imn), surf(isurf)%Rbc(imn), & + surf(isurf)%bin(imn)/Nfp_raw, surf(isurf)%bim(imn), surf(isurf)%Zbs(imn), & + surf(isurf)%bin(imn/Nfp_raw), surf(isurf)%bim(imn), surf(isurf)%Rbs(imn), & + surf(isurf)%bin(imn)/Nfp_raw, surf(isurf)%bim(imn), surf(isurf)%Zbc(imn) ! wall is read as plasma boundary enddo do imn = 1, Nbf write(wunit,1020) bnin(imn), bnim(imn), bns(imn), bnin(imn), bnim(imn), zero, & diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 5d5a887..edd0fb5 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -98,7 +98,7 @@ subroutine torflux( ideriv ) use globals, only: dp, zero, half, one, pi2, sqrtmachprec, bsconstant, ncpu, myid, ounit, & coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, Cdof, Npc, & tflux, t1F, t2F, Ndof, psi_avg, target_tflux, & - itflux, mtflux, LM_fvec, LM_fjac, weight_tflux + itflux, mtflux, LM_fvec, LM_fjac, weight_tflux, plasma implicit none include "mpif.h" @@ -106,7 +106,7 @@ subroutine torflux( ideriv ) INTEGER, INTENT(in) :: ideriv !-------------------------------------------------------------------------------------------- INTEGER :: astat, ierr - INTEGER :: icoil, iteta, jzeta, idof, ND, ip + INTEGER :: icoil, iteta, jzeta, idof, ND, ip, isurf REAL :: dflux, lflux, lsum REAL :: lax, lay, laz ! local Ax, Ay and Az REAL, dimension(0:Cdof, 0:Cdof) :: dAx, dAy, dAz ! dA of each coil; @@ -135,9 +135,9 @@ subroutine torflux( ideriv ) enddo ! end do icoil enddo ! end do ip; - lflux = lflux + lax * surf(1)%xt(iteta,jzeta) + & ! local flux; - lay * surf(1)%yt(iteta,jzeta) + & - laz * surf(1)%zt(iteta,jzeta) + lflux = lflux + lax * surf(isurf)%xt(iteta,jzeta) + & ! local flux; + lay * surf(isurf)%yt(iteta,jzeta) + & + laz * surf(isurf)%zt(iteta,jzeta) enddo ! end do iteta lflux = lflux * pi2/Nteta ! discretization factor; lsum = lsum + lflux @@ -183,9 +183,9 @@ subroutine torflux( ideriv ) & dAx(0,0), dAy(0,0), dAz(0,0)) ldF(idof+1, jzeta) = ldF(idof+1, jzeta) & - & + bsconstant * ( dAx(0,0)*surf(1)%xt(iteta,jzeta) & - & + dAy(0,0)*surf(1)%yt(iteta,jzeta) & - & + dAz(0,0)*surf(1)%zt(iteta,jzeta) ) + & + bsconstant * ( dAx(0,0)*surf(isurf)%xt(iteta,jzeta) & + & + dAy(0,0)*surf(isurf)%yt(iteta,jzeta) & + & + dAz(0,0)*surf(isurf)%zt(iteta,jzeta) ) idof = idof +1 endif @@ -194,9 +194,9 @@ subroutine torflux( ideriv ) & dAx(1:ND,0), dAy(1:ND,0), dAz(1:ND,0), ND) ldF(idof+1:idof+ND, jzeta) = ldF(idof+1:idof+ND, jzeta) & - & + bsconstant * coil(icoil)%I * ( dAx(1:ND,0)*surf(1)%xt(iteta,jzeta) & - & + dAy(1:ND,0)*surf(1)%yt(iteta,jzeta) & - & + dAz(1:ND,0)*surf(1)%zt(iteta,jzeta) ) + & + bsconstant * coil(icoil)%I * ( dAx(1:ND,0)*surf(isurf)%xt(iteta,jzeta) & + & + dAy(1:ND,0)*surf(isurf)%yt(iteta,jzeta) & + & + dAz(1:ND,0)*surf(isurf)%zt(iteta,jzeta) ) idof = idof + ND endif @@ -244,7 +244,7 @@ subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, Npc, & - zero, myid, ounit + zero, myid, ounit, plasma implicit none include "mpif.h" @@ -253,7 +253,7 @@ subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat, kseg + INTEGER :: ierr, astat, kseg, isurf REAL :: dlx, dly, dlz, rm, ltx, lty, ltz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -268,9 +268,9 @@ subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) do kseg = 0, coil(icoil)%NS-1 - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + dlx = surf(isurf)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) + dly = surf(isurf)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) + dlz = surf(isurf)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) rm = 1.0 / sqrt(dlx**2 + dly**2 + dlz**2) ltx = coil(icoil)%xt(kseg) @@ -297,7 +297,7 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, Npc, & - zero, myid, ounit + zero, myid, ounit, plasma implicit none include "mpif.h" @@ -306,7 +306,7 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat, kseg, NS + INTEGER :: ierr, astat, kseg, NS, isurf REAL :: dlx, dly, dlz, r, rm3, ltx, lty, ltz REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dAxx, dAxy, dAxz, dAyx, dAyy, dAyz, dAzx, dAzy, dAzz @@ -328,9 +328,9 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) do kseg = 0, NS-1 - dlx = surf(1)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(1)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(1)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) + dlx = surf(isurf)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) + dly = surf(isurf)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) + dlz = surf(isurf)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) r = sqrt(dlx**2 + dly**2 + dlz**2); rm3 = r**(-3) From 48ed6a28d937e2746e5e8f07ec797fb6ec87d176 Mon Sep 17 00:00:00 2001 From: CaoXiang ZHU Date: Mon, 16 Dec 2019 10:23:56 -0500 Subject: [PATCH 51/72] update version number --- sources/globals.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index c9655e8..74367a9 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.9.00' ! version number + CHARACTER(LEN=10), parameter :: version='v0.10.00' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From 878353613d6593a61d9a4226608d880bdcf1c7cc Mon Sep 17 00:00:00 2001 From: CaoXiang ZHU Date: Mon, 6 Jan 2020 13:48:16 -0500 Subject: [PATCH 52/72] add surface.f90 --- .gitignore | 2 +- sources/surface.f90 | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 sources/surface.f90 diff --git a/.gitignore b/.gitignore index 3ba476b..9ef7797 100644 --- a/.gitignore +++ b/.gitignore @@ -7,7 +7,7 @@ *.[oa] *.mod -*.F90 +*_m.F90 *.pyc *.log *.h5 diff --git a/sources/surface.f90 b/sources/surface.f90 new file mode 100644 index 0000000..c6ad2b1 --- /dev/null +++ b/sources/surface.f90 @@ -0,0 +1,36 @@ +! This is the overall function to handle surfaces +SUBROUTINE surface + use globals, only : dp, myid, ounit, machprec, surf, plasma, limiter, input_surf, limiter_surf, & + psurf, weight_cssep + use mpi + implicit none + + LOGICAL :: exist + INTEGER :: iosta, astat, ierr + + ! determine the total number of surfaces + if ( weight_cssep > machprec .and. trim(limiter_surf) /= 'none' ) then + plasma = 1 + limiter = 2 + else ! use the plasma surface as limiter + plasma = 1 + limiter = 1 + endif + allocate(surf(plasma:limiter)) + psurf = limiter + + ! read the plasma surface + inquire( file=trim(input_surf), exist=exist) + FATAL( surface, .not.exist, input_surf does not exist ) + call fousurf( input_surf, plasma ) + + ! read the limiter surface + if (limiter /= plasma) then + inquire( file=trim(limiter_surf), exist=exist) + FATAL( surface, .not.exist, limiter_surf does not exist ) + FATAL( surface, limiter <= plasma, something goes wrong the surface indexing ) + call fousurf( limiter_surf, limiter ) + endif + + RETURN +END SUBROUTINE surface From 523d4d585de49d1c782229149fd9c4e1ec26a3c4 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Fri, 10 Jan 2020 18:01:38 -0500 Subject: [PATCH 53/72] fix toroidal flux sign error --- sources/globals.f90 | 1 + sources/rdsurf.f90 | 17 +++++++++++++++-- sources/torflux.f90 | 6 +++--- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index 561f1d7..2d2a4d5 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -311,6 +311,7 @@ module globals REAL , allocatable :: t1H(:), t2H(:,:), Bmnc(:),Bmns(:), wBmn(:), tBmnc(:), tBmns(:), & carg(:,:), sarg(:,:), iBmnc(:), iBmns(:) ! Tflux error; + INTEGER :: tflux_sign = -1 ! default theta : counter-clockwise REAL :: tflux, psi_avg REAL , allocatable :: t1F(:), t2F(:,:) ! Length constraint diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index ff9741e..b701f41 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -66,7 +66,7 @@ subroutine fousurf use globals, only : dp, zero, half, pi2, myid, ounit, runit, input_surf, IsQuiet, IsSymmetric, & Nfou, Nfp, NBnf, bim, bin, Bnim, Bnin, Rbc, Rbs, Zbc, Zbs, Bnc, Bns, & - Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw + Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw, tflux_sign implicit none @@ -77,7 +77,7 @@ subroutine fousurf LOGICAL :: exist INTEGER :: iosta, astat, ierr, ii, jj, imn REAL :: RR(0:2), ZZ(0:2), szeta, czeta, xx(1:3), xt(1:3), xz(1:3), ds(1:3), & - teta, zeta, arg, dd + teta, zeta, arg, dd, theta0, zeta0, r0, z0 !-------------read plasma.boundary--------------------------------------------------------------------- inquire( file=trim(input_surf), exist=exist) @@ -279,6 +279,19 @@ subroutine fousurf surf(1)%vol = abs(surf(1)%vol ) * discretefactor * Nfp surf(1)%area = abs(surf(1)%area) * discretefactor * Nfp + + theta0 = 0.1_dp ; zeta0 = zero + call surfcoord( theta0, zeta0, r0, z0 ) + if (z0 > 0) then + ! counter-clockwise + if( myid == 0) write(ounit, '(8X": The theta angle used is counter-clockwise.")') + tflux_sign = -1 + else + ! clockwise + if( myid == 0) write(ounit, '(8X": The theta angle used is clockwise.")') + tflux_sign = 1 + endif + if( myid == 0 .and. IsQuiet <= 0) then write(ounit, '(8X": Enclosed total plasma volume ="ES12.5" m^3 ; area ="ES12.5" m^2." )') & surf(1)%vol, surf(1)%area diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 5d5a887..df9ac63 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -97,7 +97,7 @@ subroutine torflux( ideriv ) !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, half, one, pi2, sqrtmachprec, bsconstant, ncpu, myid, ounit, & coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, Cdof, Npc, & - tflux, t1F, t2F, Ndof, psi_avg, target_tflux, & + tflux, t1F, t2F, Ndof, psi_avg, target_tflux, tflux_sign, & itflux, mtflux, LM_fvec, LM_fjac, weight_tflux implicit none @@ -139,7 +139,7 @@ subroutine torflux( ideriv ) lay * surf(1)%yt(iteta,jzeta) + & laz * surf(1)%zt(iteta,jzeta) enddo ! end do iteta - lflux = lflux * pi2/Nteta ! discretization factor; + lflux = lflux * pi2/Nteta * tflux_sign ! discretization factor; lsum = lsum + lflux ldiff(jzeta) = lflux - target_tflux dflux = dflux + ldiff(jzeta)**2 @@ -208,7 +208,7 @@ subroutine torflux( ideriv ) enddo !end iteta; enddo !end jzeta - ldF = ldF * pi2/Nteta + ldF = ldF * pi2/Nteta * tflux_sign call MPI_BARRIER( MPI_COMM_WORLD, ierr ) call MPI_REDUCE(ldF, dF, Ndof*Nzeta, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) From 5a910b5a89497f165de1b60db371a71100783975 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sat, 11 Jan 2020 19:51:47 -0500 Subject: [PATCH 54/72] update version number to v0.9.01 --- sources/globals.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index 2d2a4d5..4481c25 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.9.00' ! version number + CHARACTER(LEN=10), parameter :: version='v0.9.01' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! From 39fd7ea9d1b26738bdc6d7e9eec222ee6fd27cbf Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 16 Jan 2020 11:55:08 -0500 Subject: [PATCH 55/72] merge coil%itype changes --- sources/bfield.f90 | 4 ++-- sources/bnormal.f90 | 4 +++- sources/datalloc.f90 | 22 +++++++++++----------- sources/diagnos.f90 | 10 +++++----- sources/globals.f90 | 2 +- sources/length.f90 | 8 ++++---- sources/packdof.f90 | 8 ++++---- sources/rdcoils.f90 | 36 ++++++++++++++++++------------------ sources/saving.f90 | 4 ++-- sources/solvers.f90 | 2 +- 10 files changed, 51 insertions(+), 49 deletions(-) diff --git a/sources/bfield.f90 b/sources/bfield.f90 index 0199bcc..dfa0851 100644 --- a/sources/bfield.f90 +++ b/sources/bfield.f90 @@ -49,7 +49,7 @@ subroutine bfield0(icoil, xx, yy, zz, Bx, By, Bz) dlx = zero ; dly = zero ; dlz = zero ltx = zero ; lty = zero ; ltz = zero - select case (coil(icoil)%itype) + select case (coil(icoil)%type) !--------------------------------------------------------------------------------------------- case(1) @@ -149,7 +149,7 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) dlx = zero ; dly = zero ; dlz = zero ltx = zero ; lty = zero ; ltz = zero - select case (coil(icoil)%itype) + select case (coil(icoil)%type) !--------------------------------------------------------------------------------------------- case(1) diff --git a/sources/bnormal.f90 b/sources/bnormal.f90 index 6d35664..bb38efc 100644 --- a/sources/bnormal.f90 +++ b/sources/bnormal.f90 @@ -157,12 +157,14 @@ subroutine bnormal( ideriv ) do icoil = 1, Ncoils ND = DoF(icoil)%ND if ( coil(icoil)%Ic /= 0 ) then !if current is free; + call bfield0(icoil+(ip-1)*Ncoils, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) - if (coil(icoil+(ip-1)*Ncoils)%itype == 3) dBz(0,0) = zero ! Bz doesn't change in itype=3 + if (coil(icoil+(ip-1)*Ncoils)%type == 3) dBz(0,0) = zero ! Bz doesn't change in type=3 dBn(idof+1) = ( dBx(0,0)*surf(isurf)%nx(iteta,jzeta) & & + dBy(0,0)*surf(isurf)%ny(iteta,jzeta) & & + dBz(0,0)*surf(isurf)%nz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I + if (case_bnormal == 1) then ! normalized over |B|; dBm(idof+1) = ( dBx(0,0)*surf(isurf)%Bx(iteta,jzeta) & & + dBy(0,0)*surf(isurf)%By(iteta,jzeta) & diff --git a/sources/datalloc.f90 b/sources/datalloc.f90 index 15426c4..d15ca50 100644 --- a/sources/datalloc.f90 +++ b/sources/datalloc.f90 @@ -1,6 +1,6 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine AllocData(itype) +subroutine AllocData(type) !------------------------------------------------------------------------------------------------------ ! DATE: 04/05/2017 ! Allocate data before using them, especially for those used several times; @@ -11,7 +11,7 @@ subroutine AllocData(itype) implicit none include "mpif.h" - INTEGER, intent(in) :: itype + INTEGER, intent(in) :: type INTEGER :: icoil, idof, ND, NF, icur, imag, isurf REAL :: xtmp, mtmp @@ -19,13 +19,13 @@ subroutine AllocData(itype) isurf = plasma !------------------------------------------------------------------------------------------- - if (itype == -1) then ! dof related data; + if (type == -1) then ! dof related data; Cdof = 0; Ndof = 0; Tdof = 0 do icoil = 1, Ncoils*Npc - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case(1) ! get number of DoF for each coil and allocate arrays; NF = FouCoil(icoil)%NF @@ -79,11 +79,11 @@ subroutine AllocData(itype) Inorm = zero ; Mnorm = zero icur = 0 ; imag = 0 ! icur for coil current count, imag for dipole count do icoil = 1, Ncoils - if(coil(icoil)%itype == 1 .or. coil(icoil)%itype == 3 ) then + if(coil(icoil)%type == 1 .or. coil(icoil)%type == 3 ) then ! Fourier representation or central currents Inorm = Inorm + coil(icoil)%I**2 icur = icur + 1 - else if (coil(icoil)%itype == 2) then + else if (coil(icoil)%type == 2) then ! permanent dipole Mnorm = Mnorm + coil(icoil)%I**2 imag = imag + 1 @@ -111,7 +111,7 @@ subroutine AllocData(itype) idof = 0 do icoil = 1, Ncoils - if(coil(icoil)%itype == 1) then ! Fourier representation + if(coil(icoil)%type == 1) then ! Fourier representation if(coil(icoil)%Ic /= 0) then dofnorm(idof+1) = Inorm idof = idof + 1 @@ -122,7 +122,7 @@ subroutine AllocData(itype) dofnorm(idof+1:idof+ND) = Gnorm idof = idof + ND endif - else if (coil(icoil)%itype == 2) then ! permanent magnets + else if (coil(icoil)%type == 2) then ! permanent magnets if(coil(icoil)%Ic /= 0) then dofnorm(idof+1) = Mnorm idof = idof + 1 @@ -141,7 +141,7 @@ subroutine AllocData(itype) idof = idof + 2 #endif endif - else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + else if (coil(icoil)%type == 3) then ! backgroud toroidal/vertical field if(coil(icoil)%Ic /= 0) then dofnorm(idof+1) = Inorm idof = idof + 1 @@ -168,7 +168,7 @@ subroutine AllocData(itype) endif !--------------------------------------------------------------------------------------------- - if (itype == 0 .or. itype == 1) then ! 0-order cost functions related arrays; + if (type == 0 .or. type == 1) then ! 0-order cost functions related arrays; ! Bnorm and Bharm needed; if (weight_bnorm > sqrtmachprec .or. weight_bharm > sqrtmachprec .or. IsQuiet <= -2) then @@ -195,7 +195,7 @@ subroutine AllocData(itype) endif !--------------------------------------------------------------------------------------------- - if (itype == 1) then ! 1st-order cost functions related arrays; + if (type == 1) then ! 1st-order cost functions related arrays; FATAL( AllocData, Ndof < 1, INVALID Ndof value ) SALLOCATE( t1E, (1:Ndof), zero ) diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index 041fff8..e7ac89f 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -35,7 +35,7 @@ SUBROUTINE diagnos do icoil = 1, Ncoils coilspace(iout, idof+1 ) = coil(icoil)%I ; idof = idof + 1 - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case (1) NF = FouCoil(icoil)%NF coilspace(iout, idof+1:idof+NF+1) = FouCoil(icoil)%xc(0:NF) ; idof = idof + NF +1 @@ -54,7 +54,7 @@ SUBROUTINE diagnos !-------------------------------coil maximum curvature---------------------------------------------------- MaxCurv = zero do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier call curvature(icoil) if (coil(icoil)%maxcurv .ge. MaxCurv) then MaxCurv = coil(icoil)%maxcurv @@ -73,7 +73,7 @@ SUBROUTINE diagnos if ( (case_length == 1) .and. (sum(coil(1:Ncoils)%Lo) < sqrtmachprec) ) coil(1:Ncoils)%Lo = one call length(0) do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier AvgLength = AvgLength + coil(icoil)%L enddo AvgLength = AvgLength / Ncoils @@ -84,7 +84,7 @@ SUBROUTINE diagnos minCCdist = infmax do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier if(Ncoils .eq. 1) exit !if only one coil itmp = icoil + 1 ! the guessed adjacent coil @@ -122,7 +122,7 @@ SUBROUTINE diagnos minCPdist = infmax do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier SALLOCATE(Atmp, (1:3,0:coil(icoil)%NS-1), zero) SALLOCATE(Btmp, (1:3,1:(Nteta*Nzeta)), zero) diff --git a/sources/globals.f90 b/sources/globals.f90 index 74367a9..ee81931 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -261,7 +261,7 @@ module globals end type toroidalsurface type arbitrarycoil - INTEGER :: NS, Ic=0, Lc=0, itype + INTEGER :: NS, Ic=0, Lc=0, type, symm=0 REAL :: I=zero, L=zero, Lo, maxcurv, ox, oy, oz, mt, mp, Bt, Bz REAL , allocatable :: xx(:), yy(:), zz(:), xt(:), yt(:), zt(:), xa(:), ya(:), za(:), & dl(:), dd(:) diff --git a/sources/length.f90 b/sources/length.f90 index c80f31d..1dc0101 100644 --- a/sources/length.f90 +++ b/sources/length.f90 @@ -78,7 +78,7 @@ subroutine length(ideriv) do icoil = 1, Ncoils !only care about unique coils; - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; call LenDeriv0(icoil, coil(icoil)%L) !RlBCAST( coil(icoil)%L, 1, modulo(icoil-1,ncpu) ) !broadcast each coil's length @@ -89,7 +89,7 @@ subroutine length(ideriv) if (case_length == 1) then ! quadratic; do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier if ( coil(icoil)%Lc /= 0 ) then ttlen = ttlen + half * (coil(icoil)%L - coil(icoil)%Lo)**2 / coil(icoil)%Lo**2 if (mttlen > 0) then ! L-M format of targets @@ -100,7 +100,7 @@ subroutine length(ideriv) enddo elseif (case_length == 2) then ! exponential; do icoil = 1, Ncoils - if(coil(icoil)%itype .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) exit ! only for Fourier if ( coil(icoil)%Lc /= 0 ) then ttlen = ttlen + exp(coil(icoil)%L) / exp(coil(icoil)%Lo) if (mttlen > 0) then ! L-M format of targets @@ -137,7 +137,7 @@ subroutine length(ideriv) endif if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; - if(coil(icoil)%itype .eq. 1) then ! only for Fourier + if(coil(icoil)%type .eq. 1) then ! only for Fourier ! calculate normalization if (case_length == 1) then norm(icoil) = (coil(icoil)%L - coil(icoil)%Lo) / coil(icoil)%Lo**2 ! quadratic; diff --git a/sources/packdof.f90 b/sources/packdof.f90 index b124481..fbdd634 100644 --- a/sources/packdof.f90 +++ b/sources/packdof.f90 @@ -41,7 +41,7 @@ SUBROUTINE packdof(lxdof) idof = 0 do icoil = 1, Ncoils - select case (coil(icoil)%itype) + select case (coil(icoil)%type) !--------------------------------------------------------------------------------------------- case(1) @@ -114,7 +114,7 @@ SUBROUTINE unpacking(lxdof) idof = 0 ; ifirst = 0 do icoil = 1, Ncoils - select case (coil(icoil)%itype) + select case (coil(icoil)%type) !--------------------------------------------------------------------------------------------- case(1) @@ -188,7 +188,7 @@ SUBROUTINE packcoil do icoil = 1, Ncoils - select case (coil(icoil)%itype) + select case (coil(icoil)%type) !--------------------------------------------------------------------------------------------- case(1) ! get number of DoF for each coil and allocate arrays; @@ -257,7 +257,7 @@ SUBROUTINE unpackcoil do icoil = 1, Ncoils - select case (coil(icoil)%itype) + select case (coil(icoil)%type) !--------------------------------------------------------------------------------------------- case(1) ! get number of DoF for each coil and allocate arrays; diff --git a/sources/rdcoils.f90 b/sources/rdcoils.f90 index bc0dbef..e6f2471 100644 --- a/sources/rdcoils.f90 +++ b/sources/rdcoils.f90 @@ -22,8 +22,8 @@ !latex \item[1.] \inputvar{case\_init = 1} : Toroidally placing \inputvar{Ncoils} circular coils with a !latex radius of \inputvar{init\_radius} and current of \inputvar{init\_current}. The $i$th coil !latex is placed at $\z = \frac{i-1}{Ncoils} \frac{2\pi}{Nfp}$. -!latex \item[2.] \inputvar{case\_init = 0} : Read coils data from {\bf ext.focus} file. The format is as following. \red{This is the most flexible way, and -!latex each coil can be different.} +!latex \item[2.] \inputvar{case\_init = 0} : Read coils data from {\bf ext.focus} file. The format is as following. +!latex \red{This is the most flexible way, and each coil can be different.} !latex \begin{raw} !latex # Total number of coils !latex 16 @@ -192,7 +192,7 @@ subroutine rdcoils DALLOCATE( coilseg) DALLOCATE(coilname) - coil(1:Ncoils)%itype = case_coils + coil(1:Ncoils)%type = case_coils !-------------individual coil file--------------------------------------------------------------------- case( 0 ) @@ -213,8 +213,8 @@ subroutine rdcoils do icoil = 1, Ncoils read( runit,*) read( runit,*) - read( runit,*) coil(icoil)%itype, coil(icoil)%name - if(coil(icoil)%itype == 1) then ! Fourier representation + read( runit,*) coil(icoil)%type, coil(icoil)%name + if(coil(icoil)%type == 1) then ! Fourier representation read( runit,*) read( runit,*) coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, & & coil(icoil)%L, coil(icoil)%Lc, coil(icoil)%Lo @@ -240,11 +240,11 @@ subroutine rdcoils read( runit,*) FouCoil(icoil)%ys(0:FouCoil(icoil)%NF) read( runit,*) FouCoil(icoil)%zc(0:FouCoil(icoil)%NF) read( runit,*) FouCoil(icoil)%zs(0:FouCoil(icoil)%NF) - else if (coil(icoil)%itype == 2) then ! permanent magnets + else if (coil(icoil)%type == 2) then ! permanent magnets read( runit,*) read( runit,*) coil(icoil)%Lc, coil(icoil)%ox, coil(icoil)%oy, coil(icoil)%oz, & coil(icoil)%Ic, coil(icoil)%I , coil(icoil)%mt, coil(icoil)%mp - else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + else if (coil(icoil)%type == 3) then ! backgroud toroidal/vertical field read( runit,*) read( runit,*) coil(icoil)%Ic, coil(icoil)%I, coil(icoil)%Lc, coil(icoil)%Bz else @@ -259,10 +259,10 @@ subroutine rdcoils do icoil = 1, Ncoils - IlBCAST( coil(icoil)%itype , 1 , 0 ) + IlBCAST( coil(icoil)%type , 1 , 0 ) ClBCAST( coil(icoil)%name , 10 , 0 ) - if(coil(icoil)%itype == 1) then ! Fourier representation + if(coil(icoil)%type == 1) then ! Fourier representation IlBCAST( coil(icoil)%NS , 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) @@ -290,7 +290,7 @@ subroutine rdcoils if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 - else if (coil(icoil)%itype == 2) then ! permanent magnets + else if (coil(icoil)%type == 2) then ! permanent magnets IlBCAST( coil(icoil)%Ic, 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) @@ -301,7 +301,7 @@ subroutine rdcoils RlBCAST( coil(icoil)%mt, 1 , 0 ) RlBCAST( coil(icoil)%mp, 1 , 0 ) - else if (coil(icoil)%itype == 3) then ! backgroud toroidal/vertical field + else if (coil(icoil)%type == 3) then ! backgroud toroidal/vertical field IlBCAST( coil(icoil)%Ic, 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) @@ -373,7 +373,7 @@ subroutine rdcoils enddo ! end of do icoil; - coil(1:Ncoils)%itype = 1 + coil(1:Ncoils)%type = 1 !------------- permanent dipoles and background magnetic field ---------------------------------------- case( 2 ) ! averagely positioned permanent dipoles ; 2019/01/03 @@ -403,7 +403,7 @@ subroutine rdcoils coil(icoil)%Lo = target_length coil(icoil)%Bz = zero coil(icoil)%name = 'bg_BtBz_01' - coil(icoil)%itype = 3 + coil(icoil)%type = 3 do itor = 1, num_tor @@ -419,7 +419,7 @@ subroutine rdcoils icoil = icoil + 1 !general coil parameters; - coil(icoil)%itype = 2 + coil(icoil)%type = 2 coil(icoil)%Ic = IsVaryCurrent coil(icoil)%I = init_current coil(icoil)%L = pi2*init_radius @@ -497,7 +497,7 @@ subroutine rdcoils do ip = 1, Npc-1 cosip(ip) = cos(ip*pi2/Npc) ; sinip(ip) = sin(ip*pi2/Npc) do icoil = 1, Ncoils - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case( 1 ) NF = FouCoil(icoil)%NF SALLOCATE( FouCoil(icoil+ip*Ncoils)%xc, (0:NF), zero ) @@ -567,7 +567,7 @@ subroutine mapcoil do icoil = 1, Ncoils - coil(icoil+ip*Ncoils)%itype = coil(icoil)%itype + coil(icoil+ip*Ncoils)%type = coil(icoil)%type coil(icoil+ip*Ncoils)%NS = coil(icoil)%NS coil(icoil+ip*Ncoils)%Ic = coil(icoil)%Ic coil(icoil+ip*Ncoils)%Lc = coil(icoil)%Lc @@ -577,7 +577,7 @@ subroutine mapcoil coil(icoil+ip*Ncoils)%maxcurv = coil(icoil)%maxcurv coil(icoil+ip*Ncoils)%name = coil(icoil)%name - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case( 1 ) Foucoil(icoil+ip*Ncoils)%NF = Foucoil(icoil)%NF Foucoil(icoil+ip*Ncoils)%xc = Foucoil(icoil)%xc * cosip(ip) - Foucoil(icoil)%yc * sinip(ip) @@ -627,7 +627,7 @@ subroutine discoil(ifirst) !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case( 1 ) !reset to zero for all the coils; diff --git a/sources/saving.f90 b/sources/saving.f90 index 14ba683..b2e5dc8 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -225,9 +225,9 @@ subroutine saving write(wunit, *) "#-----------------", icoil, "---------------------------" write(wunit, *) "#coil_type coil_name" - write(wunit,'(3X,I3,4X, A10)') coil(icoil)%itype, coil(icoil)%name + write(wunit,'(3X,I3,4X, A10)') coil(icoil)%type, coil(icoil)%name - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case (1) write(wunit, '(3(A6, A15, 8X))') " #Nseg", "current", "Ifree", "Length", "Lfree", "target_length" write(wunit,'(2X, I4, ES23.15, 3X, I3, ES23.15, 3X, I3, ES23.15)') & diff --git a/sources/solvers.f90 b/sources/solvers.f90 index 5ba1a3b..17ee014 100644 --- a/sources/solvers.f90 +++ b/sources/solvers.f90 @@ -545,7 +545,7 @@ subroutine output (mark) do icoil = 1, Ncoils coilspace(iout, idof+1 ) = coil(icoil)%I ; idof = idof + 1 - select case (coil(icoil)%itype) + select case (coil(icoil)%type) case (1) NF = FouCoil(icoil)%NF coilspace(iout, idof+1:idof+NF+1) = FouCoil(icoil)%xc(0:NF) ; idof = idof + NF +1 From e9623abcd4790e6ca55cf7767a12617bdf56132e Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 16 Jan 2020 22:58:14 -0500 Subject: [PATCH 56/72] debugged limiter surface; add example --- examples/limiter_surface/ellipse.boundary | 13 ++ examples/limiter_surface/limiter.input | 75 ++++++++ examples/rotating_ellipse/ellipse.focus | 224 +++++++++++----------- sources/globals.f90 | 4 +- sources/rdsurf.f90 | 2 +- sources/surface.f90 | 2 +- 6 files changed, 204 insertions(+), 116 deletions(-) create mode 100644 examples/limiter_surface/ellipse.boundary create mode 100644 examples/limiter_surface/limiter.input diff --git a/examples/limiter_surface/ellipse.boundary b/examples/limiter_surface/ellipse.boundary new file mode 100644 index 0000000..8be57fc --- /dev/null +++ b/examples/limiter_surface/ellipse.boundary @@ -0,0 +1,13 @@ +#bmn bNfp nbf +4 2 0 +#plasma boundary +# n m Rbc Rbs Zbc Zbs +0 0 3.00 0.0 0.0 0.00 +0 1 0.30 0.0 0.0 -0.30 +1 0 0.00 0.0 0.0 -0.06 +1 1 -0.06 0.0 0.0 -0.06 +#Bn harmonics +# n m bnc bns +0 0 1.0 0.0 +0 1 0.5 0.25 +1 0 0.5 0.0 \ No newline at end of file diff --git a/examples/limiter_surface/limiter.input b/examples/limiter_surface/limiter.input new file mode 100644 index 0000000..732dff6 --- /dev/null +++ b/examples/limiter_surface/limiter.input @@ -0,0 +1,75 @@ + &FOCUSIN + ISQUIET = -1, + ISSYMMETRIC = 0, + INPUT_SURF = 'ellipse.boundary', + !LIMITER_SURF = 'ellipse.limiter', + INPUT_HARM = 'target.harmonics', + INPUT_COILS = 'none', + CASE_SURFACE = 0, + KNOTSURF = 0.200000000000000 , + ELLIPTICITY = 0.000000000000000E+000, + NTETA = 64, + NZETA = 64, + CASE_INIT = 1, + CASE_COILS = 1, + NCOILS = 16, + INIT_CURRENT = 1000000.00000000 , + INIT_RADIUS = 0.60000000000000 , + ISVARYCURRENT = 0, + ISVARYGEOMETRY = 1, + NFCOIL = 4, + NSEG = 128, + ISNORMALIZE = 1, + ISNORMWEIGHT = 0, + CASE_BNORMAL = 0, + CASE_LENGTH = 1, + WEIGHT_BNORM = 1.00000000000000 , + BHARM_JSURF = 0, + WEIGHT_BHARM = 0.000000000000000E+000, + WEIGHT_TFLUX = 0.000000000000000E+000, + TARGET_TFLUX = 0.000000000000000E+000, + WEIGHT_TTLEN = 1.000000000000000E-003, + TARGET_LENGTH = 5.000000000000000E+000, + WEIGHT_CSSEP = 0.000000000000000E-004, + CSSEP_FACTOR = 1.00000000000000 , + WEIGHT_SPECW = 0.000000000000000E+000, + WEIGHT_CCSEP = 0.000000000000000E+000, + WEIGHT_INORM = 1.00000000000000 , + WEIGHT_GNORM = 1.00000000000000 , + WEIGHT_MNORM = 1.00000000000000 , + CASE_OPTIMIZE = 1, + EXIT_TOL = 1.000000000000000E-004, + DF_MAXITER = 0, + DF_XTOL = 1.000000000000000E-008, + DF_TAUSTA = 0.000000000000000E+000, + DF_TAUEND = 1.00000000000000 , + CG_MAXITER = 20, + CG_XTOL = 1.000000000000000E-008, + CG_WOLFE_C1 = 0.100000001490116 , + CG_WOLFE_C2 = 0.899999976158142 , + LM_MAXITER = 0, + LM_XTOL = 1.000000000000000E-008, + LM_FTOL = 1.000000000000000E-008, + LM_FACTOR = 100.000000000000 , + HN_MAXITER = 0, + HN_XTOL = 1.000000000000000E-008, + HN_FACTOR = 100.000000000000 , + TN_MAXITER = 0, + TN_REORDER = 0, + TN_XTOL = 1.000000000000000E-008, + TN_CR = 0.100000001490116 , + CASE_POSTPROC = 3, + SAVE_FREQ = 1, + SAVE_COILS = 1, + SAVE_HARMONICS = 0, + SAVE_FILAMENTS = 0, + UPDATE_PLASMA = 0, + PP_PHI = 0.000000000000000E+000, + PP_RAXIS = 0.000000000000000E+000, + PP_ZAXIS = 0.000000000000000E+000, + PP_RMAX = 0.000000000000000E+000, + PP_ZMAX = 0.000000000000000E+000, + PP_NS = 10, + PP_MAXITER = 1000, + PP_XTOL = 1.000000000000000E-006 + / diff --git a/examples/rotating_ellipse/ellipse.focus b/examples/rotating_ellipse/ellipse.focus index 6e3f968..5da1693 100644 --- a/examples/rotating_ellipse/ellipse.focus +++ b/examples/rotating_ellipse/ellipse.focus @@ -4,223 +4,223 @@ #coil_type coil_name 1 Mod_001 #Nseg current Ifree Length Lfree target_length - 128 7.520728588581042E+05 1 5.395655237318014E+00 1 5.000000000000000E+00 + 128 1.007712828781890E+06 1 7.736768745413340E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.988539929211658E+00 8.327106971885980E-01 3.168435563359925E-02 -4.729634749879686E-02 -3.926657715126965E-03 - 0.000000000000000E+00 5.590164418932656E-03 1.319184024220209E-02 1.523370015443930E-02 -3.497821632866293E-04 - 5.953679010924422E-01 1.619405017805486E-01 -1.909577558230045E-02 -8.878033538448384E-03 4.024800198801999E-03 - 0.000000000000000E+00 -3.892516509673482E-02 -5.912037464741764E-02 6.147106771863072E-03 4.944614114398699E-03 - 2.275902141112232E-02 -1.924294535824474E-03 -3.840214356197926E-03 -2.782417462171475E-02 -8.378734084698013E-04 - 0.000000000000000E+00 8.394507087523904E-01 2.150443980874104E-02 -5.950975483787359E-02 -3.741052453256639E-03 + 3.035812070253488E+00 1.178718088122252E+00 8.226301904596144E-02 -9.203675809244777E-02 -1.023382071597401E-02 + 0.000000000000000E+00 8.616301147951573E-03 3.253986956653675E-02 3.498799084434340E-02 -8.885224858527464E-04 + 6.058764001526894E-01 2.202864536793396E-01 -4.174400818416566E-02 -1.990981246590881E-02 1.543436943049511E-02 + 0.000000000000000E+00 -7.152839295865940E-02 -1.364096990934720E-01 5.998353132971824E-03 2.020941966100692E-02 + 2.413431691178328E-02 -5.505816697664090E-03 -9.643018431584272E-03 -4.635712550042110E-02 -1.505793523927265E-03 + 0.000000000000000E+00 1.172567382910356E+00 6.422719777078309E-02 -1.050511247457946E-01 -4.935066121438993E-03 #----------------- 2 --------------------------- #coil_type coil_name 1 Mod_002 #Nseg current Ifree Length Lfree target_length - 128 7.503347345220045E+05 1 5.393039812576576E+00 1 5.000000000000000E+00 + 128 1.001057856680767E+06 1 7.720416122162810E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.531203271089469E+00 7.076750756389344E-01 5.550873235716919E-02 -2.482647602533806E-02 -5.359706355007858E-03 - 0.000000000000000E+00 3.856525906851818E-03 1.628510942838650E-02 3.808788657393867E-02 4.826352774127734E-03 - 1.693213150342830E+00 4.631603939687156E-01 -3.287039804374595E-02 -1.451295457423486E-02 2.253117094687433E-03 - 0.000000000000000E+00 -1.547210717512680E-02 -1.777000619275685E-02 2.780702588161363E-02 -2.159867575328454E-03 - 5.443183710589018E-02 -4.858864588544106E-03 -8.437113643959614E-03 -5.855321710369821E-02 -4.169363793928258E-03 - 0.000000000000000E+00 8.428661276609882E-01 2.579319073444275E-02 -1.673066018368582E-02 -2.854239318502315E-03 + 2.570148968625153E+00 1.007414000750858E+00 1.386334577764704E-01 -3.673112756615116E-02 -1.295213733937123E-02 + 0.000000000000000E+00 3.421882288948261E-03 4.107491907192981E-02 7.682213933896125E-02 1.370948208945556E-02 + 1.723282497586355E+00 6.354398903844151E-01 -6.884675804882144E-02 -2.896796428815738E-02 1.498517485181280E-02 + 0.000000000000000E+00 -3.010455410648684E-02 -3.827778668254885E-02 5.135339828866215E-02 -7.319854012318223E-03 + 5.765125413661209E-02 -1.384650035977095E-02 -1.971281555229668E-02 -1.025407805228553E-01 -5.563199952353330E-03 + 0.000000000000000E+00 1.180157767265387E+00 7.630612006130766E-02 -3.635899306300308E-02 -3.328720688110256E-03 #----------------- 3 --------------------------- #coil_type coil_name 1 Mod_003 #Nseg current Ifree Length Lfree target_length - 128 7.501552633715026E+05 1 5.391841305583704E+00 1 5.000000000000000E+00 + 128 9.959947815598509E+05 1 7.703049123316433E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.689228855099178E+00 4.738785866764856E-01 6.298817143237868E-02 7.213526054562644E-03 3.651146060318638E-03 - 0.000000000000000E+00 -1.777792324510675E-02 -1.797643715930334E-02 3.245272161458984E-02 7.284468990029826E-03 - 2.529661048475419E+00 6.956997282618042E-01 -7.243582300751192E-03 1.337336831683070E-02 -2.455035203155118E-03 - 0.000000000000000E+00 5.225975833879028E-03 1.664719622834951E-02 4.861370192110288E-02 2.451724157622647E-03 - 5.390500309620747E-02 -5.243817138709730E-03 -7.417647548054200E-03 -4.640069989535257E-02 -5.180187411528112E-03 - 0.000000000000000E+00 8.474816641335547E-01 3.016822178480444E-02 2.672427259502096E-02 1.747583740935530E-03 + 1.712644495836300E+00 6.784380570055493E-01 1.538185103613542E-01 2.346641946617012E-02 1.196852370400807E-02 + 0.000000000000000E+00 -3.573739580334476E-02 -4.033929278453750E-02 5.372993659147889E-02 1.826821350017657E-02 + 2.573241287264196E+00 9.631762686694120E-01 -2.625882679863217E-03 2.495777438098891E-02 -3.966865325499821E-03 + 0.000000000000000E+00 5.701315840674340E-03 4.356538807688857E-02 8.461235727542724E-02 -3.702192388978986E-03 + 5.706552562783206E-02 -1.509696942921082E-02 -1.470358590642982E-02 -9.007853505434120E-02 -7.635287762220054E-03 + 0.000000000000000E+00 1.191372342826095E+00 8.582831013404432E-02 4.341141659425585E-02 2.472585787285837E-03 #----------------- 4 --------------------------- #coil_type coil_name 1 Mod_004 #Nseg current Ifree Length Lfree target_length - 128 7.514987079186337E+05 1 5.392712258582278E+00 1 5.000000000000000E+00 + 128 9.953136705502829E+05 1 7.694498108772609E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 5.927116272391375E-01 1.665859083524461E-01 2.846186262771908E-02 1.095638507800185E-02 5.684160922621262E-03 - 0.000000000000000E+00 -3.990274142492009E-02 -5.528907872114740E-02 5.774581002427468E-03 -3.623545496412463E-03 - 2.980538548240107E+00 8.219189960221159E-01 2.471745954728169E-02 5.652321883799034E-02 5.231711055756799E-03 - 0.000000000000000E+00 5.566365666221656E-03 1.266551771211142E-02 2.693263073650251E-02 4.516495680440038E-03 - 2.219784783741740E-02 -2.370949305931477E-03 -2.788313950576048E-03 -1.571469478999142E-02 -1.979049754381353E-03 - 0.000000000000000E+00 8.506574163180366E-01 3.226378283491264E-02 4.555947349958186E-02 4.805096429505946E-03 + 5.999177950903241E-01 2.391317634594994E-01 6.867939241678205E-02 2.280104508038897E-02 1.564512479405216E-02 + 0.000000000000000E+00 -7.373064958373243E-02 -1.278942556620330E-01 8.127339201131063E-04 -1.155199830192180E-02 + 3.029337519697936E+00 1.142478509633036E+00 7.710012761187962E-02 9.580045912788590E-02 4.525279204688185E-03 + 0.000000000000000E+00 7.877000042647551E-03 3.183320319611994E-02 4.436408957919718E-02 5.456334517795335E-03 + 2.358621091788803E-02 -6.643975611929005E-03 -4.634582045910598E-03 -3.385380103397225E-02 -3.348327178333740E-03 + 0.000000000000000E+00 1.199833343035113E+00 8.740012169205759E-02 8.822906359677221E-02 7.816080393282967E-03 #----------------- 5 --------------------------- #coil_type coil_name 1 Mod_005 #Nseg current Ifree Length Lfree target_length - 128 7.514987039984880E+05 1 5.392712253773238E+00 1 5.000000000000000E+00 + 128 9.953136480953702E+05 1 7.694498122494488E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -5.927118854027963E-01 -1.665859861030158E-01 -2.846187562066620E-02 -1.095638974367992E-02 -5.684162360619094E-03 - 0.000000000000000E+00 -3.990273749932960E-02 -5.528907074679813E-02 5.774588448374391E-03 -3.623541019957985E-03 - 2.980538496319568E+00 8.219189800607887E-01 2.471745451242281E-02 5.652321110817888E-02 5.231706271137767E-03 - 0.000000000000000E+00 -5.566367754216763E-03 -1.266553178467203E-02 -2.693264686120796E-02 -4.516506464882769E-03 - -2.219784448219590E-02 2.370951742061149E-03 2.788335531513377E-03 1.571470351395375E-02 1.979056866073121E-03 - 0.000000000000000E+00 8.506574142229435E-01 3.226378077005936E-02 4.555947206753809E-02 4.805095113162215E-03 + -5.999180374778748E-01 -2.391318722353527E-01 -6.867942253301033E-02 -2.280105664654825E-02 -1.564512732700421E-02 + 0.000000000000000E+00 -7.373064234036350E-02 -1.278942397557588E-01 8.127475200508375E-04 -1.155198772461002E-02 + 3.029337470076367E+00 1.142478489878644E+00 7.710011702561391E-02 9.580044771697098E-02 4.525274244011152E-03 + 0.000000000000000E+00 -7.877002057678044E-03 -3.183323447660678E-02 -4.436411511106713E-02 -5.456348744412772E-03 + -2.358620136427579E-02 6.643982753355445E-03 4.634611993460796E-03 3.385382064889689E-02 3.348339555678685E-03 + 0.000000000000000E+00 1.199833342134043E+00 8.740012094217570E-02 8.822905887661604E-02 7.816078104515458E-03 #----------------- 6 --------------------------- #coil_type coil_name 1 Mod_006 #Nseg current Ifree Length Lfree target_length - 128 7.501552440090403E+05 1 5.391841292119622E+00 1 5.000000000000000E+00 + 128 9.959947318781004E+05 1 7.703049178055673E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.689229067001008E+00 -4.738786498530534E-01 -6.298817514522354E-02 -7.213516650333737E-03 -3.651137935167777E-03 - 0.000000000000000E+00 -1.777791451826354E-02 -1.797642028022032E-02 3.245273115829594E-02 7.284472965483719E-03 - 2.529660905692762E+00 6.956996842573536E-01 -7.243588429642245E-03 1.337335562808325E-02 -2.455043212983806E-03 - 0.000000000000000E+00 -5.225973527492090E-03 -1.664719981685729E-02 -4.861370434315991E-02 -2.451725812532419E-03 - -5.390499401976419E-02 5.243817656993991E-03 7.417665985655394E-03 4.640070789057397E-02 5.180193539368011E-03 - 0.000000000000000E+00 8.474816580121304E-01 3.016821483159271E-02 2.672426608039910E-02 1.747579394926129E-03 + -1.712644710314362E+00 -6.784381463678996E-01 -1.538185231850033E-01 -2.346641014050958E-02 -1.196851262331553E-02 + 0.000000000000000E+00 -3.573738205680022E-02 -4.033925670939641E-02 5.372995834765551E-02 1.826822504315144E-02 + 2.573241132481436E+00 9.631762176638391E-01 -2.625906188340279E-03 2.495775834238372E-02 -3.966871276957000E-03 + 0.000000000000000E+00 -5.701310492114258E-03 -4.356539441348187E-02 -8.461235987345980E-02 3.702189774381795E-03 + -5.706550729986900E-02 1.509697471399099E-02 1.470361372097697E-02 9.007854960472310E-02 7.635295898869570E-03 + 0.000000000000000E+00 1.191372341984033E+00 8.582830157826138E-02 4.341140403684465E-02 2.472576014066274E-03 #----------------- 7 --------------------------- #coil_type coil_name 1 Mod_007 #Nseg current Ifree Length Lfree target_length - 128 7.503346931259049E+05 1 5.393039802229614E+00 1 5.000000000000000E+00 + 128 1.001057835887695E+06 1 7.720416345672318E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.531203410582876E+00 -7.076751153688536E-01 -5.550872998575305E-02 2.482648889925295E-02 5.359713238726924E-03 - 0.000000000000000E+00 3.856532474150872E-03 1.628512551174907E-02 3.808788384771047E-02 4.826346744368282E-03 - 1.693212938291873E+00 4.631603324885413E-01 -3.287039552315528E-02 -1.451295840805110E-02 2.253114585091834E-03 - 0.000000000000000E+00 1.547211270233631E-02 1.777001026074418E-02 -2.780702054725927E-02 2.159869161811173E-03 - -5.443181852279336E-02 4.858864977817301E-03 8.437125114458726E-03 5.855321839827211E-02 4.169365626426363E-03 - 0.000000000000000E+00 8.428661214608650E-01 2.579318055688882E-02 -1.673067211105703E-02 -2.854250261633925E-03 + -2.570149149273860E+00 -1.007414084832676E+00 -1.386334592263733E-01 3.673114474136688E-02 1.295214869369829E-02 + 0.000000000000000E+00 3.421890907591615E-03 4.107495319117371E-02 7.682214905847547E-02 1.370948143317612E-02 + 1.723282227045863E+00 6.354398128755060E-01 -6.884676614305148E-02 -2.896796768877542E-02 1.498517048416115E-02 + 0.000000000000000E+00 3.010457113387168E-02 3.827780451249946E-02 -5.135338639893422E-02 7.319852131197339E-03 + -5.765121979000968E-02 1.384650850786926E-02 1.971283616213717E-02 1.025407861959757E-01 5.563200320214472E-03 + 0.000000000000000E+00 1.180157794675723E+00 7.630611316154186E-02 -3.635901057257455E-02 -3.328734994754155E-03 #----------------- 8 --------------------------- #coil_type coil_name 1 Mod_008 #Nseg current Ifree Length Lfree target_length - 128 7.520728717143674E+05 1 5.395655368723608E+00 1 5.000000000000000E+00 + 128 1.007713011882134E+06 1 7.736769634929175E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.988540004263966E+00 -8.327107428043068E-01 -3.168435488524857E-02 4.729635190657960E-02 3.926657066712609E-03 - 0.000000000000000E+00 5.590155607965869E-03 1.319185195362873E-02 1.523368992492643E-02 -3.497862507550716E-04 - 5.953675303689776E-01 1.619404067055139E-01 -1.909575750387827E-02 -8.878027067865540E-03 4.024799004182142E-03 - 0.000000000000000E+00 3.892517314887458E-02 5.912037794862443E-02 -6.147102568629680E-03 -4.944614340579445E-03 - -2.275898666929556E-02 1.924306339749633E-03 3.840217759945165E-03 2.782416045019162E-02 8.378632429727306E-04 - 0.000000000000000E+00 8.394507264533018E-01 2.150443607028891E-02 -5.950976004534383E-02 -3.741058951554954E-03 + -3.035812190076971E+00 -1.178718246298075E+00 -8.226303973760205E-02 9.203678168888621E-02 1.023382563414603E-02 + 0.000000000000000E+00 8.616289891423583E-03 3.253988335649922E-02 3.498797318765669E-02 -8.885276136174528E-04 + 6.058759650237356E-01 2.202863188306560E-01 -4.174399386998583E-02 -1.990979554126186E-02 1.543436493092415E-02 + 0.000000000000000E+00 7.152842242867612E-02 1.364097339631465E-01 -5.998343217546971E-03 -2.020941949019226E-02 + -2.413426227598850E-02 5.505831295564258E-03 9.643028494945862E-03 4.635710357026913E-02 1.505782576973876E-03 + 0.000000000000000E+00 1.172567514240557E+00 6.422721125702005E-02 -1.050511528651706E-01 -4.935073131552209E-03 #----------------- 9 --------------------------- #coil_type coil_name 1 Mod_009 #Nseg current Ifree Length Lfree target_length - 128 7.520728720708593E+05 1 5.395655371276433E+00 1 5.000000000000000E+00 + 128 1.007713009003368E+06 1 7.736769623491082E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.988539902262396E+00 -8.327107158986544E-01 -3.168435968273983E-02 4.729634463812559E-02 3.926657957891286E-03 - 0.000000000000000E+00 -5.590155875632664E-03 -1.319184381121468E-02 -1.523370723433056E-02 3.497807060728984E-04 - -5.953680465221158E-01 -1.619405474195902E-01 1.909577291793969E-02 8.878032322442823E-03 -4.024802251256982E-03 - 0.000000000000000E+00 3.892516635190360E-02 5.912036989029839E-02 -6.147107682585245E-03 -4.944611868753231E-03 - 2.275902202931194E-02 -1.924306982936721E-03 -3.840215576219863E-03 -2.782418314092672E-02 -8.378750767367861E-04 - 0.000000000000000E+00 8.394507288719744E-01 2.150444172282285E-02 -5.950974663360842E-02 -3.741051284132857E-03 + -3.035812086490458E+00 -1.178718208804232E+00 -8.226305527630723E-02 9.203676553177235E-02 1.023382422529885E-02 + 0.000000000000000E+00 -8.616292595815122E-03 -3.253988178307896E-02 -3.498799870135588E-02 8.885200254525288E-04 + -6.058764992287430E-01 -2.202865086136521E-01 4.174402581944861E-02 1.990981426917706E-02 -1.543437525081508E-02 + 0.000000000000000E+00 7.152840881812825E-02 1.364097108263868E-01 -5.998357171315089E-03 -2.020941358880629E-02 + 2.413431578989709E-02 -5.505832469732896E-03 -9.643021174050515E-03 -4.635713854450813E-02 -1.505793896427040E-03 + 0.000000000000000E+00 1.172567516920973E+00 6.422721880132140E-02 -1.050511334987870E-01 -4.935066199393340E-03 #----------------- 10 --------------------------- #coil_type coil_name 1 Mod_010 #Nseg current Ifree Length Lfree target_length - 128 7.503346938302639E+05 1 5.393039807760921E+00 1 5.000000000000000E+00 + 128 1.001057830257406E+06 1 7.720416322737322E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.531203117426858E+00 -7.076750350135308E-01 -5.550873632846930E-02 2.482646871060215E-02 5.359705517378937E-03 - 0.000000000000000E+00 -3.856522974826531E-03 -1.628510607829157E-02 -3.808788934321725E-02 -4.826354462952137E-03 - -1.693213378675361E+00 -4.631604553693177E-01 3.287039497567841E-02 1.451295185857816E-02 -2.253115235461406E-03 - 0.000000000000000E+00 1.547210064881719E-02 1.776999665485185E-02 -2.780703199445574E-02 2.159867808951845E-03 - 5.443184093957966E-02 -4.858864957360692E-03 -8.437113751462985E-03 -5.855321907923008E-02 -4.169364706619052E-03 - 0.000000000000000E+00 8.428661273028158E-01 2.579319177244149E-02 -1.673064832391811E-02 -2.854238539554325E-03 + -2.570148852561737E+00 -1.007413972414764E+00 -1.386334798501972E-01 3.673111020124325E-02 1.295213539678410E-02 + 0.000000000000000E+00 -3.421875100775482E-03 -4.107491479541587E-02 -7.682214620298777E-02 -1.370948748539923E-02 + -1.723282680949956E+00 -6.354399814101118E-01 6.884675727576360E-02 2.896795731434789E-02 -1.498516959530881E-02 + 0.000000000000000E+00 3.010454679870936E-02 3.827776657172516E-02 -5.135341094754236E-02 7.319857702463556E-03 + 5.765125654698011E-02 -1.384650735550876E-02 -1.971281603173873E-02 -1.025407912739954E-01 -5.563201580994880E-03 + 0.000000000000000E+00 1.180157801074327E+00 7.630612715438616E-02 -3.635897127709746E-02 -3.328720849067889E-03 #----------------- 11 --------------------------- #coil_type coil_name 1 Mod_011 #Nseg current Ifree Length Lfree target_length - 128 7.501552442771002E+05 1 5.391841297188859E+00 1 5.000000000000000E+00 + 128 9.959947283677154E+05 1 7.703049160318660E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.689228624917182E+00 -4.738785252663106E-01 -6.298816823302125E-02 -7.213531089815727E-03 -3.651148197198661E-03 - 0.000000000000000E+00 1.777792885563811E-02 1.797644626465408E-02 -3.245271676404942E-02 -7.284467827929833E-03 - -2.529661201393905E+00 -6.956997680692878E-01 7.243573978656596E-03 -1.337337789546080E-02 2.455034396127163E-03 - 0.000000000000000E+00 -5.225978344874689E-03 -1.664719955824522E-02 -4.861370320989225E-02 -2.451725935001864E-03 - 5.390499895719188E-02 -5.243816480907436E-03 -7.417646806010670E-03 -4.640069406005268E-02 -5.180187026541793E-03 - 0.000000000000000E+00 8.474816632291637E-01 3.016822256421065E-02 2.672427955485484E-02 1.747584881525684E-03 + -1.712644264450062E+00 -6.784379697121713E-01 -1.538185073195206E-01 -2.346642703984504E-02 -1.196853000603485E-02 + 0.000000000000000E+00 3.573740731570572E-02 4.033931497421444E-02 -5.372992549301056E-02 -1.826820967299947E-02 + -2.573241435757327E+00 -9.631763343437154E-01 2.625867477739654E-03 -2.495779447975716E-02 3.966867266908904E-03 + 0.000000000000000E+00 -5.701320786415893E-03 -4.356539567371004E-02 -8.461235812758644E-02 3.702189342477119E-03 + 5.706552141656023E-02 -1.509696955366239E-02 -1.470358338788201E-02 -9.007852687853637E-02 -7.635286717773872E-03 + 0.000000000000000E+00 1.191372348472213E+00 8.582830952615123E-02 4.341143368917490E-02 2.472586931893767E-03 #----------------- 12 --------------------------- #coil_type coil_name 1 Mod_012 #Nseg current Ifree Length Lfree target_length - 128 7.514987039050099E+05 1 5.392712256492853E+00 1 5.000000000000000E+00 + 128 9.953136472062048E+05 1 7.694498116532037E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -5.927113626118808E-01 -1.665858371437778E-01 -2.846185098301391E-02 -1.095638151488814E-02 -5.684159191711036E-03 - 0.000000000000000E+00 3.990274436203740E-02 5.528908359921008E-02 -5.774576514687100E-03 3.623547651385761E-03 - -2.980538600429006E+00 -8.219190098205458E-01 -2.471746400498083E-02 -5.652322541696598E-02 -5.231712897147735E-03 - 0.000000000000000E+00 -5.566363574429256E-03 -1.266551294252646E-02 -2.693262048426263E-02 -4.516494151956416E-03 - 2.219783830678712E-02 -2.370948189480474E-03 -2.788312669518343E-03 -1.571468787189318E-02 -1.979048802249423E-03 - 0.000000000000000E+00 8.506574162324855E-01 3.226378305621138E-02 4.555947516034409E-02 4.805096758450513E-03 + -5.999175121250989E-01 -2.391316593673553E-01 -6.867936583068979E-02 -2.280103670376822E-02 -1.564512028792894E-02 + 0.000000000000000E+00 7.373065446635568E-02 1.278942681172012E-01 -8.127255678641903E-04 1.155200382772511E-02 + -3.029337576386504E+00 -1.142478531366271E+00 -7.710013895610672E-02 -9.580046973731804E-02 -4.525282109908059E-03 + 0.000000000000000E+00 -7.876995673694556E-03 -3.183319154455465E-02 -4.436407243126113E-02 -5.456333107994519E-03 + 2.358620001280720E-02 -6.643973860751291E-03 -4.634579712825352E-03 -3.385378691877480E-02 -3.348325514503858E-03 + 0.000000000000000E+00 1.199833344763041E+00 8.740012238699597E-02 8.822906846429071E-02 7.816081209880421E-03 #----------------- 13 --------------------------- #coil_type coil_name 1 Mod_013 #Nseg current Ifree Length Lfree target_length - 128 7.514987080121123E+05 1 5.392712255862662E+00 1 5.000000000000000E+00 + 128 9.953136714394486E+05 1 7.694498114735064E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 5.927121500300441E-01 1.665860573116816E-01 2.846188726536878E-02 1.095639330678970E-02 5.684164091526844E-03 - 0.000000000000000E+00 3.990273456220943E-02 5.528906586873038E-02 -5.774592936118736E-03 3.623538864982569E-03 - -2.980538444130621E+00 -8.219189662623464E-01 -2.471745005472040E-02 -5.652320452919800E-02 -5.231704429744331E-03 - 0.000000000000000E+00 5.566369846007909E-03 1.266553655425424E-02 2.693265711344370E-02 4.516507993364239E-03 - -2.219785401282495E-02 2.370952858511593E-03 2.788336812570616E-03 1.571471043205211E-02 1.979057818204685E-03 - 0.000000000000000E+00 8.506574143084941E-01 3.226378054875979E-02 4.555947040677443E-02 4.805094784216935E-03 + 5.999183204430892E-01 2.391319763274959E-01 6.867944911909597E-02 2.280106502316325E-02 1.564513183312241E-02 + 0.000000000000000E+00 7.373063745773815E-02 1.278942273005794E-01 -8.127558723072576E-04 1.155198219880172E-02 + -3.029337413387749E+00 -1.142478468145390E+00 -7.710010568137941E-02 -9.580043710753043E-02 -4.525271338788939E-03 + 0.000000000000000E+00 7.877006426629297E-03 3.183324612816577E-02 4.436413225899662E-02 5.456350154209810E-03 + -2.358621226935413E-02 6.643984504532813E-03 4.634614326545263E-03 3.385383476409352E-02 3.348341219507851E-03 + 0.000000000000000E+00 1.199833340406115E+00 8.740012024723698E-02 8.822905400909316E-02 7.816077287916244E-03 #----------------- 14 --------------------------- #coil_type coil_name 1 Mod_014 #Nseg current Ifree Length Lfree target_length - 128 7.501552631034428E+05 1 5.391841300514464E+00 1 5.000000000000000E+00 + 128 9.959947850702358E+05 1 7.703049141053451E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.689229297182977E+00 4.738787112632208E-01 6.298817834457687E-02 7.213511615076581E-03 3.651135798285880E-03 - 0.000000000000000E+00 1.777790890773168E-02 1.797641117486880E-02 -3.245273600883360E-02 -7.284474127581214E-03 - -2.529660752774237E+00 -6.956996444498592E-01 7.243596751735662E-03 -1.337334604945491E-02 2.455044020010202E-03 - 0.000000000000000E+00 5.225971016493626E-03 1.664719648695688E-02 4.861370305436504E-02 2.451724035150668E-03 - -5.390499815877593E-02 5.243818314796265E-03 7.417666727698075E-03 4.640071372587241E-02 5.180193924353800E-03 - 0.000000000000000E+00 8.474816589165207E-01 3.016821405218489E-02 2.672425912056227E-02 1.747578254334600E-03 + 1.712644941700573E+00 6.784382336612624E-01 1.538185262268274E-01 2.346640256682597E-02 1.196850632128575E-02 + 0.000000000000000E+00 3.573737054444041E-02 4.033923451971971E-02 -5.372996944612102E-02 -1.826822887032361E-02 + -2.573240983988262E+00 -9.631761519895228E-01 2.625921390462567E-03 -2.495773824361796E-02 3.966869335545995E-03 + 0.000000000000000E+00 5.701305546367504E-03 4.356538681665208E-02 8.461235902128973E-02 -3.702192820885288E-03 + -5.706551151114052E-02 1.509697458953986E-02 1.470361623952536E-02 9.007855778052265E-02 7.635296943313601E-03 + 0.000000000000000E+00 1.191372336337914E+00 8.582830218615099E-02 4.341138694192239E-02 2.472574869455472E-03 #----------------- 15 --------------------------- #coil_type coil_name 1 Mod_015 #Nseg current Ifree Length Lfree target_length - 128 7.503347338176459E+05 1 5.393039807045271E+00 1 5.000000000000000E+00 + 128 1.001057862311056E+06 1 7.720416145097795E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.531203564245448E+00 7.076751559942464E-01 5.550872601445132E-02 -2.482649621398703E-02 -5.359714076353015E-03 - 0.000000000000000E+00 -3.856535406174458E-03 -1.628512886184260E-02 -3.808788107842729E-02 -4.826345055542259E-03 - -1.693212709959316E+00 -4.631602710879332E-01 3.287039859121983E-02 1.451296112370399E-02 -2.253116444319106E-03 - 0.000000000000000E+00 -1.547211922864832E-02 -1.777001979865050E-02 2.780701443441668E-02 -2.159868928186500E-03 - -5.443181468910067E-02 4.858864609000908E-03 8.437125006953651E-03 5.855321642273492E-02 4.169364713732138E-03 - 0.000000000000000E+00 8.428661218190376E-01 2.579317951888924E-02 -1.673068397082541E-02 -2.854251040582261E-03 + 2.570149265337249E+00 1.007414113168748E+00 1.386334371526461E-01 -3.673116210627275E-02 -1.295215063628104E-02 + 0.000000000000000E+00 -3.421898095762639E-03 -4.107495746767556E-02 -7.682214219443834E-02 -1.370947603722971E-02 + -1.723282043682246E+00 -6.354397218498025E-01 6.884676691609849E-02 2.896797466257835E-02 -1.498517574066408E-02 + 0.000000000000000E+00 -3.010457844164984E-02 -3.827782462332342E-02 5.135337374005363E-02 -7.319848441048770E-03 + -5.765121737963493E-02 1.384650151212856E-02 1.971283568268974E-02 1.025407754448263E-01 5.563198691570684E-03 + 0.000000000000000E+00 1.180157760866785E+00 7.630610606846362E-02 -3.635903235847662E-02 -3.328734833795404E-03 #----------------- 16 --------------------------- #coil_type coil_name 1 Mod_016 #Nseg current Ifree Length Lfree target_length - 128 7.520728585016159E+05 1 5.395655234765190E+00 1 5.000000000000000E+00 + 128 1.007712831660658E+06 1 7.736768756851439E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.988540031213204E+00 8.327107240942389E-01 3.168435083610435E-02 -4.729635476724804E-02 -3.926656823945956E-03 - 0.000000000000000E+00 -5.590164151263538E-03 -1.319184838461032E-02 -1.523368284503427E-02 3.497877079669447E-04 - -5.953673849392954E-01 -1.619403610664742E-01 1.909576016823804E-02 8.878028283871835E-03 -4.024796951726851E-03 - 0.000000000000000E+00 -3.892517189370693E-02 -5.912038270574568E-02 6.147101657908195E-03 4.944616586224016E-03 - -2.275898605110795E-02 1.924293892638741E-03 3.840216539925661E-03 2.782415193097603E-02 8.378615746983008E-04 - 0.000000000000000E+00 8.394507063337221E-01 2.150443415621218E-02 -5.950976824960581E-02 -3.741060120678750E-03 + 3.035812173839982E+00 1.178718125616083E+00 8.226300350725990E-02 -9.203677424955586E-02 -1.023382212481892E-02 + 0.000000000000000E+00 -8.616298443560863E-03 -3.253987113995281E-02 -3.498796533064394E-02 8.885300740171318E-04 + -6.058758659476825E-01 -2.202862638963616E-01 4.174397623470221E-02 1.990979373799351E-02 -1.543435911060122E-02 + 0.000000000000000E+00 -7.152840656920091E-02 -1.364097222302232E-01 5.998339179209172E-03 2.020942556239318E-02 + -2.413426339787611E-02 5.505815523492382E-03 9.643025752479053E-03 4.635709052618470E-02 1.505782204472723E-03 + 0.000000000000000E+00 1.172567380229947E+00 6.422719022648439E-02 -1.050511441121710E-01 -4.935073053594819E-03 diff --git a/sources/globals.f90 b/sources/globals.f90 index ee81931..a3a2ddc 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -108,14 +108,14 @@ module globals REAL :: weight_ttlen = 0.000D+00 REAL :: target_length = 0.000D+00 REAL :: weight_cssep = 0.000D+00 - REAL :: cssep_factor = 1.000D+00 + REAL :: cssep_factor = 4.000D+00 REAL :: weight_specw = 0.000D+00 REAL :: weight_ccsep = 0.000D+00 REAL :: weight_inorm = 1.000D+00 REAL :: weight_gnorm = 1.000D+00 REAL :: weight_mnorm = 1.000D+00 - INTEGER :: case_optimize = 1 + INTEGER :: case_optimize = 0 REAL :: exit_tol = 1.000D-04 INTEGER :: DF_maxiter = 0 REAL :: DF_xtol = 1.000D-08 diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index 6529724..e9f1c4d 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -158,7 +158,7 @@ subroutine fousurf(filename, index) !-------------output for check------------------------------------------------------------------------- if( myid == 0 .and. IsQuiet <= 0) then write(ounit, *) "-----------Reading surface-----------------------------------" - write(ounit, '("surface : The surface", A," will be discretized in "I6" X "I6" elements.")') trim(filename), Nteta, Nzeta + write(ounit, '("surface : The surface ", A," will be discretized in "I6" X "I6" elements.")') trim(filename), Nteta, Nzeta write(ounit, '(8X": Nfou = " I06 " ; Nfp = " I06 " ; NBnf = " I06 " ;" )') surf(index)%Nfou, surf(index)%Nfp, surf(index)%NBnf endif diff --git a/sources/surface.f90 b/sources/surface.f90 index c6ad2b1..4276ef0 100644 --- a/sources/surface.f90 +++ b/sources/surface.f90 @@ -9,7 +9,7 @@ SUBROUTINE surface INTEGER :: iosta, astat, ierr ! determine the total number of surfaces - if ( weight_cssep > machprec .and. trim(limiter_surf) /= 'none' ) then + if ( weight_cssep > machprec .and. trim(limiter_surf) /= trim(input_surf) ) then plasma = 1 limiter = 2 else ! use the plasma surface as limiter From 4cfe21be319c48fa6bdc783826e4e7e011de2f57 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 16 Jan 2020 23:40:02 -0500 Subject: [PATCH 57/72] minor fixes --- sources/globals.f90 | 2 +- sources/rdsurf.f90 | 3 ++- sources/torflux.f90 | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/sources/globals.f90 b/sources/globals.f90 index c723368..8eb2fba 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.10.01' ! version number + CHARACTER(LEN=10), parameter :: version='v0.10.02' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index f76ab0a..c9c04d4 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -64,7 +64,8 @@ subroutine fousurf(filename, index) use globals, only : dp, zero, half, pi2, myid, ounit, runit, IsQuiet, IsSymmetric, & - Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw, Nfp, plasma + Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw, Nfp, plasma, & + tflux_sign use mpi implicit none diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 21ad6dd..77e0000 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -97,7 +97,7 @@ subroutine torflux( ideriv ) !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, half, one, pi2, sqrtmachprec, bsconstant, ncpu, myid, ounit, & coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, Cdof, Npc, & - tflux, t1F, t2F, Ndof, psi_avg, target_tflux, tflux_sig, & + tflux, t1F, t2F, Ndof, psi_avg, target_tflux, tflux_sign, & itflux, mtflux, LM_fvec, LM_fjac, weight_tflux, plasma implicit none From aea22f901a2735b16d024faac98760ccdbd18280 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Fri, 17 Jan 2020 11:19:45 -0500 Subject: [PATCH 58/72] change rdsurf for stellatorator symmtry --- examples/rotating_ellipse/ellipse.input | 2 +- sources/focus.f90 | 2 + sources/globals.f90 | 5 +- sources/initial.f90 | 9 ++- sources/rdsurf.f90 | 94 +++++++++++++++---------- 5 files changed, 65 insertions(+), 47 deletions(-) diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index eb7ac12..c2bd858 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -1,6 +1,6 @@ &focusin IsQuiet = -1 ! -2 verbose and including unconstrained cost functions; -1: verbose; 0: normal; 1: concise - IsSymmetric = 0 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced + IsSymmetric = 1 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced case_surface = 0 ! 0: general VMEC-like format (Rbc, Rbs, Zbc, Zbs); 1: read axis for knots knotsurf = 0.200D-00 ! minor plasma radius for knototrans, only valid for case surface = 1 diff --git a/sources/focus.f90 b/sources/focus.f90 index bce4f9b..62f1907 100644 --- a/sources/focus.f90 +++ b/sources/focus.f90 @@ -75,6 +75,8 @@ PROGRAM focus end select + call MPI_FINALIZE( ierr ) + STOP select case( case_coils ) diff --git a/sources/globals.f90 b/sources/globals.f90 index 8eb2fba..e252f6e 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -261,7 +261,7 @@ module globals end type toroidalsurface type arbitrarycoil - INTEGER :: NS, Ic=0, Lc=0, type, symm=0 + INTEGER :: NS, Ic=0, Lc=0, type=0, symm=0 REAL :: I=zero, L=zero, Lo, maxcurv, ox, oy, oz, mt, mp, Bt, Bz REAL , allocatable :: xx(:), yy(:), zz(:), xt(:), yt(:), zt(:), xa(:), ya(:), za(:), & dl(:), dd(:) @@ -283,9 +283,10 @@ module globals type(FourierCoil) , allocatable :: FouCoil(:) type(DegreeOfFreedom), allocatable :: DoF(:) - INTEGER :: Nfp = 1, Npc = 1, Nfp_raw = 1 + INTEGER :: Nfp = 1, symmetry = 0, Nfp_raw, Npc INTEGER :: plasma = 1, limiter = 1 REAL , allocatable :: cosip(:), sinip(:) + REAL , allocatable :: cosnfp(:), sinnfp(:) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.f90 b/sources/initial.f90 index c374ccf..cbd222d 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -23,9 +23,9 @@ !latex \item \inputvar{IsSymmetric = 0} \\ !latex \textit{Enforce stellarator symmetry or not} \\ !latex \bi \vspace{-5mm} -!latex \item[0:] no stellarator symmetry enforced; +!latex \item[0:] no symmetry or periodicity enforced; !latex \item[1:] plasma periodicty enforced; -!latex \item[2:] coil and plasma periodicity enforced. +!latex \item[2:] periodicity and stellartor symmetry enforced. !latex \ei !latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} @@ -424,11 +424,10 @@ subroutine initial & 'No stellarator symmetry or periodicity enforced.' case (1) if (IsQuiet < 0) write(ounit, 1000) 'IsSymmetric', IsSymmetric, & - & 'Plasma boundary periodicity is enforced.' - FATAL( initial, .true., This would cause unbalanced coils please use IsSymmetric=0 instead) + & 'Periodicity is enforced.' case (2) if (IsQuiet < 0) write(ounit, 1000) 'IsSymmetric', IsSymmetric, & - & 'Plasma boundary and coil periodicity are both enforced.' + & 'Periodicity and stellarator symmetry are both enforced.' case default FATAL( initial, .true., IsSymmetric /= 0 or 2 unspported option) end select diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index c9c04d4..28b3ebf 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -64,8 +64,8 @@ subroutine fousurf(filename, index) use globals, only : dp, zero, half, pi2, myid, ounit, runit, IsQuiet, IsSymmetric, & - Nteta, Nzeta, surf, Npc, discretefactor, Nfp_raw, Nfp, plasma, & - tflux_sign + Nteta, Nzeta, surf, discretefactor, Nfp, plasma, symmetry, & + tflux_sign, cosnfp, sinnfp use mpi implicit none @@ -74,9 +74,9 @@ subroutine fousurf(filename, index) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: iosta, astat, ierr, ii, jj, imn, Nfou, Nbnf + INTEGER :: iosta, astat, ierr, ii, jj, imn, Nfou, Nbnf, ip REAL :: RR(0:2), ZZ(0:2), szeta, czeta, xx(1:3), xt(1:3), xz(1:3), ds(1:3), & - teta, zeta, arg, dd, theta0, zeta0, r0, z0 + teta, zeta, arg, dd, dz ! read the header if( myid == 0 ) then @@ -177,24 +177,33 @@ subroutine fousurf(filename, index) endif endif - if (index == plasma) then - Nfp = surf(plasma)%Nfp - Nfp_raw = Nfp ! save the raw value of Nfp + surf(index)%Nteta = Nteta + surf(index)%Nzeta = Nzeta + + if (index == plasma) then select case (IsSymmetric) case ( 0 ) - Nfp = 1 !reset Nfp to 1; - Npc = 1 !number of coils periodicity - case ( 1 ) !plasma periodicity enabled; - Npc = 1 - case ( 2 ) !plasma and coil periodicity enabled; - Npc = Nfp + Nfp = 1 ! reset Nfp to 1; + symmetry = 0 + case ( 1 ) ! plasma and coil periodicity enabled; + Nfp = surf(plasma)%Nfp ! use the raw Nfp + symmetry = 0 + case ( 2 ) ! stellarator symmetry enforced; + Nfp = surf(plasma)%Nfp ! use the raw Nfp + symmetry = 1 end select - discretefactor = discretefactor/Nfp + + SALLOCATE( cosnfp, (1:Nfp), zero ) + SALLOCATE( sinnfp, (1:Nfp), zero ) + do ip = 1, Nfp + cosnfp(ip) = cos((ip-1)*pi2/Nfp) + sinnfp(ip) = sin((ip-1)*pi2/Nfp) + enddo + ! discretefactor = discretefactor/Nfp + surf(index)%Nzeta = Nzeta * Nfp * 2**symmetry ! the total number from [0, 2pi] + discretefactor = (pi2/surf(plasma)%Nteta) * (pi2/surf(plasma)%Nzeta) endif - surf(index)%Nteta = Nteta ! not used yet; used for multiple surfaces; 20170307; - surf(index)%Nzeta = Nzeta ! not used yet; used for multiple surfaces; 20170307; - SALLOCATE( surf(index)%xx, (0:Nteta-1,0:Nzeta-1), zero ) !x coordinates; SALLOCATE( surf(index)%yy, (0:Nteta-1,0:Nzeta-1), zero ) !y coordinates SALLOCATE( surf(index)%zz, (0:Nteta-1,0:Nzeta-1), zero ) !z coordinates @@ -215,9 +224,9 @@ subroutine fousurf(filename, index) ! The center point value was used to discretize grid; do ii = 0, Nteta-1 - teta = ( ii + half ) * pi2 / Nteta + teta = ( ii + half ) * pi2 / surf(index)%Nteta do jj = 0, Nzeta-1 - zeta = ( jj + half ) * pi2 / ( Nzeta*Nfp ) + zeta = ( jj + half ) * pi2 / surf(index)%Nzeta RR(0:2) = zero ; ZZ(0:2) = zero do imn = 1, surf(index)%Nfou arg = surf(index)%bim(imn) * teta - surf(index)%bin(imn) * zeta @@ -232,8 +241,10 @@ subroutine fousurf(filename, index) czeta = cos(zeta) xx(1:3) = (/ RR(0) * czeta, RR(0) * szeta, ZZ(0) /) xt(1:3) = (/ RR(1) * czeta, RR(1) * szeta, ZZ(1) /) - xz(1:3) = (/ RR(2) * czeta, RR(2) * szeta, ZZ(2) /) + (/ - RR(0) * szeta, RR(0) * czeta, zero /) - ds(1:3) = -(/ xt(2) * xz(3) - xt(3) * xz(2), & ! minus sign for theta counterclockwise direction; + xz(1:3) = (/ RR(2) * czeta, RR(2) * szeta, ZZ(2) /) & + + (/ - RR(0) * szeta, RR(0) * czeta, zero /) + ! minus sign for theta counterclockwise direction; + ds(1:3) = -(/ xt(2) * xz(3) - xt(3) * xz(2), & xt(3) * xz(1) - xt(1) * xz(3), & xt(1) * xz(2) - xt(2) * xz(1) /) dd = sqrt( sum( ds(1:3)*ds(1:3) ) ) @@ -262,32 +273,37 @@ subroutine fousurf(filename, index) enddo ! end of do ii; 14 Apr 16; ! print volume and area - surf(index)%vol = abs(surf(index)%vol ) * discretefactor * Nfp - surf(index)%area = abs(surf(index)%area) * discretefactor * Nfp - - theta0 = 0.1_dp ; zeta0 = zero - call surfcoord( theta0, zeta0, r0, z0 ) - if (z0 > 0) then - ! counter-clockwise - if( myid == 0) write(ounit, '(8X": The theta angle used is counter-clockwise.")') - tflux_sign = -1 - else - ! clockwise - if( myid == 0) write(ounit, '(8X": The theta angle used is clockwise.")') - tflux_sign = 1 - endif - + surf(index)%vol = abs(surf(index)%vol ) * (pi2/surf(index)%Nteta) * (pi2/surf(index)%Nzeta) + surf(index)%area = abs(surf(index)%area) * (pi2/surf(index)%Nteta) * (pi2/surf(index)%Nzeta) + if (index == plasma) then + surf(index)%vol = surf(index)%vol * Nfp * 2**symmetry + surf(index)%area = surf(index)%area * Nfp * 2**symmetry + endif if( myid == 0 .and. IsQuiet <= 0) then write(ounit, '(8X": Enclosed total surface volume ="ES12.5" m^3 ; area ="ES12.5" m^2." )') & surf(index)%vol, surf(index)%area endif + ! check theta direction for the plasma surface and determine the toroidal flux sign + if (index == plasma) then + dz = surf(plasma)%zz(1,0) - surf(plasma)%zz(0,0) + if (dz > 0) then + ! counter-clockwise + if( myid == 0) write(ounit, '(8X": The theta angle used is counter-clockwise.")') + tflux_sign = -1 + else + ! clockwise + if( myid == 0) write(ounit, '(8X": The theta angle used is clockwise.")') + tflux_sign = 1 + endif + endif + !calculate target Bn with input harmonics; 05 Jan 17; if(surf(index)%NBnf > 0) then do jj = 0, Nzeta-1 - zeta = ( jj + half ) * pi2 / (Nzeta*Nfp) + zeta = ( jj + half ) * pi2 / surf(index)%Nzeta do ii = 0, Nteta-1 - teta = ( ii + half ) * pi2 / Nteta + teta = ( ii + half ) * pi2 / surf(index)%Nteta do imn = 1, surf(index)%NBnf arg = surf(index)%Bnim(imn) * teta - surf(index)%Bnin(imn) * zeta surf(index)%pb(ii,jj) = surf(index)%pb(ii,jj) + surf(index)%Bnc(imn)*cos(arg) + surf(index)%Bns(imn)*sin(arg) @@ -295,7 +311,7 @@ subroutine fousurf(filename, index) enddo enddo endif - + return end subroutine fousurf From 8f94902846635578067f63104fb1c64ade49ff12 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Sun, 19 Jan 2020 21:05:02 -0500 Subject: [PATCH 59/72] debugged with function-only --- examples/rotating_ellipse/ellipse.focus | 34 +-- examples/rotating_ellipse/ellipse.input | 6 +- sources/bfield.f90 | 167 ++++++----- sources/bmnharm.f90 | 12 +- sources/bnormal.f90 | 6 +- sources/boozer.f90 | 2 +- sources/datalloc.f90 | 57 +++- sources/diagnos.f90 | 68 +++-- sources/focus.f90 | 8 - sources/globals.f90 | 5 +- sources/poinplot.f90 | 16 +- sources/rdcoils.f90 | 375 +++++++----------------- sources/saving.f90 | 27 +- sources/specinp.f90 | 9 +- sources/surface.f90 | 3 +- sources/torflux.f90 | 27 +- sources/wtmgrid.f90 | 4 +- 17 files changed, 356 insertions(+), 470 deletions(-) diff --git a/examples/rotating_ellipse/ellipse.focus b/examples/rotating_ellipse/ellipse.focus index 5da1693..aadffed 100644 --- a/examples/rotating_ellipse/ellipse.focus +++ b/examples/rotating_ellipse/ellipse.focus @@ -1,8 +1,8 @@ # Total number of coils - 16 + 4 #----------------- 1 --------------------------- #coil_type coil_name - 1 Mod_001 + 1 2 Mod_001 #Nseg current Ifree Length Lfree target_length 128 1.007712828781890E+06 1 7.736768745413340E+00 1 3.500000000000000E+00 #NFcoil @@ -16,7 +16,7 @@ 0.000000000000000E+00 1.172567382910356E+00 6.422719777078309E-02 -1.050511247457946E-01 -4.935066121438993E-03 #----------------- 2 --------------------------- #coil_type coil_name - 1 Mod_002 + 1 2 Mod_002 #Nseg current Ifree Length Lfree target_length 128 1.001057856680767E+06 1 7.720416122162810E+00 1 3.500000000000000E+00 #NFcoil @@ -30,7 +30,7 @@ 0.000000000000000E+00 1.180157767265387E+00 7.630612006130766E-02 -3.635899306300308E-02 -3.328720688110256E-03 #----------------- 3 --------------------------- #coil_type coil_name - 1 Mod_003 + 1 2 Mod_003 #Nseg current Ifree Length Lfree target_length 128 9.959947815598509E+05 1 7.703049123316433E+00 1 3.500000000000000E+00 #NFcoil @@ -44,7 +44,7 @@ 0.000000000000000E+00 1.191372342826095E+00 8.582831013404432E-02 4.341141659425585E-02 2.472585787285837E-03 #----------------- 4 --------------------------- #coil_type coil_name - 1 Mod_004 + 1 2 Mod_004 #Nseg current Ifree Length Lfree target_length 128 9.953136705502829E+05 1 7.694498108772609E+00 1 3.500000000000000E+00 #NFcoil @@ -58,7 +58,7 @@ 0.000000000000000E+00 1.199833343035113E+00 8.740012169205759E-02 8.822906359677221E-02 7.816080393282967E-03 #----------------- 5 --------------------------- #coil_type coil_name - 1 Mod_005 + 1 2 Mod_005 #Nseg current Ifree Length Lfree target_length 128 9.953136480953702E+05 1 7.694498122494488E+00 1 3.500000000000000E+00 #NFcoil @@ -72,7 +72,7 @@ 0.000000000000000E+00 1.199833342134043E+00 8.740012094217570E-02 8.822905887661604E-02 7.816078104515458E-03 #----------------- 6 --------------------------- #coil_type coil_name - 1 Mod_006 + 1 2 Mod_006 #Nseg current Ifree Length Lfree target_length 128 9.959947318781004E+05 1 7.703049178055673E+00 1 3.500000000000000E+00 #NFcoil @@ -86,7 +86,7 @@ 0.000000000000000E+00 1.191372341984033E+00 8.582830157826138E-02 4.341140403684465E-02 2.472576014066274E-03 #----------------- 7 --------------------------- #coil_type coil_name - 1 Mod_007 + 1 2 Mod_007 #Nseg current Ifree Length Lfree target_length 128 1.001057835887695E+06 1 7.720416345672318E+00 1 3.500000000000000E+00 #NFcoil @@ -100,7 +100,7 @@ 0.000000000000000E+00 1.180157794675723E+00 7.630611316154186E-02 -3.635901057257455E-02 -3.328734994754155E-03 #----------------- 8 --------------------------- #coil_type coil_name - 1 Mod_008 + 1 2 Mod_008 #Nseg current Ifree Length Lfree target_length 128 1.007713011882134E+06 1 7.736769634929175E+00 1 3.500000000000000E+00 #NFcoil @@ -114,7 +114,7 @@ 0.000000000000000E+00 1.172567514240557E+00 6.422721125702005E-02 -1.050511528651706E-01 -4.935073131552209E-03 #----------------- 9 --------------------------- #coil_type coil_name - 1 Mod_009 + 1 2 Mod_009 #Nseg current Ifree Length Lfree target_length 128 1.007713009003368E+06 1 7.736769623491082E+00 1 3.500000000000000E+00 #NFcoil @@ -128,7 +128,7 @@ 0.000000000000000E+00 1.172567516920973E+00 6.422721880132140E-02 -1.050511334987870E-01 -4.935066199393340E-03 #----------------- 10 --------------------------- #coil_type coil_name - 1 Mod_010 + 1 2 Mod_010 #Nseg current Ifree Length Lfree target_length 128 1.001057830257406E+06 1 7.720416322737322E+00 1 3.500000000000000E+00 #NFcoil @@ -142,7 +142,7 @@ 0.000000000000000E+00 1.180157801074327E+00 7.630612715438616E-02 -3.635897127709746E-02 -3.328720849067889E-03 #----------------- 11 --------------------------- #coil_type coil_name - 1 Mod_011 + 1 2 Mod_011 #Nseg current Ifree Length Lfree target_length 128 9.959947283677154E+05 1 7.703049160318660E+00 1 3.500000000000000E+00 #NFcoil @@ -156,7 +156,7 @@ 0.000000000000000E+00 1.191372348472213E+00 8.582830952615123E-02 4.341143368917490E-02 2.472586931893767E-03 #----------------- 12 --------------------------- #coil_type coil_name - 1 Mod_012 + 1 2 Mod_012 #Nseg current Ifree Length Lfree target_length 128 9.953136472062048E+05 1 7.694498116532037E+00 1 3.500000000000000E+00 #NFcoil @@ -170,7 +170,7 @@ 0.000000000000000E+00 1.199833344763041E+00 8.740012238699597E-02 8.822906846429071E-02 7.816081209880421E-03 #----------------- 13 --------------------------- #coil_type coil_name - 1 Mod_013 + 1 2 Mod_013 #Nseg current Ifree Length Lfree target_length 128 9.953136714394486E+05 1 7.694498114735064E+00 1 3.500000000000000E+00 #NFcoil @@ -184,7 +184,7 @@ 0.000000000000000E+00 1.199833340406115E+00 8.740012024723698E-02 8.822905400909316E-02 7.816077287916244E-03 #----------------- 14 --------------------------- #coil_type coil_name - 1 Mod_014 + 1 2 Mod_014 #Nseg current Ifree Length Lfree target_length 128 9.959947850702358E+05 1 7.703049141053451E+00 1 3.500000000000000E+00 #NFcoil @@ -198,7 +198,7 @@ 0.000000000000000E+00 1.191372336337914E+00 8.582830218615099E-02 4.341138694192239E-02 2.472574869455472E-03 #----------------- 15 --------------------------- #coil_type coil_name - 1 Mod_015 + 1 2 Mod_015 #Nseg current Ifree Length Lfree target_length 128 1.001057862311056E+06 1 7.720416145097795E+00 1 3.500000000000000E+00 #NFcoil @@ -212,7 +212,7 @@ 0.000000000000000E+00 1.180157760866785E+00 7.630610606846362E-02 -3.635903235847662E-02 -3.328734833795404E-03 #----------------- 16 --------------------------- #coil_type coil_name - 1 Mod_016 + 1 2 Mod_016 #Nseg current Ifree Length Lfree target_length 128 1.007712831660658E+06 1 7.736768756851439E+00 1 3.500000000000000E+00 #NFcoil diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index c2bd858..28a12e0 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -8,7 +8,7 @@ Nteta = 128 ! poloidal number for discretizing the surface Nzeta = 128 ! toroidal number for discretizing the surface - case_init = 1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles + case_init = 0 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation Ncoils = 16 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 @@ -33,7 +33,7 @@ weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. - case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing using the gradient (DF and/or CG); + case_optimize = 0 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing using the gradient (DF and/or CG); exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold DF_maxiter = 0 ! maximum iterations allowed for using Differential Flow (DF) @@ -53,7 +53,7 @@ case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates save_freq = 1 ! frequency for writing output files; should be positive - save_coils = 1 ! flag for indicating whether write example.focus and example.coils + save_coils = 0 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics save_filaments = 0 ! flag for indicating whether write .example.filaments.xxxxxx diff --git a/sources/bfield.f90 b/sources/bfield.f90 index dfa0851..68fbf12 100644 --- a/sources/bfield.f90 +++ b/sources/bfield.f90 @@ -20,96 +20,111 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine bfield0(icoil, xx, yy, zz, Bx, By, Bz) +subroutine bfield0(icoil, x, y, z, tBx, tBy, tBz) !------------------------------------------------------------------------------------------------------ ! DATE: 06/15/2016; 03/26/2017 ! calculate the magnetic field of icoil using manually discretized coils. ! Biot-Savart constant and currents are not included for later simplication. ! Be careful if coils have different resolutions. !------------------------------------------------------------------------------------------------------ - use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc, Nfp, pi2, half, two, one, bsconstant + use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, cosnfp, sinnfp, & + zero, myid, ounit, Nfp, pi2, half, two, one, bsconstant + use mpi implicit none - include "mpif.h" INTEGER, intent(in ) :: icoil - REAL, intent(in ) :: xx, yy, zz - REAL , intent(out) :: Bx, By, Bz + REAL, intent(in ) :: x, y, z + REAL , intent(out) :: tBx, tBy, tBz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat, kseg - REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, mx, my, mz + INTEGER :: ierr, astat, kseg, ip, is, cs, Npc + REAL :: dlx, dly, dlz, rm3, ltx, lty, ltz, rr, r2, m_dot_r, & + & mx, my, mz, xx, yy, zz, Bx, By, Bz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - FATAL( bfield0, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) - - Bx = zero; By = zero; Bz = zero + FATAL( bfield0, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) + ! initialization + Npc = 1 ; cs = 0 + tBx = zero ; tBy = zero ; tBz = zero dlx = zero ; dly = zero ; dlz = zero ltx = zero ; lty = zero ; ltz = zero - - select case (coil(icoil)%type) - !--------------------------------------------------------------------------------------------- - case(1) - - do kseg = 0, coil(icoil)%NS-1 - - dlx = xx - coil(icoil)%xx(kseg) - dly = yy - coil(icoil)%yy(kseg) - dlz = zz - coil(icoil)%zz(kseg) - rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) - - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) - - Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) - By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) - Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) - - enddo ! enddo kseg - - Bx = Bx * coil(icoil)%I * bsconstant - By = By * coil(icoil)%I * bsconstant - Bz = Bz * coil(icoil)%I * bsconstant - - !--------------------------------------------------------------------------------------------- - case(2) - - dlx = xx - coil(icoil)%ox - dly = yy - coil(icoil)%oy - dlz = zz - coil(icoil)%oz - r2 = dlx**2 + dly**2 + dlz**2 - rm3 = one/(sqrt(r2)*r2) - mx = sin(coil(icoil)%mt) * cos(coil(icoil)%mp) - my = sin(coil(icoil)%mt) * sin(coil(icoil)%mp) - mz = cos(coil(icoil)%mt) - m_dot_r = mx * dlx + my * dly + mz * dlz - - Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - mx * rm3 - By = 3.0_dp * m_dot_r * rm3 / r2 * dly - my * rm3 - Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - mz * rm3 - - Bx = Bx * coil(icoil)%I * bsconstant - By = By * coil(icoil)%I * bsconstant - Bz = Bz * coil(icoil)%I * bsconstant - - !--------------------------------------------------------------------------------------------- - case(3) - ! might be only valid for cylindrical coordinates - ! Bt = u0*I/(2 pi R) - rr = sqrt( xx**2 + yy**2 ) - coil(icoil)%Bt = two/rr * coil(icoil)%I * bsconstant - - Bx = - coil(icoil)%Bt * yy/rr - By = coil(icoil)%Bt * xx/rr - Bz = coil(icoil)%Bz - - !--------------------------------------------------------------------------------------------- - case default - FATAL(bfield0, .true., not supported coil types) + ! check if the coil is stellarator symmetric + select case (coil(icoil)%symm) + case ( 0 ) + cs = 0 + Npc = 1 + case ( 1 ) + cs = 0 + Npc = Nfp + case ( 2) + cs = 1 + Npc = Nfp end select + ! periodicity and stellarator symmetry + do ip = 1, Npc + do is = 0, cs + ! find the point on plasma by rotating in reverse direction. + symmetric + xx = ( x*cosnfp(ip) + y*sinnfp(ip) ) + yy = (-x*sinnfp(ip) + y*cosnfp(ip) ) * (-1)**is + zz = z * (-1)**is + Bx = zero; By = zero; Bz = zero + select case (coil(icoil)%type) + ! Fourier coils + case(1) + ! Biot-Savart law + do kseg = 0, coil(icoil)%NS-1 + dlx = xx - coil(icoil)%xx(kseg) + dly = yy - coil(icoil)%yy(kseg) + dlz = zz - coil(icoil)%zz(kseg) + rm3 = (sqrt(dlx**2 + dly**2 + dlz**2))**(-3) + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + Bx = Bx + ( dlz*lty - dly*ltz ) * rm3 * coil(icoil)%dd(kseg) + By = By + ( dlx*ltz - dlz*ltx ) * rm3 * coil(icoil)%dd(kseg) + Bz = Bz + ( dly*ltx - dlx*lty ) * rm3 * coil(icoil)%dd(kseg) + enddo ! enddo kseg + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + ! magnetic dipoles + case(2) + ! Biot-Savart law + dlx = xx - coil(icoil)%ox + dly = yy - coil(icoil)%oy + dlz = zz - coil(icoil)%oz + r2 = dlx**2 + dly**2 + dlz**2 + rm3 = one/(sqrt(r2)*r2) + mx = sin(coil(icoil)%mt) * cos(coil(icoil)%mp) + my = sin(coil(icoil)%mt) * sin(coil(icoil)%mp) + mz = cos(coil(icoil)%mt) + m_dot_r = mx * dlx + my * dly + mz * dlz + Bx = 3.0_dp * m_dot_r * rm3 / r2 * dlx - mx * rm3 + By = 3.0_dp * m_dot_r * rm3 / r2 * dly - my * rm3 + Bz = 3.0_dp * m_dot_r * rm3 / r2 * dlz - mz * rm3 + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + ! toroidal field and verticle field + case(3) + ! might be only valid for cylindrical coordinates + ! Bt = u0*I/(2 pi R) + rr = sqrt( xx**2 + yy**2 ) + coil(icoil)%Bt = two/rr * coil(icoil)%I * bsconstant + Bx = - coil(icoil)%Bt * yy/rr + By = coil(icoil)%Bt * xx/rr + Bz = coil(icoil)%Bz + case default + FATAL(bfield0, .true., not supported coil types) + end select + ! sum all the contributions + tBx = tBx + (Bx*cosnfp(ip) - By*sinnfp(ip))*(-1)**is + tBy = tBy + (By*cosnfp(ip) + Bx*sinnfp(ip)) + tBz = tBz + Bz + enddo + enddo return @@ -125,7 +140,7 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc, one, bsconstant + zero, myid, ounit, Nfp, one, bsconstant implicit none include "mpif.h" @@ -142,7 +157,7 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - FATAL( bfield1, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) + FATAL( bfield1, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) FATAL( bfield1, ND <= 0, wrong inout dimension of ND ) Bx = zero; By = zero; Bz = zero @@ -259,7 +274,7 @@ end subroutine bfield1 subroutine coils_bfield(B,x,y,z) use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Npc, bsconstant, one, two, ncpu, & + zero, myid, ounit, Nfp, bsconstant, one, two, ncpu, & master, nworker, myworkid, MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS use mpi implicit none @@ -279,7 +294,7 @@ subroutine coils_bfield(B,x,y,z) call MPI_BARRIER(MPI_COMM_MYWORLD, ierr ) ! wait all cpus; B = zero - do icoil = 1, Ncoils*Npc + do icoil = 1, Ncoils if ( myworkid /= modulo(icoil-1, nworker) ) cycle ! MPI ! Bx = zero; By = zero; Bz = zero call bfield0( icoil, x, y, z, Bx, By, Bz ) diff --git a/sources/bmnharm.f90 b/sources/bmnharm.f90 index 8139a71..a3adb0c 100644 --- a/sources/bmnharm.f90 +++ b/sources/bmnharm.f90 @@ -125,7 +125,7 @@ SUBROUTINE readBmn ! allocate trig functions; !---------------------------------------------------------------------------------------- use globals, only: dp, zero, half, pi2, myid, ounit, runit, ext, IsQuiet, Nteta, Nzeta, Nfp, & - NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, Nfp_raw, case_bnormal, & + NBmn, Bmnin, Bmnim, wBmn, tBmnc, tBmns, carg, sarg, case_bnormal, & input_harm, bharm_jsurf, surf, plasma use bharm_mod implicit none @@ -136,6 +136,7 @@ SUBROUTINE readBmn LOGICAL :: exist !---------------------------------------------------------------------------------------- + isurf = plasma inquire( file=trim(input_harm), exist=exist) FATAL( readBmn, .not.exist, ext.harmonics does not exist ) @@ -184,11 +185,14 @@ SUBROUTINE readBmn SALLOCATE( carg, (1:Nteta*Nzeta, 1:NBmn), zero ) SALLOCATE( sarg, (1:Nteta*Nzeta, 1:NBmn), zero ) - Bmnin(1:NBmn) = Bmnin(1:NBmn) * Nfp_raw + Bmnin(1:NBmn) = Bmnin(1:NBmn) * surf(isurf)%Nfp ij = 0 - do jj = 0, Nzeta-1 ; zeta = ( jj + half ) * pi2 / (Nzeta*Nfp) ! the same as in rdsurf.h - do ii = 0, Nteta-1 ; teta = ( ii + half ) * pi2 / Nteta + ! the same as in rdsurf.h + do jj = 0, Nzeta-1 + zeta = ( jj + half ) * pi2 / surf(isurf)%Nzeta + do ii = 0, Nteta-1 + teta = ( ii + half ) * pi2 / surf(isurf)%Nteta ij = ij + 1 do imn = 1, NBmn arg = Bmnim(imn) * teta - Bmnin(imn) * zeta diff --git a/sources/bnormal.f90 b/sources/bnormal.f90 index bb38efc..a05f201 100644 --- a/sources/bnormal.f90 +++ b/sources/bnormal.f90 @@ -35,7 +35,7 @@ subroutine bnormal( ideriv ) !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, half, one, pi2, sqrtmachprec, bsconstant, ncpu, myid, ounit, & coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, plasma, & - bnorm, t1B, t2B, bn, Ndof, Npc, Cdof, weight_bharm, case_bnormal, & + bnorm, t1B, t2B, bn, Ndof, Cdof, weight_bharm, case_bnormal, & weight_bnorm, ibnorm, mbnorm, ibharm, mbharm, LM_fvec, LM_fjac, & bharm, t1H, Bmnc, Bmns, wBmn, tBmnc, tBmns, Bmnim, Bmnin, NBmn use bnorm_mod @@ -66,7 +66,7 @@ subroutine bnormal( ideriv ) do iteta = 0, Nteta - 1 if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - do icoil = 1, Ncoils*Npc + do icoil = 1, Ncoils call bfield0(icoil, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) surf(isurf)%Bx(iteta, jzeta) = surf(isurf)%Bx(iteta, jzeta) + dBx( 0, 0) @@ -151,7 +151,7 @@ subroutine bnormal( ideriv ) if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - do ip = 1, Npc + do ip = 1, 1 idof = 0 do icoil = 1, Ncoils diff --git a/sources/boozer.f90 b/sources/boozer.f90 index 951e681..4b8fc8d 100644 --- a/sources/boozer.f90 +++ b/sources/boozer.f90 @@ -1,6 +1,6 @@ subroutine boozmn USE globals, only : dp, myid, ncpu, zero, ounit, total_num, pp_maxiter, pp_ns, & - XYZB, lboozmn, bmin, bmim, booz_mnc, booz_mns, booz_mpol, booz_ntor, booz_mn, nfp_raw + XYZB, lboozmn, bmin, bmim, booz_mnc, booz_mns, booz_mpol, booz_ntor, booz_mn USE mpi IMPLICIT NONE diff --git a/sources/datalloc.f90 b/sources/datalloc.f90 index d15ca50..bd5b1df 100644 --- a/sources/datalloc.f90 +++ b/sources/datalloc.f90 @@ -13,21 +13,19 @@ subroutine AllocData(type) INTEGER, intent(in) :: type - INTEGER :: icoil, idof, ND, NF, icur, imag, isurf - REAL :: xtmp, mtmp + INTEGER :: icoil, idof, ND, NF, icur, imag, isurf, NS, mm, iseg + REAL :: xtmp, mtmp, tt isurf = plasma !------------------------------------------------------------------------------------------- if (type == -1) then ! dof related data; - Cdof = 0; Ndof = 0; Tdof = 0 - - do icoil = 1, Ncoils*Npc - + do icoil = 1, Ncoils select case (coil(icoil)%type) case(1) ! get number of DoF for each coil and allocate arrays; + NS = coil(icoil)%NS NF = FouCoil(icoil)%NF ND = (6*NF + 3) ! total variables for geometry DoF(icoil)%ND = coil(icoil)%Lc * ND !# of DoF for icoil; @@ -35,6 +33,53 @@ subroutine AllocData(type) SALLOCATE(DoF(icoil)%xof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%yof , (0:coil(icoil)%NS-1, 1:ND), zero) SALLOCATE(DoF(icoil)%zof , (0:coil(icoil)%NS-1, 1:ND), zero) + ! allocate and calculate trignometric functions for re-use + SALLOCATE( FouCoil(icoil)%cmt, (0:NS, 0:NF), zero ) + SALLOCATE( FouCoil(icoil)%smt, (0:NS, 0:NF), zero ) + do iseg = 0, NS + tt = iseg * pi2 / NS + do mm = 0, NF + FouCoil(icoil)%cmt(iseg,mm) = cos( mm * tt ) + FouCoil(icoil)%smt(iseg,mm) = sin( mm * tt ) + enddo + enddo + +!!$ ip = (icoil-1)/Ncoils ! the integer is the period number; +!!$ DoF(icoil)%xof(0:NS-1, 1: NF+1) = cosip(ip) * cmt(0:NS-1, 0:NF) !x/xc +!!$ DoF(icoil)%xof(0:NS-1, NF+2:2*NF+1) = cosip(ip) * smt(0:NS-1, 1:NF) !x/xs +!!$ DoF(icoil)%xof(0:NS-1, 2*NF+2:3*NF+2) = -sinip(ip) * cmt(0:NS-1, 0:NF) !x/yc ; valid for ip>0 ; +!!$ DoF(icoil)%xof(0:NS-1, 3*NF+3:4*NF+2) = -sinip(ip) * smt(0:NS-1, 1:NF) !x/ys ; valid for ip>0 ; +!!$ DoF(icoil)%yof(0:NS-1, 1: NF+1) = sinip(ip) * cmt(0:NS-1, 0:NF) !y/xc ; valid for ip>0 ; +!!$ DoF(icoil)%yof(0:NS-1, NF+2:2*NF+1) = sinip(ip) * smt(0:NS-1, 1:NF) !y/xs ; valid for ip>0 ; +!!$ DoF(icoil)%yof(0:NS-1, 2*NF+2:3*NF+2) = cosip(ip) * cmt(0:NS-1, 0:NF) !y/yc +!!$ DoF(icoil)%yof(0:NS-1, 3*NF+3:4*NF+2) = cosip(ip) * smt(0:NS-1, 1:NF) !y/ys +!!$ DoF(icoil)%zof(0:NS-1, 4*NF+3:5*NF+3) = cmt(0:NS-1, 0:NF) !z/zc +!!$ DoF(icoil)%zof(0:NS-1, 5*NF+4:6*NF+3) = smt(0:NS-1, 1:NF) !z/zs + + ! the derivatives of dx/dv + DoF(icoil)%xof(0:NS-1, 1: NF+1) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !x/xc + DoF(icoil)%xof(0:NS-1, NF+2:2*NF+1) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !x/xs + DoF(icoil)%xof(0:NS-1, 2*NF+2:3*NF+2) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !x/yc + DoF(icoil)%xof(0:NS-1, 3*NF+3:4*NF+2) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !x/ys + DoF(icoil)%yof(0:NS-1, 1: NF+1) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !y/xc + DoF(icoil)%yof(0:NS-1, NF+2:2*NF+1) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !y/xs + DoF(icoil)%yof(0:NS-1, 2*NF+2:3*NF+2) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !y/yc + DoF(icoil)%yof(0:NS-1, 3*NF+3:4*NF+2) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !y/ys + DoF(icoil)%zof(0:NS-1, 4*NF+3:5*NF+3) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !z/zc + DoF(icoil)%zof(0:NS-1, 5*NF+4:6*NF+3) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !z/zs + ! allocate xyz data + SALLOCATE( coil(icoil)%xx, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%yy, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%zz, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%xt, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%yt, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%zt, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%xa, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%ya, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%za, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%dl, (0:coil(icoil)%NS), zero ) + SALLOCATE( coil(icoil)%dd, (0:coil(icoil)%NS), zero ) + coil(icoil)%dd = pi2 / NS ! discretizing factor; case(2) #ifdef dposition DoF(icoil)%ND = coil(icoil)%Lc * 5 ! number of DoF for permanent magnet diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index e7ac89f..8ed8d99 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -7,18 +7,21 @@ SUBROUTINE diagnos !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, one, myid, ounit, sqrtmachprec, IsQuiet, case_optimize, coil, surf, Ncoils, & Nteta, Nzeta, bnorm, bharm, tflux, ttlen, specw, ccsep, coilspace, FouCoil, iout, Tdof, case_length, & - cssep, Bmnc, Bmns, tBmnc, tBmns, weight_bharm, coil_importance, Npc, weight_bnorm, overlap, plasma - + cssep, Bmnc, Bmns, tBmnc, tBmns, weight_bharm, coil_importance, Nfp, weight_bnorm, overlap, plasma, & + cosnfp, sinnfp + use mpi implicit none - include "mpif.h" - INTEGER :: icoil, itmp=0, astat, ierr, NF, idof, i, j, isurf - LOGICAL :: lwbnorm = .True. , l_raw = .False.!if use raw coils data + INTEGER :: icoil, itmp, astat, ierr, NF, idof, i, j, isurf, cs, ip, is + LOGICAL :: lwbnorm, l_raw REAL :: MaxCurv, AvgLength, MinCCdist, MinCPdist, tmp_dist, ReDot, ImDot REAL, parameter :: infmax = 1.0E6 REAL, allocatable :: Atmp(:,:), Btmp(:,:) isurf = plasma + itmp = 0 + lwbnorm = .True. + l_raw = .False. ! if use raw coils data if (myid == 0 .and. IsQuiet < 0) write(ounit, *) "-----------COIL DIAGNOSTICS----------------------------------" !--------------------------------cost functions------------------------------------------------------- @@ -83,37 +86,42 @@ SUBROUTINE diagnos ! coils are supposed to be placed in order minCCdist = infmax do icoil = 1, Ncoils - if(coil(icoil)%type .ne. 1) exit ! only for Fourier - - if(Ncoils .eq. 1) exit !if only one coil - itmp = icoil + 1 ! the guessed adjacent coil - if(icoil .eq. Ncoils .and. npc==1) itmp = 1 - ! only when if npc==1, the last coil would be compared with the first one - + if(Ncoils .eq. 1) exit ! if only one coil + ! Data for the first coil SALLOCATE(Atmp, (1:3,0:coil(icoil)%NS-1), zero) - SALLOCATE(Btmp, (1:3,0:coil(itmp )%NS-1), zero) - Atmp(1, 0:coil(icoil)%NS-1) = coil(icoil)%xx(0:coil(icoil)%NS-1) Atmp(2, 0:coil(icoil)%NS-1) = coil(icoil)%yy(0:coil(icoil)%NS-1) Atmp(3, 0:coil(icoil)%NS-1) = coil(icoil)%zz(0:coil(icoil)%NS-1) - - Btmp(1, 0:coil(itmp )%NS-1) = coil(itmp)%xx(0:coil(itmp )%NS-1) - Btmp(2, 0:coil(itmp )%NS-1) = coil(itmp)%yy(0:coil(itmp )%NS-1) - Btmp(3, 0:coil(itmp )%NS-1) = coil(itmp)%zz(0:coil(itmp )%NS-1) - - call mindist(Atmp, coil(icoil)%NS, Btmp, coil(itmp)%NS, tmp_dist) - + do itmp = 1, Ncoils + ! skip self and non-Fourier coils + if (itmp == icoil .or. coil(icoil)%type /= 1) cycle + SALLOCATE(Btmp, (1:3,0:coil(itmp )%NS-1), zero) + ! check if the coil is stellarator symmetric + if (coil(icoil)%symm == 2) then + cs = 1 + else + cs = 0 + endif + ! load data + do ip = 1, Nfp + do is = 0, cs + Btmp(1, 0:coil(itmp)%NS-1) = (coil(itmp)%xx(0:coil(itmp)%NS-1)*cosnfp(ip) & + & - coil(itmp)%yy(0:coil(itmp)%NS-1)*sinnfp(ip) ) + Btmp(2, 0:coil(itmp)%NS-1) = (-1)**is * (coil(itmp)%xx(0:coil(itmp)%NS-1)*sinnfp(ip) & + & + coil(itmp)%yy(0:coil(itmp)%NS-1)*cosnfp(ip) ) + Btmp(3, 0:coil(itmp)%NS-1) = (-1)**is * (coil(itmp)%zz(0:coil(itmp)%NS-1)) + call mindist(Atmp, coil(icoil)%NS, Btmp, coil(itmp)%NS, tmp_dist) #ifdef DEBUG - if(myid .eq. 0) write(ounit, '(8X": distance between "I3 "-th and "I3"-th coil is : " ES23.15)') & - icoil, itmp, tmp_dist + if(myid .eq. 0) write(ounit, '(8X": distance between "I3.3"-th and "I3.3"-th coil (ip="I2.2 & + ", is="I1") is : " ES23.15)') icoil, itmp, tmp_dist #endif - - if (minCCdist .ge. tmp_dist) minCCdist=tmp_dist - + if (minCCdist .ge. tmp_dist) minCCdist=tmp_dist + enddo + enddo + DALLOCATE(Btmp) + enddo DALLOCATE(Atmp) - DALLOCATE(Btmp) - enddo if(myid .eq. 0) write(ounit, '(8X": The minimum coil-coil distance is "4X" :" ES23.15)') minCCdist @@ -177,11 +185,11 @@ SUBROUTINE diagnos !--------------------------------calculate coil importance------------------------------------ if (.not. allocated(coil_importance)) then - SALLOCATE( coil_importance, (1:Ncoils*Npc), zero ) + SALLOCATE( coil_importance, (1:Ncoils), zero ) endif if (weight_bnorm > sqrtmachprec .or. weight_bharm > sqrtmachprec) then ! make sure data_allocated - do icoil = 1, Ncoils*Npc + do icoil = 1, Ncoils call importance(icoil) enddo diff --git a/sources/focus.f90 b/sources/focus.f90 index 62f1907..ee7c640 100644 --- a/sources/focus.f90 +++ b/sources/focus.f90 @@ -34,16 +34,11 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! PROGRAM focus - use globals, only: dp, ncpu, myid, ounit, ierr, astat, eunit, case_surface, case_coils, case_optimize, & case_postproc, xdof, time_initialize, time_optimize, time_postproc, & version - use mpi !to enable gfortran mpi_wtime bugs; 07/20/2017 - implicit none - - !include "mpif.h" !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -74,9 +69,6 @@ PROGRAM focus !case( 2 ) ; call readwout ! read vmec output for plasma boundary and Boozer coordinates; for future; end select - - call MPI_FINALIZE( ierr ) - STOP select case( case_coils ) diff --git a/sources/globals.f90 b/sources/globals.f90 index e252f6e..ddab491 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -270,7 +270,7 @@ module globals type FourierCoil INTEGER :: NF - REAL , allocatable :: xc(:), xs(:), yc(:), ys(:), zc(:), zs(:) + REAL , allocatable :: xc(:), xs(:), yc(:), ys(:), zc(:), zs(:), cmt(:,:), smt(:,:) end type FourierCoil type DegreeOfFreedom @@ -283,9 +283,8 @@ module globals type(FourierCoil) , allocatable :: FouCoil(:) type(DegreeOfFreedom), allocatable :: DoF(:) - INTEGER :: Nfp = 1, symmetry = 0, Nfp_raw, Npc + INTEGER :: Nfp = 1, symmetry = 0 INTEGER :: plasma = 1, limiter = 1 - REAL , allocatable :: cosip(:), sinip(:) REAL , allocatable :: cosnfp(:), sinnfp(:) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/poinplot.f90 b/sources/poinplot.f90 index 9cf0704..92cbdd7 100644 --- a/sources/poinplot.f90 +++ b/sources/poinplot.f90 @@ -4,10 +4,10 @@ SUBROUTINE poinplot ! Poincare plots of the vacuum flux surfaces and calculate the rotational transform !------------------------------------------------------------------------------------------------------ USE globals, only : dp, myid, ncpu, zero, half, pi, pi2, ounit, pi, sqrtmachprec, pp_maxiter, & - pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, nfp_raw, & + pp_phi, pp_raxis, pp_zaxis, pp_xtol, pp_rmax, pp_zmax, ppr, ppz, pp_ns, iota, & XYZB, lboozmn, booz_mnc, booz_mns, booz_mn, total_num, & master, nmaster, nworker, masterid, color, myworkid, MPI_COMM_MASTERS, & - MPI_COMM_MYWORLD, MPI_COMM_WORKERS, plasma + MPI_COMM_MYWORLD, MPI_COMM_WORKERS, plasma, surf USE mpi IMPLICIT NONE @@ -108,7 +108,7 @@ SUBROUTINE poinplot if (niter==0) then iota(is) = zero else - iota(is) = rzrzt(5) / (niter*pi2/Nfp_raw) + iota(is) = rzrzt(5) / (niter*pi2/surf(Plasma)%Nfp) endif if (myworkid == 0) write(ounit, '(8X": order="I6" ; masterid="I6" ; (R,Z)=("ES12.5","ES12.5 & @@ -143,7 +143,7 @@ END SUBROUTINE poinplot !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! SUBROUTINE find_axis(RZ, MAXFEV, XTOL) - USE globals, only : dp, myid, ounit, zero, pp_phi, Nfp_raw + USE globals, only : dp, myid, ounit, zero, pp_phi USE mpi IMPLICIT NONE @@ -201,7 +201,7 @@ END SUBROUTINE find_axis !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! SUBROUTINE axis_fcn(n,x,fvec,iflag) - USE globals, only : dp, myid, IsQuiet, ounit, zero, pi2, sqrtmachprec, pp_phi, Nfp_raw, pp_xtol + USE globals, only : dp, myid, IsQuiet, ounit, zero, pi2, sqrtmachprec, pp_phi, surf, pp_xtol, plasma USE mpi IMPLICIT NONE @@ -216,7 +216,7 @@ SUBROUTINE axis_fcn(n,x,fvec,iflag) relerr = pp_xtol abserr = sqrtmachprec phi_init = pp_phi - phi_stop = pp_phi + pi2/Nfp_raw + phi_stop = pp_phi + pi2/surf(plasma)%Nfp rz_end = x call ode( BRpZ, n, rz_end, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) @@ -246,7 +246,7 @@ END SUBROUTINE axis_fcn !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! SUBROUTINE ppiota(rzrzt,iflag) - USE globals, only : dp, myid, IsQuiet, ounit, zero, pi2, sqrtmachprec, pp_phi, Nfp_raw, pp_xtol + USE globals, only : dp, myid, IsQuiet, ounit, zero, pi2, sqrtmachprec, pp_phi, surf, pp_xtol, plasma USE mpi IMPLICIT NONE @@ -262,7 +262,7 @@ SUBROUTINE ppiota(rzrzt,iflag) relerr = pp_xtol abserr = sqrtmachprec phi_init = pp_phi - phi_stop = pp_phi + pi2/Nfp_raw + phi_stop = pp_phi + pi2/surf(plasma)%Nfp call ode( BRpZ_iota, n, rzrzt, phi_init, phi_stop, relerr, abserr, ifail, work, iwork ) if ( ifail /= 2 ) then diff --git a/sources/rdcoils.f90 b/sources/rdcoils.f90 index e6f2471..947bacc 100644 --- a/sources/rdcoils.f90 +++ b/sources/rdcoils.f90 @@ -92,13 +92,10 @@ !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! subroutine rdcoils - use globals - + use mpi implicit none - include "mpif.h" - LOGICAL :: exist INTEGER :: icoil, maxnseg, ifirst, NF, itmp, ip, icoef, total_coef, num_pm, num_bg, & num_per_array, num_tor, ipol, itor @@ -111,10 +108,8 @@ subroutine rdcoils num_bg = 0 ! number of background field if(myid == 0) write(ounit, *) "-----------INITIALIZE COILS----------------------------------" - select case( case_init ) - - !-------------read coils file-------------------------------------------------------------------------- + !-------------read coils file-------------------------------------------------------------------------- case(-1 ) if (myid == 0) then write(ounit,'("rdcoils : Reading coils data (MAKEGRID format) from "A)') trim(input_coils) @@ -123,11 +118,10 @@ subroutine rdcoils if (IsQuiet < 0) write(ounit, '(8X,": NFcoil = "I3" ; IsVaryCurrent = "I1 & " ; IsVaryGeometry = "I1)') NFcoil, IsVaryCurrent, IsVaryGeometry endif - IlBCAST( Ncoils , 1, 0 ) IlBCAST( maxnseg , 1, 0 ) - - if( .not. allocated(coilsX) ) then !allocate arrays on other nodes; + ! allocate arrays on other nodes; + if( .not. allocated(coilsX) ) then SALLOCATE( coilsX, (1:maxnseg,1:Ncoils), zero ) SALLOCATE( coilsY, (1:maxnseg,1:Ncoils), zero ) SALLOCATE( coilsZ, (1:maxnseg,1:Ncoils), zero ) @@ -135,7 +129,6 @@ subroutine rdcoils SALLOCATE( coilseg,( 1:Ncoils), 0 ) SALLOCATE( coilname,( 1:Ncoils), '' ) endif - ! broadcast coils data; RlBCAST( coilsX, maxnseg*Ncoils, 0 ) RlBCAST( coilsY, maxnseg*Ncoils, 0 ) @@ -143,16 +136,15 @@ subroutine rdcoils RlBCAST( coilsI, Ncoils, 0 ) IlBCAST( coilseg, Ncoils, 0 ) ClBCAST( coilname, Ncoils, 0 ) - + ! Ncoils are the number of unique coils allocate( coil(1:Ncoils) ) allocate( FouCoil(1:Ncoils) ) allocate( DoF(1:Ncoils) ) - - Ncoils = Ncoils / Npc ! Ncoils changed to unique number of coils; + !Ncoils = Ncoils / Npc ! Ncoils changed to unique number of coils; icoil = 0 do icoil = 1, Ncoils - - !general coil parameters; + ! general coil parameters; + coil(icoil)%symm = 0 ! no symmetry or periodicity coil(icoil)%NS = Nseg coil(icoil)%I = coilsI(icoil) coil(icoil)%Ic = IsVaryCurrent @@ -160,14 +152,13 @@ subroutine rdcoils coil(icoil)%Lc = IsVaryGeometry coil(icoil)%Lo = target_length coil(icoil)%name = trim(coilname(icoil)) - - FATAL( rdcoils, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) - FATAL( rdcoils, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 1, illegal ) - FATAL( rdcoils, coil(icoil)%Lo < zero , illegal ) + ! check coil current and length + FATAL( rdcoils01, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) + FATAL( rdcoils02, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 1, illegal ) + FATAL( rdcoils03, coil(icoil)%Lo < zero , illegal ) if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 - - !Fourier representation related; + ! Fourier representation related; FouCoil(icoil)%NF = NFcoil NF = NFcoil ! alias SALLOCATE( FouCoil(icoil)%xc, (0:NF), zero ) @@ -176,57 +167,56 @@ subroutine rdcoils SALLOCATE( FouCoil(icoil)%ys, (0:NF), zero ) SALLOCATE( FouCoil(icoil)%zc, (0:NF), zero ) SALLOCATE( FouCoil(icoil)%zs, (0:NF), zero ) - !if(myid .ne. modulo(icoil-1, ncpu)) cycle - - call Fourier( coilsX(1:coilseg(icoil),icoil), Foucoil(icoil)%xc, Foucoil(icoil)%xs, coilseg(icoil), NF) - call Fourier( coilsY(1:coilseg(icoil),icoil), Foucoil(icoil)%yc, Foucoil(icoil)%ys, coilseg(icoil), NF) - call Fourier( coilsZ(1:coilseg(icoil),icoil), Foucoil(icoil)%zc, Foucoil(icoil)%zs, coilseg(icoil), NF) - + ! Fourier transformation (FFT might be appied) + call Fourier( coilsX(1:coilseg(icoil),icoil), Foucoil(icoil)%xc, Foucoil(icoil)%xs, coilseg(icoil), NF) + call Fourier( coilsY(1:coilseg(icoil),icoil), Foucoil(icoil)%yc, Foucoil(icoil)%ys, coilseg(icoil), NF) + call Fourier( coilsZ(1:coilseg(icoil),icoil), Foucoil(icoil)%zc, Foucoil(icoil)%zs, coilseg(icoil), NF) enddo - + ! clean space DALLOCATE( coilsX ) DALLOCATE( coilsY ) DALLOCATE( coilsZ ) DALLOCATE( coilsI ) DALLOCATE( coilseg) DALLOCATE(coilname) + ! use Fourier representation by default + coil(1:Ncoils)%type = 1 - coil(1:Ncoils)%type = case_coils - - !-------------individual coil file--------------------------------------------------------------------- + !-------------individual coil file--------------------------------------------------------------------- case( 0 ) - - if( myid==0 ) then !get file number; + ! get coil number first + if( myid==0 ) then open( runit, file=trim(input_coils), status="old", action='read') read( runit,*) read( runit,*) Ncoils write(ounit,'("rdcoils : identified "i6" unique coils in "A" ;")') Ncoils, trim(input_coils) - endif - + endif + ! broadcase and allocate data IlBCAST( Ncoils , 1, 0 ) - allocate( FouCoil(1:Ncoils*Npc) ) - allocate( coil(1:Ncoils*Npc) ) - allocate( DoF(1:Ncoils*Npc) ) - + allocate( FouCoil(1:Ncoils) ) + allocate( coil(1:Ncoils) ) + allocate( DoF(1:Ncoils) ) + ! master CPU read the coils if( myid==0 ) then do icoil = 1, Ncoils read( runit,*) read( runit,*) - read( runit,*) coil(icoil)%type, coil(icoil)%name + read( runit,*) coil(icoil)%type, coil(icoil)%symm, coil(icoil)%name + FATAL( rdcoils04, coil(icoil)%type < 1 .or. coil(icoil)%type > 3, illegal ) + FATAL( rdcoils05, coil(icoil)%symm < 0 .or. coil(icoil)%type > 2, illegal ) if(coil(icoil)%type == 1) then ! Fourier representation read( runit,*) read( runit,*) coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, & & coil(icoil)%L, coil(icoil)%Lc, coil(icoil)%Lo - FATAL( rdcoils, coil(icoil)%NS < 0 , illegal ) - FATAL( rdcoils, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) - FATAL( rdcoils, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 2, illegal ) - FATAL( rdcoils, coil(icoil)%L < zero , illegal ) - FATAL( rdcoils, coil(icoil)%Lc < zero , illegal ) - FATAL( rdcoils, coil(icoil)%Lo < zero , illegal ) + FATAL( rdcoils06, coil(icoil)%NS < 0 , illegal ) + FATAL( rdcoils07, coil(icoil)%Ic < 0 .or. coil(icoil)%Ic > 1, illegal ) + FATAL( rdcoils08, coil(icoil)%Lc < 0 .or. coil(icoil)%Lc > 1, illegal ) + FATAL( rdcoils09, coil(icoil)%L < zero , illegal ) + FATAL( rdcoils10, coil(icoil)%Lo < zero , illegal ) read( runit,*) read( runit,*) FouCoil(icoil)%NF - FATAL( rdcoils, Foucoil(icoil)%NF < 0 , illegal ) + FATAL( rdcoils12, Foucoil(icoil)%NF < 0 , illegal ) SALLOCATE( FouCoil(icoil)%xc, (0:FouCoil(icoil)%NF), zero ) SALLOCATE( FouCoil(icoil)%xs, (0:FouCoil(icoil)%NF), zero ) SALLOCATE( FouCoil(icoil)%yc, (0:FouCoil(icoil)%NF), zero ) @@ -246,24 +236,21 @@ subroutine rdcoils coil(icoil)%Ic, coil(icoil)%I , coil(icoil)%mt, coil(icoil)%mp else if (coil(icoil)%type == 3) then ! backgroud toroidal/vertical field read( runit,*) - read( runit,*) coil(icoil)%Ic, coil(icoil)%I, coil(icoil)%Lc, coil(icoil)%Bz + read( runit,*) coil(icoil)%Ic, coil(icoil)%I, coil(icoil)%Lc, coil(icoil)%Bz + coil(icoil)%symm = 0 ! automatic reset to 0; might not be necessary; 2020/01/17 else STOP " wrong coil type in rdcoils" call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) - endif - + endif enddo !end do icoil; - close( runit ) endif ! end of if( myid==0 ); - + ! broad cast the data and allocate space on slavers do icoil = 1, Ncoils - IlBCAST( coil(icoil)%type , 1 , 0 ) - ClBCAST( coil(icoil)%name , 10 , 0 ) - + IlBCAST( coil(icoil)%symm , 1 , 0 ) + ClBCAST( coil(icoil)%name , 10 , 0 ) if(coil(icoil)%type == 1) then ! Fourier representation - IlBCAST( coil(icoil)%NS , 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) IlBCAST( coil(icoil)%Ic , 1 , 0 ) @@ -271,7 +258,6 @@ subroutine rdcoils IlBCAST( coil(icoil)%Lc , 1 , 0 ) RlBCAST( coil(icoil)%Lo , 1 , 0 ) IlBCAST( FouCoil(icoil)%NF , 1 , 0 ) - if (.not. allocated(FouCoil(icoil)%xc) ) then SALLOCATE( FouCoil(icoil)%xc, (0:FouCoil(icoil)%NF), zero ) SALLOCATE( FouCoil(icoil)%xs, (0:FouCoil(icoil)%NF), zero ) @@ -286,12 +272,9 @@ subroutine rdcoils RlBCAST( FouCoil(icoil)%ys(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) RlBCAST( FouCoil(icoil)%zc(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) RlBCAST( FouCoil(icoil)%zs(0:FouCoil(icoil)%NF) , 1+FouCoil(icoil)%NF , 0 ) - if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 - else if (coil(icoil)%type == 2) then ! permanent magnets - IlBCAST( coil(icoil)%Ic, 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) IlBCAST( coil(icoil)%Lc, 1 , 0 ) @@ -300,39 +283,38 @@ subroutine rdcoils RlBCAST( coil(icoil)%oz, 1 , 0 ) RlBCAST( coil(icoil)%mt, 1 , 0 ) RlBCAST( coil(icoil)%mp, 1 , 0 ) - + if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 + if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 else if (coil(icoil)%type == 3) then ! backgroud toroidal/vertical field - IlBCAST( coil(icoil)%Ic, 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) IlBCAST( coil(icoil)%Lc, 1 , 0 ) RlBCAST( coil(icoil)%Bz, 1 , 0 ) - + if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 + if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 else STOP " wrong coil type in rdcoils" call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) endif - enddo - - !-------------toroidally placed circular coils--------------------------------------------------------- + !-------------toroidally placed circular coils--------------------------------------------------------- case( 1 ) ! toroidally placed coils; 2017/03/13 - - allocate( FouCoil(1:Ncoils*Npc) ) - allocate( coil(1:Ncoils*Npc) ) - allocate( DoF(1:Ncoils*Npc) ) - + ! allocate data + allocate( FouCoil(1:Ncoils) ) + allocate( coil(1:Ncoils) ) + allocate( DoF(1:Ncoils) ) + ! screen outputs if (myid == 0) then - write(ounit,'("rdcoils : initializing "i3" unique circular coils;")') Ncoils - if (IsQuiet < 1) write(ounit, '(8X,": Initialize "I4" circular coils with r="ES12.5"m ; I="& + write(ounit, '(8X,": Initialize "I4" unique circular coils with r="ES12.5"m ; I="& ES12.5" A")') Ncoils, init_radius, init_current if (IsQuiet < 0) write(ounit, '(8X,": NFcoil = "I3" ; IsVaryCurrent = "I1 & " ; IsVaryGeometry = "I1)') NFcoil, IsVaryCurrent, IsVaryGeometry endif - + ! initializations do icoil = 1, Ncoils - - !general coil parameters; + ! general coil parameters; + coil(icoil)%type = 1 + coil(icoil)%symm = IsSymmetric ! follow the general setting coil(icoil)%NS = Nseg coil(icoil)%I = init_current coil(icoil)%Ic = IsVaryCurrent @@ -345,8 +327,7 @@ subroutine rdcoils FATAL( rdcoils, coil(icoil)%Lo < zero , illegal ) if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 - - !Fourier representation related; + ! Fourier representation related; FouCoil(icoil)%NF = NFcoil SALLOCATE( FouCoil(icoil)%xc, (0:NFcoil), zero ) SALLOCATE( FouCoil(icoil)%xs, (0:NFcoil), zero ) @@ -354,36 +335,26 @@ subroutine rdcoils SALLOCATE( FouCoil(icoil)%ys, (0:NFcoil), zero ) SALLOCATE( FouCoil(icoil)%zc, (0:NFcoil), zero ) SALLOCATE( FouCoil(icoil)%zs, (0:NFcoil), zero ) - - !initilize with circular coils; - zeta = (icoil-1+half) * pi2 / (Ncoils*Npc) ! put a half for a shift; - + ! get the geometry center + zeta = (icoil-1+half) * pi2 / (Ncoils*Nfp*2**symmetry) ! put a half for a shift; call surfcoord( plasma, zero, zeta, r1, z1) call surfcoord( plasma, pi, zeta, r2, z2) - Rmaj = half * (r1 + r2) - z0 = half * (z1 + z2) - + z0 = half * (z1 + z2) + ! initilize with circular coils; FouCoil(icoil)%xc(0:1) = (/ Rmaj * cos(zeta), init_radius * cos(zeta) /) FouCoil(icoil)%xs(0:1) = (/ zero , zero /) FouCoil(icoil)%yc(0:1) = (/ Rmaj * sin(zeta), init_radius * sin(zeta) /) FouCoil(icoil)%ys(0:1) = (/ zero , zero /) FouCoil(icoil)%zc(0:1) = (/ z0 , zero /) Foucoil(icoil)%zs(0:1) = (/ zero , init_radius /) - enddo ! end of do icoil; - - coil(1:Ncoils)%type = 1 - - !------------- permanent dipoles and background magnetic field ---------------------------------------- - case( 2 ) ! averagely positioned permanent dipoles ; 2019/01/03 - - allocate( coil(1:Ncoils*Npc) ) - allocate( DoF(1:Ncoils*Npc) ) - + !------------- permanent dipoles and background magnetic field ---------------------------------------- + case( 2 ) ! averagely positioned permanent dipoles ; will be removed; 2020/01/17 + allocate( coil(1:Ncoils) ) + allocate( DoF(1:Ncoils) ) num_per_array = 16 ! number of dipoles at each toroidal cross-section num_tor = (Ncoils-1)/num_per_array ! number of toroidal arrangements - if (myid == 0) then write(ounit,'("rdcoils : initializing "i3" uniformly positioned magnetic dipoles with toroidal magnetif filed")') Ncoils-1 if (IsQuiet < 1) write(ounit, '(8X,": Initialize "I4" X "I4" dipoles on r="ES12.5"m with m="& @@ -391,9 +362,7 @@ subroutine rdcoils if (IsQuiet < 0) write(ounit, '(8X,": IsVaryCurrent = "I1 " ; IsVaryGeometry = "I1)') & IsVaryCurrent, IsVaryGeometry FATAL( rdcoils, modulo(Ncoils-1, num_per_array) /= 0, Please provide a valid number ) - endif - ! background magnetic field Bt Bz icoil = 1 coil(icoil)%I = init_current @@ -406,18 +375,13 @@ subroutine rdcoils coil(icoil)%type = 3 do itor = 1, num_tor - - !initilize with circular coils; zeta = (itor-1) * pi2 / num_tor ! put a half for a shift; call surfcoord( plasma, zero, zeta, r1, z1) call surfcoord( plasma, pi, zeta, r2, z2) Rmaj = half * (r1 + r2) z0 = half * (z1 + z2) - do ipol = 1, num_per_array - icoil = icoil + 1 - !general coil parameters; coil(icoil)%type = 2 coil(icoil)%Ic = IsVaryCurrent @@ -432,7 +396,6 @@ subroutine rdcoils if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 - teta = (ipol-1) * pi2 / num_per_array rtmp = Rmaj + init_radius * cos(teta) coil(icoil)%ox = rtmp * cos(zeta) @@ -463,68 +426,17 @@ subroutine rdcoils enddo ! enddo ipol enddo ! enddo itor - FATAL( rdcoils, icoil .ne. Ncoils, counting coils wrong when initializing ) - end select - FATAL( rdcoils, Nfixcur > Ncoils, error with fixed currents ) FATAL( rdcoils, Nfixgeo > Ncoils, error with fixed geometry ) - !-----------------------allocate coil data-------------------------------------------------- - do ip = 1, Npc - do icoil = 1, Ncoils - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%xx, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%yy, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%zz, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%xt, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%yt, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%zt, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%xa, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%ya, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%za, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%dl, (0:coil(icoil)%NS), zero ) - SALLOCATE( coil(icoil+(ip-1)*Ncoils)%dd, (0:coil(icoil)%NS), zero ) - enddo - enddo - - ! when there are permanent magnets or background fields, these should be muted. - - SALLOCATE( cosip, (0:Npc), one ) ! cos(ip*pi/Np) ; default one ; - SALLOCATE( sinip, (0:Npc), zero ) ! sin(ip*pi/Np) ; default zero; - - if (Npc >= 2) then - do ip = 1, Npc-1 - cosip(ip) = cos(ip*pi2/Npc) ; sinip(ip) = sin(ip*pi2/Npc) - do icoil = 1, Ncoils - select case (coil(icoil)%type) - case( 1 ) - NF = FouCoil(icoil)%NF - SALLOCATE( FouCoil(icoil+ip*Ncoils)%xc, (0:NF), zero ) - SALLOCATE( FouCoil(icoil+ip*Ncoils)%xs, (0:NF), zero ) - SALLOCATE( FouCoil(icoil+ip*Ncoils)%yc, (0:NF), zero ) - SALLOCATE( FouCoil(icoil+ip*Ncoils)%ys, (0:NF), zero ) - SALLOCATE( FouCoil(icoil+ip*Ncoils)%zc, (0:NF), zero ) - SALLOCATE( FouCoil(icoil+ip*Ncoils)%zs, (0:NF), zero ) - case( 2 ) - case( 3 ) - case default - FATAL(discoil, .true., not supported coil types) - end select - enddo - enddo - - call mapcoil ! map perodic coils; - - endif - !-----------------------normalize currents and geometries------------------------------------- - !sum the total currents; + ! sum the total currents; totalcurrent = zero - do icoil = 1, Ncoils*Npc + do icoil = 1, Ncoils totalcurrent = totalcurrent + coil(icoil)%I enddo - if(myid == 0 .and. IsQuiet <= 0) then write(ounit,'(" : "i3" fixed currents ; "i3" fixed geometries.")') & & Nfixcur, Nfixgeo @@ -533,12 +445,10 @@ subroutine rdcoils endif !-----------------------allocate DoF arrays -------------------------------------------------- - itmp = -1 call AllocData(itmp) !-----------------------discretize coil data-------------------------------------------------- - if (myid == 0) then if (IsQuiet < 0) write(ounit, '(8X,": coils will be discretized in "I6" segments")') Nseg endif @@ -551,55 +461,6 @@ subroutine rdcoils end subroutine rdcoils -!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - -subroutine mapcoil -!--------------------------------------------------------------------------------------------- -! mapping periodic coils; -!--------------------------------------------------------------------------------------------- - use globals, only: dp, zero, pi2, myid, ounit, ierr, coil, FouCoil, Ncoils, DoF, Npc, cosip, sinip - implicit none - include "mpif.h" - - INTEGER :: ip, icoil, NF - - do ip = 1, Npc-1 - - do icoil = 1, Ncoils - - coil(icoil+ip*Ncoils)%type = coil(icoil)%type - coil(icoil+ip*Ncoils)%NS = coil(icoil)%NS - coil(icoil+ip*Ncoils)%Ic = coil(icoil)%Ic - coil(icoil+ip*Ncoils)%Lc = coil(icoil)%Lc - coil(icoil+ip*Ncoils)%I = coil(icoil)%I - coil(icoil+ip*Ncoils)%L = coil(icoil)%L - coil(icoil+ip*Ncoils)%Lo = coil(icoil)%Lo - coil(icoil+ip*Ncoils)%maxcurv = coil(icoil)%maxcurv - coil(icoil+ip*Ncoils)%name = coil(icoil)%name - - select case (coil(icoil)%type) - case( 1 ) - Foucoil(icoil+ip*Ncoils)%NF = Foucoil(icoil)%NF - Foucoil(icoil+ip*Ncoils)%xc = Foucoil(icoil)%xc * cosip(ip) - Foucoil(icoil)%yc * sinip(ip) - Foucoil(icoil+ip*Ncoils)%xs = Foucoil(icoil)%xs * cosip(ip) - Foucoil(icoil)%ys * sinip(ip) - Foucoil(icoil+ip*Ncoils)%yc = Foucoil(icoil)%yc * cosip(ip) + Foucoil(icoil)%xc * sinip(ip) - Foucoil(icoil+ip*Ncoils)%ys = Foucoil(icoil)%ys * cosip(ip) + Foucoil(icoil)%xs * sinip(ip) - Foucoil(icoil+ip*Ncoils)%zc = Foucoil(icoil)%zc - Foucoil(icoil+ip*Ncoils)%zs = Foucoil(icoil)%zs - case( 2 ) - case( 3 ) - case default - FATAL(mapcoil, .true., not supported coil types) - end select - - enddo - enddo - - return - -END subroutine mapcoil - - !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! subroutine discoil(ifirst) @@ -608,29 +469,22 @@ subroutine discoil(ifirst) ! if ifirst = 1, it will update all the coils; otherwise, only update free coils; ! date: 20170314 !--------------------------------------------------------------------------------------------- - use globals, only: dp, zero, pi2, myid, ounit, coil, FouCoil, Ncoils, DoF, Npc, cosip, sinip + use globals, only: dp, zero, pi2, myid, ounit, coil, FouCoil, Ncoils, DoF + use mpi implicit none - include "mpif.h" INTEGER, intent(in) :: ifirst INTEGER :: icoil, iseg, mm, NS, NF, ierr, astat, ip REAL :: tt - REAL,allocatable :: cmt(:,:), smt(:,:) !------------------------------------------------------------------------------------------- - !xx, xt, xa are 0, 1st and 2nd derivatives; - if (Npc >= 2) call mapcoil ! map periodic coils; - - do icoil = 1, Ncoils*Npc - - if( (coil(icoil)%Lc + ifirst) /= 0) then !first time or if Lc/=0, then need discretize; - + do icoil = 1, Ncoils + ! first time or if Lc/=0, then need discretize; + if( (coil(icoil)%Lc + ifirst) /= 0) then !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; - select case (coil(icoil)%type) case( 1 ) - - !reset to zero for all the coils; + ! reset to zero for all the coils; coil(icoil)%xx = zero coil(icoil)%yy = zero coil(icoil)%zz = zero @@ -640,65 +494,34 @@ subroutine discoil(ifirst) coil(icoil)%xa = zero coil(icoil)%ya = zero coil(icoil)%za = zero - - NS = coil(icoil)%NS; NF = FouCoil(icoil)%NF ! allias variable for simplicity; - SALLOCATE( cmt, (0:NS, 0:NF), zero ) - SALLOCATE( smt, (0:NS, 0:NF), zero ) - - do iseg = 0, NS ; tt = iseg * pi2 / NS - do mm = 0, NF - cmt(iseg,mm) = cos( mm * tt ) - smt(iseg,mm) = sin( mm * tt ) - enddo - enddo - + NS = coil(icoil)%NS + NF = FouCoil(icoil)%NF ! allias variable for simplicity; !-------------------------calculate coil data------------------------------------------------- mm = 0 - coil(icoil)%xx(0:NS) = cmt(0:NS,mm) * Foucoil(icoil)%xc(mm) - coil(icoil)%yy(0:NS) = cmt(0:NS,mm) * Foucoil(icoil)%yc(mm) - coil(icoil)%zz(0:NS) = cmt(0:NS,mm) * Foucoil(icoil)%zc(mm) + coil(icoil)%xx(0:NS) = FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%xc(mm) + coil(icoil)%yy(0:NS) = FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%yc(mm) + coil(icoil)%zz(0:NS) = FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%zc(mm) do mm = 1, NF - coil(icoil)%xx(0:NS) = coil(icoil)%xx(0:NS) + ( cmt(0:NS,mm) * Foucoil(icoil)%xc(mm) & - + smt(0:NS,mm) * Foucoil(icoil)%xs(mm) ) - coil(icoil)%yy(0:NS) = coil(icoil)%yy(0:NS) + ( cmt(0:NS,mm) * Foucoil(icoil)%yc(mm) & - + smt(0:NS,mm) * Foucoil(icoil)%ys(mm) ) - coil(icoil)%zz(0:NS) = coil(icoil)%zz(0:NS) + ( cmt(0:NS,mm) * Foucoil(icoil)%zc(mm) & - + smt(0:NS,mm) * Foucoil(icoil)%zs(mm) ) - - coil(icoil)%xt(0:NS) = coil(icoil)%xt(0:NS) + ( - smt(0:NS,mm) * Foucoil(icoil)%xc(mm) & - + cmt(0:NS,mm) * Foucoil(icoil)%xs(mm) ) * mm - coil(icoil)%yt(0:NS) = coil(icoil)%yt(0:NS) + ( - smt(0:NS,mm) * Foucoil(icoil)%yc(mm) & - + cmt(0:NS,mm) * Foucoil(icoil)%ys(mm) ) * mm - coil(icoil)%zt(0:NS) = coil(icoil)%zt(0:NS) + ( - smt(0:NS,mm) * Foucoil(icoil)%zc(mm) & - + cmt(0:NS,mm) * Foucoil(icoil)%zs(mm) ) * mm - - coil(icoil)%xa(0:NS) = coil(icoil)%xa(0:NS) + ( - cmt(0:NS,mm) * Foucoil(icoil)%xc(mm) & - - smt(0:NS,mm) * Foucoil(icoil)%xs(mm) ) * mm*mm - coil(icoil)%ya(0:NS) = coil(icoil)%ya(0:NS) + ( - cmt(0:NS,mm) * Foucoil(icoil)%yc(mm) & - - smt(0:NS,mm) * Foucoil(icoil)%ys(mm) ) * mm*mm - coil(icoil)%za(0:NS) = coil(icoil)%za(0:NS) + ( - cmt(0:NS,mm) * Foucoil(icoil)%zc(mm) & - - smt(0:NS,mm) * Foucoil(icoil)%zs(mm) ) * mm*mm + coil(icoil)%xx(0:NS) = coil(icoil)%xx(0:NS) + ( FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%xc(mm) & + + FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%xs(mm) ) + coil(icoil)%yy(0:NS) = coil(icoil)%yy(0:NS) + ( FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%yc(mm) & + + FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%ys(mm) ) + coil(icoil)%zz(0:NS) = coil(icoil)%zz(0:NS) + ( FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%zc(mm) & + + FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%zs(mm) ) + coil(icoil)%xt(0:NS) = coil(icoil)%xt(0:NS) + ( - FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%xc(mm) & + + FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%xs(mm) ) * mm + coil(icoil)%yt(0:NS) = coil(icoil)%yt(0:NS) + ( - FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%yc(mm) & + + FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%ys(mm) ) * mm + coil(icoil)%zt(0:NS) = coil(icoil)%zt(0:NS) + ( - FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%zc(mm) & + + FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%zs(mm) ) * mm + coil(icoil)%xa(0:NS) = coil(icoil)%xa(0:NS) + ( - FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%xc(mm) & + - FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%xs(mm) ) * mm*mm + coil(icoil)%ya(0:NS) = coil(icoil)%ya(0:NS) + ( - FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%yc(mm) & + - FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%ys(mm) ) * mm*mm + coil(icoil)%za(0:NS) = coil(icoil)%za(0:NS) + ( - FouCoil(icoil)%cmt(0:NS,mm) * Foucoil(icoil)%zc(mm) & + - FouCoil(icoil)%smt(0:NS,mm) * Foucoil(icoil)%zs(mm) ) * mm*mm enddo ! end of do mm; - if(ifirst /= 0) then - ip = (icoil-1)/Ncoils ! the integer is the period number; - DoF(icoil)%xof(0:NS-1, 1: NF+1) = cosip(ip) * cmt(0:NS-1, 0:NF) !x/xc - DoF(icoil)%xof(0:NS-1, NF+2:2*NF+1) = cosip(ip) * smt(0:NS-1, 1:NF) !x/xs - DoF(icoil)%xof(0:NS-1, 2*NF+2:3*NF+2) = -sinip(ip) * cmt(0:NS-1, 0:NF) !x/yc ; valid for ip>0 ; - DoF(icoil)%xof(0:NS-1, 3*NF+3:4*NF+2) = -sinip(ip) * smt(0:NS-1, 1:NF) !x/ys ; valid for ip>0 ; - DoF(icoil)%yof(0:NS-1, 1: NF+1) = sinip(ip) * cmt(0:NS-1, 0:NF) !y/xc ; valid for ip>0 ; - DoF(icoil)%yof(0:NS-1, NF+2:2*NF+1) = sinip(ip) * smt(0:NS-1, 1:NF) !y/xs ; valid for ip>0 ; - DoF(icoil)%yof(0:NS-1, 2*NF+2:3*NF+2) = cosip(ip) * cmt(0:NS-1, 0:NF) !y/yc - DoF(icoil)%yof(0:NS-1, 3*NF+3:4*NF+2) = cosip(ip) * smt(0:NS-1, 1:NF) !y/ys - DoF(icoil)%zof(0:NS-1, 4*NF+3:5*NF+3) = cmt(0:NS-1, 0:NF) !z/zc - DoF(icoil)%zof(0:NS-1, 5*NF+4:6*NF+3) = smt(0:NS-1, 1:NF) !z/zs - endif - - coil(icoil)%dd = pi2 / NS ! discretizing factor; - - DALLOCATE(cmt) - DALLOCATE(smt) - case(2) case(3) diff --git a/sources/saving.f90 b/sources/saving.f90 index b2e5dc8..0f07c10 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -130,7 +130,7 @@ subroutine saving HWRITEIV( 1 , pp_maxiter , pp_maxiter ) HWRITERV( 1 , pp_xtol , pp_xtol ) - HWRITEIV( 1 , Nfp , Nfp_raw ) + HWRITEIV( 1 , Nfp , surf(plasma)%Nfp ) HWRITERV( 1 , surf_vol , surf(plasma)%vol ) HWRITERA( Nteta,Nzeta , xsurf , surf(plasma)%xx(0:Nteta-1,0:Nzeta-1) ) HWRITERA( Nteta,Nzeta , ysurf , surf(plasma)%yy(0:Nteta-1,0:Nzeta-1) ) @@ -172,7 +172,7 @@ subroutine saving endif if (allocated(coil_importance)) then - HWRITERV( Ncoils*Npc , coil_importance , coil_importance ) + HWRITERV( Ncoils , coil_importance , coil_importance ) endif if (allocated(LM_fvec)) then @@ -263,10 +263,10 @@ subroutine saving if( save_coils == 1 ) then open(funit,file=trim(out_coils), status="unknown", form="formatted" ) - write(funit,'("periods "I3)') Nfp_raw + write(funit,'("periods "I3)') surf(plasma)%Nfp write(funit,'("begin filament")') write(funit,'("mirror NIL")') - do icoil = 1, Ncoils*Npc + do icoil = 1, Ncoils do ii = 0, coil(icoil)%NS-1 write(funit,1010) coil(icoil)%xx(ii), coil(icoil)%yy(ii), coil(icoil)%zz(ii), coil(icoil)%I enddo @@ -289,7 +289,7 @@ subroutine saving open( funit, file="."//trim(ext)//".filaments."//srestart, status="unknown", form="unformatted" ) write(funit) Ncoils, Nseg - do icoil = 1, Ncoils*Npc + do icoil = 1, Ncoils write(funit) coil(icoil)%xx(0:coil(icoil)%NS) write(funit) coil(icoil)%yy(0:coil(icoil)%NS) write(funit) coil(icoil)%zz(0:coil(icoil)%NS) @@ -308,7 +308,8 @@ subroutine saving write(wunit,'(I6)') NBmn ! write dimensions write(wunit,'("# n m Bmnc Bmns wBmn")') ! comment line; do imn = 1, NBmn - write(wunit,'(2(I3, 4X), 3(ES23.15,4X))') Bmnin(imn)/Nfp_raw, Bmnim(imn), Bmnc(imn), Bmns(imn), wBmn(imn) + write(wunit,'(2(I3, 4X), 3(ES23.15,4X))') Bmnin(imn)/surf(plasma)%Nfp, & + Bmnim(imn), Bmnc(imn), Bmns(imn), wBmn(imn) enddo close(wunit) @@ -332,7 +333,7 @@ SUBROUTINE write_plasma !-------------------------------------------------------------------------------! use globals, only : dp, zero, half, two, pi2, myid, ncpu, ounit, wunit, ext, & plasma, & - Nteta, Nzeta, surf, Nfp_raw, bnorm, sqrtmachprec, out_plasma + Nteta, Nzeta, surf, bnorm, sqrtmachprec, out_plasma implicit none include "mpif.h" @@ -382,7 +383,7 @@ SUBROUTINE write_plasma do jj = 0, Nzeta-1 zeta = ( jj + half ) * pi2 / Nzeta - arg = im*teta - in*Nfp_raw*zeta + arg = im*teta - in*surf(isurf)%Nfp*zeta tmpc = tmpc + surf(isurf)%bn(ii,jj)*cos(arg) tmps = tmps + surf(isurf)%bn(ii,jj)*sin(arg) @@ -392,7 +393,7 @@ SUBROUTINE write_plasma if ( (abs(tmpc) + abs(tmps)) .lt. tol ) cycle imn = imn + 1 - surf(isurf)%bnin(imn) = in * Nfp_raw + surf(isurf)%bnin(imn) = in * surf(isurf)%Nfp surf(isurf)%bnim(imn) = im if (im .eq. 0 ) then @@ -415,20 +416,20 @@ SUBROUTINE write_plasma open(wunit, file=trim(out_plasma), status='unknown', action='write') write(wunit,* ) "#Nfou Nfp Nbnf" - write(wunit,'(3I6)' ) surf(isurf)%Nfou, Nfp_raw, surf(isurf)%Nbnf + write(wunit,'(3I6)' ) surf(isurf)%Nfou, surf(isurf)%Nfp, surf(isurf)%Nbnf write(wunit,* ) "#------- plasma boundary------" write(wunit,* ) "# n m Rbc Rbs Zbc Zbs" do imn = 1, surf(isurf)%Nfou - write(wunit,'(2I6, 4ES15.6)') surf(isurf)%bin(imn)/Nfp_raw, surf(isurf)%bim(imn), surf(isurf)%Rbc(imn), & - surf(isurf)%Rbs(imn), surf(isurf)%Zbc(imn), surf(isurf)%Zbs(imn) + write(wunit,'(2I6, 4ES15.6)') surf(isurf)%bin(imn)/surf(isurf)%Nfp, surf(isurf)%bim(imn), & + surf(isurf)%Rbc(imn), surf(isurf)%Rbs(imn), surf(isurf)%Zbc(imn), surf(isurf)%Zbs(imn) enddo write(wunit,* ) "#-------Bn harmonics----------" write(wunit,* ) "# n m bnc bns" if (surf(isurf)%Nbnf .gt. 0) then do imn = 1, surf(isurf)%Nbnf - write(wunit,'(2I6, 2ES15.6)') surf(isurf)%bnin(imn)/Nfp_raw, surf(isurf)%bnim(imn), & + write(wunit,'(2I6, 2ES15.6)') surf(isurf)%bnin(imn)/surf(isurf)%Nfp, surf(isurf)%bnim(imn), & surf(isurf)%bnc(imn), surf(isurf)%bns(imn) enddo else diff --git a/sources/specinp.f90 b/sources/specinp.f90 index 11bca0a..6f13fff 100644 --- a/sources/specinp.f90 +++ b/sources/specinp.f90 @@ -6,12 +6,12 @@ SUBROUTINE specinp ! 2. Calculate the poloidal and toroidal closed currents (Itor and Gpol) ! 3. Write down a xxx.Vns file with all the information for SPEC !-------------------------------------------------------------------------------! - use globals, only: dp, zero, half, two, pi2, mu0, myid, wunit, ounit, surf, bn, ext, & - Nfp_raw, Nteta, Nzeta, plasma + use globals, only: dp, zero, half, two, pi2, mu0, myid, wunit, ounit, surf, bn, ext, & + Nteta, Nzeta, plasma implicit none include "mpif.h" !------------------------------------------------------------------------------- - INTEGER :: mf, nf ! Fourier modes size + INTEGER :: mf, nf, Nfp_raw ! Fourier modes size INTEGER :: imn=0, ii, jj, im, in, astat, ierr, Nbf, iteta, jzeta, isurf REAL :: teta, zeta, arg, tol, tmpc, tmps, curtor, curpol INTEGER, allocatable:: bnim(:), bnin(:) @@ -19,6 +19,7 @@ SUBROUTINE specinp ! use the plasma for now; could be the limiter surface; 2019/12/15 isurf = plasma + Nfp_raw = surf(isurf)%Nfp ! default Fourier resolution; could be customized mf = 24 ; nf = 12 ! compute Bn @@ -40,7 +41,7 @@ SUBROUTINE specinp teta = ( ii + half ) * pi2 / Nteta do jj = 0, Nzeta-1 zeta = ( jj + half ) * pi2 / Nzeta - arg = im*teta - in*Nfp_raw*zeta + arg = im*teta - in*surf(isurf)%Nfp*zeta tmpc = tmpc + (-bn(ii, jj)*surf(isurf)%ds(ii,jj))*cos(arg) ! minus sign is required because tmps = tmps + (-bn(ii, jj)*surf(isurf)%ds(ii,jj))*sin(arg) ! the normal vector in SPEC is e_t x e_z enddo ! end jj diff --git a/sources/surface.f90 b/sources/surface.f90 index 4276ef0..ca163e1 100644 --- a/sources/surface.f90 +++ b/sources/surface.f90 @@ -9,7 +9,8 @@ SUBROUTINE surface INTEGER :: iosta, astat, ierr ! determine the total number of surfaces - if ( weight_cssep > machprec .and. trim(limiter_surf) /= trim(input_surf) ) then + ! if ( weight_cssep > machprec .and. trim(limiter_surf) /= trim(input_surf) ) then + if ( weight_cssep > machprec ) then plasma = 1 limiter = 2 else ! use the plasma surface as limiter diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 77e0000..6f3f7a3 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -96,7 +96,7 @@ subroutine torflux( ideriv ) ! ideriv = 2 -> calculate the toroidal flux constraint and its first & second derivatives; !------------------------------------------------------------------------------------------------------ use globals, only: dp, zero, half, one, pi2, sqrtmachprec, bsconstant, ncpu, myid, ounit, & - coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, Cdof, Npc, & + coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, Cdof, & tflux, t1F, t2F, Ndof, psi_avg, target_tflux, tflux_sign, & itflux, mtflux, LM_fvec, LM_fjac, weight_tflux, plasma @@ -126,7 +126,7 @@ subroutine torflux( ideriv ) lflux = zero do iteta = 0, Nteta - 1 lax = zero; lay = zero; laz = zero - do ip = 1, Npc + do ip = 1, 1 do icoil = 1, Ncoils call bpotential0(icoil+(ip-1)*Ncoils, iteta, jzeta, dAx(0,0), dAy(0,0), dAz(0,0)) lax = lax + dAx( 0, 0) * coil(icoil)%I * bsconstant @@ -174,7 +174,7 @@ subroutine torflux( ideriv ) do iteta = 0, Nteta - 1 - do ip = 1, Npc + do ip = 1, 1 idof = 0 do icoil = 1, Ncoils ND = DoF(icoil)%ND @@ -243,7 +243,7 @@ subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) ! Biot-Savart constant and currents are not included for later simplication. ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ - use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, Npc, & + use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & zero, myid, ounit, plasma implicit none include "mpif.h" @@ -258,9 +258,9 @@ subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - FATAL( bpotential0, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, icoil not in right range ) - FATAL( bpotential0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) - FATAL( bpotential0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) + FATAL( bpotential0, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) + FATAL( bpotential0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) + FATAL( bpotential0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) dlx = zero; ltx = zero; Ax = zero dly = zero; lty = zero; Ay = zero @@ -296,7 +296,7 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) ! Biot-Savart constant and currents are not included for later simplication. ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ - use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, Npc, & + use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, & zero, myid, ounit, plasma implicit none include "mpif.h" @@ -311,13 +311,10 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dAxx, dAxy, dAxz, dAyx, dAyy, dAyz, dAzx, dAzy, dAzz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - - FATAL( bpotential1, icoil .lt. 1 .or. icoil .gt. Ncoils*Npc, & - icoil not in right range ) - FATAL( bpotential1, iteta .lt. 0 .or. iteta .gt. Nteta , & - iteta not in right range ) - FATAL( bpotential1, jzeta .lt. 0 .or. jzeta .gt. Nzeta , & - jzeta not in right range ) + + FATAL( bpotential1, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) + FATAL( bpotential1, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) + FATAL( bpotential1, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) FATAL( bpotential1, ND <= 0, wrong inout dimension of ND ) NS = coil(icoil)%NS diff --git a/sources/wtmgrid.f90 b/sources/wtmgrid.f90 index 8e8bb15..b9256ea 100644 --- a/sources/wtmgrid.f90 +++ b/sources/wtmgrid.f90 @@ -9,7 +9,7 @@ end module mgrid_mod !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! subroutine wtmgrid - use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit, runit, nfp_raw, & + use globals, only : dp, zero, half, pi2, ext, ncpu, myid, ounit, wunit, runit, surf, plasma, & sqrtmachprec, master, nmaster, nworker, masterid, color, myworkid, & MPI_COMM_MASTERS, MPI_COMM_MYWORLD, MPI_COMM_WORKERS use mgrid_mod @@ -36,7 +36,7 @@ subroutine wtmgrid enddo mgrid_name = "mgrid.focus_"//trim(ext) ! filename, could be user input - if (Mfp <= 0) Mfp = nfp_raw ! overrid to nfp_raw if not specified + if (Mfp <= 0) Mfp = surf(plasma)%Nfp ! overrid to nfp_raw if not specified B = zero ; dx = 1E-4 ; dy = 1E-4 ; dz = 1E-4 FATAL( wrmgrid, abs(Rmin)+abs(Rmax) Date: Mon, 20 Jan 2020 09:41:28 -0500 Subject: [PATCH 60/72] save before changing the toroidal flux --- examples/rotating_ellipse/ellipse.focus | 258 ++++++++++++------------ examples/rotating_ellipse/ellipse.input | 18 +- sources/bfield.f90 | 219 ++++++++++---------- sources/bnormal.f90 | 148 +++++--------- sources/datalloc.f90 | 8 +- sources/torflux.f90 | 114 ++++++----- 6 files changed, 373 insertions(+), 392 deletions(-) diff --git a/examples/rotating_ellipse/ellipse.focus b/examples/rotating_ellipse/ellipse.focus index aadffed..4b0f749 100644 --- a/examples/rotating_ellipse/ellipse.focus +++ b/examples/rotating_ellipse/ellipse.focus @@ -1,226 +1,226 @@ # Total number of coils - 4 + 16 #----------------- 1 --------------------------- #coil_type coil_name - 1 2 Mod_001 + 1 Mod_001 #Nseg current Ifree Length Lfree target_length - 128 1.007712828781890E+06 1 7.736768745413340E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 3.035812070253488E+00 1.178718088122252E+00 8.226301904596144E-02 -9.203675809244777E-02 -1.023382071597401E-02 - 0.000000000000000E+00 8.616301147951573E-03 3.253986956653675E-02 3.498799084434340E-02 -8.885224858527464E-04 - 6.058764001526894E-01 2.202864536793396E-01 -4.174400818416566E-02 -1.990981246590881E-02 1.543436943049511E-02 - 0.000000000000000E+00 -7.152839295865940E-02 -1.364096990934720E-01 5.998353132971824E-03 2.020941966100692E-02 - 2.413431691178328E-02 -5.505816697664090E-03 -9.643018431584272E-03 -4.635712550042110E-02 -1.505793523927265E-03 - 0.000000000000000E+00 1.172567382910356E+00 6.422719777078309E-02 -1.050511247457946E-01 -4.935066121438993E-03 + 2.942355838996189E+00 4.903926396686359E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 5.852709823209967E-01 9.754516368753213E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.296102208412681E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 2 --------------------------- #coil_type coil_name - 1 2 Mod_002 + 1 Mod_002 #Nseg current Ifree Length Lfree target_length - 128 1.001057856680767E+06 1 7.720416122162810E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.570148968625153E+00 1.007414000750858E+00 1.386334577764704E-01 -3.673112756615116E-02 -1.295213733937123E-02 - 0.000000000000000E+00 3.421882288948261E-03 4.107491907192981E-02 7.682213933896125E-02 1.370948208945556E-02 - 1.723282497586355E+00 6.354398903844151E-01 -6.884675804882144E-02 -2.896796428815738E-02 1.498517485181280E-02 - 0.000000000000000E+00 -3.010455410648684E-02 -3.827778668254885E-02 5.135339828866215E-02 -7.319854012318223E-03 - 5.765125413661209E-02 -1.384650035977095E-02 -1.971281555229668E-02 -1.025407805228553E-01 -5.563199952353330E-03 - 0.000000000000000E+00 1.180157767265387E+00 7.630612006130766E-02 -3.635899306300308E-02 -3.328720688110256E-03 + 2.494408811601982E+00 4.157348015978825E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 1.666710741292756E+00 2.777851233244309E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 5.543278682049479E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 3 --------------------------- #coil_type coil_name - 1 2 Mod_003 + 1 Mod_003 #Nseg current Ifree Length Lfree target_length - 128 9.959947815598509E+05 1 7.703049123316433E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.712644495836300E+00 6.784380570055493E-01 1.538185103613542E-01 2.346641946617012E-02 1.196852370400807E-02 - 0.000000000000000E+00 -3.573739580334476E-02 -4.033929278453750E-02 5.372993659147889E-02 1.826821350017657E-02 - 2.573241287264196E+00 9.631762686694120E-01 -2.625882679863217E-03 2.495777438098891E-02 -3.966865325499821E-03 - 0.000000000000000E+00 5.701315840674340E-03 4.356538807688857E-02 8.461235727542724E-02 -3.702192388978986E-03 - 5.706552562783206E-02 -1.509696942921082E-02 -1.470358590642982E-02 -9.007853505434120E-02 -7.635287762220054E-03 - 0.000000000000000E+00 1.191372342826095E+00 8.582831013404432E-02 4.341141659425585E-02 2.472585787285837E-03 + 1.666710632258679E+00 2.777851051520846E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.494408884456223E+00 4.157348137402559E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 5.543278280586475E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 4 --------------------------- #coil_type coil_name - 1 2 Mod_004 + 1 Mod_004 #Nseg current Ifree Length Lfree target_length - 128 9.953136705502829E+05 1 7.694498108772609E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 5.999177950903241E-01 2.391317634594994E-01 6.867939241678205E-02 2.280104508038897E-02 1.564512479405216E-02 - 0.000000000000000E+00 -7.373064958373243E-02 -1.278942556620330E-01 8.127339201131063E-04 -1.155199830192180E-02 - 3.029337519697936E+00 1.142478509633036E+00 7.710012761187962E-02 9.580045912788590E-02 4.525279204688185E-03 - 0.000000000000000E+00 7.877000042647551E-03 3.183320319611994E-02 4.436408957919718E-02 5.456334517795335E-03 - 2.358621091788803E-02 -6.643975611929005E-03 -4.634582045910598E-03 -3.385380103397225E-02 -3.348327178333740E-03 - 0.000000000000000E+00 1.199833343035113E+00 8.740012169205759E-02 8.822906359677221E-02 7.816080393282967E-03 + 5.852708537065325E-01 9.754514225178811E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.942355864579194E+00 4.903926439324701E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.296101239195262E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 5 --------------------------- #coil_type coil_name - 1 2 Mod_005 + 1 Mod_005 #Nseg current Ifree Length Lfree target_length - 128 9.953136480953702E+05 1 7.694498122494488E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -5.999180374778748E-01 -2.391318722353527E-01 -6.867942253301033E-02 -2.280105664654825E-02 -1.564512732700421E-02 - 0.000000000000000E+00 -7.373064234036350E-02 -1.278942397557588E-01 8.127475200508375E-04 -1.155198772461002E-02 - 3.029337470076367E+00 1.142478489878644E+00 7.710011702561391E-02 9.580044771697098E-02 4.525274244011152E-03 - 0.000000000000000E+00 -7.877002057678044E-03 -3.183323447660678E-02 -4.436411511106713E-02 -5.456348744412772E-03 - -2.358620136427579E-02 6.643982753355445E-03 4.634611993460796E-03 3.385382064889689E-02 3.348339555678685E-03 - 0.000000000000000E+00 1.199833342134043E+00 8.740012094217570E-02 8.822905887661604E-02 7.816078104515458E-03 + -5.852711105438521E-01 -9.754518512327597E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.942355811444433E+00 4.903926354048007E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.296100070337964E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 6 --------------------------- #coil_type coil_name - 1 2 Mod_006 + 1 Mod_006 #Nseg current Ifree Length Lfree target_length - 128 9.959947318781004E+05 1 7.703049178055673E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.712644710314362E+00 -6.784381463678996E-01 -1.538185231850033E-01 -2.346641014050958E-02 -1.196851262331553E-02 - 0.000000000000000E+00 -3.573738205680022E-02 -4.033925670939641E-02 5.372995834765551E-02 1.826822504315144E-02 - 2.573241132481436E+00 9.631762176638391E-01 -2.625906188340279E-03 2.495775834238372E-02 -3.966871276957000E-03 - 0.000000000000000E+00 -5.701310492114258E-03 -4.356539441348187E-02 -8.461235987345980E-02 3.702189774381795E-03 - -5.706550729986900E-02 1.509697471399099E-02 1.470361372097697E-02 9.007854960472310E-02 7.635295898869570E-03 - 0.000000000000000E+00 1.191372341984033E+00 8.582830157826138E-02 4.341140403684465E-02 2.472576014066274E-03 + -1.666710847634489E+00 -2.777851414967767E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.494408734718363E+00 4.157347894555082E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -5.543276260097516E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 7 --------------------------- #coil_type coil_name - 1 2 Mod_007 + 1 Mod_007 #Nseg current Ifree Length Lfree target_length - 128 1.001057835887695E+06 1 7.720416345672318E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.570149149273860E+00 -1.007414084832676E+00 -1.386334592263733E-01 3.673114474136688E-02 1.295214869369829E-02 - 0.000000000000000E+00 3.421890907591615E-03 4.107495319117371E-02 7.682214905847547E-02 1.370948143317612E-02 - 1.723282227045863E+00 6.354398128755060E-01 -6.884676614305148E-02 -2.896796768877542E-02 1.498517048416115E-02 - 0.000000000000000E+00 3.010457113387168E-02 3.827780451249946E-02 -5.135338639893422E-02 7.319852131197339E-03 - -5.765121979000968E-02 1.384650850786926E-02 1.971283616213717E-02 1.025407861959757E-01 5.563200320214472E-03 - 0.000000000000000E+00 1.180157794675723E+00 7.630611316154186E-02 -3.635901057257455E-02 -3.328734994754155E-03 + -2.494408953281085E+00 -4.157348258826286E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 1.666710520532256E+00 2.777850869797377E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -5.543275457171508E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 8 --------------------------- #coil_type coil_name - 1 2 Mod_008 + 1 Mod_008 #Nseg current Ifree Length Lfree target_length - 128 1.007713011882134E+06 1 7.736769634929175E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -3.035812190076971E+00 -1.178718246298075E+00 -8.226303973760205E-02 9.203678168888621E-02 1.023382563414603E-02 - 0.000000000000000E+00 8.616289891423583E-03 3.253988335649922E-02 3.498797318765669E-02 -8.885276136174528E-04 - 6.058759650237356E-01 2.202863188306560E-01 -4.174399386998583E-02 -1.990979554126186E-02 1.543436493092415E-02 - 0.000000000000000E+00 7.152842242867612E-02 1.364097339631465E-01 -5.998343217546971E-03 -2.020941949019226E-02 - -2.413426227598850E-02 5.505831295564258E-03 9.643028494945862E-03 4.635710357026913E-02 1.505782576973876E-03 - 0.000000000000000E+00 1.172567514240557E+00 6.422721125702005E-02 -1.050511528651706E-01 -4.935073131552209E-03 + -2.942355888193449E+00 -4.903926481963035E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 5.852707247004597E-01 9.754512081604391E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.296098131903127E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 9 --------------------------- #coil_type coil_name - 1 2 Mod_009 + 1 Mod_009 #Nseg current Ifree Length Lfree target_length - 128 1.007713009003368E+06 1 7.736769623491082E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -3.035812086490458E+00 -1.178718208804232E+00 -8.226305527630723E-02 9.203676553177235E-02 1.023382422529885E-02 - 0.000000000000000E+00 -8.616292595815122E-03 -3.253988178307896E-02 -3.498799870135588E-02 8.885200254525288E-04 - -6.058764992287430E-01 -2.202865086136521E-01 4.174402581944861E-02 1.990981426917706E-02 -1.543437525081508E-02 - 0.000000000000000E+00 7.152840881812825E-02 1.364097108263868E-01 -5.998357171315089E-03 -2.020941358880629E-02 - 2.413431578989709E-02 -5.505832469732896E-03 -9.643021174050515E-03 -4.635713854450813E-02 -1.505793896427040E-03 - 0.000000000000000E+00 1.172567516920973E+00 6.422721880132140E-02 -1.050511334987870E-01 -4.935066199393340E-03 + -2.942355787830161E+00 -4.903926311409647E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -5.852712395499218E-01 -9.754520655901960E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.296103177630029E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 10 --------------------------- #coil_type coil_name - 1 2 Mod_010 + 1 Mod_010 #Nseg current Ifree Length Lfree target_length - 128 1.001057830257406E+06 1 7.720416322737322E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.570148852561737E+00 -1.007413972414764E+00 -1.386334798501972E-01 3.673111020124325E-02 1.295213539678410E-02 - 0.000000000000000E+00 -3.421875100775482E-03 -4.107491479541587E-02 -7.682214620298777E-02 -1.370948748539923E-02 - -1.723282680949956E+00 -6.354399814101118E-01 6.884675727576360E-02 2.896795731434789E-02 -1.498516959530881E-02 - 0.000000000000000E+00 3.010454679870936E-02 3.827776657172516E-02 -5.135341094754236E-02 7.319857702463556E-03 - 5.765125654698011E-02 -1.384650735550876E-02 -1.971281603173873E-02 -1.025407912739954E-01 -5.563201580994880E-03 - 0.000000000000000E+00 1.180157801074327E+00 7.630612715438616E-02 -3.635897127709746E-02 -3.328720849067889E-03 + -2.494408665893487E+00 -4.157347773131332E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -1.666710959360904E+00 -2.777851596691220E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 5.543279083512315E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 11 --------------------------- #coil_type coil_name - 1 2 Mod_011 + 1 Mod_011 #Nseg current Ifree Length Lfree target_length - 128 9.959947283677154E+05 1 7.703049160318660E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.712644264450062E+00 -6.784379697121713E-01 -1.538185073195206E-01 -2.346642703984504E-02 -1.196853000603485E-02 - 0.000000000000000E+00 3.573740731570572E-02 4.033931497421444E-02 -5.372992549301056E-02 -1.826820967299947E-02 - -2.573241435757327E+00 -9.631763343437154E-01 2.625867477739654E-03 -2.495779447975716E-02 3.966867266908904E-03 - 0.000000000000000E+00 -5.701320786415893E-03 -4.356539567371004E-02 -8.461235812758644E-02 3.702189342477119E-03 - 5.706552141656023E-02 -1.509696955366239E-02 -1.470358338788201E-02 -9.007852687853637E-02 -7.635286717773872E-03 - 0.000000000000000E+00 1.191372348472213E+00 8.582830952615123E-02 4.341143368917490E-02 2.472586931893767E-03 + -1.666710414190513E+00 -2.777850688073904E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.494409030164690E+00 -4.157348380250005E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 5.543277879123301E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 12 --------------------------- #coil_type coil_name - 1 2 Mod_012 + 1 Mod_012 #Nseg current Ifree Length Lfree target_length - 128 9.953136472062048E+05 1 7.694498116532037E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -5.999175121250989E-01 -2.391316593673553E-01 -6.867936583068979E-02 -2.280103670376822E-02 -1.564512028792894E-02 - 0.000000000000000E+00 7.373065446635568E-02 1.278942681172012E-01 -8.127255678641903E-04 1.155200382772511E-02 - -3.029337576386504E+00 -1.142478531366271E+00 -7.710013895610672E-02 -9.580046973731804E-02 -4.525282109908059E-03 - 0.000000000000000E+00 -7.876995673694556E-03 -3.183319154455465E-02 -4.436407243126113E-02 -5.456333107994519E-03 - 2.358620001280720E-02 -6.643973860751291E-03 -4.634579712825352E-03 -3.385378691877480E-02 -3.348325514503858E-03 - 0.000000000000000E+00 1.199833344763041E+00 8.740012238699597E-02 8.822906846429071E-02 7.816081209880421E-03 + -5.852705964776008E-01 -9.754509938029951E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.942355915745187E+00 -4.903926524601357E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.296100269977773E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 13 --------------------------- #coil_type coil_name - 1 2 Mod_013 + 1 Mod_013 #Nseg current Ifree Length Lfree target_length - 128 9.953136714394486E+05 1 7.694498114735064E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 5.999183204430892E-01 2.391319763274959E-01 6.867944911909597E-02 2.280106502316325E-02 1.564513183312241E-02 - 0.000000000000000E+00 7.373063745773815E-02 1.278942273005794E-01 -8.127558723072576E-04 1.155198219880172E-02 - -3.029337413387749E+00 -1.142478468145390E+00 -7.710010568137941E-02 -9.580043710753043E-02 -4.525271338788939E-03 - 0.000000000000000E+00 7.877006426629297E-03 3.183324612816577E-02 4.436413225899662E-02 5.456350154209810E-03 - -2.358621226935413E-02 6.643984504532813E-03 4.634614326545263E-03 3.385383476409352E-02 3.348341219507851E-03 - 0.000000000000000E+00 1.199833340406115E+00 8.740012024723698E-02 8.822905400909316E-02 7.816077287916244E-03 + 5.852713677727743E-01 9.754522799476306E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.942355760278394E+00 -4.903926268771276E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.296101039555278E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 14 --------------------------- #coil_type coil_name - 1 2 Mod_014 + 1 Mod_014 #Nseg current Ifree Length Lfree target_length - 128 9.959947850702358E+05 1 7.703049141053451E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.712644941700573E+00 6.784382336612624E-01 1.538185262268274E-01 2.346640256682597E-02 1.196850632128575E-02 - 0.000000000000000E+00 3.573737054444041E-02 4.033923451971971E-02 -5.372996944612102E-02 -1.826822887032361E-02 - -2.573240983988262E+00 -9.631761519895228E-01 2.625921390462567E-03 -2.495773824361796E-02 3.966869335545995E-03 - 0.000000000000000E+00 5.701305546367504E-03 4.356538681665208E-02 8.461235902128973E-02 -3.702192820885288E-03 - -5.706551151114052E-02 1.509697458953986E-02 1.470361623952536E-02 9.007855778052265E-02 7.635296943313601E-03 - 0.000000000000000E+00 1.191372336337914E+00 8.582830218615099E-02 4.341138694192239E-02 2.472574869455472E-03 + 1.666711065702629E+00 2.777851778414667E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.494408589009857E+00 -4.157347651707573E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -5.543276661560270E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 15 --------------------------- #coil_type coil_name - 1 2 Mod_015 + 1 Mod_015 #Nseg current Ifree Length Lfree target_length - 128 1.001057862311056E+06 1 7.720416145097795E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.570149265337249E+00 1.007414113168748E+00 1.386334371526461E-01 -3.673116210627275E-02 -1.295215063628104E-02 - 0.000000000000000E+00 -3.421898095762639E-03 -4.107495746767556E-02 -7.682214219443834E-02 -1.370947603722971E-02 - -1.723282043682246E+00 -6.354397218498025E-01 6.884676691609849E-02 2.896797466257835E-02 -1.498517574066408E-02 - 0.000000000000000E+00 -3.010457844164984E-02 -3.827782462332342E-02 5.135337374005363E-02 -7.319848441048770E-03 - -5.765121737963493E-02 1.384650151212856E-02 1.971283568268974E-02 1.025407754448263E-01 5.563198691570684E-03 - 0.000000000000000E+00 1.180157760866785E+00 7.630610606846362E-02 -3.635903235847662E-02 -3.328734833795404E-03 + 2.494409098989543E+00 4.157348501673716E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -1.666710302464085E+00 -2.777850506350425E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -5.543275055708249E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 #----------------- 16 --------------------------- #coil_type coil_name - 1 2 Mod_016 + 1 Mod_016 #Nseg current Ifree Length Lfree target_length - 128 1.007712831660658E+06 1 7.736768756851439E+00 1 3.500000000000000E+00 + 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 3.035812173839982E+00 1.178718125616083E+00 8.226300350725990E-02 -9.203677424955586E-02 -1.023382212481892E-02 - 0.000000000000000E+00 -8.616298443560863E-03 -3.253987113995281E-02 -3.498796533064394E-02 8.885300740171318E-04 - -6.058758659476825E-01 -2.202862638963616E-01 4.174397623470221E-02 1.990979373799351E-02 -1.543435911060122E-02 - 0.000000000000000E+00 -7.152840656920091E-02 -1.364097222302232E-01 5.998339179209172E-03 2.020942556239318E-02 - -2.413426339787611E-02 5.505815523492382E-03 9.643025752479053E-03 4.635709052618470E-02 1.505782204472723E-03 - 0.000000000000000E+00 1.172567380229947E+00 6.422719022648439E-02 -1.050511441121710E-01 -4.935073053594819E-03 + 2.942355939359432E+00 4.903926567239672E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -5.852704674715262E-01 -9.754507794455493E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + -2.296097162685603E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 28a12e0..770d09f 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -1,16 +1,16 @@ &focusin IsQuiet = -1 ! -2 verbose and including unconstrained cost functions; -1: verbose; 0: normal; 1: concise - IsSymmetric = 1 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced + IsSymmetric = 0 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced case_surface = 0 ! 0: general VMEC-like format (Rbc, Rbs, Zbc, Zbs); 1: read axis for knots knotsurf = 0.200D-00 ! minor plasma radius for knototrans, only valid for case surface = 1 ellipticity = 0.000D+00 ! ellipticity of plasma for knototrans, only valid for case surface = 1 - Nteta = 128 ! poloidal number for discretizing the surface - Nzeta = 128 ! toroidal number for discretizing the surface + Nteta = 64 ! poloidal number for discretizing the surface + Nzeta = 256 ! toroidal number for discretizing the surface - case_init = 0 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles + case_init = 1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation - Ncoils = 16 ! number of coils; only valid when case_init = 1 + Ncoils = 16 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 init_radius = 0.500D+00 ! initial coil radius (meter); only valid when case_init = 1 IsVaryCurrent = 1 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus @@ -26,10 +26,10 @@ weight_bharm = 0.000D+00 ! weight for Bnm harmonic errors weight_tflux = 0.000D+00 ! weight for toroidal flux error target_tflux = 0.000D+00 ! target for the toroidal flux - weight_ttlen = 0.100D-02 ! weight for coil length error + weight_ttlen = 0.000D-02 ! weight for coil length error target_length = 3.500D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length weight_specw = 0.000D+00 ! weight for spectral condensation error - weight_cssep = 0.010D+00 ! weight for coil-surface separation constraint + weight_cssep = 0.000D+00 ! weight for coil-surface separation constraint weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. @@ -51,9 +51,9 @@ LM_ftol = 1.000D-08 ! if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; LM_factor = 100.0 ! the initial step bound, which is set to the product of factor and the euclidean norm of diag*x if nonzero - case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates + case_postproc = 1 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates save_freq = 1 ! frequency for writing output files; should be positive - save_coils = 0 ! flag for indicating whether write example.focus and example.coils + save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics save_filaments = 0 ! flag for indicating whether write .example.filaments.xxxxxx diff --git a/sources/bfield.f90 b/sources/bfield.f90 index 68fbf12..1800334 100644 --- a/sources/bfield.f90 +++ b/sources/bfield.f90 @@ -132,7 +132,7 @@ end subroutine bfield0 !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) +subroutine bfield1(icoil, x, y, z, tBx, tBy, tBz, ND) !------------------------------------------------------------------------------------------------------ ! DATE: 06/15/2016; 03/26/2017 ! calculate the magnetic field and the first dirivatives of icoil using manually discretized coils; @@ -140,19 +140,20 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, Nfp, one, bsconstant + zero, myid, ounit, Nfp, one, bsconstant, cosnfp, sinnfp + use mpi implicit none - include "mpif.h" INTEGER, intent(in ) :: icoil, ND - REAL, intent(in ) :: xx, yy, zz - REAL, dimension(1:1, 1:ND), intent(inout) :: Bx, By, Bz + REAL, intent(in ) :: x, y, z + REAL, dimension(1:1, 1:ND), intent(inout) :: tBx, tBy, tBz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat, kseg, NS + INTEGER :: ierr, astat, kseg, NS, ip, is, cs, Npc REAL :: dlx, dly, dlz, r2, rm3, rm5, rm7, m_dot_r, ltx, lty, ltz, rxp, & - sinp, sint, cosp, cost, mx, my, mz + sinp, sint, cosp, cost, mx, my, mz, xx, yy, zz + REAL, dimension(1:1, 1:ND) :: Bx, By, Bz REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dBxx, dBxy, dBxz, dByx, dByy, dByz, dBzx, dBzy, dBzz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -160,111 +161,121 @@ subroutine bfield1(icoil, xx, yy, zz, Bx, By, Bz, ND) FATAL( bfield1, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) FATAL( bfield1, ND <= 0, wrong inout dimension of ND ) - Bx = zero; By = zero; Bz = zero + ! initialization + Npc = 1 ; cs = 0 + tBx = zero ; tBy = zero ; tBz = zero dlx = zero ; dly = zero ; dlz = zero ltx = zero ; lty = zero ; ltz = zero - select case (coil(icoil)%type) - !--------------------------------------------------------------------------------------------- - case(1) - - NS = coil(icoil)%NS - - do kseg = 0, NS-1 - - dlx = xx - coil(icoil)%xx(kseg) - dly = yy - coil(icoil)%yy(kseg) - dlz = zz - coil(icoil)%zz(kseg) - - r2 = dlx**2 + dly**2 + dlz**2; rm3 = one/(sqrt(r2)*r2); rm5 = rm3/r2; - - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) - - rxp = dlx*ltx + dly*lty + dlz*ltz !r dot x' - - dBxx(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlx*rm5 ) * coil(icoil)%dd(kseg) !Bx/x - dBxy(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dly*rm5 - 3*dlz*rxp*rm5 + 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !Bx/y - dBxz(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlz*rm5 + 3*dly*rxp*rm5 - 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bx/z - - dByx(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlx*rm5 + 3*dlz*rxp*rm5 - 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !By/x - dByy(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dly*rm5 ) * coil(icoil)%dd(kseg) !By/y - dByz(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlz*rm5 - 3*dlx*rxp*rm5 + 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !By/z - - dBzx(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlx*rm5 - 3*dly*rxp*rm5 + 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bz/x - dBzy(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dly*rm5 + 3*dlx*rxp*rm5 - 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !Bz/y - dBzz(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlz*rm5 ) * coil(icoil)%dd(kseg) !Bz/z - - enddo ! enddo kseg - - Bx(1:1, 1:ND) = matmul(dBxx, DoF(icoil)%xof) + matmul(dBxy, DoF(icoil)%yof) + matmul(dBxz, DoF(icoil)%zof) - By(1:1, 1:ND) = matmul(dByx, DoF(icoil)%xof) + matmul(dByy, DoF(icoil)%yof) + matmul(dByz, DoF(icoil)%zof) - Bz(1:1, 1:ND) = matmul(dBzx, DoF(icoil)%xof) + matmul(dBzy, DoF(icoil)%yof) + matmul(dBzz, DoF(icoil)%zof) - - Bx = Bx * coil(icoil)%I * bsconstant - By = By * coil(icoil)%I * bsconstant - Bz = Bz * coil(icoil)%I * bsconstant - !--------------------------------------------------------------------------------------------- - case(2) ! permanent dipoles - - dlx = xx - coil(icoil)%ox - dly = yy - coil(icoil)%oy - dlz = zz - coil(icoil)%oz - r2 = dlx**2 + dly**2 + dlz**2 - rm3 = one/(sqrt(r2)*r2) - rm5 = rm3/r2 - rm7 = rm5/r2 + ! check if the coil is stellarator symmetric + select case (coil(icoil)%symm) + case ( 0 ) + cs = 0 + Npc = 1 + case ( 1 ) + cs = 0 + Npc = Nfp + case ( 2) + cs = 1 + Npc = Nfp + end select + ! periodicity and stellarator symmetry + do ip = 1, Npc + do is = 0, cs + ! find the point on plasma by rotating in reverse direction. + symmetric + xx = ( x*cosnfp(ip) + y*sinnfp(ip) ) + yy = (-x*sinnfp(ip) + y*cosnfp(ip) ) * (-1)**is + zz = z * (-1)**is + Bx = zero; By = zero; Bz = zero - cost = cos(coil(icoil)%mt) ; sint = sin(coil(icoil)%mt) - cosp = cos(coil(icoil)%mp) ; sinp = sin(coil(icoil)%mp) - mx = sint*cosp ; my = sint*sinp ; mz = cost - m_dot_r = mx*dlx + my*dly + mz*dlz + select case (coil(icoil)%type) + case(1) + ! Fourier coils + NS = coil(icoil)%NS + do kseg = 0, NS-1 + dlx = xx - coil(icoil)%xx(kseg) + dly = yy - coil(icoil)%yy(kseg) + dlz = zz - coil(icoil)%zz(kseg) + r2 = dlx**2 + dly**2 + dlz**2; rm3 = one/(sqrt(r2)*r2); rm5 = rm3/r2; + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + rxp = dlx*ltx + dly*lty + dlz*ltz !r dot x' + dBxx(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlx*rm5 ) * coil(icoil)%dd(kseg) !Bx/x + dBxy(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dly*rm5 - 3*dlz*rxp*rm5 + 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !Bx/y + dBxz(1,kseg) = ( 3*(dlz*lty-dly*ltz)*dlz*rm5 + 3*dly*rxp*rm5 - 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bx/z + dByx(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlx*rm5 + 3*dlz*rxp*rm5 - 2*ltz*rm3 ) * coil(icoil)%dd(kseg) !By/x + dByy(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dly*rm5 ) * coil(icoil)%dd(kseg) !By/y + dByz(1,kseg) = ( 3*(dlx*ltz-dlz*ltx)*dlz*rm5 - 3*dlx*rxp*rm5 + 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !By/z + dBzx(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlx*rm5 - 3*dly*rxp*rm5 + 2*lty*rm3 ) * coil(icoil)%dd(kseg) !Bz/x + dBzy(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dly*rm5 + 3*dlx*rxp*rm5 - 2*ltx*rm3 ) * coil(icoil)%dd(kseg) !Bz/y + dBzz(1,kseg) = ( 3*(dly*ltx-dlx*lty)*dlz*rm5 ) * coil(icoil)%dd(kseg) !Bz/z + enddo ! enddo kseg + ! db/dv = dB/dx * dx/dv v->variables + Bx(1:1, 1:ND) = matmul(dBxx, DoF(icoil)%xof) + matmul(dBxy, DoF(icoil)%yof) + matmul(dBxz, DoF(icoil)%zof) + By(1:1, 1:ND) = matmul(dByx, DoF(icoil)%xof) + matmul(dByy, DoF(icoil)%yof) + matmul(dByz, DoF(icoil)%zof) + Bz(1:1, 1:ND) = matmul(dBzx, DoF(icoil)%xof) + matmul(dBzy, DoF(icoil)%yof) + matmul(dBzz, DoF(icoil)%zof) + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + case(2) ! permanent dipoles + dlx = xx - coil(icoil)%ox + dly = yy - coil(icoil)%oy + dlz = zz - coil(icoil)%oz + r2 = dlx**2 + dly**2 + dlz**2 + rm3 = one/(sqrt(r2)*r2) + rm5 = rm3/r2 + rm7 = rm5/r2 + cost = cos(coil(icoil)%mt) ; sint = sin(coil(icoil)%mt) + cosp = cos(coil(icoil)%mp) ; sinp = sin(coil(icoil)%mp) + mx = sint*cosp ; my = sint*sinp ; mz = cost + m_dot_r = mx*dlx + my*dly + mz*dlz #ifdef dposition - ! dipole position is variable - Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 - By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 - Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 - - Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 - By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 - Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 - - Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 - By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 - Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 - - Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 - By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 - Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 - - Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 - By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 - Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + ! dipole position is variable + Bx(1, 1) = 15.0_dp*m_dot_r*dlx*dlx*rm7 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*mx*dlx*rm5 - 3.0_dp*m_dot_r*rm5 + By(1, 1) = 15.0_dp*m_dot_r*dlx*dly*rm7 - 3.0_dp*mx*dly*rm5 - 3.0_dp*my*dlx*rm5 + Bz(1, 1) = 15.0_dp*m_dot_r*dlx*dlz*rm7 - 3.0_dp*mx*dlz*rm5 - 3.0_dp*mz*dlx*rm5 + + Bx(1, 2) = 15.0_dp*m_dot_r*dly*dlx*rm7 - 3.0_dp*my*dlx*rm5 - 3.0_dp*mx*dly*rm5 + By(1, 2) = 15.0_dp*m_dot_r*dly*dly*rm7 - 3.0_dp*my*dly*rm5 - 3.0_dp*my*dly*rm5 - 3.0_dp*m_dot_r*rm5 + Bz(1, 2) = 15.0_dp*m_dot_r*dly*dlz*rm7 - 3.0_dp*my*dlz*rm5 - 3.0_dp*mz*dly*rm5 + + Bx(1, 3) = 15.0_dp*m_dot_r*dlz*dlx*rm7 - 3.0_dp*mz*dlx*rm5 - 3.0_dp*mx*dlz*rm5 + By(1, 3) = 15.0_dp*m_dot_r*dlz*dly*rm7 - 3.0_dp*mz*dly*rm5 - 3.0_dp*my*dlz*rm5 + Bz(1, 3) = 15.0_dp*m_dot_r*dlz*dlz*rm7 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*mz*dlz*rm5 - 3.0_dp*m_dot_r*rm5 + + Bx(1, 4) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 + By(1, 4) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 + Bz(1, 4) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + + Bx(1, 5) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 + By(1, 5) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 + Bz(1, 5) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 #else - ! dipole origins are fixed - Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 - By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 - Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 - - Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 - By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 - Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + ! dipole origins are fixed + Bx(1, 1) = 3.0_dp*dlx*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*cosp*rm3 + By(1, 1) = 3.0_dp*dly*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 - cost*sinp*rm3 + Bz(1, 1) = 3.0_dp*dlz*( cost*cosp*dlx + cost*sinp*dly - sint*dlz)*rm5 + sint *rm3 + + Bx(1, 2) = 3.0_dp*dlx*(-sint*sinp*dlx + sint*cosp*dly )*rm5 + sint*sinp*rm3 + By(1, 2) = 3.0_dp*dly*(-sint*sinp*dlx + sint*cosp*dly )*rm5 - sint*cosp*rm3 + Bz(1, 2) = 3.0_dp*dlz*(-sint*sinp*dlx + sint*cosp*dly )*rm5 #endif - - Bx = Bx * coil(icoil)%I * bsconstant - By = By * coil(icoil)%I * bsconstant - Bz = Bz * coil(icoil)%I * bsconstant - - !--------------------------------------------------------------------------------------------- - case(3) ! only for Bz - - Bx = zero - By = zero - Bz = one - - end select + Bx = Bx * coil(icoil)%I * bsconstant + By = By * coil(icoil)%I * bsconstant + Bz = Bz * coil(icoil)%I * bsconstant + case(3) ! only for Bz + Bx = zero + By = zero + Bz = one + end select + ! sum all the contributions + tBx = tBx + (Bx*cosnfp(ip) - By*sinnfp(ip))*(-1)**is + tBy = tBy + (By*cosnfp(ip) + Bx*sinnfp(ip)) + tBz = tBz + Bz + enddo + enddo return diff --git a/sources/bnormal.f90 b/sources/bnormal.f90 index a05f201..303adaf 100644 --- a/sources/bnormal.f90 +++ b/sources/bnormal.f90 @@ -40,32 +40,26 @@ subroutine bnormal( ideriv ) bharm, t1H, Bmnc, Bmns, wBmn, tBmnc, tBmns, Bmnim, Bmnin, NBmn use bnorm_mod use bharm_mod + use mpi implicit none - include "mpif.h" INTEGER, INTENT(in) :: ideriv !-------------------------------------------------------------------------------------------- INTEGER :: astat, ierr - INTEGER :: icoil, iteta, jzeta, idof, ND, NumGrid, ip, isurf - + INTEGER :: icoil, iteta, jzeta, idof, ND, NumGrid, isurf !--------------------------initialize and allocate arrays------------------------------------- - isurf = plasma NumGrid = Nteta*Nzeta ! reset to zero; bnorm = zero surf(isurf)%Bx = zero; surf(isurf)%By = zero; surf(isurf)%Bz = zero; surf(isurf)%Bn = zero dBx = zero; dBy = zero; dBz = zero; Bm = zero - bn = zero - !-------------------------------calculate Bn-------------------------------------------------- if( ideriv >= 0 ) then - do jzeta = 0, Nzeta - 1 do iteta = 0, Nteta - 1 if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - do icoil = 1, Ncoils call bfield0(icoil, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) @@ -73,12 +67,10 @@ subroutine bnormal( ideriv ) surf(isurf)%By(iteta, jzeta) = surf(isurf)%By(iteta, jzeta) + dBy( 0, 0) surf(isurf)%Bz(iteta, jzeta) = surf(isurf)%Bz(iteta, jzeta) + dBz( 0, 0) enddo ! end do icoil - surf(isurf)%Bn(iteta, jzeta) = surf(isurf)%Bx(iteta, jzeta)*surf(isurf)%nx(iteta, jzeta) & & + surf(isurf)%By(iteta, jzeta)*surf(isurf)%ny(iteta, jzeta) & & + surf(isurf)%Bz(iteta, jzeta)*surf(isurf)%nz(iteta, jzeta) & & - surf(isurf)%pb(iteta, jzeta) - select case (case_bnormal) case (0) ! no normalization over |B|; bnorm = bnorm + surf(isurf)%Bn(iteta, jzeta) * surf(isurf)%Bn(iteta, jzeta) * surf(isurf)%ds(iteta, jzeta) @@ -91,28 +83,25 @@ subroutine bnormal( ideriv ) case default FATAL( bnorm, .true., case_bnormal can only be 0/1 ) end select - enddo ! end do iteta enddo ! end do jzeta - + ! gather data call MPI_BARRIER( MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%Bx, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%By, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%Bz, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, surf(isurf)%Bn, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, bnorm, 1 , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - bnorm = bnorm * half * discretefactor bn = surf(isurf)%Bn + surf(isurf)%pb ! bn is B.n from coils ! bn = surf(isurf)%Bx * surf(isurf)%nx + surf(isurf)%By * surf(isurf)%ny + surf(isurf)%Bz * surf(isurf)%nz !! if (case_bnormal == 0) bnorm = bnorm * bsconstant * bsconstant ! take bsconst back - - if (case_bnormal == 1) then ! collect |B| + ! collect |B| + if (case_bnormal == 1) then call MPI_ALLREDUCE( MPI_IN_PLACE, Bm, NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) !! bm = bm * bsconstant * bsconstant - endif - - ! Another type of target functions + endif + ! LM required discrete cost functions if (mbnorm > 0) then select case (case_bnormal) case (0) ! no normalization over |B|; @@ -123,113 +112,93 @@ subroutine bnormal( ideriv ) & * reshape(surf(isurf)%bn(0:Nteta-1, 0:Nzeta-1)/sqrt(bm(0:Nteta-1, 0:Nzeta-1)), (/Nteta*Nzeta/)) case default FATAL( bnorm, .true., case_bnormal can only be 0/1 ) - end select - + end select endif - ! Bn harmonics related if (weight_bharm > sqrtmachprec) then call twodft( bn, Bmns, Bmnc, Bmnim, Bmnin, NBmn ) ! Bn from coils bharm = half * sum( wBmn * ((Bmnc - tBmnc)**2 + (Bmns - tBmns)**2) ) - if (mbharm > 0) then LM_fvec(ibharm+1:ibharm+mbharm/2) = weight_bharm * wBmn * (Bmnc - tBmnc) LM_fvec(ibharm+mbharm/2+1:ibharm+mbharm) = weight_bharm * wBmn * (Bmns - tBmns) endif - endif endif !-------------------------------calculate Bn/x------------------------------------------------ if ( ideriv >= 1 ) then - + ! reset data t1B = zero ; d1B = zero dBn = zero ; dBm = zero - do jzeta = 0, Nzeta - 1 do iteta = 0, Nteta - 1 - if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - - do ip = 1, 1 - - idof = 0 - do icoil = 1, Ncoils - ND = DoF(icoil)%ND - if ( coil(icoil)%Ic /= 0 ) then !if current is free; - - call bfield0(icoil+(ip-1)*Ncoils, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & - & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) - if (coil(icoil+(ip-1)*Ncoils)%type == 3) dBz(0,0) = zero ! Bz doesn't change in type=3 - dBn(idof+1) = ( dBx(0,0)*surf(isurf)%nx(iteta,jzeta) & - & + dBy(0,0)*surf(isurf)%ny(iteta,jzeta) & - & + dBz(0,0)*surf(isurf)%nz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I - - if (case_bnormal == 1) then ! normalized over |B|; + idof = 0 + do icoil = 1, Ncoils + ND = DoF(icoil)%ND + ! derivatives w.r.t currents + if ( coil(icoil)%Ic /= 0 ) then + call bfield0(icoil, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & + & surf(isurf)%zz(iteta, jzeta), dBx(0,0), dBy(0,0), dBz(0,0)) + if (coil(icoil)%type == 3) dBz(0,0) = zero ! Bz doesn't change in type=3 + dBn(idof+1) = ( dBx(0,0)*surf(isurf)%nx(iteta,jzeta) & + & + dBy(0,0)*surf(isurf)%ny(iteta,jzeta) & + & + dBz(0,0)*surf(isurf)%nz(iteta,jzeta) ) / coil(icoil)%I + if (case_bnormal == 1) then ! normalized over |B|; dBm(idof+1) = ( dBx(0,0)*surf(isurf)%Bx(iteta,jzeta) & & + dBy(0,0)*surf(isurf)%By(iteta,jzeta) & - & + dBz(0,0)*surf(isurf)%Bz(iteta,jzeta) ) / coil(icoil+(ip-1)*Ncoils)%I - endif - - idof = idof +1 + & + dBz(0,0)*surf(isurf)%Bz(iteta,jzeta) ) / coil(icoil)%I endif - - if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; - call bfield1(icoil+(ip-1)*Ncoils, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & - & surf(isurf)%zz(iteta, jzeta), dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) - dBn(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(isurf)%nx(iteta,jzeta) & - & + dBy(1:ND,0)*surf(isurf)%ny(iteta,jzeta) & - & + dBz(1:ND,0)*surf(isurf)%nz(iteta,jzeta) ) - if (case_bnormal == 1) then ! normalized over |B|; + idof = idof +1 + endif + ! derivatives w.r.t geometries + if ( coil(icoil)%Lc /= 0 ) then + call bfield1(icoil, surf(isurf)%xx(iteta, jzeta), surf(isurf)%yy(iteta, jzeta), & + & surf(isurf)%zz(iteta, jzeta), dBx(1:ND,0), dBy(1:ND,0), dBz(1:ND,0), ND) + dBn(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(isurf)%nx(iteta,jzeta) & + & + dBy(1:ND,0)*surf(isurf)%ny(iteta,jzeta) & + & + dBz(1:ND,0)*surf(isurf)%nz(iteta,jzeta) ) + if (case_bnormal == 1) then ! normalized over |B|; dBm(idof+1:idof+ND) = ( dBx(1:ND,0)*surf(isurf)%Bx(iteta,jzeta) & & + dBy(1:ND,0)*surf(isurf)%By(iteta,jzeta) & & + dBz(1:ND,0)*surf(isurf)%Bz(iteta,jzeta) ) - endif - - idof = idof + ND - endif - - enddo !end icoil; - FATAL( bnormal , idof .ne. Ndof, counting error in packing ) - - select case (case_bnormal) - case (0) ! no normalization over |B|; - t1B(1:Ndof) = t1B(1:Ndof) + surf(isurf)%bn(iteta,jzeta) * surf(isurf)%ds(iteta,jzeta) * dBn(1:Ndof) - d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) - case (1) ! normalized over |B|; - t1B(1:Ndof) = t1B(1:Ndof) + ( surf(isurf)%Bn(iteta,jzeta) * dBn(1:Ndof) & - & / bm(iteta, jzeta) & - & - surf(isurf)%Bn(iteta,jzeta) * surf(isurf)%Bn(iteta,jzeta) & - & / (bm(iteta, jzeta)*bm(iteta, jzeta)) & - & * dBm(1:Ndof) ) * surf(isurf)%ds(iteta,jzeta) - d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) & - & / sqrt(bm(iteta, jzeta)) & - & - surf(isurf)%Bn(iteta,jzeta) * dBm(1:Ndof) & - & / (bm(iteta, jzeta) * sqrt(bm(iteta, jzeta))) - case default - FATAL( bnorm, .true., case_bnormal can only be 0/1 ) - end select - - enddo !end ip; - + idof = idof + ND + endif + enddo !end icoil; + FATAL( bnormal , idof .ne. Ndof, counting error in packing ) + select case (case_bnormal) + case (0) ! no normalization over |B|; + t1B(1:Ndof) = t1B(1:Ndof) + surf(isurf)%bn(iteta,jzeta) * surf(isurf)%ds(iteta,jzeta) * dBn(1:Ndof) + d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) + case (1) ! normalized over |B|; + t1B(1:Ndof) = t1B(1:Ndof) + ( surf(isurf)%Bn(iteta,jzeta) * dBn(1:Ndof) & + & / bm(iteta, jzeta) & + & - surf(isurf)%Bn(iteta,jzeta) * surf(isurf)%Bn(iteta,jzeta) & + & / (bm(iteta, jzeta)*bm(iteta, jzeta)) & + & * dBm(1:Ndof) ) * surf(isurf)%ds(iteta,jzeta) + d1B(1:Ndof, iteta, jzeta) = d1B(1:Ndof, iteta, jzeta) + dBn(1:Ndof) & + & / sqrt(bm(iteta, jzeta)) & + & - surf(isurf)%Bn(iteta,jzeta) * dBm(1:Ndof) & + & / (bm(iteta, jzeta) * sqrt(bm(iteta, jzeta))) + case default + FATAL( bnorm, .true., case_bnormal can only be 0/1 ) + end select enddo !end iteta; enddo !end jzeta; - + ! gather data call MPI_BARRIER( MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, t1B, Ndof , MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) call MPI_ALLREDUCE( MPI_IN_PLACE, d1B, Ndof*NumGrid, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr ) - t1B = t1B * discretefactor - - ! Another type of target functions + ! LM discrete derivatives if (mbnorm > 0) then do idof = 1, Ndof LM_fjac(ibnorm+1:ibnorm+mbnorm, idof) = weight_bnorm & & * reshape(d1B(idof, 0:Nteta-1, 0:Nzeta-1), (/Nteta*Nzeta/)) enddo endif - + ! derivatives for Bn harmonics if (weight_bharm > sqrtmachprec) then dBc = zero ; dBs = zero do idof = 1, Ndof @@ -241,13 +210,8 @@ subroutine bnormal( ideriv ) endif enddo endif - endif - !-------------------------------------------------------------------------------------------- - call MPI_barrier( MPI_COMM_WORLD, ierr ) - return end subroutine bnormal - diff --git a/sources/datalloc.f90 b/sources/datalloc.f90 index bd5b1df..88c05bd 100644 --- a/sources/datalloc.f90 +++ b/sources/datalloc.f90 @@ -59,10 +59,10 @@ subroutine AllocData(type) ! the derivatives of dx/dv DoF(icoil)%xof(0:NS-1, 1: NF+1) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !x/xc DoF(icoil)%xof(0:NS-1, NF+2:2*NF+1) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !x/xs - DoF(icoil)%xof(0:NS-1, 2*NF+2:3*NF+2) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !x/yc - DoF(icoil)%xof(0:NS-1, 3*NF+3:4*NF+2) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !x/ys - DoF(icoil)%yof(0:NS-1, 1: NF+1) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !y/xc - DoF(icoil)%yof(0:NS-1, NF+2:2*NF+1) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !y/xs + !DoF(icoil)%xof(0:NS-1, 2*NF+2:3*NF+2) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !x/yc + !DoF(icoil)%xof(0:NS-1, 3*NF+3:4*NF+2) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !x/ys + !DoF(icoil)%yof(0:NS-1, 1: NF+1) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !y/xc + !DoF(icoil)%yof(0:NS-1, NF+2:2*NF+1) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !y/xs DoF(icoil)%yof(0:NS-1, 2*NF+2:3*NF+2) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !y/yc DoF(icoil)%yof(0:NS-1, 3*NF+3:4*NF+2) = FouCoil(icoil)%smt(0:NS-1, 1:NF) !y/ys DoF(icoil)%zof(0:NS-1, 4*NF+3:5*NF+3) = FouCoil(icoil)%cmt(0:NS-1, 0:NF) !z/zc diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 6f3f7a3..3b51105 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -99,14 +99,13 @@ subroutine torflux( ideriv ) coil, DoF, surf, Ncoils, Nteta, Nzeta, discretefactor, Cdof, & tflux, t1F, t2F, Ndof, psi_avg, target_tflux, tflux_sign, & itflux, mtflux, LM_fvec, LM_fjac, weight_tflux, plasma - + use mpi implicit none - include "mpif.h" INTEGER, INTENT(in) :: ideriv !-------------------------------------------------------------------------------------------- INTEGER :: astat, ierr - INTEGER :: icoil, iteta, jzeta, idof, ND, ip, isurf + INTEGER :: icoil, iteta, jzeta, idof, ND, isurf REAL :: dflux, lflux, lsum REAL :: lax, lay, laz ! local Ax, Ay and Az REAL, dimension(0:Cdof, 0:Cdof) :: dAx, dAy, dAz ! dA of each coil; @@ -126,15 +125,12 @@ subroutine torflux( ideriv ) lflux = zero do iteta = 0, Nteta - 1 lax = zero; lay = zero; laz = zero - do ip = 1, 1 - do icoil = 1, Ncoils - call bpotential0(icoil+(ip-1)*Ncoils, iteta, jzeta, dAx(0,0), dAy(0,0), dAz(0,0)) - lax = lax + dAx( 0, 0) * coil(icoil)%I * bsconstant - lay = lay + dAy( 0, 0) * coil(icoil)%I * bsconstant - laz = laz + dAz( 0, 0) * coil(icoil)%I * bsconstant - enddo ! end do icoil - enddo ! end do ip; - + do icoil = 1, Ncoils + call bpotential0(icoil, iteta, jzeta, dAx(0,0), dAy(0,0), dAz(0,0)) + lax = lax + dAx( 0, 0) * coil(icoil)%I * bsconstant + lay = lay + dAy( 0, 0) * coil(icoil)%I * bsconstant + laz = laz + dAz( 0, 0) * coil(icoil)%I * bsconstant + enddo ! end do icoil lflux = lflux + lax * surf(isurf)%xt(iteta,jzeta) + & ! local flux; lay * surf(isurf)%yt(iteta,jzeta) + & laz * surf(isurf)%zt(iteta,jzeta) @@ -171,39 +167,35 @@ subroutine torflux( ideriv ) do jzeta = 0, Nzeta - 1 if( myid.ne.modulo(jzeta,ncpu) ) cycle ! parallelization loop; - do iteta = 0, Nteta - 1 - - do ip = 1, 1 - idof = 0 - do icoil = 1, Ncoils - ND = DoF(icoil)%ND - if ( coil(icoil)%Ic /= 0 ) then !if current is free; - call bpotential0(icoil, iteta, jzeta, & - & dAx(0,0), dAy(0,0), dAz(0,0)) - - ldF(idof+1, jzeta) = ldF(idof+1, jzeta) & - & + bsconstant * ( dAx(0,0)*surf(isurf)%xt(iteta,jzeta) & - & + dAy(0,0)*surf(isurf)%yt(iteta,jzeta) & - & + dAz(0,0)*surf(isurf)%zt(iteta,jzeta) ) - idof = idof +1 - endif - - if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; - call bpotential1(icoil, iteta, jzeta, & - & dAx(1:ND,0), dAy(1:ND,0), dAz(1:ND,0), ND) - - ldF(idof+1:idof+ND, jzeta) = ldF(idof+1:idof+ND, jzeta) & - & + bsconstant * coil(icoil)%I * ( dAx(1:ND,0)*surf(isurf)%xt(iteta,jzeta) & - & + dAy(1:ND,0)*surf(isurf)%yt(iteta,jzeta) & - & + dAz(1:ND,0)*surf(isurf)%zt(iteta,jzeta) ) - - idof = idof + ND - endif - - enddo !end icoil; - FATAL( torflux , idof .ne. Ndof, counting error in packing ) - enddo ! end do ip; + idof = 0 + do icoil = 1, Ncoils + ND = DoF(icoil)%ND + if ( coil(icoil)%Ic /= 0 ) then !if current is free; + call bpotential0(icoil, iteta, jzeta, & + & dAx(0,0), dAy(0,0), dAz(0,0)) + + ldF(idof+1, jzeta) = ldF(idof+1, jzeta) & + & + bsconstant * ( dAx(0,0)*surf(isurf)%xt(iteta,jzeta) & + & + dAy(0,0)*surf(isurf)%yt(iteta,jzeta) & + & + dAz(0,0)*surf(isurf)%zt(iteta,jzeta) ) + idof = idof +1 + endif + + if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; + call bpotential1(icoil, iteta, jzeta, & + & dAx(1:ND,0), dAy(1:ND,0), dAz(1:ND,0), ND) + + ldF(idof+1:idof+ND, jzeta) = ldF(idof+1:idof+ND, jzeta) & + & + bsconstant * coil(icoil)%I * ( dAx(1:ND,0)*surf(isurf)%xt(iteta,jzeta) & + & + dAy(1:ND,0)*surf(isurf)%yt(iteta,jzeta) & + & + dAz(1:ND,0)*surf(isurf)%zt(iteta,jzeta) ) + + idof = idof + ND + endif + + enddo !end icoil; + FATAL( torflux , idof .ne. Ndof, counting error in packing ) enddo !end iteta; enddo !end jzeta @@ -236,7 +228,7 @@ end subroutine torflux !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) +subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) !------------------------------------------------------------------------------------------------------ ! DATE: 06/15/2017 ! calculate the magnetic potential from coil(icoil) at the evaluation point (iteta, jzeta); @@ -244,27 +236,41 @@ subroutine bpotential0(icoil, iteta, jzeta, Ax, Ay, Az) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, plasma + zero, myid, ounit, plasma, Nfp, cosnfp, sinnfp + use mpi implicit none - include "mpif.h" INTEGER, intent(in ) :: icoil, iteta, jzeta - REAL , intent(out) :: Ax, Ay, Az + REAL , intent(out) :: tAx, tAy, tAz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat, kseg, isurf - REAL :: dlx, dly, dlz, rm, ltx, lty, ltz + INTEGER :: ierr, astat, kseg, isurf, ip, is, cs, Npc + REAL :: dlx, dly, dlz, rm, ltx, lty, ltz, & + & Ax, Ay, Az !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! FATAL( bpotential0, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) FATAL( bpotential0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bpotential0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) - + ! initialization + Npc = 1 ; cs = 0 dlx = zero; ltx = zero; Ax = zero dly = zero; lty = zero; Ay = zero dlz = zero; ltz = zero; Az = zero + ! check if the coil is stellarator symmetric + select case (coil(icoil)%symm) + case ( 0 ) + cs = 0 + Npc = 1 + case ( 1 ) + cs = 0 + Npc = Nfp + case ( 2) + cs = 1 + Npc = Nfp + end select do kseg = 0, coil(icoil)%NS-1 @@ -297,16 +303,16 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, DoF, surf, NFcoil, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, plasma + zero, myid, ounit, plasma, Nfp, cosnfp, sinnfp + use mpi implicit none - include "mpif.h" INTEGER, intent(in ) :: icoil, iteta, jzeta, ND REAL, dimension(1:1, 1:ND), intent(inout) :: Ax, Ay, Az !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ierr, astat, kseg, NS, isurf + INTEGER :: ierr, astat, kseg, NS, isurf, ip, is, cs, Npc REAL :: dlx, dly, dlz, r, rm3, ltx, lty, ltz REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dAxx, dAxy, dAxz, dAyx, dAyy, dAyz, dAzx, dAzy, dAzz From d1a5cb479d13f41baea5bd1c44c5d840a16c8266 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 21 Jan 2020 13:23:11 -0500 Subject: [PATCH 61/72] fix bugs when checking the theta-angle direction for the plasma boundary --- sources/rdsurf.f90 | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index c9c04d4..b6506db 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -265,16 +265,18 @@ subroutine fousurf(filename, index) surf(index)%vol = abs(surf(index)%vol ) * discretefactor * Nfp surf(index)%area = abs(surf(index)%area) * discretefactor * Nfp - theta0 = 0.1_dp ; zeta0 = zero - call surfcoord( theta0, zeta0, r0, z0 ) - if (z0 > 0) then - ! counter-clockwise - if( myid == 0) write(ounit, '(8X": The theta angle used is counter-clockwise.")') - tflux_sign = -1 - else - ! clockwise - if( myid == 0) write(ounit, '(8X": The theta angle used is clockwise.")') - tflux_sign = 1 + if (index == plasma) then + theta0 = 0.1_dp ; zeta0 = zero + call surfcoord(index, theta0, zeta0, r0, z0 ) + if (z0 > 0) then + ! counter-clockwise + if( myid == 0) write(ounit, '(8X": The theta angle used is counter-clockwise.")') + tflux_sign = -1 + else + ! clockwise + if( myid == 0) write(ounit, '(8X": The theta angle used is clockwise.")') + tflux_sign = 1 + endif endif if( myid == 0 .and. IsQuiet <= 0) then From fc035ae8be00cb3d19a509074dd94c462ceb99a9 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 21 Jan 2020 22:09:35 -0500 Subject: [PATCH 62/72] temp fix toroidal flux, final clean and bug fixes --- examples/limiter_surface/ellipse.limiter | 13 ++ examples/rotating_ellipse/ellipse.focus | 242 ++++------------------- examples/rotating_ellipse/ellipse.input | 34 ++-- sources/diagnos.f90 | 14 +- sources/globals.f90 | 2 +- sources/initial.f90 | 17 +- sources/rdcoils.f90 | 12 +- sources/saving.f90 | 4 +- sources/torflux.f90 | 163 +++++++++------ 9 files changed, 206 insertions(+), 295 deletions(-) create mode 100644 examples/limiter_surface/ellipse.limiter diff --git a/examples/limiter_surface/ellipse.limiter b/examples/limiter_surface/ellipse.limiter new file mode 100644 index 0000000..700aaea --- /dev/null +++ b/examples/limiter_surface/ellipse.limiter @@ -0,0 +1,13 @@ +#bmn bNfp nbf +4 2 0 +#plasma boundary +# n m Rbc Rbs Zbc Zbs +0 0 3.00 0.0 0.0 0.00 +0 1 0.50 0.0 0.0 -0.50 +1 0 0.00 0.0 0.0 -0.06 +1 1 -0.06 0.0 0.0 -0.06 +#Bn harmonics +# n m bnc bns +0 0 1.0 0.0 +0 1 0.5 0.25 +1 0 0.5 0.0 \ No newline at end of file diff --git a/examples/rotating_ellipse/ellipse.focus b/examples/rotating_ellipse/ellipse.focus index 4b0f749..ff1f599 100644 --- a/examples/rotating_ellipse/ellipse.focus +++ b/examples/rotating_ellipse/ellipse.focus @@ -1,226 +1,58 @@ # Total number of coils - 16 + 4 #----------------- 1 --------------------------- - #coil_type coil_name - 1 Mod_001 + #coil_type coil_symm coil_name + 1 2 Mod_001 #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 + 128 1.009811647172201E+06 1 8.670769764879882E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.942355838996189E+00 4.903926396686359E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 5.852709823209967E-01 9.754516368753213E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.296102208412681E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 3.060954863802166E+00 1.310254825066786E+00 1.071765871853575E-01 -1.120043816175074E-01 -1.520286072710724E-02 + 0.000000000000000E+00 9.810788125646671E-03 4.065115131685829E-02 4.559037701826145E-02 -4.071928591958048E-03 + 6.106840692922476E-01 2.443673607509968E-01 -5.149696668322107E-02 -2.671241706618427E-02 3.038351252326858E-02 + 0.000000000000000E+00 -8.619249228138577E-02 -1.687729013376058E-01 -3.046585765489713E-03 3.878698675740049E-02 + 2.542842340799642E-02 -7.558796236777470E-03 -1.412396858823538E-02 -5.744816005982935E-02 -2.716859514842065E-03 + 0.000000000000000E+00 1.295916257700958E+00 8.161932730997404E-02 -1.281728144546573E-01 -7.864767225451891E-03 #----------------- 2 --------------------------- - #coil_type coil_name - 1 Mod_002 + #coil_type coil_symm coil_name + 1 2 Mod_002 #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 + 128 1.000934843583982E+06 1 8.646814639774334E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.494408811601982E+00 4.157348015978825E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 1.666710741292756E+00 2.777851233244309E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 5.543278682049479E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 2.591039474744833E+00 1.119083580235844E+00 1.763932894682944E-01 -3.850563986364065E-02 -2.321904514718601E-02 + 0.000000000000000E+00 1.789304409269933E-03 5.214288348378480E-02 9.859707440071824E-02 2.084761842767816E-02 + 1.736596659855606E+00 7.059339213835694E-01 -8.358551564924986E-02 -4.314421730932739E-02 2.838097220648132E-02 + 0.000000000000000E+00 -3.771894176537822E-02 -4.560491027332799E-02 5.683180127361215E-02 -1.631526037275912E-02 + 6.022014795231187E-02 -1.982376147463092E-02 -2.855959291933952E-02 -1.255668085436268E-01 -8.213306932623459E-03 + 0.000000000000000E+00 1.306003803055004E+00 9.917583500188788E-02 -4.287174650767827E-02 -3.235796030843676E-03 #----------------- 3 --------------------------- - #coil_type coil_name - 1 Mod_003 + #coil_type coil_symm coil_name + 1 2 Mod_003 #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 + 128 9.948908235802455E+05 1 8.621473283434842E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.666710632258679E+00 2.777851051520846E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.494408884456223E+00 4.157348137402559E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 5.543278280586475E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 1.725483292101542E+00 7.507849844801009E-01 1.938412706935032E-01 3.972908073125690E-02 2.092579035804881E-02 + 0.000000000000000E+00 -4.529054472111800E-02 -4.887401181894353E-02 6.259390861075441E-02 3.018925039342284E-02 + 2.590809675965432E+00 1.067772746516816E+00 1.126636919133895E-03 2.442376205950504E-02 -1.059057602175693E-02 + 0.000000000000000E+00 4.076757537180798E-03 5.618278149077867E-02 1.052245687446653E-01 -1.011846548157847E-02 + 5.896970416337852E-02 -2.196346805257908E-02 -2.182018403978711E-02 -1.084433175182200E-01 -7.180231700278182E-03 + 0.000000000000000E+00 1.322462293184084E+00 1.121536610042754E-01 5.412783734366871E-02 4.141507709321130E-03 #----------------- 4 --------------------------- - #coil_type coil_name - 1 Mod_004 + #coil_type coil_symm coil_name + 1 2 Mod_004 #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 + 128 9.946545305238812E+05 1 8.608497474656698E+00 1 5.000000000000000E+00 #NFcoil 4 #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 5.852708537065325E-01 9.754514225178811E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.942355864579194E+00 4.903926439324701E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.296101239195262E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 5 --------------------------- - #coil_type coil_name - 1 Mod_005 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -5.852711105438521E-01 -9.754518512327597E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.942355811444433E+00 4.903926354048007E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.296100070337964E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 6 --------------------------- - #coil_type coil_name - 1 Mod_006 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.666710847634489E+00 -2.777851414967767E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.494408734718363E+00 4.157347894555082E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -5.543276260097516E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 7 --------------------------- - #coil_type coil_name - 1 Mod_007 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.494408953281085E+00 -4.157348258826286E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 1.666710520532256E+00 2.777850869797377E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -5.543275457171508E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 8 --------------------------- - #coil_type coil_name - 1 Mod_008 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.942355888193449E+00 -4.903926481963035E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 5.852707247004597E-01 9.754512081604391E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.296098131903127E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 9 --------------------------- - #coil_type coil_name - 1 Mod_009 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.942355787830161E+00 -4.903926311409647E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -5.852712395499218E-01 -9.754520655901960E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.296103177630029E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 10 --------------------------- - #coil_type coil_name - 1 Mod_010 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -2.494408665893487E+00 -4.157347773131332E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -1.666710959360904E+00 -2.777851596691220E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 5.543279083512315E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 11 --------------------------- - #coil_type coil_name - 1 Mod_011 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -1.666710414190513E+00 -2.777850688073904E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.494409030164690E+00 -4.157348380250005E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 5.543277879123301E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 12 --------------------------- - #coil_type coil_name - 1 Mod_012 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - -5.852705964776008E-01 -9.754509938029951E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.942355915745187E+00 -4.903926524601357E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 2.296100269977773E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 13 --------------------------- - #coil_type coil_name - 1 Mod_013 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 5.852713677727743E-01 9.754522799476306E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.942355760278394E+00 -4.903926268771276E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.296101039555278E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 14 --------------------------- - #coil_type coil_name - 1 Mod_014 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.666711065702629E+00 2.777851778414667E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.494408589009857E+00 -4.157347651707573E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -5.543276661560270E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 15 --------------------------- - #coil_type coil_name - 1 Mod_015 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.494409098989543E+00 4.157348501673716E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -1.666710302464085E+00 -2.777850506350425E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -5.543275055708249E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - #----------------- 16 --------------------------- - #coil_type coil_name - 1 Mod_016 - #Nseg current Ifree Length Lfree target_length - 128 1.000000000000000E+06 1 3.141592741012573E+00 1 3.500000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.942355939359432E+00 4.903926567239672E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -5.852704674715262E-01 -9.754507794455493E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - -2.296097162685603E-02 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 - 0.000000000000000E+00 5.000000000000000E-01 0.000000000000000E+00 0.000000000000000E+00 0.000000000000000E+00 + 6.040169668061979E-01 2.636207250904417E-01 8.568695014994318E-02 3.300213049748593E-02 2.784082935503811E-02 + 0.000000000000000E+00 -8.950259741234350E-02 -1.567838305464813E-01 -1.072621721864652E-02 -2.321936415783295E-02 + 3.047184005374481E+00 1.263139806640376E+00 1.006446548244153E-01 1.169900450991863E-01 2.614474340279832E-03 + 0.000000000000000E+00 7.975569107616570E-03 3.988898414060333E-02 5.621427092549287E-02 8.599805773917217E-03 + 2.404104588079173E-02 -9.788569523807458E-03 -7.323149156916673E-03 -4.017330361351994E-02 -1.773284223695257E-03 + 0.000000000000000E+00 1.334866623968677E+00 1.148802510600708E-01 1.070059161954770E-01 6.132575423488384E-03 diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 770d09f..208bfd6 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -1,16 +1,16 @@ &focusin IsQuiet = -1 ! -2 verbose and including unconstrained cost functions; -1: verbose; 0: normal; 1: concise - IsSymmetric = 0 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced + IsSymmetric = 2 ! 0: no stellarator symmetry enforced; 1: plasma periodicity enforced; 2: coil periodicity enforced case_surface = 0 ! 0: general VMEC-like format (Rbc, Rbs, Zbc, Zbs); 1: read axis for knots knotsurf = 0.200D-00 ! minor plasma radius for knototrans, only valid for case surface = 1 ellipticity = 0.000D+00 ! ellipticity of plasma for knototrans, only valid for case surface = 1 - Nteta = 64 ! poloidal number for discretizing the surface - Nzeta = 256 ! toroidal number for discretizing the surface + Nteta = 64 ! poloidal number for discretizing the surface + Nzeta = 64 ! toroidal number for discretizing the surface case_init = 1 ! -1: read coils.ext file; 0: read ext.focus file; 1: initialize with circular coils; 2: initialize with dipoles case_coils = 1 ! 0: using piecewise linear representation; (not ready); 1: using Fourier series representation - Ncoils = 16 ! number of coils; only valid when case_init = 1 + Ncoils = 4 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 init_radius = 0.500D+00 ! initial coil radius (meter); only valid when case_init = 1 IsVaryCurrent = 1 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus @@ -26,14 +26,14 @@ weight_bharm = 0.000D+00 ! weight for Bnm harmonic errors weight_tflux = 0.000D+00 ! weight for toroidal flux error target_tflux = 0.000D+00 ! target for the toroidal flux - weight_ttlen = 0.000D-02 ! weight for coil length error - target_length = 3.500D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length + weight_ttlen = 0.100D-02 ! weight for coil length error + target_length = 5.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length weight_specw = 0.000D+00 ! weight for spectral condensation error - weight_cssep = 0.000D+00 ! weight for coil-surface separation constraint + weight_cssep = 0.010D+00 ! weight for coil-surface separation constraint weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. weight_gnorm = 1.000D+00 ! weight for normalization of geometric coefficients. Larger weight makes the derivatives more important. - case_optimize = 0 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing using the gradient (DF and/or CG); + case_optimize = 1 ! -2: check the 2nd derivatives (not ready); -1: check the 1st derivatives; 0: no optimizations performed; 1: optimizing using the gradient (DF and/or CG); exit_tol = 1.000D-04 ! Exit the optimizer if the percent change in the cost function over the last 5 steps is below this threshold DF_maxiter = 0 ! maximum iterations allowed for using Differential Flow (DF) @@ -41,7 +41,7 @@ DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea DF_tauend = 1.000D-00 ! ending value of τ. The larger value of τend − τsta, the more optimized - CG_maxiter = 10 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_maxiter = 20 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization CG_wolfe_c1 = 0.1 ! c1 value in the strong wolfe condition for line search, (0.0, 0.5) CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; 0 < c1 < c2 < 1 @@ -51,7 +51,7 @@ LM_ftol = 1.000D-08 ! if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; LM_factor = 100.0 ! the initial step bound, which is set to the product of factor and the euclidean norm of diag*x if nonzero - case_postproc = 1 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates + case_postproc = 3 ! 0: no extra post-processing; 1: evaluate the current coils; 2: write SPEC file; 3: perform Poincare plots; 4: calculates |B| Fourier harmonics in Boozer coordinates save_freq = 1 ! frequency for writing output files; should be positive save_coils = 1 ! flag for indicating whether write example.focus and example.coils save_harmonics = 0 ! flag for indicating whether write example.harmonics @@ -66,5 +66,17 @@ pp_ns = 10 ! number of following fieldlines pp_maxiter = 1000 ! number of periods for each fieldline following pp_xtol = 1.000D-06 ! tolarence of ODE solver during fieldline fowllowing - +/ +&mgrid +! mgrid file dimensions +Rmin = 0.0 +Rmax = 0.0 +Zmin = 0.0 +Zmax = 0.0 +Pmin = 0.0 +Pmax = 6.283 +! resolutions +NR = 101 +NZ = 101 +NP = 72 / diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index 8ed8d99..809e8d3 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -8,7 +8,7 @@ SUBROUTINE diagnos use globals, only: dp, zero, one, myid, ounit, sqrtmachprec, IsQuiet, case_optimize, coil, surf, Ncoils, & Nteta, Nzeta, bnorm, bharm, tflux, ttlen, specw, ccsep, coilspace, FouCoil, iout, Tdof, case_length, & cssep, Bmnc, Bmns, tBmnc, tBmns, weight_bharm, coil_importance, Nfp, weight_bnorm, overlap, plasma, & - cosnfp, sinnfp + cosnfp, sinnfp, symmetry, discretefactor use mpi implicit none @@ -114,7 +114,7 @@ SUBROUTINE diagnos call mindist(Atmp, coil(icoil)%NS, Btmp, coil(itmp)%NS, tmp_dist) #ifdef DEBUG if(myid .eq. 0) write(ounit, '(8X": distance between "I3.3"-th and "I3.3"-th coil (ip="I2.2 & - ", is="I1") is : " ES23.15)') icoil, itmp, tmp_dist + ", is="I1") is : " ES23.15)') icoil, itmp, ip, is, tmp_dist #endif if (minCCdist .ge. tmp_dist) minCCdist=tmp_dist enddo @@ -177,8 +177,14 @@ SUBROUTINE diagnos !--------------------------------calculate the average Bn error------------------------------- if (allocated(surf(isurf)%bn)) then ! \sum{ |Bn| / |B| }/ (Nt*Nz) - if(myid .eq. 0) write(ounit, '(8X": Average relative absolute Bn error is :" ES23.15)') & - sum(abs(surf(isurf)%bn/sqrt(surf(isurf)%Bx**2 + surf(isurf)%By**2 + surf(isurf)%Bz**2))) / (Nteta*Nzeta) + if(myid .eq. 0) then + write(ounit, '(8X": Ave. relative absolute Bn error |Bn|/B : " ES12.5"; max(|Bn|)="ES12.5)') & + sum(abs(surf(plasma)%bn/sqrt(surf(plasma)%Bx**2+surf(plasma)%By**2+surf(plasma)%Bz**2))) & + / (Nteta*Nzeta), maxval(abs(surf(plasma)%bn)) + write(ounit, '(8X": Surface area normalized Bn error int(|Bn|/B*ds)/A : "ES23.15)') & + sum(abs(surf(plasma)%bn)/sqrt(surf(plasma)%Bx**2+surf(plasma)%By**2+surf(plasma)%Bz**2) & + *surf(plasma)%ds)*discretefactor/(surf(plasma)%area/(Nfp*2**symmetry)) + endif endif return diff --git a/sources/globals.f90 b/sources/globals.f90 index ddab491..75fd942 100644 --- a/sources/globals.f90 +++ b/sources/globals.f90 @@ -15,7 +15,7 @@ module globals !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - CHARACTER(LEN=10), parameter :: version='v0.10.02' ! version number + CHARACTER(LEN=10), parameter :: version='v0.11.00' ! version number !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! diff --git a/sources/initial.f90 b/sources/initial.f90 index cbd222d..0a1c9aa 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -24,8 +24,8 @@ !latex \textit{Enforce stellarator symmetry or not} \\ !latex \bi \vspace{-5mm} !latex \item[0:] no symmetry or periodicity enforced; -!latex \item[1:] plasma periodicty enforced; -!latex \item[2:] periodicity and stellartor symmetry enforced. +!latex \item[1:] periodicty of the plasma boundary enforced; +!latex \item[2:] periodicity and stellartor symmetry of the plasma boundary enforced. !latex \ei !latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} @@ -41,6 +41,9 @@ !latex \item \inputvar{input\_harm = `target.harmonics'} \\ !latex \textit{Input file containing the target harmonics for Bmn optimization.} !latex +!latex \item \inputvar{limiter\_surf = `none'} \\ +!latex \textit{Input file containing the limiter surface for coil-surface separation.} +!latex !latex \par \begin{tikzpicture} \draw[dashed] (0,1) -- (10,1); \end{tikzpicture} !latex !latex \item \inputvar{case\_surface = 0} \\ @@ -168,8 +171,11 @@ !latex \item \inputvar{weight\_specw = 0.0} \\ !latex \textit{weight for spectral condensation error, if zero, turned off; seen in \link{specwid}}; (not ready) !latex -!latex \item \inputvar{weight\_ccsep = 0.0} \\ -!latex \textit{weight for coil-coil separation constraint, if zero, turned off; seen in \link{coilsep}}; (not ready) +!latex \item \inputvar{weight\_cssep = 0.0} \\ +!latex \textit{weight for coil-surface separation constraint, if zero, turned off; seen in \link{surfsep}}; +!latex +!latex \item \inputvar{cssep\_factor = 4.0} \\ +!latex \textit{exponential index for coil-surface separation; the higher, the steeper; seen in \link{surfsep}}; !latex !latex \item \inputvar{weight\_Inorm = 1.0} \\ !latex \textit{additional factor for normalizing currents; the larger, the more optimized for currents; @@ -187,7 +193,7 @@ !latex \item[-2:] check the 2nd derivatives; seen in\link{fdcheck}; (not ready) !latex \item[-1:] check the 1st derivatives; seen in\link{fdcheck}; !latex \item[ 0:] no optimizations performed; -!latex \item[ 1:] optimizing with algorithms using the gradient (DF and/or CG); seen in \link{solvers}; +!latex \item[ 1:] optimizing with algorithms using the gradient (DF, CG and/or LM); seen in \link{solvers}; !latex \item[ 2:] optimizing with algorithms using the Hessian (HT and/or NT); seen in \link{solvers}; (not ready) !latex \ei !latex @@ -241,6 +247,7 @@ !latex \item[ 2:] diagnos; write SPEC input file; !latex \item[ 3:] diagnos; Field-line tracing, axis locating and iota calculating; !latex \item[ 4:] diagnos; Field-line tracing; Calculates Bmn coefficients in Boozer coordinates; +!latex \item[ 5:] diagnos; write mgrid file (input variables in the namelist \&mgrid); !latex \ei !latex !latex \item \inputvar{update\_plasma = 0} \\ diff --git a/sources/rdcoils.f90 b/sources/rdcoils.f90 index 947bacc..b745ae0 100644 --- a/sources/rdcoils.f90 +++ b/sources/rdcoils.f90 @@ -28,8 +28,8 @@ !latex # Total number of coils !latex 16 !latex #------------1-------------------------------- -!latex #coil_type coil_name -!latex 1 Mod_001 +!latex #coil_type symm coil_name +!latex 1 0 Mod_001 !latex #Nseg current Ifree Length Lfree target_length !latex 128 9.844910899889484E+05 1 5.889288927667147E+00 1 1.000000000000000E+00 !latex #NFcoil @@ -42,13 +42,13 @@ !latex -4.293247278325474E-17 -1.303273952226587E-15 7.710821807870230E-16 -3.156539892466338E-16 9.395672288215928E-17 !latex 0.000000000000000E+00 9.997301975562740E-01 2.929938238054118E-02 2.436889176706748E-02 1.013941937492003E-03 !latex #-----------2--permanent magnet--------------- -!latex #coil_type coil_name -!latex 2 dipole_01 +!latex #coil_type symm coil_name +!latex 2 0 dipole_01 !latex # Lc ox oy oz Ic I mt mp !latex 1 0.0 0.0 0.0 1 1.0E6 0.0 0.0 !latex #-----------3--backgound Bt Bz---------------- -!latex #coil_type coil_name -!latex 3 bg_BtBz_01 +!latex #coil_type symm coil_name +!latex 3 0 bg_BtBz_01 !latex # Ic I Lc Bz (Ic control I; Lc control Bz) !latex 1 1.0E6 0 0.0 !latex . diff --git a/sources/saving.f90 b/sources/saving.f90 index 0f07c10..323383b 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -224,8 +224,8 @@ subroutine saving do icoil = 1, Ncoils write(wunit, *) "#-----------------", icoil, "---------------------------" - write(wunit, *) "#coil_type coil_name" - write(wunit,'(3X,I3,4X, A10)') coil(icoil)%type, coil(icoil)%name + write(wunit, *) "#coil_type coil_symm coil_name" + write(wunit,'(3X,I3,4X,I3,4X,A10)') coil(icoil)%type, coil(icoil)%symm, coil(icoil)%name select case (coil(icoil)%type) case (1) diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 3b51105..f434ec8 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -112,7 +112,7 @@ subroutine torflux( ideriv ) REAL, dimension(1:Ndof, 0:Nzeta-1) :: ldF, dF REAL, dimension(0:Nzeta-1) :: ldiff, psi_diff !--------------------------initialize and allocate arrays------------------------------------- - + isurf = plasma tflux = zero ; lsum = zero ; psi_avg = zero ; dflux = zero ; psi_diff = zero ldiff = zero ; lax = zero; lay = zero; laz = zero !already allocted; reset to zero; @@ -230,7 +230,7 @@ end subroutine torflux subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) !------------------------------------------------------------------------------------------------------ -! DATE: 06/15/2017 +! DATE: 06/15/2017; 01/20/2020 ! calculate the magnetic potential from coil(icoil) at the evaluation point (iteta, jzeta); ! Biot-Savart constant and currents are not included for later simplication. ! Discretizing factor is includeed; coil(icoil)%dd(kseg) @@ -247,18 +247,18 @@ subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) INTEGER :: ierr, astat, kseg, isurf, ip, is, cs, Npc REAL :: dlx, dly, dlz, rm, ltx, lty, ltz, & - & Ax, Ay, Az + & Ax, Ay, Az, xx, yy, zz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - + isurf = plasma FATAL( bpotential0, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) FATAL( bpotential0, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bpotential0, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) ! initialization Npc = 1 ; cs = 0 - dlx = zero; ltx = zero; Ax = zero - dly = zero; lty = zero; Ay = zero - dlz = zero; ltz = zero; Az = zero + tAx = zero ; tAy = zero ; tAz = zero + dlx = zero ; dly = zero ; dlz = zero + ltx = zero ; lty = zero ; ltz = zero ! check if the coil is stellarator symmetric select case (coil(icoil)%symm) case ( 0 ) @@ -272,22 +272,38 @@ subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) Npc = Nfp end select - do kseg = 0, coil(icoil)%NS-1 - - dlx = surf(isurf)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(isurf)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(isurf)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) - rm = 1.0 / sqrt(dlx**2 + dly**2 + dlz**2) - - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) - - Ax = Ax + ltx * rm * coil(icoil)%dd(kseg) - Ay = Ay + lty * rm * coil(icoil)%dd(kseg) - Az = Az + ltz * rm * coil(icoil)%dd(kseg) - - enddo ! enddo kseg + ! periodicity and stellarator symmetry + do ip = 1, Npc + do is = 0, cs + ! find the point on plasma by rotating in reverse direction. + symmetric + xx = ( surf(isurf)%xx(iteta,jzeta)*cosnfp(ip) + surf(isurf)%yy(iteta,jzeta)*sinnfp(ip) ) + yy = (-surf(isurf)%xx(iteta,jzeta)*sinnfp(ip) + surf(isurf)%yy(iteta,jzeta)*cosnfp(ip) ) * (-1)**is + zz = surf(isurf)%zz(iteta,jzeta) * (-1)**is + Ax = zero; Ay = zero; Az = zero + select case (coil(icoil)%type) + case(1) + ! Fourier coils + do kseg = 0, coil(icoil)%NS-1 + dlx = xx - coil(icoil)%xx(kseg) + dly = yy - coil(icoil)%yy(kseg) + dlz = zz - coil(icoil)%zz(kseg) + rm = 1.0 / sqrt(dlx**2 + dly**2 + dlz**2) + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + Ax = Ax + ltx * rm * coil(icoil)%dd(kseg) + Ay = Ay + lty * rm * coil(icoil)%dd(kseg) + Az = Az + ltz * rm * coil(icoil)%dd(kseg) + enddo ! enddo kseg + case default + FATAL(bpotential0, .true., not supported coil types) + end select + ! sum all the contributions + tAx = tAx + (Ax*cosnfp(ip) - Ay*sinnfp(ip))*(-1)**is + tAy = tAy + (Ay*cosnfp(ip) + Ax*sinnfp(ip)) + tAz = tAz + Az + enddo + enddo return @@ -295,7 +311,7 @@ end subroutine bpotential0 !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! -subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) +subroutine bpotential1(icoil, iteta, jzeta, tAx, tAy, tAz, ND) !------------------------------------------------------------------------------------------------------ ! DATE: 06/15/2017 ! calculate the magnetic potential and its 1st derivatives from coil(icoil) at the evaluation point; @@ -308,12 +324,13 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) implicit none INTEGER, intent(in ) :: icoil, iteta, jzeta, ND - REAL, dimension(1:1, 1:ND), intent(inout) :: Ax, Ay, Az + REAL, dimension(1:1, 1:ND), intent(inout) :: tAx, tAy, tAz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! INTEGER :: ierr, astat, kseg, NS, isurf, ip, is, cs, Npc - REAL :: dlx, dly, dlz, r, rm3, ltx, lty, ltz + REAL :: dlx, dly, dlz, r, rm3, ltx, lty, ltz, xx, yy, zz + REAL, dimension(1:1, 1:ND) :: Ax, Ay, Az REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dAxx, dAxy, dAxz, dAyx, dAyy, dAyz, dAzx, dAzy, dAzz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! @@ -322,43 +339,67 @@ subroutine bpotential1(icoil, iteta, jzeta, Ax, Ay, Az, ND) FATAL( bpotential1, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bpotential1, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) FATAL( bpotential1, ND <= 0, wrong inout dimension of ND ) + + ! initialization + Npc = 1 ; cs = 0 + tAx = zero ; tAy = zero ; tAz = zero + dlx = zero ; dly = zero ; dlz = zero + ltx = zero ; lty = zero ; ltz = zero + ! check if the coil is stellarator symmetric + select case (coil(icoil)%symm) + case ( 0 ) + cs = 0 + Npc = 1 + case ( 1 ) + cs = 0 + Npc = Nfp + case ( 2) + cs = 1 + Npc = Nfp + end select NS = coil(icoil)%NS - - dlx = zero; ltx = zero; Ax = zero - dly = zero; lty = zero; Ay = zero - dlz = zero; ltz = zero; Az = zero - - do kseg = 0, NS-1 - - dlx = surf(isurf)%xx(iteta,jzeta) - coil(icoil)%xx(kseg) - dly = surf(isurf)%yy(iteta,jzeta) - coil(icoil)%yy(kseg) - dlz = surf(isurf)%zz(iteta,jzeta) - coil(icoil)%zz(kseg) - - r = sqrt(dlx**2 + dly**2 + dlz**2); rm3 = r**(-3) - - ltx = coil(icoil)%xt(kseg) - lty = coil(icoil)%yt(kseg) - ltz = coil(icoil)%zt(kseg) - - dAxx(1,kseg) = - (dly*lty + dlz*ltz) * rm3 * coil(icoil)%dd(kseg) !Ax/x - dAxy(1,kseg) = dly*ltx * rm3 * coil(icoil)%dd(kseg) !Ax/y - dAxz(1,kseg) = dlz*ltx * rm3 * coil(icoil)%dd(kseg) !Ax/z - - dAyx(1,kseg) = dlx*lty * rm3 * coil(icoil)%dd(kseg) !Ay/x - dAyy(1,kseg) = - (dlx*ltx + dlz*ltz) * rm3 * coil(icoil)%dd(kseg) !Ay/y - dAyz(1,kseg) = dlz*lty * rm3 * coil(icoil)%dd(kseg) !Ay/z - - dAzx(1,kseg) = dlx*ltz * rm3 * coil(icoil)%dd(kseg) !Az/x - dAzy(1,kseg) = dly*ltz * rm3 * coil(icoil)%dd(kseg) !Az/y - dAzz(1,kseg) = - (dlx*ltx + dly*lty) * rm3 * coil(icoil)%dd(kseg) !Az/z - - enddo ! enddo kseg - - Ax(1:1, 1:ND) = matmul(dAxx, DoF(icoil)%xof) + matmul(dAxy, DoF(icoil)%yof) + matmul(dAxz, DoF(icoil)%zof) - Ay(1:1, 1:ND) = matmul(dAyx, DoF(icoil)%xof) + matmul(dAyy, DoF(icoil)%yof) + matmul(dAyz, DoF(icoil)%zof) - Az(1:1, 1:ND) = matmul(dAzx, DoF(icoil)%xof) + matmul(dAzy, DoF(icoil)%yof) + matmul(dAzz, DoF(icoil)%zof) - + ! periodicity and stellarator symmetry + do ip = 1, Npc + do is = 0, cs + ! find the point on plasma by rotating in reverse direction. + symmetric + xx = ( surf(isurf)%xx(iteta,jzeta)*cosnfp(ip) + surf(isurf)%yy(iteta,jzeta)*sinnfp(ip) ) + yy = (-surf(isurf)%xx(iteta,jzeta)*sinnfp(ip) + surf(isurf)%yy(iteta,jzeta)*cosnfp(ip) ) * (-1)**is + zz = surf(isurf)%zz(iteta,jzeta) * (-1)**is + Ax = zero; Ay = zero; Az = zero + select case (coil(icoil)%type) + case(1) + ! Fourier coils + do kseg = 0, NS-1 + dlx = xx - coil(icoil)%xx(kseg) + dly = yy - coil(icoil)%yy(kseg) + dlz = zz - coil(icoil)%zz(kseg) + r = sqrt(dlx**2 + dly**2 + dlz**2); rm3 = r**(-3) + ltx = coil(icoil)%xt(kseg) + lty = coil(icoil)%yt(kseg) + ltz = coil(icoil)%zt(kseg) + dAxx(1,kseg) = - (dly*lty + dlz*ltz) * rm3 * coil(icoil)%dd(kseg) !Ax/x + dAxy(1,kseg) = dly*ltx * rm3 * coil(icoil)%dd(kseg) !Ax/y + dAxz(1,kseg) = dlz*ltx * rm3 * coil(icoil)%dd(kseg) !Ax/z + dAyx(1,kseg) = dlx*lty * rm3 * coil(icoil)%dd(kseg) !Ay/x + dAyy(1,kseg) = - (dlx*ltx + dlz*ltz) * rm3 * coil(icoil)%dd(kseg) !Ay/y + dAyz(1,kseg) = dlz*lty * rm3 * coil(icoil)%dd(kseg) !Ay/z + dAzx(1,kseg) = dlx*ltz * rm3 * coil(icoil)%dd(kseg) !Az/x + dAzy(1,kseg) = dly*ltz * rm3 * coil(icoil)%dd(kseg) !Az/y + dAzz(1,kseg) = - (dlx*ltx + dly*lty) * rm3 * coil(icoil)%dd(kseg) !Az/z + enddo ! enddo kseg + Ax(1:1, 1:ND) = matmul(dAxx, DoF(icoil)%xof) + matmul(dAxy, DoF(icoil)%yof) + matmul(dAxz, DoF(icoil)%zof) + Ay(1:1, 1:ND) = matmul(dAyx, DoF(icoil)%xof) + matmul(dAyy, DoF(icoil)%yof) + matmul(dAyz, DoF(icoil)%zof) + Az(1:1, 1:ND) = matmul(dAzx, DoF(icoil)%xof) + matmul(dAzy, DoF(icoil)%yof) + matmul(dAzz, DoF(icoil)%zof) + case default + FATAL(bpotential1, .true., not supported coil types) + end select + ! sum all the contributions + tAx = tAx + (Ax*cosnfp(ip) - Ay*sinnfp(ip))*(-1)**is + tAy = tAy + (Ay*cosnfp(ip) + Ax*sinnfp(ip)) + tAz = tAz + Az + enddo + enddo return end subroutine bpotential1 From 3661c82b6fdcdf21dc4588aed26836423edb1bfa Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Tue, 21 Jan 2020 23:05:38 -0500 Subject: [PATCH 63/72] write full coils; revise coil-coil distance; bug might still exist --- sources/diagnos.f90 | 20 +++++++++++++------- sources/saving.f90 | 32 ++++++++++++++++++++++++++------ 2 files changed, 39 insertions(+), 13 deletions(-) diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index 809e8d3..f8b7df2 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -98,13 +98,19 @@ SUBROUTINE diagnos if (itmp == icoil .or. coil(icoil)%type /= 1) cycle SALLOCATE(Btmp, (1:3,0:coil(itmp )%NS-1), zero) ! check if the coil is stellarator symmetric - if (coil(icoil)%symm == 2) then - cs = 1 - else - cs = 0 - endif - ! load data - do ip = 1, Nfp + select case (coil(icoil)%symm) + case ( 0 ) + cs = 0 + Npc = 1 + case ( 1 ) + cs = 0 + Npc = Nfp + case ( 2) + cs = 1 + Npc = Nfp + end select + ! periodicity and stellarator symmetry + do ip = 1, Npc do is = 0, cs Btmp(1, 0:coil(itmp)%NS-1) = (coil(itmp)%xx(0:coil(itmp)%NS-1)*cosnfp(ip) & & - coil(itmp)%yy(0:coil(itmp)%NS-1)*sinnfp(ip) ) diff --git a/sources/saving.f90 b/sources/saving.f90 index 323383b..a643c68 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -26,7 +26,7 @@ subroutine saving !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - INTEGER :: ii, jj, icoil, NF + INTEGER :: ii, jj, icoil, NF, ip, is, cs, Npc ! the following are used by the macros HWRITEXX below; do not alter/remove; INTEGER :: hdfier, rank @@ -267,12 +267,32 @@ subroutine saving write(funit,'("begin filament")') write(funit,'("mirror NIL")') do icoil = 1, Ncoils - do ii = 0, coil(icoil)%NS-1 - write(funit,1010) coil(icoil)%xx(ii), coil(icoil)%yy(ii), coil(icoil)%zz(ii), coil(icoil)%I + ! check if the coil is stellarator symmetric + select case (coil(icoil)%symm) + case ( 0 ) + cs = 0 + Npc = 1 + case ( 1 ) + cs = 0 + Npc = Nfp + case ( 2) + cs = 1 + Npc = Nfp + end select + ! periodicity and stellarator symmetry + do ip = 1, Npc + do is = 0, cs + do ii = 0, coil(icoil)%NS-1 + write(funit,1010) coil(icoil)%xx(ii)*cosnfp(ip)-coil(icoil)%yy(ii)*sinnfp(ip), & + & (-1)**is*(coil(icoil)%xx(ii)*sinnfp(ip)+coil(icoil)%yy(ii)*cosnfp(ip)), & + & (-1)**is*coil(icoil)%zz(ii), coil(icoil)%I + enddo + ii = 0 + write(funit,1010) coil(icoil)%xx(ii)*cosnfp(ip)-coil(icoil)%yy(ii)*sinnfp(ip), & + & (-1)**is*(coil(icoil)%xx(ii)*sinnfp(ip)+coil(icoil)%yy(ii)*cosnfp(ip)),& + & (-1)**is*coil(icoil)%zz(ii), zero, icoil, coil(icoil)%name + enddo enddo - ii = 0 - write(funit,1010) coil(icoil)%xx(ii), coil(icoil)%yy(ii), coil(icoil)%zz(ii), & - zero, icoil, coil(icoil)%name enddo write(funit,'("end")') close(funit) From ee3eec69527dfed414efacb64c6129aedb906132 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 22 Jan 2020 09:28:52 -0500 Subject: [PATCH 64/72] fix un-declared Npc; fix latex comments --- sources/diagnos.f90 | 2 +- sources/initial.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/sources/diagnos.f90 b/sources/diagnos.f90 index f8b7df2..59a5d0c 100644 --- a/sources/diagnos.f90 +++ b/sources/diagnos.f90 @@ -12,7 +12,7 @@ SUBROUTINE diagnos use mpi implicit none - INTEGER :: icoil, itmp, astat, ierr, NF, idof, i, j, isurf, cs, ip, is + INTEGER :: icoil, itmp, astat, ierr, NF, idof, i, j, isurf, cs, ip, is, Npc LOGICAL :: lwbnorm, l_raw REAL :: MaxCurv, AvgLength, MinCCdist, MinCPdist, tmp_dist, ReDot, ImDot REAL, parameter :: infmax = 1.0E6 diff --git a/sources/initial.f90 b/sources/initial.f90 index 0a1c9aa..101c6d6 100644 --- a/sources/initial.f90 +++ b/sources/initial.f90 @@ -71,8 +71,8 @@ !latex \item \inputvar{case\_init = 0} \\ !latex \textit{Specify the initializing method for coils, seen in \link{rdcoils}} \\ !latex \bi \vspace{-5mm} -!latex \item[-1:] read the standard MAKEGRID format coils from \inputvar{input_coils}; -!latex \item[0:] read FOCUS format data from \inputvar{input_coils}; +!latex \item[-1:] read the standard MAKEGRID format coils from \inputvar{input\_coils}; +!latex \item[0:] read FOCUS format data from \inputvar{input\_coils}; !latex \item[1:] toroidally spaced \inputvar{Ncoils} circular coils with radius of \inputvar{init\_radius}; !latex \item[2:] toroidally spaced \inputvar{Ncoils}-1 magnetic dipoles pointing poloidallly on the toroidal surface !latex with radius of \inputvar{init\_radius} and a central infinitely long current. From aac14ffabe62ead824d5de50299611e2cfbc2c4c Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 22 Jan 2020 10:38:52 -0500 Subject: [PATCH 65/72] fix unassigned value for isurf in torflux.f90 --- sources/torflux.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/torflux.f90 b/sources/torflux.f90 index f434ec8..1e27e01 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -334,7 +334,7 @@ subroutine bpotential1(icoil, iteta, jzeta, tAx, tAy, tAz, ND) REAL, dimension(1:1, 0:coil(icoil)%NS-1) :: dAxx, dAxy, dAxz, dAyx, dAyy, dAyz, dAzx, dAzy, dAzz !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! - + isurf = plasma FATAL( bpotential1, icoil .lt. 1 .or. icoil .gt. Ncoils, icoil not in right range ) FATAL( bpotential1, iteta .lt. 0 .or. iteta .gt. Nteta , iteta not in right range ) FATAL( bpotential1, jzeta .lt. 0 .or. jzeta .gt. Nzeta , jzeta not in right range ) From d3c9e88cd28d693676de2ff58e9d9ba9c6c79a27 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Wed, 22 Jan 2020 22:18:39 -0500 Subject: [PATCH 66/72] fix typo in checking coil_symm --- sources/rdcoils.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/rdcoils.f90 b/sources/rdcoils.f90 index b745ae0..1693439 100644 --- a/sources/rdcoils.f90 +++ b/sources/rdcoils.f90 @@ -204,7 +204,7 @@ subroutine rdcoils read( runit,*) read( runit,*) coil(icoil)%type, coil(icoil)%symm, coil(icoil)%name FATAL( rdcoils04, coil(icoil)%type < 1 .or. coil(icoil)%type > 3, illegal ) - FATAL( rdcoils05, coil(icoil)%symm < 0 .or. coil(icoil)%type > 2, illegal ) + FATAL( rdcoils05, coil(icoil)%symm < 0 .or. coil(icoil)%symm > 2, illegal ) if(coil(icoil)%type == 1) then ! Fourier representation read( runit,*) read( runit,*) coil(icoil)%NS, coil(icoil)%I, coil(icoil)%Ic, & From c6048e9f36fa84bd283c8974672dd388a21711b3 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 23 Jan 2020 09:58:08 -0500 Subject: [PATCH 67/72] fix bug in computing the volume --- sources/rdsurf.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index 28b3ebf..3ce2a62 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -266,15 +266,16 @@ subroutine fousurf(filename, index) surf(index)%nz(ii,jj) = ds(3) / dd surf(index)%ds(ii,jj) = dd ! using Gauss theorom; V = \int_S x \cdot n dt dz - surf(index)%vol = surf(index)%vol + surf(index)%xx(ii,jj) * ds(1) + surf(index)%vol = surf(index)%vol + surf(index)%xx(ii,jj) * ds(1) & + & + surf(index)%yy(ii,jj) * ds(2) + surf(index)%zz(ii,jj) * ds(3) ! surface area surf(index)%area = surf(index)%area + surf(index)%ds(ii,jj) enddo ! end of do jj; 14 Apr 16; enddo ! end of do ii; 14 Apr 16; ! print volume and area - surf(index)%vol = abs(surf(index)%vol ) * (pi2/surf(index)%Nteta) * (pi2/surf(index)%Nzeta) - surf(index)%area = abs(surf(index)%area) * (pi2/surf(index)%Nteta) * (pi2/surf(index)%Nzeta) + surf(index)%vol = abs(surf(index)%vol)/3 * (pi2/surf(index)%Nteta) * (pi2/surf(index)%Nzeta) + surf(index)%area = abs(surf(index)%area) * (pi2/surf(index)%Nteta) * (pi2/surf(index)%Nzeta) if (index == plasma) then surf(index)%vol = surf(index)%vol * Nfp * 2**symmetry surf(index)%area = surf(index)%area * Nfp * 2**symmetry From cff3b407ac24a9a5f9f946e4bade5a3daec59c19 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 23 Jan 2020 10:04:06 -0500 Subject: [PATCH 68/72] fix errors when trying to write makegrid coils --- sources/saving.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sources/saving.f90 b/sources/saving.f90 index a643c68..797a43a 100644 --- a/sources/saving.f90 +++ b/sources/saving.f90 @@ -267,6 +267,8 @@ subroutine saving write(funit,'("begin filament")') write(funit,'("mirror NIL")') do icoil = 1, Ncoils + ! will only write x,y,z in cartesian coordinates + if (coil(icoil)%type /= 1) cycle ! check if the coil is stellarator symmetric select case (coil(icoil)%symm) case ( 0 ) From 1a9233fce9747d94d81c73adb670996c63f5b633 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 23 Jan 2020 10:22:40 -0500 Subject: [PATCH 69/72] half-fix length constraint for LM --- sources/length.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sources/length.f90 b/sources/length.f90 index 1dc0101..e68a965 100644 --- a/sources/length.f90 +++ b/sources/length.f90 @@ -78,7 +78,7 @@ subroutine length(ideriv) do icoil = 1, Ncoils !only care about unique coils; - if(coil(icoil)%type .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) cycle ! only for Fourier !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; call LenDeriv0(icoil, coil(icoil)%L) !RlBCAST( coil(icoil)%L, 1, modulo(icoil-1,ncpu) ) !broadcast each coil's length @@ -89,7 +89,7 @@ subroutine length(ideriv) if (case_length == 1) then ! quadratic; do icoil = 1, Ncoils - if(coil(icoil)%type .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) cycle ! only for Fourier if ( coil(icoil)%Lc /= 0 ) then ttlen = ttlen + half * (coil(icoil)%L - coil(icoil)%Lo)**2 / coil(icoil)%Lo**2 if (mttlen > 0) then ! L-M format of targets @@ -100,7 +100,7 @@ subroutine length(ideriv) enddo elseif (case_length == 2) then ! exponential; do icoil = 1, Ncoils - if(coil(icoil)%type .ne. 1) exit ! only for Fourier + if(coil(icoil)%type .ne. 1) cycle ! only for Fourier if ( coil(icoil)%Lc /= 0 ) then ttlen = ttlen + exp(coil(icoil)%L) / exp(coil(icoil)%Lo) if (mttlen > 0) then ! L-M format of targets From a049d7ceafcaa99c8f5b2dbe10718cccfdfa7775 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Thu, 23 Jan 2020 14:13:52 -0500 Subject: [PATCH 70/72] fix bug in using LM for length --- examples/rotating_ellipse/ellipse.input | 12 ++--- sources/length.f90 | 66 +++++++++---------------- sources/rdcoils.f90 | 6 ++- sources/surfsep.f90 | 33 +++++++------ 4 files changed, 51 insertions(+), 66 deletions(-) diff --git a/examples/rotating_ellipse/ellipse.input b/examples/rotating_ellipse/ellipse.input index 208bfd6..a3d6500 100644 --- a/examples/rotating_ellipse/ellipse.input +++ b/examples/rotating_ellipse/ellipse.input @@ -13,21 +13,21 @@ Ncoils = 4 ! number of coils; only valid when case_init = 1 init_current = 1.000D+06 ! initial coil currents (Amper); only valid when case_init = 1 init_radius = 0.500D+00 ! initial coil radius (meter); only valid when case_init = 1 - IsVaryCurrent = 1 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus + IsVaryCurrent = 0 ! 0: all the currents fixed; 1: currents can be changed; overwritten by ext.focus IsVaryGeometry = 1 ! 0: all the geometries fixed; 1: geometries can be changed; overwritten by ext.focus NFcoil = 4 ! number of Fourier harmonics representing the coils; overwritten by ext.focus Nseg = 128 ! number of coil segments for discretizing; overwritten by ext.focus IsNormalize = 1 ! 0: do not normalize coil parameters; 1: normalize; I = I/I0, x = x/R0; I0 & R0 are quadrtic mean values. IsNormWeight = 1 ! 0: do not normalize the weights; 1: normalize the weights - case_bnormal = 1 ! 0: keep raw Bn error; 1: Bn residue normalized to local |B| + case_bnormal = 0 ! 0: keep raw Bn error; 1: Bn residue normalized to local |B| case_length = 1 ! 1: quadratic format, converging the target length; 2: exponential format, as short as possible weight_bnorm = 1.000D+02 ! weight for real space Bn errors weight_bharm = 0.000D+00 ! weight for Bnm harmonic errors weight_tflux = 0.000D+00 ! weight for toroidal flux error target_tflux = 0.000D+00 ! target for the toroidal flux - weight_ttlen = 0.100D-02 ! weight for coil length error - target_length = 5.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length + weight_ttlen = 1.000D+01 ! weight for coil length error + target_length = 7.000D+00 ! target value (or for normalization) of the coils length, if zero, automatically set to initial actual length weight_specw = 0.000D+00 ! weight for spectral condensation error weight_cssep = 0.010D+00 ! weight for coil-surface separation constraint weight_inorm = 1.000D+00 ! weight for normalization of current. Larger weight makes the derivatives more important. @@ -41,12 +41,12 @@ DF_tausta = 0.000D+00 ! starting value of τ. Usually 0.0 is a good idea DF_tauend = 1.000D-00 ! ending value of τ. The larger value of τend − τsta, the more optimized - CG_maxiter = 20 ! maximum iterations allowed for using Conjugate Gradient (CG) + CG_maxiter = 10 ! maximum iterations allowed for using Conjugate Gradient (CG) CG_xtol = 1.000D-08 ! the stopping criteria of finding minimum; if |dχ2/dX| < CG xtol, exit the optimization CG_wolfe_c1 = 0.1 ! c1 value in the strong wolfe condition for line search, (0.0, 0.5) CG_wolfe_c2 = 0.9 ! c2 value in the strong wolfe condition for line search; 0 < c1 < c2 < 1 - LM_maxiter = 0 ! maximum iterations allowed for using Levenberg-Marquard (LM) + LM_maxiter = 5 ! maximum iterations allowed for using Levenberg-Marquard (LM) LM_xtol = 1.000D-08 ! if the relative error between two consecutivec iterates is at most xtol, the optimization terminates LM_ftol = 1.000D-08 ! if both the actual and predicted relative reductions in the sum of squares are at most ftol, the optimization terminates; LM_factor = 100.0 ! the initial step bound, which is set to the product of factor and the euclidean norm of diag*x if nonzero diff --git a/sources/length.f90 b/sources/length.f90 index e68a965..c603195 100644 --- a/sources/length.f90 +++ b/sources/length.f90 @@ -73,69 +73,49 @@ subroutine length(ideriv) !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! ttlen = zero + ivec = 1 if( ideriv >= 0 ) then - do icoil = 1, Ncoils !only care about unique coils; - - if(coil(icoil)%type .ne. 1) cycle ! only for Fourier - !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; - call LenDeriv0(icoil, coil(icoil)%L) - !RlBCAST( coil(icoil)%L, 1, modulo(icoil-1,ncpu) ) !broadcast each coil's length - - enddo - - ivec = 1 - - if (case_length == 1) then ! quadratic; - do icoil = 1, Ncoils - if(coil(icoil)%type .ne. 1) cycle ! only for Fourier - if ( coil(icoil)%Lc /= 0 ) then - ttlen = ttlen + half * (coil(icoil)%L - coil(icoil)%Lo)**2 / coil(icoil)%Lo**2 - if (mttlen > 0) then ! L-M format of targets - LM_fvec(ittlen+ivec) = weight_ttlen * (coil(icoil)%L - coil(icoil)%Lo) - ivec = ivec + 1 - endif - endif - enddo - elseif (case_length == 2) then ! exponential; - do icoil = 1, Ncoils - if(coil(icoil)%type .ne. 1) cycle ! only for Fourier + if(coil(icoil)%type == 1) then ! only for Fourier + !if( myid.ne.modulo(icoil-1,ncpu) ) cycle ! parallelization loop; + call LenDeriv0(icoil, coil(icoil)%L) + !RlBCAST( coil(icoil)%L, 1, modulo(icoil-1,ncpu) ) !broadcast each coil's length if ( coil(icoil)%Lc /= 0 ) then - ttlen = ttlen + exp(coil(icoil)%L) / exp(coil(icoil)%Lo) - if (mttlen > 0) then ! L-M format of targets - LM_fvec(ittlen+ivec) = weight_ttlen * exp(coil(icoil)%L) / exp(coil(icoil)%Lo) - ivec = ivec + 1 - endif - endif - enddo - else - FATAL( length, .true. , invalid case_length option ) - end if - + if (case_length == 1) then ! quadratic; + ttlen = ttlen + half * (coil(icoil)%L - coil(icoil)%Lo)**2 / coil(icoil)%Lo**2 + if (mttlen > 0) then ! L-M format of targets + LM_fvec(ittlen+ivec) = weight_ttlen * (coil(icoil)%L - coil(icoil)%Lo) + ivec = ivec + 1 + endif + elseif (case_length == 2) then ! exponential; + ttlen = ttlen + exp(coil(icoil)%L) / exp(coil(icoil)%Lo) + if (mttlen > 0) then ! L-M format of targets + LM_fvec(ittlen+ivec) = weight_ttlen * exp(coil(icoil)%L) / exp(coil(icoil)%Lo) + ivec = ivec + 1 + endif + else + FATAL( length, .true. , invalid case_length option ) + end if + endif + endif + enddo if (mttlen > 0) then ! L-M format of targets FATAL( length, ivec == mttlen, Errors in counting ivec for L-M ) endif - ttlen = ttlen / (Ncoils - Nfixgeo + machprec) - endif !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! if ( ideriv >= 1 ) then - t1L = zero ; d1L = zero ; norm = zero - idof = 0 ; ivec = 1 do icoil = 1, Ncoils - ND = DoF(icoil)%ND - if ( coil(icoil)%Ic /= 0 ) then !if current is free; idof = idof +1 endif - if ( coil(icoil)%Lc /= 0 ) then !if geometry is free; if(coil(icoil)%type .eq. 1) then ! only for Fourier ! calculate normalization diff --git a/sources/rdcoils.f90 b/sources/rdcoils.f90 index 1693439..ba7691b 100644 --- a/sources/rdcoils.f90 +++ b/sources/rdcoils.f90 @@ -284,14 +284,16 @@ subroutine rdcoils RlBCAST( coil(icoil)%mt, 1 , 0 ) RlBCAST( coil(icoil)%mp, 1 , 0 ) if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 - if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + ! if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + Nfixgeo = Nfixgeo + 1 ! always treat as a fixed geometry else if (coil(icoil)%type == 3) then ! backgroud toroidal/vertical field IlBCAST( coil(icoil)%Ic, 1 , 0 ) RlBCAST( coil(icoil)%I , 1 , 0 ) IlBCAST( coil(icoil)%Lc, 1 , 0 ) RlBCAST( coil(icoil)%Bz, 1 , 0 ) if(coil(icoil)%Ic == 0) Nfixcur = Nfixcur + 1 - if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + ! if(coil(icoil)%Lc == 0) Nfixgeo = Nfixgeo + 1 + Nfixgeo = Nfixgeo + 1 ! always treat as a fixed geometry else STOP " wrong coil type in rdcoils" call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) diff --git a/sources/surfsep.f90 b/sources/surfsep.f90 index 516b234..164f646 100644 --- a/sources/surfsep.f90 +++ b/sources/surfsep.f90 @@ -96,6 +96,7 @@ SUBROUTINE surfsep(ideriv) if( ideriv >= 0 ) then ivec = 1 do icoil = 1, Ncoils + if (coil(icoil)%type /= 1) cycle ! skip for other coils coilsum = zero if ( coil(icoil)%Lc /= 0 ) then do jzeta = 0, Nzeta - 1 @@ -139,21 +140,23 @@ SUBROUTINE surfsep(ideriv) endif if ( coil(icoil)%Lc /= 0 ) then ! if geometry is free; - do jzeta = 0, Nzeta - 1 - do iteta = 0, Nteta - 1 - if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; - call CSPotential1(icoil, iteta, jzeta, d1S(idof+1:idof+ND), ND) - l1S(idof+1:idof+ND) = l1S(idof+1:idof+ND) + d1S(idof+1:idof+ND) * surf(psurf)%ds(iteta, jzeta) - enddo ! end do iteta - enddo ! end do jzeta - call MPI_BARRIER( MPI_COMM_WORLD, ierr ) - call MPI_REDUCE( l1S, jac(icoil, 1:Ndof), Ndof, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) - RlBCAST( jac(icoil, 1:Ndof), Ndof, 0 ) - ! L-M format of targets - if (mcssep > 0) LM_fjac(ivec, 1:Ndof) = weight_cssep * jac(icoil, 1:Ndof) - idof = idof + ND - ivec = ivec + 1 - endif + if (coil(icoil)%type /= 1) then ! skip for other coils + do jzeta = 0, Nzeta - 1 + do iteta = 0, Nteta - 1 + if( myid.ne.modulo(jzeta*Nteta+iteta,ncpu) ) cycle ! parallelization loop; + call CSPotential1(icoil, iteta, jzeta, d1S(idof+1:idof+ND), ND) + l1S(idof+1:idof+ND) = l1S(idof+1:idof+ND) + d1S(idof+1:idof+ND) * surf(psurf)%ds(iteta, jzeta) + enddo ! end do iteta + enddo ! end do jzeta + call MPI_BARRIER( MPI_COMM_WORLD, ierr ) + call MPI_REDUCE( l1S, jac(icoil, 1:Ndof), Ndof, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr ) + RlBCAST( jac(icoil, 1:Ndof), Ndof, 0 ) + ! L-M format of targets + if (mcssep > 0) LM_fjac(ivec, 1:Ndof) = weight_cssep * jac(icoil, 1:Ndof) + ivec = ivec + 1 + endif + idof = idof + ND ! ND should be zero if Lc==0 + endif enddo ! end do icoil FATAL( surfsep , idof .ne. Ndof, counting error in packing ) From 6780a2908350045525fab7f6142b01e9be283e66 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 3 Feb 2020 16:25:45 -0500 Subject: [PATCH 71/72] add analytical expression for inifinite long wire --- examples/rotating_ellipse/ellipse.focus | 58 ------------------------- sources/torflux.f90 | 11 ++++- 2 files changed, 9 insertions(+), 60 deletions(-) delete mode 100644 examples/rotating_ellipse/ellipse.focus diff --git a/examples/rotating_ellipse/ellipse.focus b/examples/rotating_ellipse/ellipse.focus deleted file mode 100644 index ff1f599..0000000 --- a/examples/rotating_ellipse/ellipse.focus +++ /dev/null @@ -1,58 +0,0 @@ - # Total number of coils - 4 - #----------------- 1 --------------------------- - #coil_type coil_symm coil_name - 1 2 Mod_001 - #Nseg current Ifree Length Lfree target_length - 128 1.009811647172201E+06 1 8.670769764879882E+00 1 5.000000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 3.060954863802166E+00 1.310254825066786E+00 1.071765871853575E-01 -1.120043816175074E-01 -1.520286072710724E-02 - 0.000000000000000E+00 9.810788125646671E-03 4.065115131685829E-02 4.559037701826145E-02 -4.071928591958048E-03 - 6.106840692922476E-01 2.443673607509968E-01 -5.149696668322107E-02 -2.671241706618427E-02 3.038351252326858E-02 - 0.000000000000000E+00 -8.619249228138577E-02 -1.687729013376058E-01 -3.046585765489713E-03 3.878698675740049E-02 - 2.542842340799642E-02 -7.558796236777470E-03 -1.412396858823538E-02 -5.744816005982935E-02 -2.716859514842065E-03 - 0.000000000000000E+00 1.295916257700958E+00 8.161932730997404E-02 -1.281728144546573E-01 -7.864767225451891E-03 - #----------------- 2 --------------------------- - #coil_type coil_symm coil_name - 1 2 Mod_002 - #Nseg current Ifree Length Lfree target_length - 128 1.000934843583982E+06 1 8.646814639774334E+00 1 5.000000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 2.591039474744833E+00 1.119083580235844E+00 1.763932894682944E-01 -3.850563986364065E-02 -2.321904514718601E-02 - 0.000000000000000E+00 1.789304409269933E-03 5.214288348378480E-02 9.859707440071824E-02 2.084761842767816E-02 - 1.736596659855606E+00 7.059339213835694E-01 -8.358551564924986E-02 -4.314421730932739E-02 2.838097220648132E-02 - 0.000000000000000E+00 -3.771894176537822E-02 -4.560491027332799E-02 5.683180127361215E-02 -1.631526037275912E-02 - 6.022014795231187E-02 -1.982376147463092E-02 -2.855959291933952E-02 -1.255668085436268E-01 -8.213306932623459E-03 - 0.000000000000000E+00 1.306003803055004E+00 9.917583500188788E-02 -4.287174650767827E-02 -3.235796030843676E-03 - #----------------- 3 --------------------------- - #coil_type coil_symm coil_name - 1 2 Mod_003 - #Nseg current Ifree Length Lfree target_length - 128 9.948908235802455E+05 1 8.621473283434842E+00 1 5.000000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 1.725483292101542E+00 7.507849844801009E-01 1.938412706935032E-01 3.972908073125690E-02 2.092579035804881E-02 - 0.000000000000000E+00 -4.529054472111800E-02 -4.887401181894353E-02 6.259390861075441E-02 3.018925039342284E-02 - 2.590809675965432E+00 1.067772746516816E+00 1.126636919133895E-03 2.442376205950504E-02 -1.059057602175693E-02 - 0.000000000000000E+00 4.076757537180798E-03 5.618278149077867E-02 1.052245687446653E-01 -1.011846548157847E-02 - 5.896970416337852E-02 -2.196346805257908E-02 -2.182018403978711E-02 -1.084433175182200E-01 -7.180231700278182E-03 - 0.000000000000000E+00 1.322462293184084E+00 1.121536610042754E-01 5.412783734366871E-02 4.141507709321130E-03 - #----------------- 4 --------------------------- - #coil_type coil_symm coil_name - 1 2 Mod_004 - #Nseg current Ifree Length Lfree target_length - 128 9.946545305238812E+05 1 8.608497474656698E+00 1 5.000000000000000E+00 - #NFcoil - 4 - #Fourier harmonics for coils ( xc; xs; yc; ys; zc; zs) - 6.040169668061979E-01 2.636207250904417E-01 8.568695014994318E-02 3.300213049748593E-02 2.784082935503811E-02 - 0.000000000000000E+00 -8.950259741234350E-02 -1.567838305464813E-01 -1.072621721864652E-02 -2.321936415783295E-02 - 3.047184005374481E+00 1.263139806640376E+00 1.006446548244153E-01 1.169900450991863E-01 2.614474340279832E-03 - 0.000000000000000E+00 7.975569107616570E-03 3.988898414060333E-02 5.621427092549287E-02 8.599805773917217E-03 - 2.404104588079173E-02 -9.788569523807458E-03 -7.323149156916673E-03 -4.017330361351994E-02 -1.773284223695257E-03 - 0.000000000000000E+00 1.334866623968677E+00 1.148802510600708E-01 1.070059161954770E-01 6.132575423488384E-03 diff --git a/sources/torflux.f90 b/sources/torflux.f90 index 1e27e01..0d7af3d 100644 --- a/sources/torflux.f90 +++ b/sources/torflux.f90 @@ -236,7 +236,7 @@ subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) ! Discretizing factor is includeed; coil(icoil)%dd(kseg) !------------------------------------------------------------------------------------------------------ use globals, only: dp, coil, surf, Ncoils, Nteta, Nzeta, & - zero, myid, ounit, plasma, Nfp, cosnfp, sinnfp + zero, myid, ounit, plasma, Nfp, cosnfp, sinnfp, two, bsconstant use mpi implicit none @@ -247,7 +247,7 @@ subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) INTEGER :: ierr, astat, kseg, isurf, ip, is, cs, Npc REAL :: dlx, dly, dlz, rm, ltx, lty, ltz, & - & Ax, Ay, Az, xx, yy, zz + & Ax, Ay, Az, xx, yy, zz, rr !-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-! isurf = plasma @@ -295,6 +295,11 @@ subroutine bpotential0(icoil, iteta, jzeta, tAx, tAy, tAz) Ay = Ay + lty * rm * coil(icoil)%dd(kseg) Az = Az + ltz * rm * coil(icoil)%dd(kseg) enddo ! enddo kseg + case(3) + ! central current and vertical field (zero contribution) + rr = sqrt( xx**2 + yy**2 ) + ! \vec A=-\frac{\mu_0I}{2\pi} \ln(r) \hat e_z + Az = -two*bsconstant*log(rr) case default FATAL(bpotential0, .true., not supported coil types) end select @@ -391,6 +396,8 @@ subroutine bpotential1(icoil, iteta, jzeta, tAx, tAy, tAz, ND) Ax(1:1, 1:ND) = matmul(dAxx, DoF(icoil)%xof) + matmul(dAxy, DoF(icoil)%yof) + matmul(dAxz, DoF(icoil)%zof) Ay(1:1, 1:ND) = matmul(dAyx, DoF(icoil)%xof) + matmul(dAyy, DoF(icoil)%yof) + matmul(dAyz, DoF(icoil)%zof) Az(1:1, 1:ND) = matmul(dAzx, DoF(icoil)%xof) + matmul(dAzy, DoF(icoil)%yof) + matmul(dAzz, DoF(icoil)%zof) + case(3) + continue case default FATAL(bpotential1, .true., not supported coil types) end select From 0316083180560eaac5a0118ba38daa39c202f732 Mon Sep 17 00:00:00 2001 From: Caoxiang Zhu Date: Mon, 3 Feb 2020 16:40:58 -0500 Subject: [PATCH 72/72] continue resolving the conflicts --- sources/rdsurf.f90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/sources/rdsurf.f90 b/sources/rdsurf.f90 index c34d7b6..4b55641 100644 --- a/sources/rdsurf.f90 +++ b/sources/rdsurf.f90 @@ -280,22 +280,7 @@ subroutine fousurf(filename, index) surf(index)%vol = surf(index)%vol * Nfp * 2**symmetry surf(index)%area = surf(index)%area * Nfp * 2**symmetry endif - - if (index == plasma) then - theta0 = 0.1_dp ; zeta0 = zero - call surfcoord(index, theta0, zeta0, r0, z0 ) - if (z0 > 0) then - ! counter-clockwise - if( myid == 0) write(ounit, '(8X": The theta angle used is counter-clockwise.")') - tflux_sign = -1 - else - ! clockwise - if( myid == 0) write(ounit, '(8X": The theta angle used is clockwise.")') - tflux_sign = 1 - endif - endif ->>>>>>> origin/develop if( myid == 0 .and. IsQuiet <= 0) then write(ounit, '(8X": Enclosed total surface volume ="ES12.5" m^3 ; area ="ES12.5" m^2." )') & surf(index)%vol, surf(index)%area